mirror of
https://github.com/NorfairKing/autodocodec.git
synced 2024-09-11 14:36:05 +03:00
automatically implement toEncoding via codec as well
This commit is contained in:
parent
a9bf5c517e
commit
3b206f03d7
@ -5,7 +5,7 @@ Autodocodec is short for "self(auto)- documenting encoder and decoder".
|
|||||||
In short:
|
In short:
|
||||||
You write a single instance, of the 'Codec' type-class, for your type, and you get:
|
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 '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 '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/)
|
* [A json schema](http://json-schema.org/)
|
||||||
|
@ -5,6 +5,8 @@ module Autodocodec
|
|||||||
encodeViaCodec,
|
encodeViaCodec,
|
||||||
toJSONViaCodec,
|
toJSONViaCodec,
|
||||||
toJSONVia,
|
toJSONVia,
|
||||||
|
toEncodingViaCodec,
|
||||||
|
toEncodingVia,
|
||||||
|
|
||||||
-- * Decoding
|
-- * Decoding
|
||||||
eitherDecodeViaCodec,
|
eitherDecodeViaCodec,
|
||||||
|
@ -5,6 +5,8 @@ module Autodocodec.Aeson
|
|||||||
encodeViaCodec,
|
encodeViaCodec,
|
||||||
toJSONViaCodec,
|
toJSONViaCodec,
|
||||||
toJSONVia,
|
toJSONVia,
|
||||||
|
toEncodingViaCodec,
|
||||||
|
toEncodingVia,
|
||||||
|
|
||||||
-- * Decoding
|
-- * Decoding
|
||||||
eitherDecodeViaCodec,
|
eitherDecodeViaCodec,
|
||||||
|
@ -10,9 +10,11 @@ import Autodocodec.Codec
|
|||||||
import Autodocodec.DerivingVia
|
import Autodocodec.DerivingVia
|
||||||
import Data.Aeson (toJSON)
|
import Data.Aeson (toJSON)
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
|
import qualified Data.Aeson.Encoding as JSON
|
||||||
import Data.Scientific
|
import Data.Scientific
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Vector
|
import Data.Vector (Vector)
|
||||||
|
import qualified Data.Vector as V
|
||||||
|
|
||||||
-- | Encode a value using its JSON codec.
|
-- | Encode a value using its JSON codec.
|
||||||
toJSONViaCodec :: HasCodec a => a -> JSON.Value
|
toJSONViaCodec :: HasCodec a => a -> JSON.Value
|
||||||
@ -55,5 +57,40 @@ toJSONContextVia = flip go
|
|||||||
PureCodec _ -> error "Cannot toJSON a pure object codec."
|
PureCodec _ -> error "Cannot toJSON a pure object codec."
|
||||||
ApCodec oc1 oc2 -> go a oc1 <> go a oc2
|
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
|
instance HasCodec a => JSON.ToJSON (Autodocodec a) where
|
||||||
toJSON = toJSONViaCodec . unAutodocodec
|
toJSON = toJSONViaCodec . unAutodocodec
|
||||||
|
toEncoding = toEncodingViaCodec . unAutodocodec
|
||||||
|
Loading…
Reference in New Issue
Block a user