json: Parser types

This commit is contained in:
Nathan McCarty 2025-01-25 03:16:52 -05:00
parent e74fe68e32
commit 06e9c09eab

View file

@ -5,8 +5,92 @@ module Parser.JSON
import public Parser
import public Parser.Numbers
import Structures.Dependent.DList
```
<!-- idris
import System
import Derive.Prelude
import Generics.Derive
%hide Generics.Derive.Eq
%hide Generics.Derive.Ord
%hide Generics.Derive.Show
%language ElabReflection
-->
## JSON components
Types a JSON value is allowed to have
```idris
public export
data JSONType : Type where
TObject : JSONType
TArray : JSONType
TString : JSONType
TNumber : JSONType
TBool : JSONType
TNull : JSONType
%runElab derive "JSONType" [Generic, Meta, Eq, Ord, Show, DecEq]
%name JSONType type, type2, type3
```
A JSON value indexed by its type
```idris
public export
data JSONValue : JSONType -> Type where
VObject : {types : List JSONType}
-> DList JSONType (\t => (String, JSONValue t)) types -> JSONValue TObject
VArray : {types : List JSONType}
-> DList JSONType JSONValue types -> JSONValue TArray
VString : (s : String) -> JSONValue TString
VNumber : (d : Double) -> JSONValue TNumber
VBool : (b : Bool) -> JSONValue TBool
VNull : JSONValue TNull
%name JSONValue value, value2, value3
```
<!-- idris
Show (JSONValue t) where
show (VObject xs) =
let xs = dMap (\_,(key, value) => "\"\{key}\":\{show value}") xs
in assert_total $ "{\{joinBy "," xs}}"
show (VArray xs) =
let xs = dMap (\_,e => show e) xs
in assert_total $ "[\{joinBy "," . map show $ xs}]"
show (VString s) = "\"\{s}\""
show (VNumber d) = show d
show (VBool False) = "false"
show (VBool True) = "true"
show VNull = "null"
-->
## Parsers
We are going to get mutually recursive here. Instead of using a `mutual` block,
we will use the more modern style of declaring all our types ahead of our
definitions.
```idris
export
object : Parser (JSONValue TObject)
export
array : Parser (JSONValue TArray)
export
string : Parser (JSONValue TString)
export
number : Parser (JSONValue TNumber)
export
bool : Parser (JSONValue TBool)
export
null : Parser (JSONValue TNull)
```