{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}

{-| Please read the "Dhall.Tutorial" module, which contains a tutorial explaining
    how to use the language, the compiler, and this library
-}

module Dhall.Marshal.Encode
    ( -- * General
      Encoder(..)
    , ToDhall(..)
    , Inject
    , inject

      -- * Building encoders

      -- ** Records
    , RecordEncoder(..)
    , recordEncoder
    , encodeField
    , encodeFieldWith
      -- ** Unions
    , UnionEncoder(..)
    , unionEncoder
    , encodeConstructor
    , encodeConstructorWith
    , (>|<)

      -- * Generic encoding
    , GenericToDhall(..)
    , genericToDhall
    , genericToDhallWith
    , genericToDhallWithInputNormalizer
    , InterpretOptions(..)
    , SingletonConstructors(..)
    , defaultInterpretOptions

      -- * Miscellaneous
    , InputNormalizer(..)
    , defaultInputNormalizer
    , Result
    , (>$<)
    , (>*<)

    -- * Re-exports
    , Natural
    , Seq
    , Text
    , Vector
    , Generic
    ) where

import Control.Monad.Trans.State.Strict
import Data.Functor.Contravariant           (Contravariant (..), Op (..), (>$<))
import Data.Functor.Contravariant.Divisible (Divisible (..), divided)
import Dhall.Parser                         (Src (..))
import Dhall.Syntax
    ( Chunks (..)
    , DhallDouble (..)
    , Expr (..)
    )
import GHC.Generics
import Prelude                              hiding (maybe, sequence)

import qualified Control.Applicative
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
import qualified Data.ByteString.Short
import qualified Data.Functor.Product
import qualified Data.HashMap.Strict  as HashMap
import qualified Data.HashSet
import qualified Data.Map
import qualified Data.Scientific
import qualified Data.Sequence
import qualified Data.Set
import qualified Data.Text
import qualified Data.Text.Lazy
import qualified Data.Text.Short
import qualified Data.Time            as Time
import qualified Data.Vector
import qualified Data.Void
import qualified Dhall.Core           as Core
import qualified Dhall.Map

import Dhall.Marshal.Internal

-- $setup
-- >>> :set -XRecordWildCards
-- >>> import Dhall.Pretty.Internal (prettyExpr)

{-| An @(Encoder a)@ represents a way to marshal a value of type @\'a\'@ from
    Haskell into Dhall.
-}
data Encoder a = Encoder
    { forall a. Encoder a -> a -> Expr Src Void
embed    :: a -> Expr Src Void
    -- ^ Embeds a Haskell value as a Dhall expression
    , forall a. Encoder a -> Expr Src Void
declared :: Expr Src Void
    -- ^ Dhall type of the Haskell value
    }

instance Contravariant Encoder where
    contramap :: forall a' a. (a' -> a) -> Encoder a -> Encoder a'
contramap a' -> a
f (Encoder a -> Expr Src Void
embed Expr Src Void
declared) = forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder a' -> Expr Src Void
embed' Expr Src Void
declared
      where
        embed' :: a' -> Expr Src Void
embed' a'
x = a -> Expr Src Void
embed (a' -> a
f a'
x)

{-| This class is used by `Dhall.Marshal.Decode.FromDhall` instance for functions:

> instance (ToDhall a, FromDhall b) => FromDhall (a -> b)

    You can convert Dhall functions with "simple" inputs (i.e. instances of this
    class) into Haskell functions.  This works by:

    * Marshaling the input to the Haskell function into a Dhall expression (i.e.
      @x :: Expr Src Void@)
    * Applying the Dhall function (i.e. @f :: Expr Src Void@) to the Dhall input
      (i.e. @App f x@)
    * Normalizing the syntax tree (i.e. @normalize (App f x)@)
    * Marshaling the resulting Dhall expression back into a Haskell value

    This class auto-generates a default implementation for types that
    implement `Generic`.  This does not auto-generate an instance for recursive
    types.

    The default instance can be tweaked using 'genericToDhallWith'/'genericToDhallWithInputNormalizer'
    and custom 'InterpretOptions', or using
    [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia)
    and 'Dhall.Deriving.Codec' from "Dhall.Deriving".
-}
class ToDhall a where
    injectWith :: InputNormalizer -> Encoder a
    default injectWith
        :: (Generic a, GenericToDhall (Rep a)) => InputNormalizer -> Encoder a
    injectWith InputNormalizer
_ = forall a. (Generic a, GenericToDhall (Rep a)) => Encoder a
genericToDhall

-- | A compatibility alias for `ToDhall`
type Inject = ToDhall
{-# DEPRECATED Inject "Use ToDhall instead" #-}

{-| Use the default input normalizer for injecting a value.

> inject = injectWith defaultInputNormalizer
-}
inject :: ToDhall a => Encoder a
inject :: forall a. ToDhall a => Encoder a
inject = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
defaultInputNormalizer



instance ToDhall Void where
    injectWith :: InputNormalizer -> Encoder Void
injectWith InputNormalizer
_ = Encoder {forall {a}. Void -> a
forall {s} {a}. Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {a}. Void -> a
declared :: Expr Src Void
embed :: Void -> Expr Src Void
..}
      where
        embed :: Void -> a
embed = forall {a}. Void -> a
Data.Void.absurd

        declared :: Expr s a
declared = forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union forall a. Monoid a => a
mempty

instance ToDhall Bool where
    injectWith :: InputNormalizer -> Encoder Bool
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Bool -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Bool -> Expr s a
declared :: Expr Src Void
embed :: Bool -> Expr Src Void
..}
      where
        embed :: Bool -> Expr s a
embed = forall {s} {a}. Bool -> Expr s a
BoolLit

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Bool

instance ToDhall Data.ByteString.Short.ShortByteString where
    injectWith :: InputNormalizer -> Encoder ShortByteString
injectWith InputNormalizer
options =
        forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap ShortByteString -> ByteString
Data.ByteString.Short.fromShort (forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
options)

instance ToDhall Data.ByteString.Lazy.ByteString where
    injectWith :: InputNormalizer -> Encoder ByteString
injectWith InputNormalizer
options =
        forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap ByteString -> ByteString
Data.ByteString.Lazy.toStrict (forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
options)

instance ToDhall Data.ByteString.ByteString where
    injectWith :: InputNormalizer -> Encoder ByteString
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. ByteString -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. ByteString -> Expr s a
declared :: Expr Src Void
embed :: ByteString -> Expr Src Void
..}
      where
        embed :: ByteString -> Expr s a
embed ByteString
bytes = forall {s} {a}. ByteString -> Expr s a
BytesLit ByteString
bytes

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Bytes

instance ToDhall Data.Text.Short.ShortText where
    injectWith :: InputNormalizer -> Encoder ShortText
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. ShortText -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. ShortText -> Expr s a
declared :: Expr Src Void
embed :: ShortText -> Expr Src Void
..}
      where
        embed :: ShortText -> Expr s a
embed ShortText
text =
            forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (ShortText -> Text
Data.Text.Short.toText ShortText
text))

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Text

instance ToDhall Data.Text.Lazy.Text where
    injectWith :: InputNormalizer -> Encoder Text
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Text -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Text -> Expr s a
declared :: Expr Src Void
embed :: Text -> Expr Src Void
..}
      where
        embed :: Text -> Expr s a
embed Text
text =
            forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (Text -> Text
Data.Text.Lazy.toStrict Text
text))

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Text

instance ToDhall Text where
    injectWith :: InputNormalizer -> Encoder Text
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Text -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Text -> Expr s a
declared :: Expr Src Void
embed :: Text -> Expr Src Void
..}
      where
        embed :: Text -> Expr s a
embed Text
text = forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
text)

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Text

instance {-# OVERLAPS #-} ToDhall String where
    injectWith :: InputNormalizer -> Encoder String
injectWith InputNormalizer
inputNormalizer =
        forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap String -> Text
Data.Text.pack (forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer :: Encoder Text)

instance ToDhall Natural where
    injectWith :: InputNormalizer -> Encoder Natural
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Natural -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Natural -> Expr s a
declared :: Expr Src Void
embed :: Natural -> Expr Src Void
..}
      where
        embed :: Natural -> Expr s a
