fork download
copy 
  1. // (0) PUBLIC DOMAIN
  2. // To the extent possible under law, the person who associated CC0 with this work
  3. // has waived all copyright and related or neighboring rights to this work.
  4.  
  5. open System
  6. open System.IO
  7.  
  8. let parseTest parser src =
  9.     use sr = new StringReader(src)
  10.     try
  11.         printfn "%A" (parser sr)
  12.     with e ->
  13.         printfn "%s" e.Message
  14.  
  15. let anyChar (tr:TextReader) =
  16.     let ch = tr.Read()
  17.     if ch >= 0 then char ch else
  18.     failwith "anyChar: unexpected end of input"
  19.  
  20. parseTest anyChar "abc"
  21. parseTest anyChar ""
  22.  
  23. let plist list tr = [for p in list -> p tr]
  24.  
  25. parseTest (plist [anyChar; anyChar]) "abc"
  26. parseTest (plist [anyChar; anyChar]) "a"
  27.  
  28. let peek (tr:TextReader) =
  29.     let ch = tr.Peek()
  30.     if ch >= 0 then char ch else
  31.     failwith "peek: unexpected end of input"
  32.  
  33. parseTest (plist [anyChar; peek; anyChar]) "abc"
  34.  
  35. let isOneOf (s:string) (tr:TextReader) =
  36.     let ch = tr.Peek()
  37.     if ch = -1 || s.IndexOf(char ch) < 0 then false else
  38.     tr.Read() |> ignore
  39.     true
  40.  
  41. parseTest (isOneOf "ab") "abc"
  42. parseTest (isOneOf "ab") "def"
  43.  
  44. let oneOf (s:string) (tr:TextReader) =
  45.     let ch = tr.Peek()
  46.     if isOneOf s tr then char ch else
  47.     failwith <| sprintf "oneOf: '%c' is not in \"%s\"" (char ch) s
  48.  
  49. parseTest (oneOf "ab") "abc"
  50. parseTest (oneOf "ab") "def"
  51.  
  52. let many f (tr:TextReader) =
  53.     use sw = new StringWriter()
  54.     let rec g() =
  55.         let ch = tr.Peek()
  56.         if ch >= 0 && f (char ch) then
  57.             sw.Write(char ch)
  58.             tr.Read() |> ignore
  59.             g()
  60.     g()
  61.     sw.ToString()
  62.  
  63. parseTest (many Char.IsDigit) "123abc"
  64.  
  65. let isSpace (ch:char) = " \r\n\t".IndexOf ch >= 0
  66.  
  67. let rec spaces (tr:TextReader) =
  68.     let ch = tr.Peek()
  69.     if ch >= 0 && isSpace (char ch) then
  70.         tr.Read() |> ignore
  71.         spaces tr
  72.  
  73. let (@>>) a b = fun tr -> a tr |> ignore; b tr
  74. let (@<<) a b = fun tr -> let r = a tr in b tr |> ignore; r
  75.  
  76. parseTest (spaces @>> anyChar) "   123"
  77. parseTest (plist [anyChar @<< spaces; anyChar]) "1   23"
  78.  
  79. let jsonHex tr =
  80.     match anyChar tr with
  81.     | ch when '0' <= ch && ch <= '9' -> int ch - int '0'
  82.     | ch when 'A' <= ch && ch <= 'F' -> int ch - int 'A' + 10
  83.     | ch when 'a' <= ch && ch <= 'f' -> int ch - int 'a' + 10
  84.     | ch -> failwith <| sprintf "hexChar: '%c' is not hex char" ch
  85.  
  86. let jsonUnescape tr =
  87.     match anyChar tr with
  88.     | 'b' -> '\b'
  89.     | 't' -> '\t'
  90.     | 'n' -> '\n'
  91.     | 'v' -> char 11
  92.     | 'f' -> char 12
  93.     | 'r' -> '\r'
  94.     | 'x' -> (jsonHex tr <<<  4) ||| (jsonHex tr) |> char
  95.     | 'u' -> (jsonHex tr <<< 12) ||| (jsonHex tr <<< 8) |||
  96.              (jsonHex tr <<<  4) ||| (jsonHex tr) |> char
  97.     | ch  -> ch
  98.  
  99. let jsonString tr =
  100.     let start = oneOf "'\"" tr
  101.     use sw = new StringWriter()
  102.     let rec f() =
  103.         match anyChar tr with
  104.         | ch when ch = start -> ()
  105.         | '\\' -> sw.Write (jsonUnescape tr); f()
  106.         | ch -> sw.Write ch; f()
  107.     f()
  108.     sw.ToString()
  109.  
  110. parseTest jsonString "\"abc\""
  111. parseTest jsonString @"'a\\b\\c'"
  112. parseTest jsonString @"'A\x42\u0043'"
  113.  
  114. let rec jsonNumber tr =
  115.     if isOneOf "-" tr then "-" + jsonNumber tr else
  116.     let n1 = many Char.IsDigit tr
  117.     if not <| isOneOf "." tr then n1 else
  118.     n1 + "." + many Char.IsDigit tr
  119.  
  120. parseTest jsonNumber "123"
  121. parseTest jsonNumber "-3.14"
  122.  
  123. let jsonValue tr =
  124.     match peek tr with
  125.     | '\'' | '"' -> jsonString tr
  126.     | '-'        -> jsonNumber tr
  127.     | ch when Char.IsDigit  ch -> jsonNumber tr
  128.     | ch when Char.IsLetter ch -> many Char.IsLetterOrDigit tr
  129.     | ch -> failwith <| sprintf "jsonValue: unknown '%c'" ch
  130.  
  131. parseTest jsonValue "abc 456"
  132. parseTest jsonValue "-1,2"
  133.  
  134. let jsonParser (tr:TextReader) =
  135.     let rec value stack = seq {
  136.         match (spaces @>> peek) tr with
  137.         | '{' ->
  138.             while isOneOf "{," tr && (spaces @>> peek) tr <> '}' do
  139.                 match peek tr with
  140.                 | '\'' | '"' ->
  141.                     let name = (jsonString @<< spaces @<< oneOf ":") tr
  142.                     let ch = (spaces @>> peek) tr
  143.                     match ch with
  144.                     | '{' | '[' ->
  145.                         yield name, ch, "", stack
  146.                         yield! value (name::stack)
  147.                         yield name, (if ch = '{' then '}' else ']'), "", stack
  148.                     | _ ->
  149.                         yield name, ':', jsonValue tr, stack
  150.                 | ch ->
  151.                     failwith <| sprintf "jsonParser: unknown '%c'" ch
  152.             (spaces @<< oneOf "}") tr
  153.         | '[' ->
  154.             while isOneOf "[," tr && (spaces @>> peek) tr <> ']' do
  155.                 let ch = peek tr
  156.                 match ch with
  157.                 | '{' | '[' ->
  158.                     yield "", ch, "", stack
  159.                     yield! value (""::stack)
  160.                     yield "", (if ch = '{' then '}' else ']'), "", stack
  161.                 | _ ->
  162.                     yield "", ':', jsonValue tr, stack
  163.             (spaces @<< oneOf "]") tr
  164.         | ch ->
  165.             failwith <| sprintf "jsonParser: unknown '%c'" ch }
  166.     value []
  167.  
  168. let test = """
  169. {
  170.   "log": {
  171.     "version": "1.1",
  172.     "creator": {
  173.       "name": "Foo",
  174.       "version": "1.0" },
  175.     "pages": [
  176.       { "id": "page_1", "title": "Test1" },
  177.       { "id": "page_2", "title": "Test2" }
  178.     ],
  179.     "test": [-1.23, null, [1, 2, 3]]
  180.   }
  181. }
  182. """
  183.  
  184. try
  185.     use sr = new StringReader(test)
  186.     let it = (jsonParser sr).GetEnumerator
  187.     for (n, t, v, st) in jsonParser sr do
  188.         let v = if v.Length < 20 then v else v.[..19] + ".."
  189.         printfn "%A %A %c %A" (List.rev st) n t v
  190. with e ->
  191.     printf "%A" e
  192.  
  193. type JSONParser(tr:TextReader) =
  194.     let en = (jsonParser tr).GetEnumerator()
  195.     member x.Dispose() = tr.Dispose()
  196.     interface IDisposable with
  197.         member x.Dispose() = x.Dispose()
  198.     member x.Current = en.Current
  199.     member x.Name  = let (n, _, _, _) = en.Current in n
  200.     member x.Type  = let (_, t, _, _) = en.Current in t
  201.     member x.Value = let (_, _, v, _) = en.Current in v
  202.     member x.Stack = let (_, _, _, s) = en.Current in s
  203.     member x.Read() = en.MoveNext()
  204.     member x.Find(name:string) =
  205.         let rec f() =
  206.             if not <| x.Read() then false
  207.             elif x.Name = name then true else f()
  208.         f()
  209.     member x.Each() =
  210.         let len = x.Stack.Length
  211.         let num = ref 0
  212.         seq {
  213.             while x.Read() && x.Stack.Length <> len do
  214.                 yield !num
  215.                 num := !num + 1 }
  216.  
  217. try
  218.     use jp = new JSONParser(new StringReader(test))
  219.     if jp.Find "pages" then
  220.         for i in jp.Each() do
  221.         for j in jp.Each() do
  222.         printfn "%d:%d. %s = %s" i j jp.Name jp.Value
  223. with e ->
  224.     printf "%A" e
  225.  
