NorfairKing/autodocodec
1
1
Fork 0
mirror of https://github.com/NorfairKing/autodocodec.git synced 2024-08-16 18:00:32 +03:00
Code Issues Projects Releases Wiki Activity

automatically implement toEncoding via codec as well

Browse Source
This commit is contained in:
Tom Sydney Kerckhove 2021-11-11 13:45:40 +01:00
parent a9bf5c517e
commit 3b206f03d7
4 changed files with 43 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@ -5,7 +5,7 @@ Autodocodec is short for "self(auto)- documenting encoder and decoder".
In short:
You write a single instance, of the 'Codec' type-class, for your type, and you get:
* [A 'ToJSON' instance from 'aeson'](https://hackage.haskell.org/package/aeson-2.0.1.0/docs/Data-Aeson-Types.html#t:ToJSON)
* [A 'ToJSON' instance from 'aeson' with both a `toJSON` and `toEncoding` implementation](https://hackage.haskell.org/package/aeson-2.0.1.0/docs/Data-Aeson-Types.html#t:ToJSON)
* [A 'FromJSON' instance from 'aeson'](https://hackage.haskell.org/package/aeson-2.0.1.0/docs/Data-Aeson-Types.html#t:FromJSON)
* [A 'ToYaml] instance from 'yaml'](https://hackage.haskell.org/package/yaml-0.11.7.0/docs/Data-Yaml-Builder.html#t:ToYaml)
* [A json schema](http://json-schema.org/)

2
autodocodec/src/Autodocodec.hs
View File

@ -5,6 +5,8 @@ module Autodocodec
encodeViaCodec,
toJSONViaCodec,
toJSONVia,
toEncodingViaCodec,
toEncodingVia,
-- * Decoding
eitherDecodeViaCodec,

2
autodocodec/src/Autodocodec/Aeson.hs
View File

@ -5,6 +5,8 @@ module Autodocodec.Aeson
encodeViaCodec,
toJSONViaCodec,
toJSONVia,
toEncodingViaCodec,
toEncodingVia,
-- * Decoding
eitherDecodeViaCodec,

39
autodocodec/src/Autodocodec/Aeson/Encode.hs
View File

@ -10,9 +10,11 @@ import Autodocodec.Codec
import Autodocodec.DerivingVia
import Data.Aeson (toJSON)
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Encoding as JSON
import Data.Scientific
import Data.Text (Text)
import Data.Vector
import Data.Vector (Vector)
import qualified Data.Vector as V
-- | Encode a value using its JSON codec.
toJSONViaCodec :: HasCodec a => a -> JSON.Value
@ -55,5 +57,40 @@ toJSONContextVia = flip go
PureCodec _ -> error "Cannot toJSON a pure object codec."
ApCodec oc1 oc2 -> go a oc1 <> go a oc2
toEncodingViaCodec :: HasCodec a => a -> JSON.Encoding
toEncodingViaCodec = toEncodingVia codec
toEncodingVia :: ValueCodec a void -> a -> JSON.Encoding
toEncodingVia = flip go
where
go :: a -> ValueCodec a void -> JSON.Encoding
go a = \case
NullCodec -> JSON.null_
BoolCodec _ -> JSON.bool (a :: Bool)
StringCodec _ -> JSON.text (a :: Text)
NumberCodec _ -> JSON.scientific (a :: Scientific)
ArrayOfCodec _ c -> JSON.list (`go` c) (V.toList (a :: Vector _))
ObjectOfCodec _ oc -> JSON.pairs (goObject a oc)
ObjectCodec -> JSON.toEncoding (a :: JSON.Object)
ValueCodec -> JSON.value (a :: JSON.Value)
EqCodec value c -> go value c
MapCodec _ g c -> go (g a) c
EitherCodec c1 c2 -> case (a :: Either _ _) of
Left a1 -> go a1 c1
Right a2 -> go a2 c2
CommentCodec _ c -> go a c
ReferenceCodec _ c -> go a c
goObject :: a -> ObjectCodec a void -> JSON.Series
goObject a = \case
RequiredKeyCodec k c _ -> JSON.pair k (go a c)
OptionalKeyCodec k c _ -> case (a :: Maybe _) of
Nothing -> mempty :: JSON.Series
Just b -> JSON.pair k (go b c)
OptionalKeyWithDefaultCodec k c _ mdoc -> goObject (Just a) (OptionalKeyCodec k c mdoc)
PureCodec _ -> mempty :: JSON.Series
MapCodec _ g c -> goObject (g a) c
ApCodec oc1 oc2 -> goObject a oc1 <> goObject a oc2
instance HasCodec a => JSON.ToJSON (Autodocodec a) where
toJSON = toJSONViaCodec . unAutodocodec
toEncoding = toEncodingViaCodec . unAutodocodec