embed = forall {s} {a}. Natural -> Expr s a
NaturalLit

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Natural

instance ToDhall Integer where
    injectWith :: InputNormalizer -> Encoder Integer
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Integer -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Integer -> Expr s a
declared :: Expr Src Void
embed :: Integer -> Expr Src Void
..}
      where
        embed :: Integer -> Expr s a
embed = forall {s} {a}. Integer -> Expr s a
IntegerLit

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Integer

instance ToDhall Int where
    injectWith :: InputNormalizer -> Encoder Int
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Int -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Int -> Expr s a
declared :: Expr Src Void
embed :: Int -> Expr Src Void
..}
      where
        embed :: Int -> Expr s a
embed = forall {s} {a}. Integer -> Expr s a
IntegerLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Integer

instance ToDhall Int8 where
    injectWith :: InputNormalizer -> Encoder Int8
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Int8 -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Int8 -> Expr s a
declared :: Expr Src Void
embed :: Int8 -> Expr Src Void
..}
      where
        embed :: Int8 -> Expr s a
embed = forall {s} {a}. Integer -> Expr s a
IntegerLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Integer

instance ToDhall Int16 where
    injectWith :: InputNormalizer -> Encoder Int16
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Int16 -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Int16 -> Expr s a
declared :: Expr Src Void
embed :: Int16 -> Expr Src Void
..}
      where
        embed :: Int16 -> Expr s a
embed = forall {s} {a}. Integer -> Expr s a
IntegerLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Integer

instance ToDhall Int32 where
    injectWith :: InputNormalizer -> Encoder Int32
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Int32 -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Int32 -> Expr s a
declared :: Expr Src Void
embed :: Int32 -> Expr Src Void
..}
      where
        embed :: Int32 -> Expr s a
embed = forall {s} {a}. Integer -> Expr s a
IntegerLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Integer

instance ToDhall Int64 where
    injectWith :: InputNormalizer -> Encoder Int64
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Int64 -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Int64 -> Expr s a
declared :: Expr Src Void
embed :: Int64 -> Expr Src Void
..}
      where
        embed :: Int64 -> Expr s a
embed = forall {s} {a}. Integer -> Expr s a
IntegerLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Integer

{-| Encode a 'Word' to a Dhall @Natural@.

>>> embed inject (12 :: Word)
NaturalLit 12
-}
instance ToDhall Word where
    injectWith :: InputNormalizer -> Encoder Word
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Word -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Word -> Expr s a
declared :: Expr Src Void
embed :: Word -> Expr Src Void
..}
      where
        embed :: Word -> Expr s a
embed = forall {s} {a}. Natural -> Expr s a
NaturalLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Natural

{-| Encode a 'Word8' to a Dhall @Natural@.

>>> embed inject (12 :: Word8)
NaturalLit 12
-}
instance ToDhall Word8 where
    injectWith :: InputNormalizer -> Encoder Word8
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Word8 -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Word8 -> Expr s a
declared :: Expr Src Void
embed :: Word8 -> Expr Src Void
..}
      where
        embed :: Word8 -> Expr s a
embed = forall {s} {a}. Natural -> Expr s a
NaturalLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Natural

{-| Encode a 'Word16' to a Dhall @Natural@.

>>> embed inject (12 :: Word16)
NaturalLit 12
-}
instance ToDhall Word16 where
    injectWith :: InputNormalizer -> Encoder Word16
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Word16 -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Word16 -> Expr s a
declared :: Expr Src Void
embed :: Word16 -> Expr Src Void
..}
      where
        embed :: Word16 -> Expr s a
embed = forall {s} {a}. Natural -> Expr s a
NaturalLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Natural

{-| Encode a 'Word32' to a Dhall @Natural@.

>>> embed inject (12 :: Word32)
NaturalLit 12
-}
instance ToDhall Word32 where
    injectWith :: InputNormalizer -> Encoder Word32
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Word32 -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Word32 -> Expr s a
declared :: Expr Src Void
embed :: Word32 -> Expr Src Void
..}
      where
        embed :: Word32 -> Expr s a
embed = forall {s} {a}. Natural -> Expr s a
NaturalLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Natural

{-| Encode a 'Word64' to a Dhall @Natural@.

>>> embed inject (12 :: Word64)
NaturalLit 12
-}
instance ToDhall Word64 where
    injectWith :: InputNormalizer -> Encoder Word64
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Word64 -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Word64 -> Expr s a
declared :: Expr Src Void
embed :: Word64 -> Expr Src Void
..}
      where
        embed :: Word64 -> Expr s a
embed = forall {s} {a}. Natural -> Expr s a
NaturalLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Natural

instance ToDhall Double where
    injectWith :: InputNormalizer -> Encoder Double
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Double -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Double -> Expr s a
declared :: Expr Src Void
embed :: Double -> Expr Src Void
..}
      where
        embed :: Double -> Expr s a
embed = forall s a. DhallDouble -> Expr s a
DoubleLit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> DhallDouble
DhallDouble

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Double

instance ToDhall Scientific where
    injectWith :: InputNormalizer -> Encoder Scientific
injectWith InputNormalizer
inputNormalizer =
        forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a. RealFloat a => Scientific -> a
Data.Scientific.toRealFloat (forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer :: Encoder Double)

instance ToDhall () where
    injectWith :: InputNormalizer -> Encoder ()
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {b} {s} {a}. b -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {b} {s} {a}. b -> Expr s a
declared :: Expr Src Void
embed :: () -> Expr Src Void
..}
      where
        embed :: b -> Expr s a
embed = forall a b. a -> b -> a
const (forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit forall a. Monoid a => a
mempty)

        declared :: Expr s a
declared = forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a. Monoid a => a
mempty

instance ToDhall a => ToDhall (Maybe a) where
    injectWith :: InputNormalizer -> Encoder (Maybe a)
injectWith InputNormalizer
inputNormalizer = forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder Maybe a -> Expr Src Void
embedOut Expr Src Void
declaredOut
      where
        embedOut :: Maybe a -> Expr Src Void
embedOut (Just a
x ) = forall s a. Expr s a -> Expr s a
Some (a -> Expr Src Void
embedIn a
x)
        embedOut  Maybe a
Nothing  = forall s a. Expr s a -> Expr s a -> Expr s a
App forall {s} {a}. Expr s a
None Expr Src Void
declaredIn

        Encoder a -> Expr Src Void
embedIn Expr Src Void
declaredIn = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer

        declaredOut :: Expr Src Void
declaredOut = forall s a. Expr s a -> Expr s a -> Expr s a
App forall {s} {a}. Expr s a
Optional Expr Src Void
declaredIn

instance ToDhall a => ToDhall (Seq a) where
    injectWith :: InputNormalizer -> Encoder (Seq a)
injectWith InputNormalizer
inputNormalizer = forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder Seq a -> Expr Src Void
embedOut Expr Src Void
declaredOut
      where
        embedOut :: Seq a -> Expr Src Void
embedOut Seq a
xs = forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src Void)
listType (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Expr Src Void
embedIn Seq a
xs)
          where
            listType :: Maybe (Expr Src Void)
listType
                | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
xs   = forall a. a -> Maybe a
Just (forall s a. Expr s a -> Expr s a -> Expr s a
App forall {s} {a}. Expr s a
List Expr Src Void
declaredIn)
                | Bool
otherwise = forall a. Maybe a
Nothing

        declaredOut :: Expr Src Void
declaredOut = forall s a. Expr s a -> Expr s a -> Expr s a
App forall {s} {a}. Expr s a
List Expr Src Void
declaredIn

        Encoder a -> Expr Src Void
embedIn Expr Src Void
declaredIn = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer

instance ToDhall a => ToDhall [a] where
    injectWith :: InputNormalizer -> Encoder [a]
injectWith = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a. [a] -> Seq a
Data.Sequence.fromList) forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith

instance ToDhall a => ToDhall (Vector a) where
    injectWith :: InputNormalizer -> Encoder (Vector a)
