{-# 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) = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder (a -> (Value, Encoding)
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f)

newtype KeyEncoder a = KeyEncoder {forall a. KeyEncoder a -> a -> Key
encodeAsKey :: a -> Key}

instance Contravariant KeyEncoder where
  contramap :: forall a' a. (a' -> a) -> KeyEncoder a -> KeyEncoder a'
contramap a' -> a
f (KeyEncoder a -> Key
a) = forall a. (a -> Key) -> KeyEncoder a
KeyEncoder (a -> Key
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f)

-- * 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 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 = forall a. Typeable a => a -> Typed a
fun (forall a. (a -> Text) -> KeyEncoder a
keyEncoder a -> Text
f)

keyEncoder :: (a -> Text) -> KeyEncoder a
keyEncoder :: forall a. (a -> Text) -> KeyEncoder a
keyEncoder a -> Text
f = forall a. (a -> Key) -> KeyEncoder a
KeyEncoder forall a b. (a -> b) -> a -> b
$ String -> Key
K.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
f

-- * 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 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 = forall a. Typeable a => a -> Typed a
fun (forall a. Encoder a -> Encoder (Set a)
setOfEncoder @a)

setOfEncoder :: Encoder a -> Encoder (Set a)
setOfEncoder :: forall a. Encoder a -> Encoder (Set a)
setOfEncoder (Encoder a -> (Value, Encoding)
ea) = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \Set a
as -> do
  let ([Value]
ls1, [Encoding]
ls2) = forall a b. [(a, b)] -> ([a], [b])
unzip (a -> (Value, Encoding)
ea forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
S.toList Set a
as)
  ([Value] -> Value
array [Value]
ls1, forall a. (a -> Encoding) -> [a] -> Encoding
list forall a. a -> a
identity [Encoding]
ls2)

-- | 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 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 = forall a. Typeable a => a -> Typed a
fun (forall a b. KeyEncoder a -> Encoder b -> Encoder (Map a b)
mapOfEncoder @a @b)

mapOfEncoder :: KeyEncoder a -> Encoder b -> Encoder (Map a b)
mapOfEncoder :: forall a b. KeyEncoder a -> Encoder b -> Encoder (Map a b)
mapOfEncoder KeyEncoder a
ea (Encoder b -> (Value, Encoding)
eb) = forall a. (a -> (Value, Encoding)) -> Encoder a
Encoder forall a b. (a -> b) -> a -> b
$ \Map a b
ms -> do
  let ks :: [Key]
ks = forall a. KeyEncoder a -> a -> Key
encodeAsKey KeyEncoder a
ea forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [k]
M.keys Map a b
ms
  let ([Value]
vs1, [Encoding]
vs2) = forall a b. [(a, b)] -> ([a], [b])
unzip (b -> (Value, Encoding)
eb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map a b
ms)
  (Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. [(Key, v)] -> KeyMap v
KM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
ks [Value]
vs1, Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Encoding -> Series
pair) (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
ks [Encoding]
vs2))

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

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

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

-- * 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 b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Encoding -> Series
pair) (forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
fieldNamesKeys [Encoding]
es))