113 lines
3 KiB
Text
113 lines
3 KiB
Text
import Lean
|
||
|
||
open Lean
|
||
|
||
declare_syntax_cat json
|
||
syntax str : json
|
||
syntax num : json
|
||
syntax "{" (ident ": " json),* "}" : json
|
||
syntax "[" json,* "]" : json
|
||
|
||
syntax "json " json : term
|
||
|
||
/- declare a micro json parser, so we can write our tests in a more legible way. -/
|
||
open Json in macro_rules
|
||
| `(json $s:str) => pure s
|
||
| `(json $n:num) => pure n
|
||
| `(json { $[$ns : $js],* }) => do
|
||
let mut fields := #[]
|
||
for n in ns, j in js do
|
||
fields := fields.push (← `(($(quote n.getId.getString!), json $j)))
|
||
`(mkObj [$fields,*])
|
||
| `(json [ $[$js],* ]) => do
|
||
let mut fields := #[]
|
||
for j in js do
|
||
fields := fields.push (← `(json $j))
|
||
`(Json.arr #[$fields,*])
|
||
|
||
def checkToJson [ToJson α] (obj : α) (rhs : Json) : MetaM Unit :=
|
||
let lhs := (obj |> toJson).pretty
|
||
if lhs == rhs.pretty then
|
||
pure ()
|
||
else
|
||
throwError "{lhs} ≟ {rhs}"
|
||
|
||
def checkRoundTrip [Repr α] [BEq α] [ToJson α] [FromJson α] (obj : α) : MetaM Unit := do
|
||
let roundTripped := obj |> toJson |> fromJson?
|
||
if let Except.ok roundTripped := roundTripped then
|
||
if obj == roundTripped then
|
||
pure ()
|
||
else
|
||
throwError "{repr obj} ≟ {repr roundTripped}"
|
||
else
|
||
throwError "couldn't parse: {repr obj} ≟ {obj |> toJson}"
|
||
|
||
-- set_option trace.Meta.debug true in
|
||
structure Foo where
|
||
x : Nat
|
||
y : String
|
||
deriving ToJson, FromJson, Repr, BEq
|
||
|
||
#eval checkToJson { x := 1, y := "bla" : Foo} (json { y : "bla", x : 1 })
|
||
#eval checkRoundTrip { x := 1, y := "bla" : Foo }
|
||
|
||
-- set_option trace.Elab.command true
|
||
structure WInfo where
|
||
a : Nat
|
||
b : Nat
|
||
deriving ToJson, FromJson, Repr, BEq
|
||
|
||
-- set_option trace.Elab.command true
|
||
inductive E
|
||
| W : WInfo → E
|
||
| WAlt (a b : Nat)
|
||
| X : Nat → Nat → E
|
||
| Y : Nat → E
|
||
| YAlt (a : Nat)
|
||
| Z
|
||
deriving ToJson, FromJson, Repr, BEq
|
||
|
||
#eval checkToJson (E.W { a := 2, b := 3}) (json { W : { a : 2, b : 3 } })
|
||
#eval checkRoundTrip (E.W { a := 2, b := 3 })
|
||
|
||
#eval checkToJson (E.WAlt 2 3) (json { WAlt : { a : 2, b : 3 } })
|
||
#eval checkRoundTrip (E.WAlt 2 3)
|
||
|
||
#eval checkToJson (E.X 2 3) (json { X : [2, 3] })
|
||
#eval checkRoundTrip (E.X 2 3)
|
||
|
||
#eval checkToJson (E.Y 4) (json { Y : 4 })
|
||
#eval checkRoundTrip (E.Y 4)
|
||
|
||
#eval checkToJson (E.YAlt 5) (json { YAlt : { a : 5 } })
|
||
#eval checkRoundTrip (E.YAlt 5)
|
||
|
||
#eval checkToJson E.Z (json "Z")
|
||
#eval checkRoundTrip E.Z
|
||
|
||
inductive ERec
|
||
| mk : Nat → ERec
|
||
| W : ERec → ERec
|
||
deriving ToJson, FromJson, Repr, BEq
|
||
|
||
#eval checkToJson (ERec.W (ERec.mk 6)) (json { W : { mk : 6 }})
|
||
#eval checkRoundTrip (ERec.mk 7)
|
||
#eval checkRoundTrip (ERec.W (ERec.mk 8))
|
||
|
||
inductive ENest
|
||
| mk : Nat → ENest
|
||
| W : (Array ENest) → ENest
|
||
deriving ToJson, FromJson, Repr, BEq
|
||
|
||
#eval checkToJson (ENest.W #[ENest.mk 9]) (json { W : [{ mk : 9 }]})
|
||
#eval checkRoundTrip (ENest.mk 10)
|
||
#eval checkRoundTrip (ENest.W #[ENest.mk 11])
|
||
|
||
inductive EParam (α : Type)
|
||
| mk : α → EParam α
|
||
deriving ToJson, FromJson, Repr, BEq
|
||
|
||
#eval checkToJson (EParam.mk 12) (json { mk : 12 })
|
||
#eval checkToJson (EParam.mk "abcd") (json { mk : "abcd" })
|
||
#eval checkRoundTrip (EParam.mk 13)
|
||
#eval checkRoundTrip (EParam.mk "efgh")
|