injectWith = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a. Vector a -> [a]
Data.Vector.toList) forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith

instance ToDhall Time.TimeOfDay where
    injectWith :: InputNormalizer -> Encoder TimeOfDay
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. TimeOfDay -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. TimeOfDay -> Expr s a
declared :: Expr Src Void
embed :: TimeOfDay -> Expr Src Void
..}
      where
        embed :: TimeOfDay -> Expr s a
embed TimeOfDay
timeOfDay = forall s a. TimeOfDay -> Word -> Expr s a
TimeLiteral TimeOfDay
timeOfDay Word
12

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Time

instance ToDhall Time.Day where
    injectWith :: InputNormalizer -> Encoder Day
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. Day -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. Day -> Expr s a
declared :: Expr Src Void
embed :: Day -> Expr Src Void
..}
      where
        embed :: Day -> Expr s a
embed = forall {s} {a}. Day -> Expr s a
DateLiteral

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
Date

instance ToDhall Time.TimeZone where
    injectWith :: InputNormalizer -> Encoder TimeZone
injectWith InputNormalizer
_ = Encoder {forall {s} {a}. Expr s a
forall {s} {a}. TimeZone -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. TimeZone -> Expr s a
declared :: Expr Src Void
embed :: TimeZone -> Expr Src Void
..}
      where
        embed :: TimeZone -> Expr s a
embed = forall {s} {a}. TimeZone -> Expr s a
TimeZoneLiteral

        declared :: Expr s a
declared = forall {s} {a}. Expr s a
TimeZone

instance ToDhall Time.LocalTime where
    injectWith :: InputNormalizer -> Encoder LocalTime
injectWith InputNormalizer
_ = forall a. RecordEncoder a -> Encoder a
recordEncoder forall a b. (a -> b) -> a -> b
$
      LocalTime -> (Day, TimeOfDay)
adapt
        forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. ToDhall a => Text -> RecordEncoder a
encodeField Text
"date"
        forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
>*< forall a. ToDhall a => Text -> RecordEncoder a
encodeField Text
"time"
      where
        adapt :: LocalTime -> (Day, TimeOfDay)
adapt (Time.LocalTime Day
date TimeOfDay
time) = (Day
date, TimeOfDay
time)

instance ToDhall Time.ZonedTime where
    injectWith :: InputNormalizer -> Encoder ZonedTime
injectWith InputNormalizer
_ = forall a. RecordEncoder a -> Encoder a
recordEncoder forall a b. (a -> b) -> a -> b
$
      ZonedTime -> (Day, (TimeOfDay, TimeZone))
adapt
        forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. ToDhall a => Text -> RecordEncoder a
encodeField Text
"date"
        forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
>*< forall a. ToDhall a => Text -> RecordEncoder a
encodeField Text
"time"
        forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
>*< forall a. ToDhall a => Text -> RecordEncoder a
encodeField Text
"timeZone"
      where
        adapt :: ZonedTime -> (Day, (TimeOfDay, TimeZone))
adapt (Time.ZonedTime (Time.LocalTime Day
date TimeOfDay
time) TimeZone
timeZone) = (Day
date, (TimeOfDay
time, TimeZone
timeZone))

instance ToDhall Time.UTCTime where
    injectWith :: InputNormalizer -> Encoder UTCTime
injectWith = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (TimeZone -> UTCTime -> ZonedTime
Time.utcToZonedTime TimeZone
Time.utc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith

instance ToDhall Time.DayOfWeek where
    injectWith :: InputNormalizer -> Encoder DayOfWeek
injectWith InputNormalizer
_ = Encoder{forall {s} {a}. Expr s a
forall {s} {a}. DayOfWeek -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {s} {a}. DayOfWeek -> Expr s a
declared :: Expr Src Void
embed :: DayOfWeek -> Expr Src Void
..}
      where
        embed :: DayOfWeek -> Expr s a
embed DayOfWeek
Time.Sunday =
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field forall {s} {a}. Expr s a
declared (forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
"Sunday")
        embed DayOfWeek
Time.Monday =
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field forall {s} {a}. Expr s a
declared (forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
"Monday" )
        embed DayOfWeek
Time.Tuesday =
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field forall {s} {a}. Expr s a
declared (forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
"Tuesday")
        embed DayOfWeek
Time.Wednesday =
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field forall {s} {a}. Expr s a
declared (forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
"Wednesday")
        embed DayOfWeek
Time.Thursday =
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field forall {s} {a}. Expr s a
declared (forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
"Thursday")
        embed DayOfWeek
Time.Friday =
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field forall {s} {a}. Expr s a
declared (forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
"Friday")
        embed DayOfWeek
Time.Saturday =
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field forall {s} {a}. Expr s a
declared (forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
"Saturday")

        declared :: Expr s a
declared =
            forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union
                (forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                    [ (Text
"Sunday", forall a. Maybe a
Nothing)
                    , (Text
"Monday", forall a. Maybe a
Nothing)
                    , (Text
"Tuesday", forall a. Maybe a
Nothing)
                    , (Text
"Wednesday", forall a. Maybe a
Nothing)
                    , (Text
"Thursday", forall a. Maybe a
Nothing)
                    , (Text
"Friday", forall a. Maybe a
Nothing)
                    , (Text
"Saturday", forall a. Maybe a
Nothing)
                    ]
                )

{-| Note that the output list will be sorted.

>>> let x = Data.Set.fromList ["mom", "hi" :: Text]
>>> prettyExpr $ embed inject x
[ "hi", "mom" ]

-}
instance ToDhall a => ToDhall (Data.Set.Set a) where
    injectWith :: InputNormalizer -> Encoder (Set a)
injectWith = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a. Set a -> [a]
Data.Set.toAscList) forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith

-- | Note that the output list may not be sorted
instance ToDhall a => ToDhall (Data.HashSet.HashSet a) where
    injectWith :: InputNormalizer -> Encoder (HashSet a)
injectWith = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a. HashSet a -> [a]
Data.HashSet.toList) forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith

instance (ToDhall a, ToDhall b) => ToDhall (a, b)

{-| Embed a `Data.Map` as a @Prelude.Map.Type@.

>>> prettyExpr $ embed inject (Data.Map.fromList [(1 :: Natural, True)])
[ { mapKey = 1, mapValue = True } ]

>>> prettyExpr $ embed inject (Data.Map.fromList [] :: Data.Map.Map Natural Bool)
[] : List { mapKey : Natural, mapValue : Bool }

-}
instance (ToDhall k, ToDhall v) => ToDhall (Data.Map.Map k v) where
    injectWith :: InputNormalizer -> Encoder (Map k v)
injectWith InputNormalizer
inputNormalizer = forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder Map k v -> Expr Src Void
embedOut Expr Src Void
declaredOut
      where
        embedOut :: Map k v -> Expr Src Void
embedOut Map k v
m = forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src Void)
listType (Map k v -> Seq (Expr Src Void)
mapEntries Map k v
m)
          where
            listType :: Maybe (Expr Src Void)
listType
                | forall k a. Map k a -> Bool
Data.Map.null Map k v
m = forall a. a -> Maybe a
Just Expr Src Void
declaredOut
                | Bool
otherwise       = forall a. Maybe a
Nothing

        declaredOut :: Expr Src Void
declaredOut = forall s a. Expr s a -> Expr s a -> Expr s a
App forall {s} {a}. Expr s a
List (forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                          [ (Text
"mapKey", forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declaredK)
                          , (Text
"mapValue", forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declaredV)
                          ])

        mapEntries :: Map k v -> Seq (Expr Src Void)
mapEntries = forall a. [a] -> Seq a
Data.Sequence.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, v) -> Expr Src Void
recordPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Data.Map.toList
        recordPair :: (k, v) -> Expr Src Void
recordPair (k
k, v
v) = forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                                [ (Text
"mapKey", forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall a b. (a -> b) -> a -> b
$ k -> Expr Src Void
embedK k
k)
                                , (Text
"mapValue", forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall a b. (a -> b) -> a -> b
$ v -> Expr Src Void
embedV v
v)
                                ]

        Encoder k -> Expr Src Void
