json: object refactor
This commit is contained in:
parent
19ce8ac798
commit
aa1ae93165
1 changed files with 33 additions and 18 deletions
|
@ -121,8 +121,7 @@ Top level json value parser
|
||||||
export
|
export
|
||||||
value : Parser (t : JSONType ** JSONValue t)
|
value : Parser (t : JSONType ** JSONValue t)
|
||||||
value = do
|
value = do
|
||||||
_ <- many whitespace
|
surround whitespace $ oneOfE
|
||||||
val <- oneOfE
|
|
||||||
(throwParseError "Expected JSON Value")
|
(throwParseError "Expected JSON Value")
|
||||||
(the (List _)
|
(the (List _)
|
||||||
[
|
[
|
||||||
|
@ -133,8 +132,6 @@ value = do
|
||||||
, dpairize bool
|
, dpairize bool
|
||||||
, dpairize null
|
, dpairize null
|
||||||
])
|
])
|
||||||
_ <- many whitespace
|
|
||||||
pure val
|
|
||||||
```
|
```
|
||||||
|
|
||||||
Now go through our json value types
|
Now go through our json value types
|
||||||
|
@ -147,29 +144,27 @@ object = do
|
||||||
where
|
where
|
||||||
emptyObject : Parser (JSONValue TObject)
|
emptyObject : Parser (JSONValue TObject)
|
||||||
emptyObject = do
|
emptyObject = do
|
||||||
_ <- parseExactChar '{'
|
delimited '{' '}' (nom whitespace)
|
||||||
_ <- many whitespace
|
|
||||||
_ <- parseExactChar '}'
|
|
||||||
pure $ VObject Nil
|
pure $ VObject Nil
|
||||||
firstKeyValue : Parser (t : JSONType ** (String, JSONValue t))
|
keyValue : Parser (t : JSONType ** (String, JSONValue t))
|
||||||
firstKeyValue = do
|
keyValue = do
|
||||||
_ <- many whitespace
|
VString key <- surround whitespace string
|
||||||
VString key <- string
|
|
||||||
_ <- many whitespace
|
|
||||||
_ <- parseExactChar ':'
|
_ <- parseExactChar ':'
|
||||||
(typ ** val) <- value
|
(typ ** val) <- value
|
||||||
pure (typ ** (key, val))
|
pure (typ ** (key, val))
|
||||||
restKeyValue : Parser (t : JSONType ** (String, JSONValue t))
|
restKeyValue : Parser (t : JSONType ** (String, JSONValue t))
|
||||||
restKeyValue = do
|
restKeyValue = do
|
||||||
_ <- parseExactChar ','
|
_ <- parseExactChar ','
|
||||||
firstKeyValue
|
keyValue
|
||||||
|
pairs : Parser (List1 (t : JSONType ** (String, JSONValue t)))
|
||||||
|
pairs = do
|
||||||
|
first <- keyValue
|
||||||
|
rest <- many restKeyValue
|
||||||
|
pure $ first ::: rest
|
||||||
occupiedObject : Parser (JSONValue TObject)
|
occupiedObject : Parser (JSONValue TObject)
|
||||||
occupiedObject = do
|
occupiedObject = do
|
||||||
_ <- parseExactChar '{'
|
val <- delimited '{' '}' pairs
|
||||||
first <- firstKeyValue
|
let (types ** xs) = DList.fromList (forget val)
|
||||||
rest <- many restKeyValue
|
|
||||||
_ <- parseExactChar '}'
|
|
||||||
let (types ** xs) = DList.fromList (first :: rest)
|
|
||||||
pure $ VObject xs
|
pure $ VObject xs
|
||||||
```
|
```
|
||||||
|
|
||||||
|
@ -237,3 +232,23 @@ null = do
|
||||||
_ <- exactString "null"
|
_ <- exactString "null"
|
||||||
pure VNull
|
pure VNull
|
||||||
```
|
```
|
||||||
|
|
||||||
|
## Unit tests
|
||||||
|
|
||||||
|
Quick smoke test
|
||||||
|
|
||||||
|
```idris
|
||||||
|
-- @@test JSON Quick Smoke
|
||||||
|
quickSmoke : IO Bool
|
||||||
|
quickSmoke = do
|
||||||
|
let input = "{\"string\":\"string\",\"number\":5,\"true\":true,\"false\":false,\"null\":null,\"array\":[1,2,3]}"
|
||||||
|
putStrLn input
|
||||||
|
Right parsed <- runFirstIO object input
|
||||||
|
| Left err => do
|
||||||
|
printLn err
|
||||||
|
pure False
|
||||||
|
putStrLn "Input: \{input}\nOutput: \{show parsed}"
|
||||||
|
case parsed of
|
||||||
|
VObject xs => ?quickSmoke_rhs_0
|
||||||
|
_ => pure False
|
||||||
|
```
|
||||||
|
|
Loading…
Add table
Reference in a new issue