{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}

{-
  An Encoder is used to encode a specific data type into a Aeson Object
  This module provides several functions to create encoders and assemble them into a registry of encoders.
-}

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 qualified Data.Vector as V
import Protolude hiding (Type, list)

-- * ENCODER DATA TYPE

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)

-- * ENCODE VALUES

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

-- * CREATE ENCODERS

-- | Create an Encoder from a function returning a Value
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)

-- | Create an encoder from a Aeson instance
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)

-- * COMBINATORS

-- | Create an Encoder for a (Maybe 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

-- | Create an Encoder for a pair (a, b)
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)

-- | Create an Encoder for a tripe (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 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)

-- | Create an Encoder for a list [a]
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)

-- | Create an Encoder for a non-empty list (NonEmpty a)
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

-- | Shortcut function to create arrays
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

-- * DEFAULT VALUES

defaultEncoderOptions :: Registry _ _
defaultEncoderOptions :: Registry '[] '[ConstructorEncoder, 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, Show a) => a -> Typed a
val Options
defaultOptions

-- * BUILDING ENCODERS

-- | A ConstructorEncoder uses configuration options + type information extracted from
--   a given data type (with TemplateHaskell) in order to produce a Value and an Encoding
newtype ConstructorEncoder = ConstructorEncoder
  { ConstructorEncoder
-> Options -> FromConstructor -> (Value, Encoding)
encodeConstructor :: Options -> FromConstructor -> (Value, Encoding)
  }

-- | Default implementation, it can be overridden in a registry
defaultConstructorEncoder :: ConstructorEncoder
defaultConstructorEncoder :: ConstructorEncoder
defaultConstructorEncoder = (Options -> FromConstructor -> (Value, Encoding))
-> ConstructorEncoder
ConstructorEncoder Options -> FromConstructor -> (Value, Encoding)
makeEncoderFromConstructor

-- | Minimum set of data extracted from a given type with Template Haskell
--   in order to create the appropriate encoder given an Options value
data FromConstructor = FromConstructor
  { -- | names of all the constructors of the type
    FromConstructor -> [Text]
fromConstructorNames :: [Text],
    -- | types of all the constructors of the type
    FromConstructor -> [Text]
fromConstructorTypes :: [Text],
    -- | name of the constructor for the value to encode
    FromConstructor -> Text
fromConstructorName :: Text,
    -- | name of all the constructor fields
    FromConstructor -> [Text]
fromConstructorFieldNames :: [Text],
    -- | encoded values of all the constructor fields
    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)

-- | Make an Encoder from Options and the representation of a constructor for a given value to encode
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
    -- nullary constructors
    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
    -- single constructor
    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
    -- sum constructor
    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))
                )

-- | Apply Options to the constructor name + field names
--   and remove Nothing values if necessary
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
    }

-- | Create an Object from a list of field names and a list of Values
--   both as a Value and as an Encoding
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. a -> a
identity (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))