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