basis/json/reader/reader.factor

   1 ! Copyright (C) 2006 Chris Double.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel parser-combinators namespaces make sequences promises strings
   4        assocs math math.parser math.vectors math.functions math.order
   5        lists hashtables ascii accessors ;
   6 IN: json.reader
   7
   8 ! Grammar for JSON from RFC 4627
   9
  10 SYMBOL: json-null
  11
  12 : [<&>] ( quot -- quot )
  13   { } make unclip [ <&> ] reduce ;
  14
  15 : [<|>] ( quot -- quot )
  16   { } make unclip [ <|> ] reduce ;
  17
  18 LAZY: 'ws' ( -- parser )
  19   " " token
  20   "\n" token <|>
  21   "\r" token <|>
  22   "\t" token <|> <*> ;
  23
  24 LAZY: spaced ( parser -- parser )
  25   'ws' swap &> 'ws' <& ;
  26
  27 LAZY: 'begin-array' ( -- parser )
  28   "[" token spaced ;
  29
  30 LAZY: 'begin-object' ( -- parser )
  31   "{" token spaced ;
  32
  33 LAZY: 'end-array' ( -- parser )
  34   "]" token spaced ;
  35
  36 LAZY: 'end-object' ( -- parser )
  37   "}" token spaced ;
  38
  39 LAZY: 'name-separator' ( -- parser )
  40   ":" token spaced ;
  41
  42 LAZY: 'value-separator' ( -- parser )
  43   "," token spaced ;
  44
  45 LAZY: 'false' ( -- parser )
  46   "false" token [ drop f ] <@ ;
  47
  48 LAZY: 'null' ( -- parser )
  49   "null" token [ drop json-null ] <@ ;
  50
  51 LAZY: 'true' ( -- parser )
  52   "true" token [ drop t ] <@ ;
  53
  54 LAZY: 'quot' ( -- parser )
  55   "\"" token ;
  56
  57 LAZY: 'hex-digit' ( -- parser )
  58   [ digit> ] satisfy [ digit> ] <@ ;
  59
  60 : hex-digits>ch ( digits -- ch )
  61     0 [ swap 16 * + ] reduce ;
  62
  63 LAZY: 'string-char' ( -- parser )
  64   [ quotable? ] satisfy
  65   "\\b" token [ drop 8 ] <@ <|>
  66   "\\t" token [ drop CHAR: \t ] <@ <|>
  67   "\\n" token [ drop CHAR: \n ] <@ <|>
  68   "\\f" token [ drop 12 ] <@ <|>
  69   "\\r" token [ drop CHAR: \r ] <@ <|>
  70   "\\\"" token [ drop CHAR: " ] <@ <|>
  71   "\\/" token [ drop CHAR: / ] <@ <|>
  72   "\\\\" token [ drop CHAR: \\ ] <@ <|>
  73   "\\u" token 'hex-digit' 4 exactly-n &>
  74   [ hex-digits>ch ] <@ <|> ;
  75
  76 LAZY: 'string' ( -- parser )
  77   'quot'
  78   'string-char' <*> &>
  79   'quot' <& [ >string ] <@  ;
  80
  81 DEFER: 'value'
  82
  83 LAZY: 'member' ( -- parser )
  84   'string'
  85   'name-separator' <&
  86   'value' <&> ;
  87
  88 USE: prettyprint
  89 LAZY: 'object' ( -- parser )
  90   'begin-object'
  91   'member' 'value-separator' list-of &>
  92   'end-object' <& [ >hashtable ] <@ ;
  93
  94 LAZY: 'array' ( -- parser )
  95   'begin-array'
  96   'value' 'value-separator' list-of &>
  97   'end-array' <&  ;
  98
  99 LAZY: 'minus' ( -- parser )
 100   "-" token ;
 101
 102 LAZY: 'plus' ( -- parser )
 103   "+" token ;
 104
 105 LAZY: 'sign' ( -- parser )
 106   'minus' 'plus' <|> ;
 107
 108 LAZY: 'zero' ( -- parser )
 109   "0" token [ drop 0 ] <@ ;
 110
 111 LAZY: 'decimal-point' ( -- parser )
 112   "." token ;
 113
 114 LAZY: 'digit1-9' ( -- parser )
 115   [
 116     dup integer? [
 117       CHAR: 1 CHAR: 9 between?
 118     ] [
 119       drop f
 120     ] if
 121   ] satisfy [ digit> ] <@ ;
 122
 123 LAZY: 'digit0-9' ( -- parser )
 124   [ digit? ] satisfy [ digit> ] <@ ;
 125
 126 : decimal>integer ( seq -- num ) 10 digits>integer ;
 127
 128 LAZY: 'int' ( -- parser )
 129   'zero'
 130   'digit1-9' 'digit0-9' <*> <&:> [ decimal>integer ] <@ <|>  ;
 131
 132 LAZY: 'e' ( -- parser )
 133   "e" token "E" token <|> ;
 134
 135 : sign-number ( pair -- number )
 136   #! Pair is { minus? num }
 137   #! Convert the json number value to a factor number
 138   dup second swap first [ first "-" = [ -1 * ] when ] when* ;
 139
 140 LAZY: 'exp' ( -- parser )
 141     'e'
 142     'sign' <?> &>
 143     'digit0-9' <+> [ decimal>integer ] <@ <&> [ sign-number ] <@ ;
 144
 145 : sequence>frac ( seq -- num )
 146   #! { 1 2 3 } => 0.123
 147   reverse 0 [ swap 10 / + ] reduce 10 / >float ;
 148
 149 LAZY: 'frac' ( -- parser )
 150   'decimal-point' 'digit0-9' <+> &> [ sequence>frac ] <@ ;
 151
 152 : raise-to-power ( pair -- num )
 153   #! Pair is { num exp }.
 154   #! Multiply 'num' by 10^exp
 155   dup second dup [ 10 swap first ^ swap first * ] [ drop first ] if ;
 156
 157 LAZY: 'number' ( -- parser )
 158   'sign' <?>
 159   [ 'int' , 'frac' 0 succeed <|> , ] [<&>] [ sum ] <@
 160   'exp' <?> <&> [ raise-to-power ] <@ <&> [ sign-number ] <@ ;
 161
 162 LAZY: 'value' ( -- parser )
 163   [
 164     'false' ,
 165     'null' ,
 166     'true' ,
 167     'string' ,
 168     'object' ,
 169     'array' ,
 170     'number' ,
 171   ] [<|>] spaced ;
 172 ERROR: could-not-parse-json ;
 173
 174 : json> ( string -- object )
 175   #! Parse a json formatted string to a factor object
 176   'value' parse dup nil? [
 177       could-not-parse-json
 178   ] [
 179     car parsed>>
 180   ] if ;