module Data.Json
(
JsonSpec(..), FieldSpec(..), FieldKey, P.reqKey, P.optKey, P.TypedKey
, (.=), (.=?)
, JsonSumSpec(..), (P..->), (P.<||>), (S..<-)
,
makeParser, makeSerialiser, makeSumParser, makeSumSerialiser
, S.ToJson(..), P.JsonReadable(..)
,
P.parseJsonBs, P.parseJsonBsl, P.parseJsonT
, S.serialiseJsonBs, S.serialiseJsonBsl, S.serialiseJsonT
)
where
import Data.HVect
import Data.Typeable
import qualified Data.Json.Serialiser as S
import qualified Data.Json.Parser as P
data JsonSpec k (ts :: [*])
= JsonSpec
{ j_constr :: !(HVectElim ts k)
, j_fields :: !(FieldSpec k ts)
}
data FieldSpec k (ts :: [*]) where
EmptySpec :: FieldSpec k '[]
(:+:) :: (S.ToJson t, P.JsonReadable t, Typeable t) => !(FieldKey k t) -> !(FieldSpec k ts) -> FieldSpec k (t ': ts)
infixr 5 :+:
data FieldKey k t
= FieldKey
{ fk_tk :: !(P.TypedKey t)
, fk_sk :: !(S.SpecKey k t)
}
(.=) :: (S.ToJson t, P.JsonReadable t, Typeable t) => P.TypedKey t -> (k -> t) -> FieldKey k t
tk .= getter = FieldKey tk ((P.typedKeyKey tk) S..: getter)
(.=?) :: (S.ToJson t, P.JsonReadable t, Typeable t) => P.TypedKey (Maybe t) -> (k -> Maybe t) -> FieldKey k (Maybe t)
tk .=? getter = FieldKey tk ((P.typedKeyKey tk) S..:? getter)
makeParser :: JsonSpec k ts -> P.Parser k
makeParser spec = P.runParseSpec $ (j_constr spec) P.:$: (mkObjSpec $ j_fields spec)
mkObjSpec :: FieldSpec k ts -> P.ObjSpec ts
mkObjSpec EmptySpec = P.ObjSpecNil
mkObjSpec (FieldKey k _ :+: xs) = k P.:&&: mkObjSpec xs
makeSerialiser :: JsonSpec k ts -> k -> S.Value
makeSerialiser spec = S.runSerSpec (S.SingleConstr $ mkSerSpec (j_fields spec))
mkSerSpec :: FieldSpec k ts -> S.SerObjSpec k ts
mkSerSpec EmptySpec = S.SerObjSpecNil
mkSerSpec (FieldKey _ getter :+: xs) = getter S.:&&&: mkSerSpec xs
data JsonSumSpec k
= JsonSumSpec
{ js_parser :: !(P.ParseSpec k)
, js_serialiser :: !(k -> S.KeyedSerialiser k)
}
makeSumParser :: JsonSumSpec k -> P.Parser k
makeSumParser = P.runParseSpec . js_parser
makeSumSerialiser :: JsonSumSpec k -> k -> S.Value
makeSumSerialiser s = S.runSerSpec (S.MultiConstr (js_serialiser s))