embedK Expr Src Void
declaredK = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer
        Encoder v -> Expr Src Void
embedV Expr Src Void
declaredV = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer

{-| Embed a `Data.HashMap` as a @Prelude.Map.Type@.

>>> prettyExpr $ embed inject (HashMap.fromList [(1 :: Natural, True)])
[ { mapKey = 1, mapValue = True } ]

>>> prettyExpr $ embed inject (HashMap.fromList [] :: HashMap Natural Bool)
[] : List { mapKey : Natural, mapValue : Bool }

-}
instance (ToDhall k, ToDhall v) => ToDhall (HashMap k v) where
    injectWith :: InputNormalizer -> Encoder (HashMap k v)
injectWith InputNormalizer
inputNormalizer = forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder HashMap k v -> Expr Src Void
embedOut Expr Src Void
declaredOut
      where
        embedOut :: HashMap k v -> Expr Src Void
embedOut HashMap k v
m = forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src Void)
listType (HashMap k v -> Seq (Expr Src Void)
mapEntries HashMap k v
m)
          where
            listType :: Maybe (Expr Src Void)
listType
                | forall k v. HashMap k v -> Bool
HashMap.null HashMap k v
m = forall a. a -> Maybe a
Just Expr Src Void
declaredOut
                | Bool
otherwise       = forall a. Maybe a
Nothing

        declaredOut :: Expr Src Void
declaredOut = forall s a. Expr s a -> Expr s a -> Expr s a
App forall {s} {a}. Expr s a
List (forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                          [ (Text
"mapKey", forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declaredK)
                          , (Text
"mapValue", forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declaredV)
                          ])

        mapEntries :: HashMap k v -> Seq (Expr Src Void)
mapEntries = forall a. [a] -> Seq a
Data.Sequence.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, v) -> Expr Src Void
recordPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HashMap.toList
        recordPair :: (k, v) -> Expr Src Void
recordPair (k
k, v
v) = forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                                [ (Text
"mapKey", forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall a b. (a -> b) -> a -> b
$ k -> Expr Src Void
embedK k
k)
                                , (Text
"mapValue", forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall a b. (a -> b) -> a -> b
$ v -> Expr Src Void
embedV v
v)
                                ]

        Encoder k -> Expr Src Void
embedK Expr Src Void
declaredK = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer
        Encoder v -> Expr Src Void
embedV Expr Src Void
declaredV = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer

instance ToDhall (f (Result f)) => ToDhall (Result f) where
    injectWith :: InputNormalizer -> Encoder (Result f)
injectWith InputNormalizer
inputNormalizer = Encoder {Expr Src Void
Result f -> Expr Src Void
declared :: Expr Src Void
embed :: Result f -> Expr Src Void
declared :: Expr Src Void
embed :: Result f -> Expr Src Void
..}
      where
        embed :: Result f -> Expr Src Void
embed = forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
"Make" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoder a -> a -> Expr Src Void
Dhall.Marshal.Encode.embed (forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Result f -> f (Result f)
_unResult
        declared :: Expr Src Void
declared = Expr Src Void
"result"

instance forall f. (Functor f, ToDhall (f (Result f))) => ToDhall (Fix f) where
    injectWith :: InputNormalizer -> Encoder (Fix f)
injectWith InputNormalizer
inputNormalizer = Encoder {Expr Src Void
Fix f -> Expr Src Void
declared :: Expr Src Void
embed :: Fix f -> Expr Src Void
declared :: Expr Src Void
embed :: Fix f -> Expr Src Void
..}
      where
        embed :: Fix f -> Expr Src Void
embed Fix f
fixf =
          forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam forall a. Maybe a
Nothing (forall s a. Text -> Expr s a -> FunctionBinding s a
Core.makeFunctionBinding Text
"result" (forall s a. Const -> Expr s a
Const Const
Core.Type)) forall a b. (a -> b) -> a -> b
$
            forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam forall a. Maybe a
Nothing (forall s a. Text -> Expr s a -> FunctionBinding s a
Core.makeFunctionBinding Text
"Make" Expr Src Void
makeType) forall a b. (a -> b) -> a -> b
$
              Result f -> Expr Src Void
embed' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Functor f => Fix f -> Result f
fixToResult forall a b. (a -> b) -> a -> b
$ Fix f
fixf

        declared :: Expr Src Void
declared = forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Maybe a
Nothing Text
"result" (forall s a. Const -> Expr s a
Const Const
Core.Type) forall a b. (a -> b) -> a -> b
$ forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Maybe a
Nothing Text
"_" Expr Src Void
makeType Expr Src Void
"result"

        makeType :: Expr Src Void
makeType = forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Maybe a
Nothing Text
"_" Expr Src Void
declared' Expr Src Void
"result"
        Encoder Result f -> Expr Src Void
embed' Expr Src Void
_ = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith @(Dhall.Marshal.Internal.Result f) InputNormalizer
inputNormalizer
        Encoder f (Result f) -> Expr Src Void
_ Expr Src Void
declared' = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith @(f (Dhall.Marshal.Internal.Result f)) InputNormalizer
inputNormalizer

fixToResult :: Functor f => Fix f -> Result f
fixToResult :: forall (f :: * -> *). Functor f => Fix f -> Result f
fixToResult (Fix f (Fix f)
x) = forall (f :: * -> *). f (Result f) -> Result f
Result (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *). Functor f => Fix f -> Result f
fixToResult f (Fix f)
x)



{-| This is the underlying class that powers the `Dhall.Marshal.Decode.FromDhall` class's support
    for automatically deriving a generic implementation.
-}
class GenericToDhall f where
    genericToDhallWithNormalizer :: InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))

