{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
module Data.Registry.Aeson.Encoder
( module Data.Registry.Aeson.Encoder,
module Data.Registry.Aeson.TH.Encoder,
module Data.Registry.Aeson.TH.ThOptions,
)
where
import Data.Aeson
import Data.Aeson.Encoding.Internal
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Lazy qualified as BL (toStrict)
import Data.Functor.Contravariant
import Data.Map qualified as M
import Data.Registry
import Data.Registry.Aeson.TH.Encoder
import Data.Registry.Aeson.TH.ThOptions
import Data.Set qualified as S
import Data.Vector qualified as V
import Protolude hiding (Type, list)
import Prelude (String)
newtype Encoder a = Encoder {forall a. Encoder a -> a -> (Value, Encoding)
encode :: a -> (Value, Encoding)}
instance Contravariant Encoder where
contramap :: forall a' a. (a' -> a) -> Encoder a -> Encoder a'
contramap a' -> a
f (Encoder a -> (Value, Encoding)
a) = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder (a -> (Value, Encoding)
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f)
newtype KeyEncoder a = KeyEncoder {forall a. KeyEncoder a -> a -> Key
encodeAsKey :: a -> Key}
instance Contravariant KeyEncoder where
contramap :: forall a' a. (a' -> a) -> KeyEncoder a -> KeyEncoder a'
contramap a' -> a
f (KeyEncoder a -> Key
a) = forall a. (a -> Key) -> KeyEncoder a
KeyEncoder (a -> Key
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f)
encodeByteString :: Encoder a -> a -> ByteString
encodeByteString :: forall a. Encoder a -> a -> ByteString
encodeByteString (Encoder a -> (Value, Encoding)
e) = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoding' a -> ByteString
encodingToLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Value, Encoding)
e
encodeValue :: Encoder a -> a -> Value
encodeValue :: forall a. Encoder a -> a -> Value
encodeValue (Encoder a -> (Value, Encoding)
e) = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Value, Encoding)
e
encodeKey :: forall a. Typeable a => (a -> Text) -> Typed (KeyEncoder a)
encodeKey :: forall a. Typeable a => (a -> Text) -> Typed (KeyEncoder a)
encodeKey a -> Text
f = forall a. Typeable a => a -> Typed a
fun (forall a. (a -> Text) -> KeyEncoder a
keyEncoder a -> Text
f)
keyEncoder :: (a -> Text) -> KeyEncoder a
keyEncoder :: forall a. (a -> Text) -> KeyEncoder a
keyEncoder a -> Text
f = forall a. (a -> Key) -> KeyEncoder a
KeyEncoder forall a b. (a -> b) -> a -> b
$ String -> Key
K.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
f
fromValue :: (a -> Value) -> Encoder a
fromValue :: forall a. (a -> Value) -> Encoder a
fromValue a -> Value
f = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \a
a -> let v :: Value
v = a -> Value
f a
a in (Value
v, Value -> Encoding
value Value
v)
jsonEncoder :: forall a. (ToJSON a, Typeable a) => Typed (Encoder a)
jsonEncoder :: forall a. (ToJSON a, Typeable a) => Typed (Encoder a)
jsonEncoder = forall a. Typeable a => a -> Typed a
fun (forall a. ToJSON a => Encoder a
jsonEncoderOf @a)
jsonEncoderOf :: ToJSON a => Encoder a
jsonEncoderOf :: forall a. ToJSON a => Encoder a
jsonEncoderOf = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \a
a -> (forall a. ToJSON a => a -> Value
toJSON a
a, forall a. ToJSON a => a -> Encoding
toEncoding a
a)
encodeMaybeOf :: forall a. (Typeable a) => Typed (Encoder a -> Encoder (Maybe a))
encodeMaybeOf :: forall a. Typeable a => Typed (Encoder a -> Encoder (Maybe a))
encodeMaybeOf = forall a. Typeable a => a -> Typed a
fun (forall a. Encoder a -> Encoder (Maybe a)
maybeOfEncoder @a)
maybeOfEncoder :: Encoder a -> Encoder (Maybe a)
maybeOfEncoder :: forall a. Encoder a -> Encoder (Maybe a)
maybeOfEncoder (Encoder a -> (Value, Encoding)
e) = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \case
Maybe a
Nothing -> (Value
Null, Encoding
null_)
Just a
a -> a -> (Value, Encoding)
e a
a
encodePairOf :: forall a b. (Typeable a, Typeable b) => Typed (Encoder a -> Encoder b -> Encoder (a, b))
encodePairOf :: forall a b.
(Typeable a, Typeable b) =>
Typed (Encoder a -> Encoder b -> Encoder (a, b))
encodePairOf = forall a. Typeable a => a -> Typed a
fun (forall a b. Encoder a -> Encoder b -> Encoder (a, b)
pairOfEncoder @a @b)
pairOfEncoder :: Encoder a -> Encoder b -> Encoder (a, b)
pairOfEncoder :: forall a b. Encoder a -> Encoder b -> Encoder (a, b)
pairOfEncoder (Encoder a -> (Value, Encoding)
ea) (Encoder b -> (Value, Encoding)
eb) =
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \(a
a, b
b) -> do
let ([Value]
ls1, [Encoding]
ls2) = forall a b. [(a, b)] -> ([a], [b])
unzip [a -> (Value, Encoding)
ea a
a, b -> (Value, Encoding)
eb b
b]
([Value] -> Value
array [Value]
ls1, forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
ls2)
encodeTripleOf :: forall a b c. (Typeable a, Typeable b, Typeable c) => Typed (Encoder a -> Encoder b -> Encoder c -> Encoder (a, b, c))
encodeTripleOf :: forall a b c.
(Typeable a, Typeable b, Typeable c) =>
Typed (Encoder a -> Encoder b -> Encoder c -> Encoder (a, b, c))
encodeTripleOf = forall a. Typeable a => a -> Typed a
fun (forall a b c.
Encoder a -> Encoder b -> Encoder c -> Encoder (a, b, c)
tripleOfEncoder @a @b @c)
tripleOfEncoder :: Encoder a -> Encoder b -> Encoder c -> Encoder (a, b, c)
tripleOfEncoder :: forall a b c.
Encoder a -> Encoder b -> Encoder c -> Encoder (a, b, c)
tripleOfEncoder (Encoder a -> (Value, Encoding)
ea) (Encoder b -> (Value, Encoding)
eb) (Encoder c -> (Value, Encoding)
ec) =
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \(a
a, b
b, c
c) -> do
let ([Value]
ls1, [Encoding]
ls2) = forall a b. [(a, b)] -> ([a], [b])
unzip [a -> (Value, Encoding)
ea a
a, b -> (Value, Encoding)
eb b
b, c -> (Value, Encoding)
ec c
c]
([Value] -> Value
array [Value]
ls1, forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
ls2)
encodeSetOf :: forall a. (Typeable a) => Typed (Encoder a -> Encoder (Set a))
encodeSetOf :: forall a. Typeable a => Typed (Encoder a -> Encoder (Set a))
encodeSetOf = forall a. Typeable a => a -> Typed a
fun (forall a. Encoder a -> Encoder (Set a)
setOfEncoder @a)
setOfEncoder :: Encoder a -> Encoder (Set a)
setOfEncoder :: forall a. Encoder a -> Encoder (Set a)
setOfEncoder (Encoder a -> (Value, Encoding)
ea) = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \Set a
as -> do
let ([Value]
ls1, [Encoding]
ls2) = forall a b. [(a, b)] -> ([a], [b])
unzip (a -> (Value, Encoding)
ea forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
S.toList Set a
as)
([Value] -> Value
array [Value]
ls1, forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
ls2)
encodeListOf :: forall a. (Typeable a) => Typed (Encoder a -> Encoder [a])
encodeListOf :: forall a. Typeable a => Typed (Encoder a -> Encoder [a])
encodeListOf = forall a. Typeable a => a -> Typed a
fun (forall a. Encoder a -> Encoder [a]
listOfEncoder @a)
listOfEncoder :: Encoder a -> Encoder [a]
listOfEncoder :: forall a. Encoder a -> Encoder [a]
listOfEncoder (Encoder a -> (Value, Encoding)
ea) = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \[a]
as -> do
let ([Value]
ls1, [Encoding]
ls2) = forall a b. [(a, b)] -> ([a], [b])
unzip (a -> (Value, Encoding)
ea forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as)
([Value] -> Value
array [Value]
ls1, forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
ls2)
encodeMapOf :: forall a b. (Typeable a, Typeable b) => Typed (KeyEncoder a -> Encoder b -> Encoder (Map a b))
encodeMapOf :: forall a b.
(Typeable a, Typeable b) =>
Typed (KeyEncoder a -> Encoder b -> Encoder (Map a b))
encodeMapOf = forall a. Typeable a => a -> Typed a
fun (forall a b. KeyEncoder a -> Encoder b -> Encoder (Map a b)
mapOfEncoder @a @b)
mapOfEncoder :: KeyEncoder a -> Encoder b -> Encoder (Map a b)
mapOfEncoder :: forall a b. KeyEncoder a -> Encoder b -> Encoder (Map a b)
mapOfEncoder KeyEncoder a
ea (Encoder b -> (Value, Encoding)
eb) = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \Map a b
ms -> do
let ks :: [Key]
ks = forall a. KeyEncoder a -> a -> Key
encodeAsKey KeyEncoder a
ea forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [k]
M.keys Map a b
ms
let ([Value]
vs1, [Encoding]
vs2) = forall a b. [(a, b)] -> ([a], [b])
unzip (b -> (Value, Encoding)
eb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map a b
ms)
(Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. [(Key, v)] -> KeyMap v
KM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
ks [Value]
vs1, Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Encoding -> Series
pair) (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
ks [Encoding]
vs2))
encodeNonEmptyOf :: forall a. (Typeable a) => Typed (Encoder a -> Encoder (NonEmpty a))
encodeNonEmptyOf :: forall a. Typeable a => Typed (Encoder a -> Encoder (NonEmpty a))
encodeNonEmptyOf = forall a. Typeable a => a -> Typed a
fun (forall a. Encoder a -> Encoder (NonEmpty a)
nonEmptyOfEncoder @a)
nonEmptyOfEncoder :: Encoder a -> Encoder (NonEmpty a)
nonEmptyOfEncoder :: forall a. Encoder a -> Encoder (NonEmpty a)
nonEmptyOfEncoder = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoder a -> Encoder [a]
listOfEncoder
array :: [Value] -> Value
array :: [Value] -> Value
array = Array -> Value
Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList
defaultEncoderOptions :: Registry _ _
defaultEncoderOptions :: Registry
'[]
'[ConstructorEncoder, KeyEncoder Text, KeyEncoder String, Options]
defaultEncoderOptions =
forall a. Typeable a => a -> Typed a
fun ConstructorEncoder
defaultConstructorEncoder
forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun KeyEncoder Text
textKeyEncoder
forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun KeyEncoder String
stringKeyEncoder
forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. (Typeable a, Show a) => a -> Typed a
val Options
defaultOptions
textKeyEncoder :: KeyEncoder Text
textKeyEncoder :: KeyEncoder Text
textKeyEncoder = forall a. (a -> Key) -> KeyEncoder a
KeyEncoder Text -> Key
K.fromText
stringKeyEncoder :: KeyEncoder String
stringKeyEncoder :: KeyEncoder String
stringKeyEncoder = forall a. (a -> Key) -> KeyEncoder a
KeyEncoder String -> Key
K.fromString
newtype ConstructorEncoder = ConstructorEncoder
{ ConstructorEncoder
-> Options -> FromConstructor -> (Value, Encoding)
encodeConstructor :: Options -> FromConstructor -> (Value, Encoding)
}
defaultConstructorEncoder :: ConstructorEncoder
defaultConstructorEncoder :: ConstructorEncoder
defaultConstructorEncoder = (Options -> FromConstructor -> (Value, Encoding))
-> ConstructorEncoder
ConstructorEncoder Options -> FromConstructor -> (Value, Encoding)
makeEncoderFromConstructor
data FromConstructor = FromConstructor
{
FromConstructor -> [Text]
fromConstructorNames :: [Text],
FromConstructor -> [Text]
fromConstructorTypes :: [Text],
FromConstructor -> Text
fromConstructorName :: Text,
FromConstructor -> [Text]
fromConstructorFieldNames :: [Text],
FromConstructor -> [(Value, Encoding)]
fromConstructorValues :: [(Value, Encoding)]
}
deriving (FromConstructor -> FromConstructor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromConstructor -> FromConstructor -> Bool
$c/= :: FromConstructor -> FromConstructor -> Bool
== :: FromConstructor -> FromConstructor -> Bool
$c== :: FromConstructor -> FromConstructor -> Bool
Eq, Int -> FromConstructor -> ShowS
[FromConstructor] -> ShowS
FromConstructor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromConstructor] -> ShowS
$cshowList :: [FromConstructor] -> ShowS
show :: FromConstructor -> String
$cshow :: FromConstructor -> String
showsPrec :: Int -> FromConstructor -> ShowS
$cshowsPrec :: Int -> FromConstructor -> ShowS
Show)
makeEncoderFromConstructor :: Options -> FromConstructor -> (Value, Encoding)
makeEncoderFromConstructor :: Options -> FromConstructor -> (Value, Encoding)
makeEncoderFromConstructor Options
options FromConstructor
fromConstructor = do
let fc :: FromConstructor
fc = Options -> FromConstructor -> FromConstructor
modifyFromConstructorWithOptions Options
options FromConstructor
fromConstructor
case FromConstructor
fc of
FromConstructor [Text]
_ [] Text
name [Text]
_ [(Value, Encoding)]
_ ->
if Options -> Bool
allNullaryToStringTag Options
options
then (Text -> Value
String Text
name, forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
name)
else Options -> FromConstructor -> (Value, Encoding)
makeSumEncoding Options
options FromConstructor
fc
FromConstructor [Item [Text]
_] [Text]
_ Text
_ [Text]
names [(Value, Encoding)]
values ->
if Options -> Bool
tagSingleConstructors Options
options
then case ([Text]
names, [(Value, Encoding)]
values) of
([Text]
_, [Item [(Value, Encoding)]
v]) | Options -> SumEncoding
sumEncoding Options
options forall a. Eq a => a -> a -> Bool
== SumEncoding
UntaggedValue Bool -> Bool -> Bool
&& Options -> Bool
unwrapUnaryRecords Options
options -> Item [(Value, Encoding)]
v
([Text], [(Value, Encoding)])
_ -> Options -> FromConstructor -> (Value, Encoding)
makeSumEncoding Options
options FromConstructor
fc
else do
case [(Value, Encoding)]
values of
[(Value
v, Encoding
e)] ->
if Options -> Bool
unwrapUnaryRecords Options
options Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
names
then (Value
v, Encoding
e)
else [Text] -> [(Value, Encoding)] -> (Value, Encoding)
valuesToObject [Text]
names [(Value, Encoding)]
values
[(Value, Encoding)]
_ ->
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
names
then do
let ([Value]
vs, [Encoding]
es) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
([Value] -> Value
array [Value]
vs, forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
es)
else [Text] -> [(Value, Encoding)] -> (Value, Encoding)
valuesToObject [Text]
names [(Value, Encoding)]
values
FromConstructor
_ ->
Options -> FromConstructor -> (Value, Encoding)
makeSumEncoding Options
options FromConstructor
fc
makeSumEncoding :: Options -> FromConstructor -> (Value, Encoding)
makeSumEncoding :: Options -> FromConstructor -> (Value, Encoding)
makeSumEncoding Options
options (FromConstructor [Text]
_constructorNames [Text]
_constructorTypes Text
constructorTag [Text]
fieldNames [(Value, Encoding)]
values) = do
let fieldNamesKeys :: [Key]
fieldNamesKeys = Text -> Key
K.fromText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
fieldNames
case Options -> SumEncoding
sumEncoding Options
options of
SumEncoding
UntaggedValue ->
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fieldNames
then do
let ([Value]
vs, [Encoding]
es) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
case ([Value]
vs, [Encoding]
es) of
([], []) -> (Text -> Value
String forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag, forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag)
([Item [Value]
v], [Item [Encoding]
e]) -> (Item [Value]
v, Item [Encoding]
e)
([Value], [Encoding])
_ -> ([Value] -> Value
array [Value]
vs, forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
es)
else do
let ([Value]
vs, [Encoding]
es) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
case ([Value]
vs, [Encoding]
es) of
([Item [Value]
v], [Item [Encoding]
e]) | Options -> Bool
unwrapUnaryRecords Options
options -> (Item [Value]
v, Item [Encoding]
e)
([Value], [Encoding])
_ -> [Text] -> [(Value, Encoding)] -> (Value, Encoding)
valuesToObject [Text]
fieldNames [(Value, Encoding)]
values
SumEncoding
TwoElemArray ->
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fieldNames
then do
let ([Value]
vs, [Encoding]
es) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
case ([Value]
vs, [Encoding]
es) of
([], []) -> (Text -> Value
String Text
constructorTag, forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag)
([Item [Value]
v], [Item [Encoding]
e]) -> ([Value] -> Value
array [Text -> Value
String Text
constructorTag, Item [Value]
v], forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag, Item [Encoding]
e])
([Value], [Encoding])
_ -> ([Value] -> Value
array [Text -> Value
String Text
constructorTag, [Value] -> Value
array [Value]
vs], forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag, forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
es])
else do
let ([Value]
vs, [Encoding]
es) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
case ([Value]
vs, [Encoding]
es) of
([Item [Value]
v], [Item [Encoding]
e])
| Options -> Bool
unwrapUnaryRecords Options
options ->
([Value] -> Value
array [Text -> Value
String Text
constructorTag, Item [Value]
v], forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag, Item [Encoding]
e])
([Value], [Encoding])
_ -> do
let (Value
vs', Encoding
es') = [Text] -> [(Value, Encoding)] -> (Value, Encoding)
valuesToObject [Text]
fieldNames [(Value, Encoding)]
values
([Value] -> Value
array [Text -> Value
String Text
constructorTag, Value
vs'], forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag, Encoding
es'])
SumEncoding
ObjectWithSingleField -> do
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fieldNames
then do
let ([Value]
vs, [Encoding]
es) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
case ([Value]
vs, [Encoding]
es) of
([], []) -> (Text -> Value
String Text
constructorTag, forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag)
([Item [Value]
v], [Item [Encoding]
e]) -> (Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Key -> v -> KeyMap v
KM.singleton (Text -> Key
K.fromText Text
constructorTag) Item [Value]
v, Series -> Encoding
pairs (Key -> Encoding -> Series
pair (Text -> Key
K.fromText Text
constructorTag) Item [Encoding]
e))
([Value], [Encoding])
_ -> (Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Key -> v -> KeyMap v
KM.singleton (Text -> Key
K.fromText Text
constructorTag) ([Value] -> Value
array [Value]
vs), Series -> Encoding
pairs (Key -> Encoding -> Series
pair (Text -> Key
K.fromText Text
constructorTag) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
es))
else do
let ([Value]
vs, [Encoding]
es) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
case ([Value]
vs, [Encoding]
es) of
([Item [Value]
v], [Item [Encoding]
e])
| Options -> Bool
unwrapUnaryRecords Options
options ->
(Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Key -> v -> KeyMap v
KM.singleton (Text -> Key
K.fromText Text
constructorTag) Item [Value]
v, Series -> Encoding
pairs (Key -> Encoding -> Series
pair (Text -> Key
K.fromText Text
constructorTag) Item [Encoding]
e))
([Value], [Encoding])
_ -> do
let (Value
vs', Encoding
es') = [Text] -> [(Value, Encoding)] -> (Value, Encoding)
valuesToObject [Text]
fieldNames [(Value, Encoding)]
values
(Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Key -> v -> KeyMap v
KM.singleton (Text -> Key
K.fromText Text
constructorTag) Value
vs', Series -> Encoding
pairs (Key -> Encoding -> Series
pair (Text -> Key
K.fromText Text
constructorTag) Encoding
es'))
TaggedObject String
tagFieldName String
contentsFieldName ->
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Value, Encoding)]
values
then
( Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
tagFieldName, Text -> Value
String Text
constructorTag)],
Series -> Encoding
pairs (Key -> Encoding -> Series
pair (Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
tagFieldName) (forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag))
)
else
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fieldNames
then case forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values of
([Item [Value]
v], [Item [Encoding]
e]) ->
( Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
tagFieldName, Text -> Value
String Text
constructorTag), (Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
contentsFieldName, Item [Value]
v)],
Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair (Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
tagFieldName) (forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag) forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair (Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
contentsFieldName) Item [Encoding]
e
)
([Value]
vs, [Encoding]
es) ->
( Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
tagFieldName, Text -> Value
String Text
constructorTag), (Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
contentsFieldName, [Value] -> Value
array [Value]
vs)],
Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair (Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
tagFieldName) (forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag) forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair (Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
contentsFieldName) (forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
es)
)
else do
let ([Value]
vs, [Encoding]
es) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
( Object -> Value
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. [(Key, v)] -> KeyMap v
KM.fromList forall a b. (a -> b) -> a -> b
$ (Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
tagFieldName, Text -> Value
String Text
constructorTag) forall a. a -> [a] -> [a]
: forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
fieldNamesKeys [Value]
vs,
Series -> Encoding
pairs (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. a -> a
identity forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair (Text -> Key
K.fromText forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS String
tagFieldName) (forall a. String -> Encoding' a
string forall a b. (a -> b) -> a -> b
$ forall a b. ConvertText a b => a -> b
toS Text
constructorTag) forall a. a -> [a] -> [a]
: (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Encoding -> Series
pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
fieldNamesKeys [Encoding]
es))
)
modifyFromConstructorWithOptions :: Options -> FromConstructor -> FromConstructor
modifyFromConstructorWithOptions :: Options -> FromConstructor -> FromConstructor
modifyFromConstructorWithOptions Options
options FromConstructor
fc = do
let ([Text]
fn, [(Value, Encoding)]
fv) =
if Options -> Bool
omitNothingFields Options
options Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length (FromConstructor -> [Text]
fromConstructorFieldNames FromConstructor
fc) forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length (FromConstructor -> [(Value, Encoding)]
fromConstructorValues FromConstructor
fc)
then forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Value
Null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (FromConstructor -> [Text]
fromConstructorFieldNames FromConstructor
fc) (FromConstructor -> [(Value, Encoding)]
fromConstructorValues FromConstructor
fc)
else (FromConstructor -> [Text]
fromConstructorFieldNames FromConstructor
fc, FromConstructor -> [(Value, Encoding)]
fromConstructorValues FromConstructor
fc)
FromConstructor
fc
{ fromConstructorName :: Text
fromConstructorName = forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ShowS
constructorTagModifier Options
options forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall a b. (a -> b) -> a -> b
$ FromConstructor -> Text
fromConstructorName FromConstructor
fc,
fromConstructorFieldNames :: [Text]
fromConstructorFieldNames = forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ShowS
fieldLabelModifier Options
options forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
fn,
fromConstructorValues :: [(Value, Encoding)]
fromConstructorValues = [(Value, Encoding)]
fv
}
valuesToObject :: [Text] -> [(Value, Encoding)] -> (Value, Encoding)
valuesToObject :: [Text] -> [(Value, Encoding)] -> (Value, Encoding)
valuesToObject [Text]
fieldNames [(Value, Encoding)]
values = do
let ([Value]
vs, [Encoding]
es) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
let fieldNamesKeys :: [Key]
fieldNamesKeys = Text -> Key
K.fromText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
fieldNames
(Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. [(Key, v)] -> KeyMap v
KM.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
fieldNamesKeys [Value]
vs), Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Encoding -> Series
pair) (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
fieldNamesKeys [Encoding]
es))