Success #stdin #stdout 0.07s 31304KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
'a'
anyChar: unexpected end of input
['a'; 'b']
anyChar: unexpected end of input
['a'; 'b'; 'b']
true
false
'a'
oneOf: 'd' is not in "ab"
"123"
'1'
['1'; '2']
"abc"
"a\b\c"
"ABC"
"123"
"-3.14"
"abc"
"-1"
[] "log" { ""
["log"] "version" : "1.1"
["log"] "creator" { ""
["log"; "creator"] "name" : "Foo"
["log"; "creator"] "version" : "1.0"
["log"] "creator" } ""
["log"] "pages" [ ""
["log"; "pages"] "" { ""
["log"; "pages"; ""] "id" : "page_1"
["log"; "pages"; ""] "title" : "Test1"
["log"; "pages"] "" } ""
["log"; "pages"] "" { ""
["log"; "pages"; ""] "id" : "page_2"
["log"; "pages"; ""] "title" : "Test2"
["log"; "pages"] "" } ""
["log"] "pages" ] ""
["log"] "test" [ ""
["log"; "test"] "" : "-1.23"
["log"; "test"] "" : "null"
["log"; "test"] "" [ ""
["log"; "test"; ""] "" : "1"
["log"; "test"; ""] "" : "2"
["log"; "test"; ""] "" : "3"
["log"; "test"] "" ] ""
["log"] "test" ] ""
[] "log" } ""
0:0. id = page_1
0:1. title = Test1
1:0. id = page_2
1:1. title = Test2
https://ideone.com/4V8oNB
F# JSON Parser (Sample)
language:
F# (mono 4.1)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!