instance GenericToDhall f => GenericToDhall (M1 D d f) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions -> State Int (Encoder (M1 D d f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options = do
        Encoder (f a)
res <- forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 Encoder (f a)
res)

instance GenericToDhall f => GenericToDhall (M1 C c f) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions -> State Int (Encoder (M1 C c f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options = do
        Encoder (f a)
res <- forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 Encoder (f a)
res)

instance (Selector s, ToDhall a) => GenericToDhall (M1 S s (K1 i a)) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions -> State Int (Encoder (M1 S s (K1 i a) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions{SingletonConstructors
Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
..} = do
        let Encoder { embed :: forall a. Encoder a -> a -> Expr Src Void
embed = a -> Expr Src Void
embed', declared :: forall a. Encoder a -> Expr Src Void
declared = Expr Src Void
declared' } =
                forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer

        let n :: M1 S s (K1 i a) r
            n :: forall r. M1 S s (K1 i a) r
n = forall a. HasCallStack => a
undefined

        Text
name <- Text -> Text
fieldModifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> StateT Int Identity Text
getSelName forall r. M1 S s (K1 i a) r
n

        let embed0 :: M1 i c (K1 i a) p -> Expr Src Void
embed0 (M1 (K1 a
x)) = a -> Expr Src Void
embed' a
x

        let embed1 :: M1 i c (K1 i a) p -> Expr Src Void
embed1 (M1 (K1 a
x)) =
                forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name (forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall a b. (a -> b) -> a -> b
$ a -> Expr Src Void
embed' a
x))

        let embed :: M1 i c (K1 i a) p -> Expr Src Void
embed =
                case SingletonConstructors
singletonConstructors of
                    SingletonConstructors
Bare                    -> forall {i} {c :: Meta} {i} {p}. M1 i c (K1 i a) p -> Expr Src Void
embed0
                    SingletonConstructors
Smart | forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName forall r. M1 S s (K1 i a) r
n forall a. Eq a => a -> a -> Bool
== String
"" -> forall {i} {c :: Meta} {i} {p}. M1 i c (K1 i a) p -> Expr Src Void
embed0
                    SingletonConstructors
_                       -> forall {i} {c :: Meta} {i} {p}. M1 i c (K1 i a) p -> Expr Src Void
embed1

        let declared :: Expr Src Void
declared =
                case SingletonConstructors
singletonConstructors of
                    SingletonConstructors
Bare ->
                        Expr Src Void
declared'
                    SingletonConstructors
Smart | forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName forall r. M1 S s (K1 i a) r
n forall a. Eq a => a -> a -> Bool
== String
"" ->
                        Expr Src Void
declared'
                    SingletonConstructors
_ ->
                        forall s a. Map Text (RecordField s a) -> Expr s a
Record (forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name forall a b. (a -> b) -> a -> b
$ forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declared')

        forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder {Expr Src Void
forall {i} {c :: Meta} {i} {p}. M1 i c (K1 i a) p -> Expr Src Void
declared :: Expr Src Void
embed :: forall {i} {c :: Meta} {i} {p}. M1 i c (K1 i a) p -> Expr Src Void
declared :: Expr Src Void
embed :: M1 S s (K1 i a) a -> Expr Src Void
..})

instance (Constructor c1, Constructor c2, GenericToDhall f1, GenericToDhall f2) => GenericToDhall (M1 C c1 f1 :+: M1 C c2 f2) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions
-> State Int (Encoder ((:+:) (M1 C c1 f1) (M1 C c2 f2) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer options :: InterpretOptions
options@(InterpretOptions {SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..}) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder {Expr Src Void
forall {i} {c :: Meta} {i} {c :: Meta} {a}.
(:+:) (M1 i c f1) (M1 i c f2) a -> Expr Src Void
declared :: Expr Src Void
embed :: forall {i} {c :: Meta} {i} {c :: Meta} {a}.
(:+:) (M1 i c f1) (M1 i c f2) a -> Expr Src Void
declared :: Expr Src Void
embed :: (:+:) (M1 C c1 f1) (M1 C c2 f2) a -> Expr Src Void
..})
      where
        embed :: (:+:) (M1 i c f1) (M1 i c f2) a -> Expr Src Void
embed (L1 (M1 f1 a
l)) =
            case forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (forall {a}. f1 a -> Expr Src Void
embedL f1 a
l) of
                Maybe (Expr Src Void)
Nothing ->
                    forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL
                Just Expr Src Void
valL ->
                    forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL) Expr Src Void
valL

        embed (R1 (M1 f2 a
r)) =
            case forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (forall {a}. f2 a -> Expr Src Void
embedR f2 a
r) of
                Maybe (Expr Src Void)
Nothing ->
                    forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR
                Just Expr Src Void
valR ->
                    forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR) Expr Src Void
valR

        declared :: Expr Src Void
declared =
            forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union
                (forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                    [ (Text
keyL, forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
declaredL)
                    , (Text
keyR, forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
declaredR)
                    ]
                )

        nL :: M1 i c1 f1 a
        nL :: forall i a. M1 i c1 f1 a
nL = forall a. HasCallStack => a
undefined

        nR :: M1 i c2 f2 a
        nR :: forall i a. M1 i c2 f2 a
nR = forall a. HasCallStack => a
undefined

        keyL :: Text
keyL = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName forall i a. M1 i c1 f1 a
nL))
        keyR :: Text
keyR = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName forall i a. M1 i c2 f2 a
nR))

        Encoder f1 a -> Expr Src Void
embedL Expr Src Void
declaredL = forall s a. State s a -> s -> a
evalState (forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options) Int
1
        Encoder f2 a -> Expr Src Void
embedR Expr Src Void
declaredR = forall s a. State s a -> s -> a
evalState (forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options) Int
1

instance (Constructor c, GenericToDhall (f :+: g), GenericToDhall h) => GenericToDhall ((f :+: g) :+: M1 C c h) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions
-> State Int (Encoder ((:+:) (f :+: g) (M1 C c h) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer options :: InterpretOptions
options@(InterpretOptions {SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..}) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder {Expr Src Void
forall {i} {c :: Meta} {a}.
(:+:) (f :+: g) (M1 i c h) a -> Expr Src Void
declared :: Expr Src Void
embed :: forall {i} {c :: Meta} {a}.
(:+:) (f :+: g) (M1 i c h) a -> Expr Src Void
declared :: Expr Src Void
embed :: (:+:) (f :+: g) (M1 C c h) a -> Expr Src Void
..})
      where
        embed :: (:+:) (f :+: g) (M1 i c h) a -> Expr Src Void
embed (L1 (:+:) f g a
l) =
            case Maybe (Expr Src Void)
maybeValL of
                Maybe (Expr Src Void)
Nothing   -> forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL
                Just Expr Src Void
valL -> forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL) Expr Src Void
valL
          where
            (Text
keyL, Maybe (Expr Src Void)
maybeValL) =
              Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit Text
"genericToDhallWithNormalizer (:+:)" (forall {a}. (:+:) f g a -> Expr Src Void
embedL (:+:) f g a
l)
        embed (R1 (M1 h a
r)) =
            case forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (forall {a}. h a -> Expr Src Void
embedR h a
r) of
                Maybe (Expr Src Void)
Nothing   -> forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR
                Just Expr Src Void
valR -> forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR) Expr Src Void
valR

        nR :: M1 i c h a
        nR :: forall i a. M1 i c h a
nR = forall a. HasCallStack => a
undefined

        keyR :: Text
keyR = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName forall i a. M1 i c h a
nR))

        declared :: Expr Src Void
declared = forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
keyR (forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
declaredR) Map Text (Maybe (Expr Src Void))
ktsL)

        Encoder (:+:) f g a -> Expr Src Void
embedL Expr Src Void
declaredL = forall s a. State s a -> s -> a
evalState (forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options) Int
1
        Encoder h a -> Expr Src Void
embedR Expr Src Void
declaredR = forall s a. State s a -> s -> a
evalState (forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options) Int
1

        ktsL :: Map Text (Maybe (Expr Src Void))
ktsL = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion Text
"genericToDhallWithNormalizer (:+:)" Expr Src Void
declaredL

instance (Constructor c, GenericToDhall f, GenericToDhall (g :+: h)) => GenericToDhall (M1 C c f :+: (g :+: h)) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions
-> State Int (Encoder ((:+:) (M1 C c f) (g :+: h) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer options :: InterpretOptions
options@(InterpretOptions {SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..}) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder {Expr Src Void
forall {i} {c :: Meta} {a}.
(:+:) (M1 i c f) (g :+: h) a -> Expr Src Void
declared :: Expr Src Void
embed :: forall {i} {c :: Meta} {a}.
(:+:) (M1 i c f) (g :+: h) a -> Expr Src Void
declared :: Expr Src Void
embed :: (:+:) (M1 C c f) (g :+: h) a -> Expr Src Void
..})
      where
        embed :: (:+:) (M1 i c f) (g :+: h) a -> Expr Src Void
embed (L1 (M1 f a
l)) =
            case forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (forall {a}. f a -> Expr Src Void
embedL f a
l) of
                Maybe (Expr Src Void)
Nothing   -> forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL
                Just Expr Src Void
valL -> forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL) Expr Src Void
valL
        embed (R1 (:+:) g h a
r) =
            case Maybe (Expr Src Void)
maybeValR of
                Maybe (Expr Src Void)
Nothing   -> forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR
                Just Expr Src Void
valR -> forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR) Expr Src Void
valR
          where
            (Text
keyR, Maybe (Expr Src Void)
maybeValR) =
                Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit Text
"genericToDhallWithNormalizer (:+:)" (forall {a}. (:+:) g h a -> Expr Src Void
embedR (:+:) g h a
r)

        nL :: M1 i c f a
        nL :: forall i a. M1 i c f a
nL = forall a. HasCallStack => a
undefined

        keyL :: Text
keyL = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName forall i a. M1 i c f a
nL))

        declared :: Expr Src Void
declared = forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
keyL (forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
declaredL) Map Text (Maybe (Expr Src Void))
ktsR)

        Encoder f a -> Expr Src Void
embedL Expr Src Void
declaredL = forall s a. State s a -> s -> a
evalState (forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options) Int
1
        Encoder (:+:) g h a -> Expr Src Void
embedR Expr Src Void
declaredR = forall s a. State s a -> s -> a
evalState (forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options) Int
1

        ktsR :: Map Text (Maybe (Expr Src Void))
