{-# 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,
)
where
import Data.Aeson
import Data.Aeson.Encoding.Internal
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString.Lazy as BL (toStrict)
import Data.Functor.Contravariant
import Data.Registry
import Data.Registry.Aeson.TH.Encoder
import Data.Registry.Internal.Types hiding (Value)
import qualified Data.Vector as V
import Protolude hiding (Type, list)
newtype Encoder a = Encoder {Encoder a -> a -> (Value, Encoding)
encode :: a -> (Value, Encoding)}
instance Contravariant Encoder where
contramap :: (a -> b) -> Encoder b -> Encoder a
contramap a -> b
f (Encoder b -> (Value, Encoding)
a) = (a -> (Value, Encoding)) -> Encoder a
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder (b -> (Value, Encoding)
a (b -> (Value, Encoding)) -> (a -> b) -> a -> (Value, Encoding)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
encodeByteString :: Encoder a -> a -> ByteString
encodeByteString :: Encoder a -> a -> ByteString
encodeByteString (Encoder a -> (Value, Encoding)
e) = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
forall a. Encoding' a -> ByteString
encodingToLazyByteString (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value, Encoding) -> Encoding
forall a b. (a, b) -> b
snd ((Value, Encoding) -> Encoding)
-> (a -> (Value, Encoding)) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Value, Encoding)
e
encodeValue :: Encoder a -> a -> Value
encodeValue :: Encoder a -> a -> Value
encodeValue (Encoder a -> (Value, Encoding)
e) = (Value, Encoding) -> Value
forall a b. (a, b) -> a
fst ((Value, Encoding) -> Value)
-> (a -> (Value, Encoding)) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Value, Encoding)
e
fromValue :: (a -> Value) -> Encoder a
fromValue :: (a -> Value) -> Encoder a
fromValue a -> Value
f = (a -> (Value, Encoding)) -> Encoder a
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder ((a -> (Value, Encoding)) -> Encoder a)
-> (a -> (Value, Encoding)) -> Encoder a
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 :: Typed (Encoder a)
jsonEncoder = Encoder a -> Typed (Encoder a)
forall a. Typeable a => a -> Typed a
fun (ToJSON a => Encoder a
forall a. ToJSON a => Encoder a
jsonEncoderOf @a)
jsonEncoderOf :: ToJSON a => Encoder a
jsonEncoderOf :: Encoder a
jsonEncoderOf = (a -> (Value, Encoding)) -> Encoder a
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder ((a -> (Value, Encoding)) -> Encoder a)
-> (a -> (Value, Encoding)) -> Encoder a
forall a b. (a -> b) -> a -> b
$ \a
a -> (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a, a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding a
a)
encodeMaybeOf :: forall a. (Typeable a) => Typed (Encoder a -> Encoder (Maybe a))
encodeMaybeOf :: Typed (Encoder a -> Encoder (Maybe a))
encodeMaybeOf = (Encoder a -> Encoder (Maybe a))
-> Typed (Encoder a -> Encoder (Maybe a))
forall a. Typeable a => a -> Typed a
fun (Encoder a -> Encoder (Maybe a)
forall a. Encoder a -> Encoder (Maybe a)
maybeOfEncoder @a)
maybeOfEncoder :: Encoder a -> Encoder (Maybe a)
maybeOfEncoder :: Encoder a -> Encoder (Maybe a)
maybeOfEncoder (Encoder a -> (Value, Encoding)
e) = (Maybe a -> (Value, Encoding)) -> Encoder (Maybe a)
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder ((Maybe a -> (Value, Encoding)) -> Encoder (Maybe a))
-> (Maybe a -> (Value, Encoding)) -> Encoder (Maybe a)
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 :: Typed (Encoder a -> Encoder b -> Encoder (a, b))
encodePairOf = (Encoder a -> Encoder b -> Encoder (a, b))
-> Typed (Encoder a -> Encoder b -> Encoder (a, b))
forall a. Typeable a => a -> Typed a
fun (Encoder a -> Encoder b -> Encoder (a, b)
forall a b. Encoder a -> Encoder b -> Encoder (a, b)
pairOfEncoder @a @b)
pairOfEncoder :: Encoder a -> Encoder b -> Encoder (a, b)
pairOfEncoder :: Encoder a -> Encoder b -> Encoder (a, b)
pairOfEncoder (Encoder a -> (Value, Encoding)
ea) (Encoder b -> (Value, Encoding)
eb) =
((a, b) -> (Value, Encoding)) -> Encoder (a, b)
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder (((a, b) -> (Value, Encoding)) -> Encoder (a, b))
-> ((a, b) -> (Value, Encoding)) -> Encoder (a, b)
forall a b. (a -> b) -> a -> b
$ \(a
a, b
b) -> do
let ([Value]
ls1, [Encoding]
ls2) = [(Value, Encoding)] -> ([Value], [Encoding])
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, (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
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 :: Typed (Encoder a -> Encoder b -> Encoder c -> Encoder (a, b, c))
encodeTripleOf = (Encoder a -> Encoder b -> Encoder c -> Encoder (a, b, c))
-> Typed (Encoder a -> Encoder b -> Encoder c -> Encoder (a, b, c))
forall a. Typeable a => a -> Typed a
fun (Encoder a -> Encoder b -> Encoder c -> Encoder (a, b, c)
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 :: 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) =
((a, b, c) -> (Value, Encoding)) -> Encoder (a, b, c)
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder (((a, b, c) -> (Value, Encoding)) -> Encoder (a, b, c))
-> ((a, b, c) -> (Value, Encoding)) -> Encoder (a, b, c)
forall a b. (a -> b) -> a -> b
$ \(a
a, b
b, c
c) -> do
let ([Value]
ls1, [Encoding]
ls2) = [(Value, Encoding)] -> ([Value], [Encoding])
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, (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [Encoding]
ls2)
encodeListOf :: forall a. (Typeable a) => Typed (Encoder a -> Encoder [a])
encodeListOf :: Typed (Encoder a -> Encoder [a])
encodeListOf = (Encoder a -> Encoder [a]) -> Typed (Encoder a -> Encoder [a])
forall a. Typeable a => a -> Typed a
fun (Encoder a -> Encoder [a]
forall a. Encoder a -> Encoder [a]
listOfEncoder @a)
listOfEncoder :: Encoder a -> Encoder [a]
listOfEncoder :: Encoder a -> Encoder [a]
listOfEncoder (Encoder a -> (Value, Encoding)
ea) = ([a] -> (Value, Encoding)) -> Encoder [a]
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder (([a] -> (Value, Encoding)) -> Encoder [a])
-> ([a] -> (Value, Encoding)) -> Encoder [a]
forall a b. (a -> b) -> a -> b
$ \[a]
as -> do
let ([Value]
ls1, [Encoding]
ls2) = [(Value, Encoding)] -> ([Value], [Encoding])
forall a b. [(a, b)] -> ([a], [b])
unzip (a -> (Value, Encoding)
ea (a -> (Value, Encoding)) -> [a] -> [(Value, Encoding)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
as)
([Value] -> Value
array [Value]
ls1, (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [Encoding]
ls2)
encodeNonEmptyOf :: forall a. (Typeable a) => Typed (Encoder a -> Encoder (NonEmpty a))
encodeNonEmptyOf :: Typed (Encoder a -> Encoder (NonEmpty a))
encodeNonEmptyOf = (Encoder a -> Encoder (NonEmpty a))
-> Typed (Encoder a -> Encoder (NonEmpty a))
forall a. Typeable a => a -> Typed a
fun (Encoder a -> Encoder (NonEmpty a)
forall a. Encoder a -> Encoder (NonEmpty a)
nonEmptyOfEncoder @a)
nonEmptyOfEncoder :: Encoder a -> Encoder (NonEmpty a)
nonEmptyOfEncoder :: Encoder a -> Encoder (NonEmpty a)
nonEmptyOfEncoder = (NonEmpty a -> [a]) -> Encoder [a] -> Encoder (NonEmpty a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Encoder [a] -> Encoder (NonEmpty a))
-> (Encoder a -> Encoder [a]) -> Encoder a -> Encoder (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder a -> Encoder [a]
forall a. Encoder a -> Encoder [a]
listOfEncoder
array :: [Value] -> Value
array :: [Value] -> Value
array = Array -> Value
Array (Array -> Value) -> ([Value] -> Array) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
V.fromList
defaultEncoderOptions :: Registry _ _
defaultEncoderOptions :: Registry '[] '[ConstructorEncoder, Options]
defaultEncoderOptions =
ConstructorEncoder -> Typed ConstructorEncoder
forall a. Typeable a => a -> Typed a
fun ConstructorEncoder
defaultConstructorEncoder
Typed ConstructorEncoder
-> Typed Options -> Registry '[] '[ConstructorEncoder, Options]
forall a b c. AddRegistryLike a b c => a -> b -> c
<: Options -> Typed Options
forall a. (Typeable a, Show a) => a -> Typed a
val Options
defaultOptions
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
(FromConstructor -> FromConstructor -> Bool)
-> (FromConstructor -> FromConstructor -> Bool)
-> Eq FromConstructor
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
(Int -> FromConstructor -> ShowS)
-> (FromConstructor -> String)
-> ([FromConstructor] -> ShowS)
-> Show FromConstructor
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, String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
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 SumEncoding -> SumEncoding -> Bool
forall a. Eq a => a -> a -> Bool
== SumEncoding
UntaggedValue Bool -> Bool -> Bool
&& Options -> Bool
unwrapUnaryRecords Options
options -> (Value, Encoding)
Item [(Value, Encoding)]
v
([Text], [(Value, Encoding)])
_ -> Options -> FromConstructor -> (Value, Encoding)
makeSumEncoding Options
options FromConstructor
fc
else do
case [(Value, Encoding)]
values of
[(v, e)] ->
if Options -> Bool
unwrapUnaryRecords Options
options Bool -> Bool -> Bool
|| [Text] -> 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 [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
names
then do
let ([Value]
vs, [Encoding]
es) = [(Value, Encoding)] -> ([Value], [Encoding])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
([Value] -> Value
array [Value]
vs, (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
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 (Text -> Key) -> [Text] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
fieldNames
case Options -> SumEncoding
sumEncoding Options
options of
SumEncoding
UntaggedValue ->
if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fieldNames
then do
let ([Value]
vs, [Encoding]
es) = [(Value, Encoding)] -> ([Value], [Encoding])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
case ([Value]
vs, [Encoding]
es) of
([], []) -> (Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall a b. ConvertText a b => a -> b
toS Text
constructorTag, String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
constructorTag)
([Item [Value]
v], [Item [Encoding]
e]) -> (Value
Item [Value]
v, Encoding
Item [Encoding]
e)
([Value], [Encoding])
_ -> ([Value] -> Value
array [Value]
vs, (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [Encoding]
es)
else do
let ([Value]
vs, [Encoding]
es) = [(Value, Encoding)] -> ([Value], [Encoding])
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
Item [Value]
v, Encoding
Item [Encoding]
e)
([Value], [Encoding])
_ -> [Text] -> [(Value, Encoding)] -> (Value, Encoding)
valuesToObject [Text]
fieldNames [(Value, Encoding)]
values
SumEncoding
TwoElemArray ->
if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fieldNames
then do
let ([Value]
vs, [Encoding]
es) = [(Value, Encoding)] -> ([Value], [Encoding])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
case ([Value]
vs, [Encoding]
es) of
([], []) -> (Text -> Value
String Text
constructorTag, String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
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], (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
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], (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
constructorTag, (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [Encoding]
es])
else do
let ([Value]
vs, [Encoding]
es) = [(Value, Encoding)] -> ([Value], [Encoding])
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], (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
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
Item [Value]
vs'], (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
constructorTag, Encoding
Item [Encoding]
es'])
SumEncoding
ObjectWithSingleField -> do
if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fieldNames
then do
let ([Value]
vs, [Encoding]
es) = [(Value, Encoding)] -> ([Value], [Encoding])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
case ([Value]
vs, [Encoding]
es) of
([], []) -> (Text -> Value
String Text
constructorTag, String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
constructorTag)
([Item [Value]
v], [Item [Encoding]
e]) -> (Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KM.singleton (Text -> Key
K.fromText Text
constructorTag) Value
Item [Value]
v, Series -> Encoding
pairs (Key -> Encoding -> Series
pair (Text -> Key
K.fromText Text
constructorTag) Encoding
Item [Encoding]
e))
([Value], [Encoding])
_ -> (Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
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) (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ (Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [Encoding]
es))
else do
let ([Value]
vs, [Encoding]
es) = [(Value, Encoding)] -> ([Value], [Encoding])
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 (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KM.singleton (Text -> Key
K.fromText Text
constructorTag) Value
Item [Value]
v, Series -> Encoding
pairs (Key -> Encoding -> Series
pair (Text -> Key
K.fromText Text
constructorTag) Encoding
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 (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
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 [(Value, Encoding)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Value, Encoding)]
values
then
( Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
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 (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
tagFieldName) (String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
constructorTag))
)
else
if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
fieldNames
then case [(Value, Encoding)] -> ([Value], [Encoding])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values of
([Item [Value]
v], [Item [Encoding]
e]) ->
( Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
tagFieldName, Text -> Value
String Text
constructorTag), (Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
contentsFieldName, Value
Item [Value]
v)],
Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair (Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
tagFieldName) (String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
constructorTag) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair (Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
contentsFieldName) Encoding
Item [Encoding]
e
)
([Value]
vs, [Encoding]
es) ->
( Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList [(Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
tagFieldName, Text -> Value
String Text
constructorTag), (Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
contentsFieldName, [Value] -> Value
array [Value]
vs)],
Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair (Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
tagFieldName) (String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
constructorTag) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Encoding -> Series
pair (Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
contentsFieldName) ((Encoding -> Encoding) -> [Encoding] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list Encoding -> Encoding
forall a. a -> a
identity [Encoding]
es)
)
else do
let ([Value]
vs, [Encoding]
es) = [(Value, Encoding)] -> ([Value], [Encoding])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
( Object -> Value
Object (Object -> Value)
-> ([(Key, Value)] -> Object) -> [(Key, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ (Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
tagFieldName, Text -> Value
String Text
constructorTag) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: [Key] -> [Value] -> [(Key, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
fieldNamesKeys [Value]
vs,
Series -> Encoding
pairs ((Series -> Series) -> [Series] -> Series
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Series -> Series
forall a. a -> a
identity ([Series] -> Series) -> [Series] -> Series
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
pair (Text -> Key
K.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertText a b => a -> b
toS String
tagFieldName) (String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> String -> Encoding
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
constructorTag) Series -> [Series] -> [Series]
forall a. a -> [a] -> [a]
: ((Key -> Encoding -> Series) -> (Key, Encoding) -> Series
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Encoding -> Series
pair ((Key, Encoding) -> Series) -> [(Key, Encoding)] -> [Series]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Key] -> [Encoding] -> [(Key, Encoding)]
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
&& [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FromConstructor -> [Text]
fromConstructorFieldNames FromConstructor
fc) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Value, Encoding)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FromConstructor -> [(Value, Encoding)]
fromConstructorValues FromConstructor
fc)
then [(Text, (Value, Encoding))] -> ([Text], [(Value, Encoding)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Text, (Value, Encoding))] -> ([Text], [(Value, Encoding)]))
-> [(Text, (Value, Encoding))] -> ([Text], [(Value, Encoding)])
forall a b. (a -> b) -> a -> b
$ ((Text, (Value, Encoding)) -> Bool)
-> [(Text, (Value, Encoding))] -> [(Text, (Value, Encoding))]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) (Value -> Bool)
-> ((Text, (Value, Encoding)) -> Value)
-> (Text, (Value, Encoding))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value, Encoding) -> Value
forall a b. (a, b) -> a
fst ((Value, Encoding) -> Value)
-> ((Text, (Value, Encoding)) -> (Value, Encoding))
-> (Text, (Value, Encoding))
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, (Value, Encoding)) -> (Value, Encoding)
forall a b. (a, b) -> b
snd) ([(Text, (Value, Encoding))] -> [(Text, (Value, Encoding))])
-> [(Text, (Value, Encoding))] -> [(Text, (Value, Encoding))]
forall a b. (a -> b) -> a -> b
$ [Text] -> [(Value, Encoding)] -> [(Text, (Value, Encoding))]
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 = String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ShowS
constructorTagModifier Options
options ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a b. ConvertText a b => a -> b
toS (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FromConstructor -> Text
fromConstructorName FromConstructor
fc,
fromConstructorFieldNames :: [Text]
fromConstructorFieldNames = String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ShowS
fieldLabelModifier Options
options ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a b. ConvertText a b => a -> b
toS (Text -> Text) -> [Text] -> [Text]
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) = [(Value, Encoding)] -> ([Value], [Encoding])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Value, Encoding)]
values
let fieldNamesKeys :: [Key]
fieldNamesKeys = Text -> Key
K.fromText (Text -> Key) -> [Text] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
fieldNames
(Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([Key] -> [Value] -> [(Key, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
fieldNamesKeys [Value]
vs), Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ (Series -> Series) -> [Series] -> Series
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Series -> Series
forall a. a -> a
identity ((Key -> Encoding -> Series) -> (Key, Encoding) -> Series
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Encoding -> Series
pair ((Key, Encoding) -> Series) -> [(Key, Encoding)] -> [Series]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Key] -> [Encoding] -> [(Key, Encoding)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
fieldNamesKeys [Encoding]
es))