{-# 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,
    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)

-- * 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) = (a' -> (Value, Encoding)) -> Encoder a'
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder (a -> (Value, Encoding)
a (a -> (Value, Encoding)) -> (a' -> a) -> a' -> (Value, Encoding)
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) = (a' -> Key) -> KeyEncoder a'
forall a. (a -> Key) -> KeyEncoder a
KeyEncoder (a -> Key
a (a -> Key) -> (a' -> a) -> a' -> Key
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 (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 :: forall a. 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

-- * CREATE KEY ENCODERS

-- | Make a key encoder from a function returning some text
encodeKey :: forall a. Typeable a => (a -> Text) -> Typed (KeyEncoder a)
encodeKey :: forall a. Typeable a => (a -> Text) -> Typed (KeyEncoder a)
encodeKey a -> Text
f = KeyEncoder a -> Typed (KeyEncoder a)
forall a. Typeable a => a -> Typed a
fun ((a -> Text) -> KeyEncoder a
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 = (a -> Key) -> KeyEncoder a
forall a. (a -> Key) -> KeyEncoder a
KeyEncoder ((a -> Key) -> KeyEncoder a) -> (a -> Key) -> KeyEncoder a
forall a b. (a -> b) -> a -> b
$ String -> Key
K.fromString (String -> Key) -> (a -> String) -> a -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a b. ConvertText a b => a -> b
toS (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
f

-- * 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 = (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)

-- | 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 = Encoder a -> Typed (Encoder a)
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 = (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)

-- * 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 = (Encoder a -> Encoder (Maybe a))
-> Typed (Encoder a -> Encoder (Maybe a))
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) = (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

-- | 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 = (Encoder a -> Encoder b -> Encoder (a, b))
-> Typed (Encoder a -> Encoder b -> Encoder (a, b))
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) =
  ((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)

-- | 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 = (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 (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) =
  ((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)

-- | Create an Encoder for a Set a
encodeSetOf :: forall a. (Typeable a) => Typed (Encoder a -> Encoder (Set a))
encodeSetOf :: forall a. Typeable a => Typed (Encoder a -> Encoder (Set a))
encodeSetOf = (Encoder a -> Encoder (Set a))
-> Typed (Encoder a -> Encoder (Set a))
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) = (Set a -> (Value, Encoding)) -> Encoder (Set a)
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder ((Set a -> (Value, Encoding)) -> Encoder (Set a))
-> (Set a -> (Value, Encoding)) -> Encoder (Set a)
forall a b. (a -> b) -> a -> b
$ \Set 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
<$> Set a -> [a]
forall a. Set a -> [a]
S.toList Set 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)

-- | 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 = (Encoder a -> Encoder [a]) -> Typed (Encoder a -> Encoder [a])
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) = ([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)

-- | Create an Encoder for a map a b
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 = (KeyEncoder a -> Encoder b -> Encoder (Map a b))
-> Typed (KeyEncoder a -> Encoder b -> Encoder (Map a b))
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) = (Map a b -> (Value, Encoding)) -> Encoder (Map a b)
forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder ((Map a b -> (Value, Encoding)) -> Encoder (Map a b))
-> (Map a b -> (Value, Encoding)) -> Encoder (Map a b)
forall a b. (a -> b) -> a -> b
$ \Map a b
ms -> do
  let ks :: [Key]
ks = KeyEncoder a -> a -> Key
forall a. KeyEncoder a -> a -> Key
encodeAsKey KeyEncoder a
ea (a -> Key) -> [a] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map a b -> [a]
forall k a. Map k a -> [k]
M.keys Map a b
ms
  let ([Value]
vs1, [Encoding]
vs2) = [(Value, Encoding)] -> ([Value], [Encoding])
forall a b. [(a, b)] -> ([a], [b])
unzip (b -> (Value, Encoding)
eb (b -> (Value, Encoding)) -> [b] -> [(Value, Encoding)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map a b -> [b]
forall a. Map a a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map a b
ms)
  (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)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$ [Key] -> [Value] -> [(Key, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
ks [Value]
vs1, Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ ((Key, Encoding) -> Series) -> [(Key, Encoding)] -> Series
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Key -> Encoding -> Series) -> (Key, Encoding) -> Series
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Encoding -> Series
pair) ([Key] -> [Encoding] -> [(Key, Encoding)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
ks [Encoding]
vs2))

-- | 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 = (Encoder a -> Encoder (NonEmpty a))
-> Typed (Encoder a -> Encoder (NonEmpty a))
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 = (NonEmpty a -> [a]) -> Encoder [a] -> Encoder (NonEmpty a)
forall a' a. (a' -> a) -> Encoder a -> Encoder a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap NonEmpty a -> [a]
forall a. 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

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

-- * DEFAULT VALUES

defaultEncoderOptions :: Registry _ _
defaultEncoderOptions :: Registry
  '[]
  '[ConstructorEncoder, KeyEncoder Text, KeyEncoder String, Options]
defaultEncoderOptions =
  ConstructorEncoder -> Typed ConstructorEncoder
forall a. Typeable a => a -> Typed a
fun ConstructorEncoder
defaultConstructorEncoder
    Typed ConstructorEncoder
-> Registry '[] '[KeyEncoder Text, KeyEncoder String, Options]
-> Registry
     '[]
     '[ConstructorEncoder, KeyEncoder Text, KeyEncoder String, Options]
forall a b c. AddRegistryLike a b c => a -> b -> c
<: KeyEncoder Text -> Typed (KeyEncoder Text)
forall a. Typeable a => a -> Typed a
fun KeyEncoder Text
textKeyEncoder
    Typed (KeyEncoder Text)
-> Registry '[] '[KeyEncoder String, Options]
-> Registry '[] '[KeyEncoder Text, KeyEncoder String, Options]
forall a b c. AddRegistryLike a b c => a -> b -> c
<: KeyEncoder String -> Typed (KeyEncoder String)
forall a. Typeable a => a -> Typed a
fun KeyEncoder String
stringKeyEncoder
    Typed (KeyEncoder String)
-> Typed Options -> Registry '[] '[KeyEncoder String, 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

textKeyEncoder :: KeyEncoder Text
textKeyEncoder :: KeyEncoder Text
textKeyEncoder = (Text -> Key) -> KeyEncoder Text
forall a. (a -> Key) -> KeyEncoder a
KeyEncoder Text -> Key
K.fromText

stringKeyEncoder :: KeyEncoder String
stringKeyEncoder :: KeyEncoder String
stringKeyEncoder = (String -> Key) -> KeyEncoder String
forall a. (a -> Key) -> KeyEncoder a
KeyEncoder String -> Key
K.fromString

-- * 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
(FromConstructor -> FromConstructor -> Bool)
-> (FromConstructor -> FromConstructor -> Bool)
-> Eq FromConstructor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FromConstructor -> FromConstructor -> Bool
== :: FromConstructor -> FromConstructor -> Bool
$c/= :: FromConstructor -> FromConstructor -> Bool
/= :: 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
$cshowsPrec :: Int -> FromConstructor -> ShowS
showsPrec :: Int -> FromConstructor -> ShowS
$cshow :: FromConstructor -> String
show :: FromConstructor -> String
$cshowList :: [FromConstructor] -> ShowS
showList :: [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, 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
    -- 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 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
            [(Value
v, Encoding
e)] ->
              if Options -> Bool
unwrapUnaryRecords Options
options Bool -> Bool -> Bool
|| [Text] -> Bool
forall a. [a] -> 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 a. [a] -> 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
    -- 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 (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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 m a. Monoid m => (a -> m) -> [a] -> m
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))
                )

-- | 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
&& [Text] -> Int
forall a. [a] -> 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 a. [a] -> 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 = toS . constructorTagModifier options . toS $ fromConstructorName fc,
      fromConstructorFieldNames = toS . fieldLabelModifier options . toS <$> fn,
      fromConstructorValues = 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) = [(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
$ ((Key, Encoding) -> Series) -> [(Key, Encoding)] -> Series
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Key -> Encoding -> Series) -> (Key, Encoding) -> Series
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Encoding -> Series
pair) ([Key] -> [Encoding] -> [(Key, Encoding)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
fieldNamesKeys [Encoding]
es))