object codec for json objects

This commit is contained in:
Tom Sydney Kerckhove 2021-10-31 23:15:58 +01:00
parent 3b3a23b434
commit d61887924e
4 changed files with 8 additions and 0 deletions

View File

@ -45,6 +45,7 @@ parseContextVia = flip go
Nothing -> parseJSON value
Just name -> withObject (T.unpack name) pure value
(`go` c) object_
ObjectCodec -> parseJSON value
ValueCodec -> pure value
EqCodec expected c -> do
actual <- go value c

View File

@ -279,6 +279,7 @@ jsonSchemaVia = go
NumberCodec mname -> maybe id CommentSchema mname NumberSchema
ArrayOfCodec mname c -> maybe id CommentSchema mname $ ArraySchema (go c)
ObjectOfCodec mname oc -> maybe id CommentSchema mname $ ObjectSchema (goObject oc)
ObjectCodec -> ObjectSchema []
ValueCodec -> AnySchema
EqCodec value c -> ValueSchema (toJSONVia c value)
EitherCodec c1 c2 -> ChoiceSchema (goChoice (go c1 :| [go c2]))

View File

@ -26,6 +26,7 @@ toContextVia = flip go
NumberCodec _ -> toJSON (a :: Scientific)
ArrayOfCodec _ c -> toJSON (fmap (`go` c) a)
ObjectOfCodec _ oc -> JSON.Object (go a oc)
ObjectCodec -> JSON.Object a
ValueCodec -> a
EqCodec value c -> go value c
MapCodec _ g c -> go (g a) c

View File

@ -75,6 +75,10 @@ data Codec context input output where
!(ObjectCodec input output) ->
-- |
ValueCodec input output
-- | Encode a 'JSON.Object', and decode any 'JSON.Object'.
ObjectCodec ::
-- |
ValueCodec JSON.Object JSON.Object
-- | Encode a 'JSON.Value', and decode any 'JSON.Value'.
ValueCodec ::
-- |
@ -230,6 +234,7 @@ showCodecABit = ($ "") . (`evalState` S.empty) . go 0
ArrayOfCodec mname c -> (\s -> showParen (d > 10) $ showString "ArrayOfCodec " . showsPrec d mname . showString " " . s) <$> go 11 c
ObjectOfCodec mname oc -> (\s -> showParen (d > 10) $ showString "ObjectOfCodec " . showsPrec d mname . showString " " . s) <$> go 11 oc
ValueCodec -> pure $ showString "ValueCodec"
ObjectCodec -> pure $ showString "ObjectCodec"
EqCodec value c -> (\s -> showParen (d > 10) $ showString "EqCodec " . showsPrec d value . showString " " . s) <$> go 11 c
MapCodec _ _ c -> (\s -> showParen (d > 10) $ showString "MapCodec " . s) <$> go 11 c
EitherCodec c1 c2 -> (\s1 s2 -> showParen (d > 10) $ showString "EitherCodec " . s1 . showString " " . s2) <$> go 11 c1 <*> go 11 c2