0 | module Language.JSON.Parser
 1 |
 2 | import Language.JSON.Data
 3 | import Text.Parser
 4 | import Data.List
 5 |
 6 | import public Language.JSON.Tokens
 7 |
 8 | %default total
 9 |
10 | private
11 | punct : Punctuation -> Grammar state JSONToken True ()
12 | punct p = match $ JTPunct p
13 |
14 | private
15 | rawString : Grammar state JSONToken True String
16 | rawString = do mstr <- match JTString
17 |                the (Grammar _ _ False _) $
18 |                    case mstr of
19 |                         Just str => pure str
20 |                         Nothing => fail "invalid string"
21 |
22 | mutual
23 |   private
24 |   json : Grammar state JSONToken True JSON
25 |   json = object
26 |      <|> array
27 |      <|> string
28 |      <|> boolean
29 |      <|> number
30 |      <|> null
31 |
32 |   private
33 |   object : Grammar state JSONToken True JSON
34 |   object = do punct $ Curly Open
35 |               commit
36 |               props <- properties
37 |               punct $ Curly Close
38 |               pure $ JObject props
39 |     where
40 |       properties : Grammar state JSONToken False (List (String, JSON))
41 |       properties = sepBy (punct Comma) $
42 |                          do key <- rawString
43 |                             punct Colon
44 |                             value <- json
45 |                             pure (key, value)
46 |
47 |   private
48 |   array : Grammar state JSONToken True JSON
49 |   array = do punct (Square Open)
50 |              commit
51 |              vals <- values
52 |              punct (Square Close)
53 |              pure (JArray vals)
54 |     where
55 |       values : Grammar state JSONToken False (List JSON)
56 |       values = sepBy (punct Comma) json
57 |
58 |   private
59 |   string : Grammar state JSONToken True JSON
60 |   string = map JString rawString
61 |
62 |   private
63 |   boolean : Grammar state JSONToken True JSON
64 |   boolean = map JBoolean $ match JTBoolean
65 |
66 |   private
67 |   number : Grammar state JSONToken True JSON
68 |   number = map JNumber $ match JTNumber
69 |
70 |   private
71 |   null : Grammar state JSONToken True JSON
72 |   null = map (const JNull) $ match JTNull
73 |
74 | export
75 | parseJSON : List (WithBounds JSONToken) -> Maybe JSON
76 | parseJSON toks = case parse json $ filter (not . ignored) toks of
77 |                       Right (j, []) => Just j
78 |                       _ => Nothing
79 |