ktsR = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion Text
"genericToDhallWithNormalizer (:+:)" Expr Src Void
declaredR

instance (GenericToDhall (f :+: g), GenericToDhall (h :+: i)) => GenericToDhall ((f :+: g) :+: (h :+: i)) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions
-> State Int (Encoder ((:+:) (f :+: g) (h :+: i) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder {Expr Src Void
forall {p}. (:+:) (f :+: g) (h :+: i) p -> Expr Src Void
declared :: Expr Src Void
embed :: forall {p}. (:+:) (f :+: g) (h :+: i) p -> Expr Src Void
declared :: Expr Src Void
embed :: (:+:) (f :+: g) (h :+: i) a -> Expr Src Void
..})
      where
        embed :: (:+:) (f :+: g) (h :+: i) p -> Expr Src Void
embed (L1 (:+:) f g p
l) =
            case Maybe (Expr Src Void)
maybeValL of
                Maybe (Expr Src Void)
Nothing   -> forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL
                Just Expr Src Void
valL -> forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL) Expr Src Void
valL
          where
            (Text
keyL, Maybe (Expr Src Void)
maybeValL) =
                Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit Text
"genericToDhallWithNormalizer (:+:)" (forall {a}. (:+:) f g a -> Expr Src Void
embedL (:+:) f g p
l)
        embed (R1 (:+:) h i p
r) =
            case Maybe (Expr Src Void)
maybeValR of
                Maybe (Expr Src Void)
Nothing   -> forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR
                Just Expr Src Void
valR -> forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR) Expr Src Void
valR
          where
            (Text
keyR, Maybe (Expr Src Void)
maybeValR) =
                Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit Text
"genericToDhallWithNormalizer (:+:)" (forall {a}. (:+:) h i a -> Expr Src Void
embedR (:+:) h i p
r)

        declared :: Expr Src Void
declared = forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union Map Text (Maybe (Expr Src Void))
ktsL Map Text (Maybe (Expr Src Void))
ktsR)

        Encoder (:+:) f g a -> Expr Src Void
embedL Expr Src Void
declaredL = forall s a. State s a -> s -> a
evalState (forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options) Int
1
        Encoder (:+:) h i a -> Expr Src Void
embedR Expr Src Void
declaredR = forall s a. State s a -> s -> a
evalState (forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options) Int
1

        ktsL :: Map Text (Maybe (Expr Src Void))
ktsL = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion Text
"genericToDhallWithNormalizer (:+:)" Expr Src Void
declaredL
        ktsR :: Map Text (Maybe (Expr Src Void))
ktsR = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion Text
"genericToDhallWithNormalizer (:+:)" Expr Src Void
declaredR

instance (GenericToDhall (f :*: g), GenericToDhall (h :*: i)) => GenericToDhall ((f :*: g) :*: (h :*: i)) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions
-> State Int (Encoder ((:*:) (f :*: g) (h :*: i) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options = do
        Encoder (:*:) f g a -> Expr Src Void
embedL Expr Src Void
declaredL <- forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options
        Encoder (:*:) h i a -> Expr Src Void
embedR Expr Src Void
declaredR <- forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options

        let embed :: (:*:) (f :*: g) (h :*: i) a -> Expr Src Void
embed ((:*:) f g a
l :*: (:*:) h i a
r) =
                forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union Map Text (RecordField Src Void)
mapL Map Text (RecordField Src Void)
mapR)
              where
                mapL :: Map Text (RecordField Src Void)
mapL =
                    Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecordLit Text
"genericToDhallWithNormalizer (:*:)" ((:*:) f g a -> Expr Src Void
embedL (:*:) f g a
l)

                mapR :: Map Text (RecordField Src Void)
mapR =
                    Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecordLit Text
"genericToDhallWithNormalizer (:*:)" ((:*:) h i a -> Expr Src Void
embedR (:*:) h i a
r)

        let declared :: Expr Src Void
declared = forall s a. Map Text (RecordField s a) -> Expr s a
Record (forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union Map Text (RecordField Src Void)
mapL Map Text (RecordField Src Void)
mapR)
              where
                mapL :: Map Text (RecordField Src Void)
mapL = Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecord Text
"genericToDhallWithNormalizer (:*:)" Expr Src Void
declaredL
                mapR :: Map Text (RecordField Src Void)
mapR = Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecord Text
"genericToDhallWithNormalizer (:*:)" Expr Src Void
declaredR

        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder {Expr Src Void
(:*:) (f :*: g) (h :*: i) a -> Expr Src Void
declared :: Expr Src Void
embed :: (:*:) (f :*: g) (h :*: i) a -> Expr Src Void
declared :: Expr Src Void
embed :: (:*:) (f :*: g) (h :*: i) a -> Expr Src Void
..})

instance (GenericToDhall (f :*: g), Selector s, ToDhall a) => GenericToDhall ((f :*: g) :*: M1 S s (K1 i a)) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions
-> State Int (Encoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer options :: InterpretOptions
options@InterpretOptions{SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..} = do
        let nR :: M1 S s (K1 i a) r
            nR :: forall r. M1 S s (K1 i a) r
nR = forall a. HasCallStack => a
undefined

        Text
nameR <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> StateT Int Identity Text
getSelName forall r. M1 S s (K1 i a) r
nR)

        Encoder (:*:) f g a -> Expr Src Void
embedL Expr Src Void
declaredL <- forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options

        let Encoder a -> Expr Src Void
embedR Expr Src Void
declaredR = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer

        let embed :: (:*:) (f :*: g) (M1 i c (K1 i a)) a -> Expr Src Void
embed ((:*:) f g a
l :*: M1 (K1 a
r)) =
                forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameR (forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall a b. (a -> b) -> a -> b
$ a -> Expr Src Void
embedR a
r) Map Text (RecordField Src Void)
mapL)
              where
                mapL :: Map Text (RecordField Src Void)
mapL =
                    Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecordLit Text
"genericToDhallWithNormalizer (:*:)" ((:*:) f g a -> Expr Src Void
embedL (:*:) f g a
l)

        let declared :: Expr Src Void
declared = forall s a. Map Text (RecordField s a) -> Expr s a
Record (forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameR (forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declaredR) Map Text (RecordField Src Void)
mapL)
              where
                mapL :: Map Text (RecordField Src Void)
mapL = Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecord Text
"genericToDhallWithNormalizer (:*:)" Expr Src Void
declaredL

        forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder {Expr Src Void
forall {i} {c :: Meta} {i}.
(:*:) (f :*: g) (M1 i c (K1 i a)) a -> Expr Src Void
declared :: Expr Src Void
embed :: forall {i} {c :: Meta} {i}.
(:*:) (f :*: g) (M1 i c (K1 i a)) a -> Expr Src Void
declared :: Expr Src Void
embed :: (:*:) (f :*: g) (M1 S s (K1 i a)) a -> Expr Src Void
..})

instance (Selector s, ToDhall a, GenericToDhall (f :*: g)) => GenericToDhall (M1 S s (K1 i a) :*: (f :*: g)) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions
-> State Int (Encoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer options :: InterpretOptions
options@InterpretOptions{SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..} = do
        let nL :: M1 S s (K1 i a) r
            nL :: forall r. M1 S s (K1 i a) r
nL = forall a. HasCallStack => a
undefined

        Text
nameL <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> StateT Int Identity Text
getSelName forall r. M1 S s (K1 i a) r
nL)

        let Encoder a -> Expr Src Void
embedL Expr Src Void
declaredL = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer

        Encoder (:*:) f g a -> Expr Src Void
embedR Expr Src Void
declaredR <- forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options

        let embed :: (:*:) (M1 i c (K1 i a)) (f :*: g) a -> Expr Src Void
embed (M1 (K1 a
l) :*: (:*:) f g a
r) =
                forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameL (forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall a b. (a -> b) -> a -> b
$ a -> Expr Src Void
embedL a
l) Map Text (RecordField Src Void)
mapR)
              where
                mapR :: Map Text (RecordField Src Void)
mapR =
                    Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecordLit Text
