{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
module Autodocodec.Aeson.Encode
(
toJSONViaCodec,
toJSONVia,
toEncodingViaCodec,
toEncodingVia,
toJSONObjectViaCodec,
toJSONObjectVia,
toSeriesViaCodec,
toSeriesVia,
)
where
import qualified Autodocodec.Aeson.Compat as Compat
import Autodocodec.Class
import Autodocodec.Codec
import Data.Aeson (toJSON)
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Encoding as JSON
import Data.Coerce (coerce)
import Data.HashMap.Strict (HashMap)
import Data.Map (Map)
import Data.Scientific
import Data.Text (Text)
import Data.Vector (Vector)
import qualified Data.Vector as V
toJSONViaCodec :: (HasCodec a) => a -> JSON.Value
toJSONViaCodec :: forall a. HasCodec a => a -> Value
toJSONViaCodec = ValueCodec a a -> a -> Value
forall a void. ValueCodec a void -> a -> Value
toJSONVia ValueCodec a a
forall value. HasCodec value => JSONCodec value
codec
toJSONObjectViaCodec :: (HasObjectCodec a) => a -> JSON.Object
toJSONObjectViaCodec :: forall a. HasObjectCodec a => a -> Object
toJSONObjectViaCodec = ObjectCodec a a -> a -> Object
forall a void. ObjectCodec a void -> a -> Object
toJSONObjectVia ObjectCodec a a
forall object. HasObjectCodec object => JSONObjectCodec object
objectCodec
toJSONObjectVia :: ObjectCodec a void -> a -> JSON.Object
toJSONObjectVia :: forall a void. ObjectCodec a void -> a -> Object
toJSONObjectVia = (a -> ObjectCodec a void -> Object)
-> ObjectCodec a void -> a -> Object
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> ObjectCodec a void -> Object
forall a void. a -> ObjectCodec a void -> Object
go
where
go :: a -> ObjectCodec a void -> JSON.Object
go :: forall a void. a -> ObjectCodec a void -> Object
go a
a = \case
RequiredKeyCodec Text
k ValueCodec a void
c Maybe Text
_ -> Text -> Key
Compat.toKey Text
k Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueCodec a void -> a -> Value
forall a void. ValueCodec a void -> a -> Value
toJSONVia ValueCodec a void
c a
a
OptionalKeyCodec Text
k ValueCodec input1 output1
c Maybe Text
_ -> case (a -> Maybe input1
forall a b. Coercible a b => a -> b
coerce a
a :: Maybe _) of
Maybe input1
Nothing -> Object
forall a. Monoid a => a
mempty
Just input1
b -> Text -> Key
Compat.toKey Text
k Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ValueCodec input1 output1 -> input1 -> Value
forall a void. ValueCodec a void -> a -> Value
toJSONVia ValueCodec input1 output1
c input1
b
OptionalKeyWithDefaultCodec Text
k ValueCodec a a
c a
_ Maybe Text
mdoc -> Maybe a -> ObjectCodec (Maybe a) (Maybe a) -> Object
forall a void. a -> ObjectCodec a void -> Object
go (a -> Maybe a
forall a. a -> Maybe a
Just a
a) (Text
-> ValueCodec a a -> Maybe Text -> ObjectCodec (Maybe a) (Maybe a)
forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
optionalKeyCodec Text
k ValueCodec a a
c Maybe Text
mdoc)
OptionalKeyWithOmittedDefaultCodec Text
k ValueCodec value value
c value
defaultValue Maybe Text
mdoc ->
if a -> value
forall a b. Coercible a b => a -> b
coerce a
a value -> value -> Bool
forall a. Eq a => a -> a -> Bool
== value
defaultValue
then Object
forall a. Monoid a => a
mempty
else a -> ObjectCodec a a -> Object
forall a void. a -> ObjectCodec a void -> Object
go a
a (Text -> ValueCodec a a -> a -> Maybe Text -> ObjectCodec a a
forall value.
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
optionalKeyWithDefaultCodec Text
k (ValueCodec value value -> ValueCodec a a
forall a b. Coercible a b => a -> b
coerce ValueCodec value value
c) (value -> a
forall a b. Coercible a b => a -> b
coerce value
defaultValue) Maybe Text
mdoc)
BimapCodec oldOutput -> Either String void
_ a -> oldInput
g Codec Object oldInput oldOutput
c -> oldInput -> Codec Object oldInput oldOutput -> Object
forall a void. a -> ObjectCodec a void -> Object
go (a -> oldInput
g a
a) Codec Object oldInput oldOutput
c
PureCodec void
_ -> Object
forall a. Monoid a => a
mempty
EitherCodec Union
_ Codec Object input1 output1
c1 Codec Object input2 output2
c2 -> case (a -> Either input1 input2
forall a b. Coercible a b => a -> b
coerce a
a :: Either _ _) of
Left input1
a1 -> input1 -> Codec Object input1 output1 -> Object
forall a void. a -> ObjectCodec a void -> Object
go input1
a1 Codec Object input1 output1
c1
Right input2
a2 -> input2 -> Codec Object input2 output2 -> Object
forall a void. a -> ObjectCodec a void -> Object
go input2
a2 Codec Object input2 output2
c2
DiscriminatedUnionCodec Text
propertyName a -> (Text, ObjectCodec a ())
mapping HashMap Text (Text, ObjectCodec Void void)
_ ->
case a -> (Text, ObjectCodec a ())
mapping a
a of
(Text
discriminatorValue, ObjectCodec a ()
c) ->
Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Compat.insert (Text -> Key
Compat.toKey Text
propertyName) (Text -> Value
JSON.String Text
discriminatorValue) (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ a -> ObjectCodec a () -> Object
forall a void. a -> ObjectCodec a void -> Object
go a
a ObjectCodec a ()
c
ApCodec ObjectCodec a (output1 -> void)
oc1 ObjectCodec a output1
oc2 -> a -> ObjectCodec a (output1 -> void) -> Object
forall a void. a -> ObjectCodec a void -> Object
go a
a ObjectCodec a (output1 -> void)
oc1 Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> a -> ObjectCodec a output1 -> Object
forall a void. a -> ObjectCodec a void -> Object
go a
a ObjectCodec a output1
oc2
toJSONVia :: ValueCodec a void -> a -> JSON.Value
toJSONVia :: forall a void. ValueCodec a void -> a -> Value
toJSONVia = (a -> ValueCodec a void -> Value)
-> ValueCodec a void -> a -> Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> ValueCodec a void -> Value
forall a void. a -> ValueCodec a void -> Value
go
where
go :: a -> ValueCodec a void -> JSON.Value
go :: forall a void. a -> ValueCodec a void -> Value
go a
a = \case
ValueCodec a void
NullCodec -> Value
JSON.Null
BoolCodec Maybe Text
_ -> Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Bool
forall a b. Coercible a b => a -> b
coerce a
a :: Bool)
StringCodec Maybe Text
_ -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Text
forall a b. Coercible a b => a -> b
coerce a
a :: Text)
IntegerCodec Maybe Text
_ Bounds Integer
_ -> Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Integer
forall a b. Coercible a b => a -> b
coerce a
a :: Integer)
NumberCodec Maybe Text
_ Bounds Scientific
_ -> Scientific -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Scientific
forall a b. Coercible a b => a -> b
coerce a
a :: Scientific)
ArrayOfCodec Maybe Text
_ ValueCodec input1 output1
c -> Vector Value -> Value
forall a. ToJSON a => a -> Value
toJSON ((input1 -> Value) -> Vector input1 -> Vector Value
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (input1 -> ValueCodec input1 output1 -> Value
forall a void. a -> ValueCodec a void -> Value
`go` ValueCodec input1 output1
c) (a -> Vector input1
forall a b. Coercible a b => a -> b
coerce a
a :: Vector _))
ObjectOfCodec Maybe Text
_ ObjectCodec a void
oc -> Object -> Value
JSON.Object (ObjectCodec a void -> a -> Object
forall a void. ObjectCodec a void -> a -> Object
toJSONObjectVia ObjectCodec a void
oc a
a)
HashMapCodec JSONCodec v
c -> (v -> Value) -> ([v] -> Value) -> HashMap k v -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Value) -> ([a] -> Value) -> f a -> Value
Compat.liftToJSON (v -> JSONCodec v -> Value
forall a void. a -> ValueCodec a void -> Value
`go` JSONCodec v
c) ([v] -> ValueCodec [v] [v] -> Value
forall a void. a -> ValueCodec a void -> Value
`go` JSONCodec v -> ValueCodec [v] [v]
forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec JSONCodec v
c) (a -> HashMap k v
forall a b. Coercible a b => a -> b
coerce a
a :: HashMap _ _)
MapCodec JSONCodec v
c -> (v -> Value) -> ([v] -> Value) -> Map k v -> Value
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Value) -> ([a] -> Value) -> f a -> Value
Compat.liftToJSON (v -> JSONCodec v -> Value
forall a void. a -> ValueCodec a void -> Value
`go` JSONCodec v
c) ([v] -> ValueCodec [v] [v] -> Value
forall a void. a -> ValueCodec a void -> Value
`go` JSONCodec v -> ValueCodec [v] [v]
forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec JSONCodec v
c) (a -> Map k v
forall a b. Coercible a b => a -> b
coerce a
a :: Map _ _)
ValueCodec a void
ValueCodec -> (a -> Value
forall a b. Coercible a b => a -> b
coerce a
a :: JSON.Value)
EqCodec value
value JSONCodec value
c -> value -> JSONCodec value -> Value
forall a void. a -> ValueCodec a void -> Value
go value
value JSONCodec value
c
BimapCodec oldOutput -> Either String void
_ a -> oldInput
g Codec Value oldInput oldOutput
c -> oldInput -> Codec Value oldInput oldOutput -> Value
forall a void. a -> ValueCodec a void -> Value
go (a -> oldInput
g a
a) Codec Value oldInput oldOutput
c
EitherCodec Union
_ Codec Value input1 output1
c1 Codec Value input2 output2
c2 -> case (a -> Either input1 input2
forall a b. Coercible a b => a -> b
coerce a
a :: Either _ _) of
Left input1
a1 -> input1 -> Codec Value input1 output1 -> Value
forall a void. a -> ValueCodec a void -> Value
go input1
a1 Codec Value input1 output1
c1
Right input2
a2 -> input2 -> Codec Value input2 output2 -> Value
forall a void. a -> ValueCodec a void -> Value
go input2
a2 Codec Value input2 output2
c2
CommentCodec Text
_ ValueCodec a void
c -> a -> ValueCodec a void -> Value
forall a void. a -> ValueCodec a void -> Value
go a
a ValueCodec a void
c
ReferenceCodec Text
_ ValueCodec a void
c -> a -> ValueCodec a void -> Value
forall a void. a -> ValueCodec a void -> Value
go a
a ValueCodec a void
c
toEncodingViaCodec :: (HasCodec a) => a -> JSON.Encoding
toEncodingViaCodec :: forall a. HasCodec a => a -> Encoding
toEncodingViaCodec = ValueCodec a a -> a -> Encoding
forall a void. ValueCodec a void -> a -> Encoding
toEncodingVia ValueCodec a a
forall value. HasCodec value => JSONCodec value
codec
toSeriesViaCodec :: (HasObjectCodec a) => a -> JSON.Series
toSeriesViaCodec :: forall a. HasObjectCodec a => a -> Series
toSeriesViaCodec = ObjectCodec a a -> a -> Series
forall a void. ObjectCodec a void -> a -> Series
toSeriesVia ObjectCodec a a
forall object. HasObjectCodec object => JSONObjectCodec object
objectCodec
toSeriesVia :: ObjectCodec a void -> a -> JSON.Series
toSeriesVia :: forall a void. ObjectCodec a void -> a -> Series
toSeriesVia = (a -> ObjectCodec a void -> Series)
-> ObjectCodec a void -> a -> Series
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> ObjectCodec a void -> Series
forall a void. a -> ObjectCodec a void -> Series
goObject
where
goObject :: a -> ObjectCodec a void -> JSON.Series
goObject :: forall a void. a -> ObjectCodec a void -> Series
goObject a
a = \case
RequiredKeyCodec Text
k ValueCodec a void
c Maybe Text
_ -> Key -> Encoding -> Series
JSON.pair (Text -> Key
Compat.toKey Text
k) (ValueCodec a void -> a -> Encoding
forall a void. ValueCodec a void -> a -> Encoding
toEncodingVia ValueCodec a void
c a
a)
OptionalKeyCodec Text
k ValueCodec input1 output1
c Maybe Text
_ -> case (a -> Maybe input1
forall a b. Coercible a b => a -> b
coerce a
a :: Maybe _) of
Maybe input1
Nothing -> Series
forall a. Monoid a => a
mempty :: JSON.Series
Just input1
b -> Key -> Encoding -> Series
JSON.pair (Text -> Key
Compat.toKey Text
k) (ValueCodec input1 output1 -> input1 -> Encoding
forall a void. ValueCodec a void -> a -> Encoding
toEncodingVia ValueCodec input1 output1
c input1
b)
OptionalKeyWithDefaultCodec Text
k ValueCodec a a
c a
_ Maybe Text
mdoc -> Maybe a -> ObjectCodec (Maybe a) (Maybe a) -> Series
forall a void. a -> ObjectCodec a void -> Series
goObject (a -> Maybe a
forall a. a -> Maybe a
Just a
a) (Text
-> ValueCodec a a -> Maybe Text -> ObjectCodec (Maybe a) (Maybe a)
forall input output.
Text
-> ValueCodec input output
-> Maybe Text
-> ObjectCodec (Maybe input) (Maybe output)
optionalKeyCodec Text
k ValueCodec a a
c Maybe Text
mdoc)
OptionalKeyWithOmittedDefaultCodec Text
k ValueCodec value value
c value
defaultValue Maybe Text
mdoc ->
if a -> value
forall a b. Coercible a b => a -> b
coerce a
a value -> value -> Bool
forall a. Eq a => a -> a -> Bool
== value
defaultValue
then Series
forall a. Monoid a => a
mempty
else a -> ObjectCodec a a -> Series
forall a void. a -> ObjectCodec a void -> Series
goObject a
a (Text -> ValueCodec a a -> a -> Maybe Text -> ObjectCodec a a
forall value.
Text
-> ValueCodec value value
-> value
-> Maybe Text
-> ObjectCodec value value
optionalKeyWithDefaultCodec Text
k (ValueCodec value value -> ValueCodec a a
forall a b. Coercible a b => a -> b
coerce ValueCodec value value
c) (value -> a
forall a b. Coercible a b => a -> b
coerce value
defaultValue) Maybe Text
mdoc)
PureCodec void
_ -> Series
forall a. Monoid a => a
mempty :: JSON.Series
BimapCodec oldOutput -> Either String void
_ a -> oldInput
g Codec Object oldInput oldOutput
c -> oldInput -> Codec Object oldInput oldOutput -> Series
forall a void. a -> ObjectCodec a void -> Series
goObject (a -> oldInput
g a
a) Codec Object oldInput oldOutput
c
EitherCodec Union
_ Codec Object input1 output1
c1 Codec Object input2 output2
c2 -> case (a -> Either input1 input2
forall a b. Coercible a b => a -> b
coerce a
a :: Either _ _) of
Left input1
a1 -> input1 -> Codec Object input1 output1 -> Series
forall a void. a -> ObjectCodec a void -> Series
goObject input1
a1 Codec Object input1 output1
c1
Right input2
a2 -> input2 -> Codec Object input2 output2 -> Series
forall a void. a -> ObjectCodec a void -> Series
goObject input2
a2 Codec Object input2 output2
c2
DiscriminatedUnionCodec Text
propertyName a -> (Text, ObjectCodec a ())
mapping HashMap Text (Text, ObjectCodec Void void)
_ ->
case a -> (Text, ObjectCodec a ())
mapping a
a of
(Text
discriminatorValue, ObjectCodec a ()
c) ->
Key -> Encoding -> Series
JSON.pair (Text -> Key
Compat.toKey Text
propertyName) (Text -> Encoding
forall a. ToJSON a => a -> Encoding
JSON.toEncoding Text
discriminatorValue) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> a -> ObjectCodec a () -> Series
forall a void. a -> ObjectCodec a void -> Series
goObject a
a ObjectCodec a ()
c
ApCodec ObjectCodec a (output1 -> void)
oc1 ObjectCodec a output1
oc2 -> a -> ObjectCodec a (output1 -> void) -> Series
forall a void. a -> ObjectCodec a void -> Series
goObject a
a ObjectCodec a (output1 -> void)
oc1 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> a -> ObjectCodec a output1 -> Series
forall a void. a -> ObjectCodec a void -> Series
goObject a
a ObjectCodec a output1
oc2
toEncodingVia :: ValueCodec a void -> a -> JSON.Encoding
toEncodingVia :: forall a void. ValueCodec a void -> a -> Encoding
toEncodingVia = (a -> ValueCodec a void -> Encoding)
-> ValueCodec a void -> a -> Encoding
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> ValueCodec a void -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
go
where
go :: a -> ValueCodec a void -> JSON.Encoding
go :: forall a void. a -> ValueCodec a void -> Encoding
go a
a = \case
ValueCodec a void
NullCodec -> Encoding
JSON.null_
BoolCodec Maybe Text
_ -> Bool -> Encoding
JSON.bool (a -> Bool
forall a b. Coercible a b => a -> b
coerce a
a :: Bool)
StringCodec Maybe Text
_ -> Text -> Encoding
forall a. Text -> Encoding' a
JSON.text (a -> Text
forall a b. Coercible a b => a -> b
coerce a
a :: Text)
IntegerCodec Maybe Text
_ Bounds Integer
_ -> Scientific -> Encoding
JSON.scientific (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall a b. Coercible a b => a -> b
coerce a
a :: Integer) :: Scientific)
NumberCodec Maybe Text
_ Bounds Scientific
_ -> Scientific -> Encoding
JSON.scientific (a -> Scientific
forall a b. Coercible a b => a -> b
coerce a
a :: Scientific)
ArrayOfCodec Maybe Text
_ ValueCodec input1 output1
c -> (input1 -> Encoding) -> [input1] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
JSON.list (input1 -> ValueCodec input1 output1 -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
`go` ValueCodec input1 output1
c) (Vector input1 -> [input1]
forall a. Vector a -> [a]
V.toList (a -> Vector input1
forall a b. Coercible a b => a -> b
coerce a
a :: Vector _))
ObjectOfCodec Maybe Text
_ ObjectCodec a void
oc -> Series -> Encoding
JSON.pairs (ObjectCodec a void -> a -> Series
forall a void. ObjectCodec a void -> a -> Series
toSeriesVia ObjectCodec a void
oc a
a)
HashMapCodec JSONCodec v
c -> (v -> Encoding) -> ([v] -> Encoding) -> HashMap k v -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
Compat.liftToEncoding (v -> JSONCodec v -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
`go` JSONCodec v
c) ([v] -> ValueCodec [v] [v] -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
`go` JSONCodec v -> ValueCodec [v] [v]
forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec JSONCodec v
c) (a -> HashMap k v
forall a b. Coercible a b => a -> b
coerce a
a :: HashMap _ _)
MapCodec JSONCodec v
c -> (v -> Encoding) -> ([v] -> Encoding) -> Map k v -> Encoding
forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
Compat.liftToEncoding (v -> JSONCodec v -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
`go` JSONCodec v
c) ([v] -> ValueCodec [v] [v] -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
`go` JSONCodec v -> ValueCodec [v] [v]
forall input output.
ValueCodec input output -> ValueCodec [input] [output]
listCodec JSONCodec v
c) (a -> Map k v
forall a b. Coercible a b => a -> b
coerce a
a :: Map _ _)
ValueCodec a void
ValueCodec -> Value -> Encoding
JSON.value (a -> Value
forall a b. Coercible a b => a -> b
coerce a
a :: JSON.Value)
EqCodec value
value JSONCodec value
c -> value -> JSONCodec value -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
go value
value JSONCodec value
c
BimapCodec oldOutput -> Either String void
_ a -> oldInput
g Codec Value oldInput oldOutput
c -> oldInput -> Codec Value oldInput oldOutput -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
go (a -> oldInput
g a
a) Codec Value oldInput oldOutput
c
EitherCodec Union
_ Codec Value input1 output1
c1 Codec Value input2 output2
c2 -> case (a -> Either input1 input2
forall a b. Coercible a b => a -> b
coerce a
a :: Either _ _) of
Left input1
a1 -> input1 -> Codec Value input1 output1 -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
go input1
a1 Codec Value input1 output1
c1
Right input2
a2 -> input2 -> Codec Value input2 output2 -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
go input2
a2 Codec Value input2 output2
c2
CommentCodec Text
_ ValueCodec a void
c -> a -> ValueCodec a void -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
go a
a ValueCodec a void
c
ReferenceCodec Text
_ ValueCodec a void
c -> a -> ValueCodec a void -> Encoding
forall a void. a -> ValueCodec a void -> Encoding
go a
a ValueCodec a void
c