basis/json/reader/reader.factor

   1 ! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: arrays assocs combinators hashtables io io.streams.string
   5 json kernel make math math.parser prettyprint sequences strings
   6 vectors ;
   7
   8 IN: json.reader
   9
  10 <PRIVATE
  11
  12 : value ( char -- num char )
  13     1string " \t\r\n,:}]" read-until
  14     [ append string>number ] dip ;
  15
  16 DEFER: j-string%
  17
  18 : j-escape% ( -- )
  19     read1 {
  20         { CHAR: b [ 8 ] }
  21         { CHAR: f [ 12 ] }
  22         { CHAR: n [ CHAR: \n ] }
  23         { CHAR: r [ CHAR: \r ] }
  24         { CHAR: t [ CHAR: \t ] }
  25         { CHAR: u [ 4 read hex> ] }
  26         [ ]
  27     } case [ , j-string% ] when* ;
  28
  29 : j-string% ( -- )
  30     "\\\"" read-until [ % ] dip
  31     CHAR: \" = [ j-escape% ] unless ;
  32
  33 : j-string ( -- str )
  34     "\\\"" read-until CHAR: \" =
  35     [ [ % j-escape% ] "" make ] unless ;
  36
  37 : second-last ( seq -- second-last )
  38     [ length 2 - ] [ nth ] bi ; inline
  39
  40 ERROR: json-error ;
  41
  42 : check-length ( seq n -- seq )
  43     [ dup length ] [ >= ] bi* [ json-error ] unless ;
  44
  45 : v-over-push ( vec -- vec' )
  46     2 check-length dup [ pop ] [ last ] bi push ;
  47
  48 : v-pick-push ( vec -- vec' )
  49     3 check-length dup [ pop ] [ second-last ] bi push ;
  50
  51 : (close) ( accum -- accum' )
  52     dup last V{ } = not [ v-over-push ] when ;
  53
  54 : (close-array) ( accum -- accum' )
  55     (close) dup pop >array suffix! ;
  56
  57 : (close-hash) ( accum -- accum' )
  58     (close) dup dup [ pop ] bi@ swap zip >hashtable suffix! ;
  59
  60 : scan ( accum char -- accum )
  61     ! 2dup 1string swap . . ! Great for debug...
  62     {
  63         { CHAR: \" [ j-string suffix! ] }
  64         { CHAR: [  [ V{ } clone suffix! ] }
  65         { CHAR: ,  [ v-over-push ] }
  66         { CHAR: ]  [ (close-array) ] }
  67         { CHAR: {  [ 2 [ V{ } clone suffix! ] times ] }
  68         { CHAR: :  [ v-pick-push ] }
  69         { CHAR: }  [ (close-hash) ] }
  70         { CHAR: \s [ ] }
  71         { CHAR: \t [ ] }
  72         { CHAR: \r [ ] }
  73         { CHAR: \n [ ] }
  74         { CHAR: t  [ 3 read drop t suffix! ] }
  75         { CHAR: f  [ 4 read drop f suffix! ] }
  76         { CHAR: n  [ 3 read drop json-null suffix! ] }
  77         [ value [ suffix! ] dip [ scan ] when*  ]
  78     } case ;
  79
  80 PRIVATE>
  81
  82 : read-jsons ( -- objects )
  83     V{ } clone [ read1 dup ] [ scan ] while drop ;
  84
  85 : json> ( string -- object )
  86     [ read-jsons first ] with-string-reader ;