"genericToDhallWithNormalizer (:*:)" ((:*:) f g a -> Expr Src Void
embedR (:*:) f g a
r)

        let declared :: Expr Src Void
declared = forall s a. Map Text (RecordField s a) -> Expr s a
Record (forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameL (forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declaredL) Map Text (RecordField Src Void)
mapR)
              where
                mapR :: Map Text (RecordField Src Void)
mapR = Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecord Text
"genericToDhallWithNormalizer (:*:)" Expr Src Void
declaredR

        forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder {Expr Src Void
forall {i} {c :: Meta} {i}.
(:*:) (M1 i c (K1 i a)) (f :*: g) a -> Expr Src Void
declared :: Expr Src Void
embed :: forall {i} {c :: Meta} {i}.
(:*:) (M1 i c (K1 i a)) (f :*: g) a -> Expr Src Void
declared :: Expr Src Void
embed :: (:*:) (M1 S s (K1 i a)) (f :*: g) a -> Expr Src Void
..})

instance (Selector s1, Selector s2, ToDhall a1, ToDhall a2) => GenericToDhall (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer
-> InterpretOptions
-> State
     Int (Encoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions{SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..} = do
        let nL :: M1 S s1 (K1 i1 a1) r
            nL :: forall r. M1 S s1 (K1 i1 a1) r
nL = forall a. HasCallStack => a
undefined

        let nR :: M1 S s2 (K1 i2 a2) r
            nR :: forall r. M1 S s2 (K1 i2 a2) r
nR = forall a. HasCallStack => a
undefined

        Text
nameL <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> StateT Int Identity Text
getSelName forall r. M1 S s1 (K1 i1 a1) r
nL)
        Text
nameR <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> StateT Int Identity Text
getSelName forall r. M1 S s2 (K1 i2 a2) r
nR)

        let Encoder a1 -> Expr Src Void
embedL Expr Src Void
declaredL = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer
        let Encoder a2 -> Expr Src Void
embedR Expr Src Void
declaredR = forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer

        let embed :: (:*:) (M1 i c (K1 i a1)) (M1 i c (K1 i a2)) p -> Expr Src Void
embed (M1 (K1 a1
l) :*: M1 (K1 a2
r)) =
                forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit forall a b. (a -> b) -> a -> b
$
                    forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                        [ (Text
nameL, forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall a b. (a -> b) -> a -> b
$ a1 -> Expr Src Void
embedL a1
l)
                        , (Text
nameR, forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall a b. (a -> b) -> a -> b
$ a2 -> Expr Src Void
embedR a2
r) ]


        let declared :: Expr Src Void
declared =
                forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                    [ (Text
nameL, forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declaredL)
                    , (Text
nameR, forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declaredR) ]


        forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder {Expr Src Void
forall {i} {c :: Meta} {i} {i} {c :: Meta} {i} {p}.
(:*:) (M1 i c (K1 i a1)) (M1 i c (K1 i a2)) p -> Expr Src Void
declared :: Expr Src Void
embed :: forall {i} {c :: Meta} {i} {i} {c :: Meta} {i} {p}.
(:*:) (M1 i c (K1 i a1)) (M1 i c (K1 i a2)) p -> Expr Src Void
declared :: Expr Src Void
embed :: (:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a -> Expr Src Void
..})

instance GenericToDhall U1 where
    genericToDhallWithNormalizer :: forall a.
InputNormalizer -> InterpretOptions -> State Int (Encoder (U1 a))
genericToDhallWithNormalizer InputNormalizer
_ InterpretOptions
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder {forall {s} {a}. Expr s a
forall {b} {s} {a}. b -> Expr s a
declared :: forall {s} {a}. Expr s a
embed :: forall {b} {s} {a}. b -> Expr s a
declared :: Expr Src Void
embed :: U1 a -> Expr Src Void
..})
      where
        embed :: p -> Expr s a
embed p
_ = forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit forall a. Monoid a => a
mempty

        declared :: Expr s a
declared = forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a. Monoid a => a
mempty

{-| Use the default options for injecting a value, whose structure is
determined generically.

This can be used when you want to use 'ToDhall' on types that you don't
want to define orphan instances for.
-}
genericToDhall
  :: (Generic a, GenericToDhall (Rep a)) => Encoder a
genericToDhall :: forall a. (Generic a, GenericToDhall (Rep a)) => Encoder a
genericToDhall
    = forall a.
(Generic a, GenericToDhall (Rep a)) =>
InterpretOptions -> Encoder a
genericToDhallWith InterpretOptions
defaultInterpretOptions

{-| Use custom options for injecting a value, whose structure is
determined generically.

This can be used when you want to use 'ToDhall' on types that you don't
want to define orphan instances for.
-}
genericToDhallWith
  :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> Encoder a
genericToDhallWith :: forall a.
(Generic a, GenericToDhall (Rep a)) =>
InterpretOptions -> Encoder a
genericToDhallWith InterpretOptions
options = forall a.
(Generic a, GenericToDhall (Rep a)) =>
InterpretOptions -> InputNormalizer -> Encoder a
genericToDhallWithInputNormalizer InterpretOptions
options InputNormalizer
defaultInputNormalizer

{-| `genericToDhallWithInputNormalizer` is like `genericToDhallWith`, but
    instead of using the `defaultInputNormalizer` it expects an custom
    `InputNormalizer`.
-}
genericToDhallWithInputNormalizer
  :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> InputNormalizer -> Encoder a
genericToDhallWithInputNormalizer :: forall a.
(Generic a, GenericToDhall (Rep a)) =>
InterpretOptions -> InputNormalizer -> Encoder a
genericToDhallWithInputNormalizer InterpretOptions
options InputNormalizer
inputNormalizer
    = forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a x. Generic a => a -> Rep a x
GHC.Generics.from (forall s a. State s a -> s -> a
evalState (forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options) Int
1)



{-| The 'RecordEncoder' divisible (contravariant) functor allows you to build
    an 'Encoder' for a Dhall record.

    For example, let's take the following Haskell data type:

>>> :{
data Project = Project
  { projectName :: Text
  , projectDescription :: Text
  , projectStars :: Natural
  }
:}

    And assume that we have the following Dhall record that we would like to
    parse as a @Project@:

> { name =
>     "dhall-haskell"
> , description =
>     "A configuration language guaranteed to terminate"
> , stars =
>     289
> }

    Our encoder has type 'Encoder' @Project@, but we can't build that out of any
    smaller encoders, as 'Encoder's cannot be combined (they are only 'Contravariant's).
    However, we can use an 'RecordEncoder' to build an 'Encoder' for @Project@:

>>> :{
injectProject :: Encoder Project
injectProject =
  recordEncoder
    ( adapt >$< encodeFieldWith "name" inject
            >*< encodeFieldWith "description" inject
            >*< encodeFieldWith "stars" inject
    )
  where
    adapt (Project{..}) = (projectName, (projectDescription, projectStars))
:}

    Or, since we are simply using the `ToDhall` instance to inject each field, we could write

>>> :{
injectProject :: Encoder Project
injectProject =
  recordEncoder
    ( adapt >$< encodeField "name"
            >*< encodeField "description"
            >*< encodeField "stars"
    )
  where
    adapt (Project{..}) = (projectName, (projectDescription, projectStars))
:}

-}
newtype RecordEncoder a
  = RecordEncoder (Dhall.Map.Map Text (Encoder a))

instance Contravariant RecordEncoder where
  contramap :: forall a' a. (a' -> a) -> RecordEncoder a -> RecordEncoder a'
contramap a' -> a
f (RecordEncoder Map Text (Encoder a)
encodeTypeRecord) = forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder a)
encodeTypeRecord

instance Divisible RecordEncoder where
  divide :: forall a b c.
(a -> (b, c))
-> RecordEncoder b -> RecordEncoder c -> RecordEncoder a
divide a -> (b, c)
f (RecordEncoder Map Text (Encoder b)
bEncoderRecord) (RecordEncoder Map Text (Encoder c)
cEncoderRecord) =
      forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder
    forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union
      ((forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder b)
bEncoderRecord)
      ((forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder c)
cEncoderRecord)
  conquer :: forall a. RecordEncoder a
