basis/json/writer/writer.factor

   1 ! Copyright (C) 2006 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel io.streams.string io strings splitting
   4 sequences math math.parser assocs classes words namespaces make
   5 prettyprint hashtables mirrors tr json ;
   6 IN: json.writer
   7
   8 #! Writes the object out to a stream in JSON format
   9 GENERIC: json-print ( obj -- )
  10
  11 : >json ( obj -- string )
  12     #! Returns a string representing the factor object in JSON format
  13     [ json-print ] with-string-writer ;
  14
  15 M: f json-print ( f -- )
  16     drop "false" write ;
  17
  18 M: t json-print ( t -- )
  19     drop "true" write ;
  20
  21 M: json-null json-print ( null -- )
  22     drop "null" write ;
  23
  24 M: string json-print ( obj -- )
  25     CHAR: " write1 "\"" split "\\\"" join CHAR: \r swap remove "\n" split "\\r\\n" join write CHAR: " write1 ;
  26
  27 M: integer json-print ( num -- )
  28     number>string write ;
  29
  30 M: real json-print ( num -- )
  31     >float number>string write ;
  32
  33 M: sequence json-print ( array -- )
  34     CHAR: [ write1 [ >json ] map "," join write CHAR: ] write1 ;
  35
  36 TR: jsvar-encode "-" "_" ;
  37
  38 : tuple>fields ( object -- seq )
  39     <mirror> [
  40         [ swap jsvar-encode >json % " : " % >json % ] "" make
  41     ] { } assoc>map ;
  42
  43 M: tuple json-print ( tuple -- )
  44     CHAR: { write1 tuple>fields "," join write CHAR: } write1 ;
  45
  46 M: hashtable json-print ( hashtable -- )
  47     CHAR: { write1
  48     [ [ swap jsvar-encode >json % CHAR: : , >json % ] "" make ]
  49     { } assoc>map "," join write
  50     CHAR: } write1 ;
  51
  52 M: word json-print name>> json-print ;