conquer = forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder forall a. Monoid a => a
mempty

-- | Convert a `RecordEncoder` into the equivalent `Encoder`.
recordEncoder :: RecordEncoder a -> Encoder a
recordEncoder :: forall a. RecordEncoder a -> Encoder a
recordEncoder (RecordEncoder Map Text (Encoder a)
encodeTypeRecord) = forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder a -> Expr Src Void
makeRecordLit Expr Src Void
recordType
  where
    recordType :: Expr Src Void
recordType = forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a b. (a -> b) -> a -> b
$ (forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoder a -> Expr Src Void
declared) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder a)
encodeTypeRecord
    makeRecordLit :: a -> Expr Src Void
makeRecordLit a
x = forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit forall a b. (a -> b) -> a -> b
$ (forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoder a -> a -> Expr Src Void
embed) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder a)
encodeTypeRecord

{-| Specify how to encode one field of a record using the default `ToDhall`
    instance for that type.
-}
encodeField :: ToDhall a => Text -> RecordEncoder a
encodeField :: forall a. ToDhall a => Text -> RecordEncoder a
encodeField Text
name = forall a. Text -> Encoder a -> RecordEncoder a
encodeFieldWith Text
name forall a. ToDhall a => Encoder a
inject

{-| Specify how to encode one field of a record by supplying an explicit
    `Encoder` for that field.
-}
encodeFieldWith :: Text -> Encoder a -> RecordEncoder a
encodeFieldWith :: forall a. Text -> Encoder a -> RecordEncoder a
encodeFieldWith Text
name Encoder a
encodeType = forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder forall a b. (a -> b) -> a -> b
$ forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name Encoder a
encodeType



{-| 'UnionEncoder' allows you to build an 'Encoder' for a Dhall record.

    For example, let's take the following Haskell data type:

>>> :{
data Status = Queued Natural
            | Result Text
            | Errored Text
:}

    And assume that we have the following Dhall union that we would like to
    parse as a @Status@:

> < Result : Text
> | Queued : Natural
> | Errored : Text
> >.Result "Finish successfully"

    Our encoder has type 'Encoder' @Status@, but we can't build that out of any
    smaller encoders, as 'Encoder's cannot be combined.
    However, we can use an 'UnionEncoder' to build an 'Encoder' for @Status@:

>>> :{
injectStatus :: Encoder Status
injectStatus = adapt >$< unionEncoder
  (   encodeConstructorWith "Queued"  inject
  >|< encodeConstructorWith "Result"  inject
  >|< encodeConstructorWith "Errored" inject
  )
  where
    adapt (Queued  n) = Left n
    adapt (Result  t) = Right (Left t)
    adapt (Errored e) = Right (Right e)
:}

    Or, since we are simply using the `ToDhall` instance to inject each branch, we could write

>>> :{
injectStatus :: Encoder Status
injectStatus = adapt >$< unionEncoder
  (   encodeConstructor "Queued"
  >|< encodeConstructor "Result"
  >|< encodeConstructor "Errored"
  )
  where
    adapt (Queued  n) = Left n
    adapt (Result  t) = Right (Left t)
    adapt (Errored e) = Right (Right e)
:}

-}
newtype UnionEncoder a =
  UnionEncoder
    ( Data.Functor.Product.Product
        ( Control.Applicative.Const
            ( Dhall.Map.Map
                Text
                ( Expr Src Void )
            )
        )
        ( Op (Text, Expr Src Void) )
        a
    )
  deriving (forall b a. b -> UnionEncoder b -> UnionEncoder a
forall a' a. (a' -> a) -> UnionEncoder a -> UnionEncoder a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: forall b a. b -> UnionEncoder b -> UnionEncoder a
$c>$ :: forall b a. b -> UnionEncoder b -> UnionEncoder a
contramap :: forall a' a. (a' -> a) -> UnionEncoder a -> UnionEncoder a'
$ccontramap :: forall a' a. (a' -> a) -> UnionEncoder a -> UnionEncoder a'
Contravariant)

-- | Convert a `UnionEncoder` into the equivalent `Encoder`.
unionEncoder :: UnionEncoder a -> Encoder a
unionEncoder :: forall a. UnionEncoder a -> Encoder a
unionEncoder ( UnionEncoder ( Data.Functor.Product.Pair ( Control.Applicative.Const Map Text (Expr Src Void)
fields ) ( Op a -> (Text, Expr Src Void)
embedF ) ) ) =
    Encoder
      { embed :: a -> Expr Src Void
embed = \a
x ->
          let (Text
name, Expr Src Void
y) = a -> (Text, Expr Src Void)
embedF a
x
          in  case forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit Expr Src Void
y of
                  Maybe (Expr Src Void)
Nothing  -> forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src Void))
fields') forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
name
                  Just Expr Src Void
val -> forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src Void))
fields') forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
name) Expr Src Void
val
      , declared :: Expr Src Void
declared =
          forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src Void))
fields'
      }
  where
    fields' :: Map Text (Maybe (Expr Src Void))
fields' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Map Text (Expr Src Void)
fields

{-| Specify how to encode an alternative by using the default `ToDhall` instance
    for that type.
-}
encodeConstructor
    :: ToDhall a
    => Text
    -> UnionEncoder a
encodeConstructor :: forall a. ToDhall a => Text -> UnionEncoder a
encodeConstructor Text
name = forall a. Text -> Encoder a -> UnionEncoder a
encodeConstructorWith Text
name forall a. ToDhall a => Encoder a
inject

{-| Specify how to encode an alternative by providing an explicit `Encoder`
    for that alternative.
-}
encodeConstructorWith
    :: Text
    -> Encoder a
    -> UnionEncoder a
encodeConstructorWith :: forall a. Text -> Encoder a -> UnionEncoder a
encodeConstructorWith Text
name Encoder a
encodeType = forall a.
Product
  (Const (Map Text (Expr Src Void))) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
UnionEncoder forall a b. (a -> b) -> a -> b
$
    forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Data.Functor.Product.Pair
      ( forall {k} a (b :: k). a -> Const a b
Control.Applicative.Const
          ( forall k v. k -> v -> Map k v
Dhall.Map.singleton
              Text
name
              ( forall a. Encoder a -> Expr Src Void
declared Encoder a
encodeType )
          )
      )
      ( forall a b. (b -> a) -> Op a b
Op ( (Text
name,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoder a -> a -> Expr Src Void
embed Encoder a
encodeType )
      )

-- | Combines two 'UnionEncoder' values.  See 'UnionEncoder' for usage
-- notes.
--
-- Ideally, this matches 'Data.Functor.Contravariant.Divisible.chosen';
-- however, this allows 'UnionEncoder' to not need a 'Divisible' instance
-- itself (since no instance is possible).
(>|<) :: UnionEncoder a -> UnionEncoder b -> UnionEncoder (Either a b)
UnionEncoder (Data.Functor.Product.Pair (Control.Applicative.Const Map Text (Expr Src Void)
mx) (Op a -> (Text, Expr Src Void)
fx))
    >|< :: forall a b.
UnionEncoder a -> UnionEncoder b -> UnionEncoder (Either a b)
>|< UnionEncoder (Data.Functor.Product.Pair (Control.Applicative.Const Map Text (Expr Src Void)
my) (Op b -> (Text, Expr Src Void)
fy)) =
    forall a.
Product
  (Const (Map Text (Expr Src Void))) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
UnionEncoder
      ( forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Data.Functor.Product.Pair
          ( forall {k} a (b :: k). a -> Const a b
Control.Applicative.Const (Map Text (Expr Src Void)
mx forall a. Semigroup a => a -> a -> a
<> Map Text (Expr Src Void)
my) )
          ( forall a b. (b -> a) -> Op a b
Op (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> (Text, Expr Src Void)
fx b -> (Text, Expr Src Void)
fy) )
      )

infixr 5 >|<



-- | Infix 'divided'
(>*<) :: Divisible f => f a -> f b -> f (a, b)
>*< :: forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
(>*<) = forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
divided

infixr 5 >*<