{-# 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.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
    { Encoder a -> a -> Expr Src Void
embed    :: a -> Expr Src Void
    -- ^ Embeds a Haskell value as a Dhall expression
    , Encoder a -> Expr Src Void
declared :: Expr Src Void
    -- ^ Dhall type of the Haskell value
    }

instance Contravariant Encoder where
    contramap :: (a -> b) -> Encoder b -> Encoder a
contramap a -> b
f (Encoder b -> Expr Src Void
embed Expr Src Void
declared) = (a -> Expr Src Void) -> Expr Src Void -> Encoder a
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 = b -> Expr Src Void
embed (a -> b
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
_ = Encoder a
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 :: Encoder a
inject = InputNormalizer -> Encoder a
forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
defaultInputNormalizer



instance ToDhall Void where
    injectWith :: InputNormalizer -> Encoder Void
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Void -> Expr Src Void
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 = Void -> a
forall a. Void -> a
Data.Void.absurd

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

instance ToDhall Bool where
    injectWith :: InputNormalizer -> Encoder Bool
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Bool -> Expr Src Void
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 = Bool -> Expr s a
forall s a. Bool -> Expr s a
BoolLit

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

instance ToDhall Data.Text.Short.ShortText where
    injectWith :: InputNormalizer -> Encoder ShortText
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
ShortText -> Expr Src Void
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 =
            Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
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 = Expr s a
forall s a. Expr s a
Text

instance ToDhall Data.Text.Lazy.Text where
    injectWith :: InputNormalizer -> Encoder Text
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Text -> Expr Src Void
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 =
            Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
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 = Expr s a
forall s a. Expr s a
Text

instance ToDhall Text where
    injectWith :: InputNormalizer -> Encoder Text
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Text -> Expr Src Void
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 = Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
text)

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

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

instance ToDhall Natural where
    injectWith :: InputNormalizer -> Encoder Natural
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Natural -> Expr Src Void
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 = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit

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

instance ToDhall Integer where
    injectWith :: InputNormalizer -> Encoder Integer
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Integer -> Expr Src Void
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 = Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit

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

instance ToDhall Int where
    injectWith :: InputNormalizer -> Encoder Int
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Int -> Expr Src Void
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 = Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit (Integer -> Expr s a) -> (Int -> Integer) -> Int -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger

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

instance ToDhall Int8 where
    injectWith :: InputNormalizer -> Encoder Int8
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Int8 -> Expr Src Void
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 = Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit (Integer -> Expr s a) -> (Int8 -> Integer) -> Int8 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Integer
forall a. Integral a => a -> Integer
toInteger

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

instance ToDhall Int16 where
    injectWith :: InputNormalizer -> Encoder Int16
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Int16 -> Expr Src Void
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 = Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit (Integer -> Expr s a) -> (Int16 -> Integer) -> Int16 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Integer
forall a. Integral a => a -> Integer
toInteger

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

instance ToDhall Int32 where
    injectWith :: InputNormalizer -> Encoder Int32
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Int32 -> Expr Src Void
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 = Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit (Integer -> Expr s a) -> (Int32 -> Integer) -> Int32 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger

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

instance ToDhall Int64 where
    injectWith :: InputNormalizer -> Encoder Int64
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Int64 -> Expr Src Void
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 = Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit (Integer -> Expr s a) -> (Int64 -> Integer) -> Int64 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger

        declared :: Expr s a
declared = Expr s a
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 a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Word -> Expr Src Void
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 = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word -> Natural) -> Word -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

        declared :: Expr s a
declared = Expr s a
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 a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Word8 -> Expr Src Void
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 = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word8 -> Natural) -> Word8 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

        declared :: Expr s a
declared = Expr s a
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 a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Word16 -> Expr Src Void
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 = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word16 -> Natural) -> Word16 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

        declared :: Expr s a
declared = Expr s a
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 a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Word32 -> Expr Src Void
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 = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word32 -> Natural) -> Word32 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

        declared :: Expr s a
declared = Expr s a
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 a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Word64 -> Expr Src Void
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 = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word64 -> Natural) -> Word64 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

instance ToDhall Double where
    injectWith :: InputNormalizer -> Encoder Double
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Double -> Expr Src Void
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 = DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
DoubleLit (DhallDouble -> Expr s a)
-> (Double -> DhallDouble) -> Double -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> DhallDouble
DhallDouble

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

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

instance ToDhall () where
    injectWith :: InputNormalizer -> Encoder ()
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
() -> Expr Src Void
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 = Expr s a -> b -> Expr s a
forall a b. a -> b -> a
const (Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit Map Text (RecordField s a)
forall a. Monoid a => a
mempty)

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

instance ToDhall a => ToDhall (Maybe a) where
    injectWith :: InputNormalizer -> Encoder (Maybe a)
injectWith InputNormalizer
inputNormalizer = (Maybe a -> Expr Src Void) -> Expr Src Void -> Encoder (Maybe a)
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 ) = Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a
Some (a -> Expr Src Void
embedIn a
x)
        embedOut  Maybe a
Nothing  = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
None Expr Src Void
declaredIn

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

        declaredOut :: Expr Src Void
declaredOut = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
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 = (Seq a -> Expr Src Void) -> Expr Src Void -> Encoder (Seq a)
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 = Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src Void)
listType ((a -> Expr Src Void) -> Seq a -> Seq (Expr Src Void)
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
                | Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
xs   = Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just (Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
List Expr Src Void
declaredIn)
                | Bool
otherwise = Maybe (Expr Src Void)
forall a. Maybe a
Nothing

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

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

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

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

instance ToDhall Time.TimeOfDay where
    injectWith :: InputNormalizer -> Encoder TimeOfDay
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
TimeOfDay -> Expr Src Void
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 = TimeOfDay -> Word -> Expr s a
forall s a. TimeOfDay -> Word -> Expr s a
TimeLiteral TimeOfDay
timeOfDay Word
12

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

instance ToDhall Time.Day where
    injectWith :: InputNormalizer -> Encoder Day
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
Day -> Expr Src Void
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 = Day -> Expr s a
forall s a. Day -> Expr s a
DateLiteral

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

instance ToDhall Time.TimeZone where
    injectWith :: InputNormalizer -> Encoder TimeZone
injectWith InputNormalizer
_ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
TimeZone -> Expr Src Void
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 = TimeZone -> Expr s a
forall s a. TimeZone -> Expr s a
TimeZoneLiteral

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

instance ToDhall Time.LocalTime where
    injectWith :: InputNormalizer -> Encoder LocalTime
injectWith InputNormalizer
_ = RecordEncoder LocalTime -> Encoder LocalTime
forall a. RecordEncoder a -> Encoder a
recordEncoder (RecordEncoder LocalTime -> Encoder LocalTime)
-> RecordEncoder LocalTime -> Encoder LocalTime
forall a b. (a -> b) -> a -> b
$
      LocalTime -> (Day, TimeOfDay)
adapt
        (LocalTime -> (Day, TimeOfDay))
-> RecordEncoder (Day, TimeOfDay) -> RecordEncoder LocalTime
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Text -> RecordEncoder Day
forall a. ToDhall a => Text -> RecordEncoder a
encodeField Text
"date"
        RecordEncoder Day
-> RecordEncoder TimeOfDay -> RecordEncoder (Day, TimeOfDay)
forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
>*< Text -> RecordEncoder TimeOfDay
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
_ = RecordEncoder ZonedTime -> Encoder ZonedTime
forall a. RecordEncoder a -> Encoder a
recordEncoder (RecordEncoder ZonedTime -> Encoder ZonedTime)
-> RecordEncoder ZonedTime -> Encoder ZonedTime
forall a b. (a -> b) -> a -> b
$
      ZonedTime -> (Day, (TimeOfDay, TimeZone))
adapt
        (ZonedTime -> (Day, (TimeOfDay, TimeZone)))
-> RecordEncoder (Day, (TimeOfDay, TimeZone))
-> RecordEncoder ZonedTime
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Text -> RecordEncoder Day
forall a. ToDhall a => Text -> RecordEncoder a
encodeField Text
"date"
        RecordEncoder Day
-> RecordEncoder (TimeOfDay, TimeZone)
-> RecordEncoder (Day, (TimeOfDay, TimeZone))
forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
>*< Text -> RecordEncoder TimeOfDay
forall a. ToDhall a => Text -> RecordEncoder a
encodeField Text
"time"
        RecordEncoder TimeOfDay
-> RecordEncoder TimeZone -> RecordEncoder (TimeOfDay, TimeZone)
forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
>*< Text -> RecordEncoder TimeZone
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 = (UTCTime -> ZonedTime) -> Encoder ZonedTime -> Encoder UTCTime
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (TimeZone -> UTCTime -> ZonedTime
Time.utcToZonedTime TimeZone
Time.utc) (Encoder ZonedTime -> Encoder UTCTime)
-> (InputNormalizer -> Encoder ZonedTime)
-> InputNormalizer
-> Encoder UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputNormalizer -> Encoder ZonedTime
forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith

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

        declared :: Expr s a
declared =
            Map Text (Maybe (Expr s a)) -> Expr s a
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union
                ([(Text, Maybe (Expr s a))] -> Map Text (Maybe (Expr s a))
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                    [ (Text
"Sunday", Maybe (Expr s a)
forall a. Maybe a
Nothing)
                    , (Text
"Monday", Maybe (Expr s a)
forall a. Maybe a
Nothing)
                    , (Text
"Tuesday", Maybe (Expr s a)
forall a. Maybe a
Nothing)
                    , (Text
"Wednesday", Maybe (Expr s a)
forall a. Maybe a
Nothing)
                    , (Text
"Thursday", Maybe (Expr s a)
forall a. Maybe a
Nothing)
                    , (Text
"Friday", Maybe (Expr s a)
forall a. Maybe a
Nothing)
                    , (Text
"Saturday", Maybe (Expr s a)
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 = (Encoder [a] -> Encoder (Set a))
-> (InputNormalizer -> Encoder [a])
-> InputNormalizer
-> Encoder (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Set a -> [a]) -> Encoder [a] -> Encoder (Set a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Set a -> [a]
forall a. Set a -> [a]
Data.Set.toAscList) InputNormalizer -> Encoder [a]
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 = (Encoder [a] -> Encoder (HashSet a))
-> (InputNormalizer -> Encoder [a])
-> InputNormalizer
-> Encoder (HashSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HashSet a -> [a]) -> Encoder [a] -> Encoder (HashSet a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap HashSet a -> [a]
forall a. HashSet a -> [a]
Data.HashSet.toList) InputNormalizer -> Encoder [a]
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 = (Map k v -> Expr Src Void) -> Expr Src Void -> Encoder (Map k v)
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 = Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
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
                | Map k v -> Bool
forall k a. Map k a -> Bool
Data.Map.null Map k v
m = Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just Expr Src Void
declaredOut
                | Bool
otherwise       = Maybe (Expr Src Void)
forall a. Maybe a
Nothing

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

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

        Encoder k -> Expr Src Void
embedK Expr Src Void
declaredK = InputNormalizer -> Encoder k
forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer
        Encoder v -> Expr Src Void
embedV Expr Src Void
declaredV = InputNormalizer -> Encoder v
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 = (HashMap k v -> Expr Src Void)
-> Expr Src Void -> Encoder (HashMap k v)
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 = Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
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
                | HashMap k v -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap k v
m = Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just Expr Src Void
declaredOut
                | Bool
otherwise       = Maybe (Expr Src Void)
forall a. Maybe a
Nothing

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

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

        Encoder k -> Expr Src Void
embedK Expr Src Void
declaredK = InputNormalizer -> Encoder k
forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer
        Encoder v -> Expr Src Void
embedV Expr Src Void
declaredV = InputNormalizer -> Encoder v
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 :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
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 = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
"Make" (Expr Src Void -> Expr Src Void)
-> (Result f -> Expr Src Void) -> Result f -> Expr Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder (f (Result f)) -> f (Result f) -> Expr Src Void
forall a. Encoder a -> a -> Expr Src Void
Dhall.Marshal.Encode.embed (InputNormalizer -> Encoder (f (Result f))
forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer) (f (Result f) -> Expr Src Void)
-> (Result f -> f (Result f)) -> Result f -> Expr Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result f -> f (Result f)
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 :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
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 =
          Maybe CharacterSet
-> FunctionBinding Src Void -> Expr Src Void -> Expr Src Void
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
forall a. Maybe a
Nothing (Text -> Expr Src Void -> FunctionBinding Src Void
forall s a. Text -> Expr s a -> FunctionBinding s a
Core.makeFunctionBinding Text
"result" (Const -> Expr Src Void
forall s a. Const -> Expr s a
Const Const
Core.Type)) (Expr Src Void -> Expr Src Void) -> Expr Src Void -> Expr Src Void
forall a b. (a -> b) -> a -> b
$
            Maybe CharacterSet
-> FunctionBinding Src Void -> Expr Src Void -> Expr Src Void
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
forall a. Maybe a
Nothing (Text -> Expr Src Void -> FunctionBinding Src Void
forall s a. Text -> Expr s a -> FunctionBinding s a
Core.makeFunctionBinding Text
"Make" Expr Src Void
makeType) (Expr Src Void -> Expr Src Void) -> Expr Src Void -> Expr Src Void
forall a b. (a -> b) -> a -> b
$
              Result f -> Expr Src Void
embed' (Result f -> Expr Src Void)
-> (Fix f -> Result f) -> Fix f -> Expr Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> Result f
forall (f :: * -> *). Functor f => Fix f -> Result f
fixToResult (Fix f -> Expr Src Void) -> Fix f -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Fix f
fixf

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

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

fixToResult :: Functor f => Fix f -> Result f
fixToResult :: Fix f -> Result f
fixToResult (Fix f (Fix f)
x) = f (Result f) -> Result f
forall (f :: * -> *). f (Result f) -> Result f
Result ((Fix f -> Result f) -> f (Fix f) -> f (Result f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix f -> Result f
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 :: InputNormalizer
-> InterpretOptions -> State Int (Encoder (M1 D d f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options = do
        Encoder (f a)
res <- InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options
        Encoder (M1 D d f a) -> State Int (Encoder (M1 D d f a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((M1 D d f a -> f a) -> Encoder (f a) -> Encoder (M1 D d f a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap M1 D d f a -> f a
forall i (c :: Meta) k (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 :: InputNormalizer
-> InterpretOptions -> State Int (Encoder (M1 C c f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options = do
        Encoder (f a)
res <- InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
forall (f :: * -> *) a.
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options
        Encoder (M1 C c f a) -> State Int (Encoder (M1 C c f a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((M1 C c f a -> f a) -> Encoder (f a) -> Encoder (M1 C c f a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap M1 C c f a -> f a
forall i (c :: Meta) k (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 :: 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' } =
                InputNormalizer -> Encoder a
forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer

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

        Text
name <- Text -> Text
fieldModifier (Text -> Text)
-> StateT Int Identity Text -> StateT Int Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> M1 S s (K1 i a) Any -> StateT Int Identity Text
forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> StateT Int Identity Text
getSelName M1 S s (K1 i a) Any
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)) =
                Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Text -> RecordField Src Void -> Map Text (RecordField Src Void)
forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name (Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expr Src Void -> RecordField Src Void
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                    -> M1 i c (K1 i a) p -> Expr Src Void
forall i (c :: Meta) i p. M1 i c (K1 i a) p -> Expr Src Void
embed0
                    SingletonConstructors
Smart | M1 S s (K1 i a) Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s (K1 i a) Any
forall r. M1 S s (K1 i a) r
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" -> M1 i c (K1 i a) p -> Expr Src Void
forall i (c :: Meta) i p. M1 i c (K1 i a) p -> Expr Src Void
embed0
                    SingletonConstructors
_                       -> M1 i c (K1 i a) p -> Expr Src Void
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 | M1 S s (K1 i a) Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s (K1 i a) Any
forall r. M1 S s (K1 i a) r
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" ->
                        Expr Src Void
declared'
                    SingletonConstructors
_ ->
                        Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Text -> RecordField Src Void -> Map Text (RecordField Src Void)
forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name (RecordField Src Void -> Map Text (RecordField Src Void))
-> RecordField Src Void -> Map Text (RecordField Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField Expr Src Void
declared')

        Encoder (M1 S s (K1 i a) a)
-> State Int (Encoder (M1 S s (K1 i a) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
M1 S s (K1 i a) a -> 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 :: 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
..}) = Encoder ((:+:) (M1 C c1 f1) (M1 C c2 f2) a)
-> State Int (Encoder ((:+:) (M1 C c1 f1) (M1 C c2 f2) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
(:+:) (M1 C c1 f1) (M1 C c2 f2) a -> 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 Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (f1 a -> Expr Src Void
forall a. f1 a -> Expr Src Void
embedL f1 a
l) of
                Maybe (Expr Src Void)
Nothing ->
                    Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL
                Just Expr Src Void
valL ->
                    Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL) Expr Src Void
valL

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

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

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

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

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

        Encoder f1 a -> Expr Src Void
embedL Expr Src Void
declaredL = State Int (Encoder (f1 a)) -> Int -> Encoder (f1 a)
forall s a. State s a -> s -> a
evalState (InputNormalizer -> InterpretOptions -> State Int (Encoder (f1 a))
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 = State Int (Encoder (f2 a)) -> Int -> Encoder (f2 a)
forall s a. State s a -> s -> a
evalState (InputNormalizer -> InterpretOptions -> State Int (Encoder (f2 a))
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 :: 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
..}) = Encoder ((:+:) (f :+: g) (M1 C c h) a)
-> State Int (Encoder ((:+:) (f :+: g) (M1 C c h) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
(:+:) (f :+: g) (M1 C c h) a -> 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   -> Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL
                Just Expr Src Void
valL -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
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 (:+:)" ((:+:) f g a -> Expr Src Void
forall a. (:+:) f g a -> Expr Src Void
embedL (:+:) f g a
l)
        embed (R1 (M1 h a
r)) =
            case Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (h a -> Expr Src Void
forall a. h a -> Expr Src Void
embedR h a
r) of
                Maybe (Expr Src Void)
Nothing   -> Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR
                Just Expr Src Void
valR -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR) Expr Src Void
valR

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

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

        declared :: Expr Src Void
declared = Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (Text
-> Maybe (Expr Src Void)
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
keyR (Expr Src Void -> Maybe (Expr Src Void)
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 = State Int (Encoder ((:+:) f g a)) -> Int -> Encoder ((:+:) f g a)
forall s a. State s a -> s -> a
evalState (InputNormalizer
-> InterpretOptions -> State Int (Encoder ((:+:) f g a))
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 = State Int (Encoder (h a)) -> Int -> Encoder (h a)
forall s a. State s a -> s -> a
evalState (InputNormalizer -> InterpretOptions -> State Int (Encoder (h a))
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 :: 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
..}) = Encoder ((:+:) (M1 C c f) (g :+: h) a)
-> State Int (Encoder ((:+:) (M1 C c f) (g :+: h) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
(:+:) (M1 C c f) (g :+: h) a -> 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 Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (f a -> Expr Src Void
forall a. f a -> Expr Src Void
embedL f a
l) of
                Maybe (Expr Src Void)
Nothing   -> Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL
                Just Expr Src Void
valL -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
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   -> Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR
                Just Expr Src Void
valR -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
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 (:+:)" ((:+:) g h a -> Expr Src Void
forall a. (:+:) g h a -> Expr Src Void
embedR (:+:) g h a
r)

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

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

        declared :: Expr Src Void
declared = Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (Text
-> Maybe (Expr Src Void)
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
keyL (Expr Src Void -> Maybe (Expr Src Void)
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 = State Int (Encoder (f a)) -> Int -> Encoder (f a)
forall s a. State s a -> s -> a
evalState (InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
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 = State Int (Encoder ((:+:) g h a)) -> Int -> Encoder ((:+:) g h a)
forall s a. State s a -> s -> a
evalState (InputNormalizer
-> InterpretOptions -> State Int (Encoder ((:+:) g h a))
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 :: InputNormalizer
-> InterpretOptions
-> State Int (Encoder ((:+:) (f :+: g) (h :+: i) a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options = Encoder ((:+:) (f :+: g) (h :+: i) a)
-> State Int (Encoder ((:+:) (f :+: g) (h :+: i) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
(:+:) (f :+: g) (h :+: i) a -> Expr Src Void
forall a. (:+:) (f :+: g) (h :+: i) a -> Expr Src Void
declared :: Expr Src Void
embed :: forall a. (:+:) (f :+: g) (h :+: i) a -> Expr Src Void
declared :: Expr Src Void
embed :: (:+:) (f :+: g) (h :+: i) a -> Expr Src Void
..})
      where
        embed :: (:+:) (f :+: g) (h :+: i) a -> Expr Src Void
embed (L1 (:+:) f g a
l) =
            case Maybe (Expr Src Void)
maybeValL of
                Maybe (Expr Src Void)
Nothing   -> Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyL
                Just Expr Src Void
valL -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
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 (:+:)" ((:+:) f g a -> Expr Src Void
forall a. (:+:) f g a -> Expr Src Void
embedL (:+:) f g a
l)
        embed (R1 (:+:) h i a
r) =
            case Maybe (Expr Src Void)
maybeValR of
                Maybe (Expr Src Void)
Nothing   -> Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
keyR
                Just Expr Src Void
valR -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Src Void
declared (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
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 (:+:)" ((:+:) h i a -> Expr Src Void
forall a. (:+:) h i a -> Expr Src Void
embedR (:+:) h i a
r)

        declared :: Expr Src Void
declared = Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
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 = State Int (Encoder ((:+:) f g a)) -> Int -> Encoder ((:+:) f g a)
forall s a. State s a -> s -> a
evalState (InputNormalizer
-> InterpretOptions -> State Int (Encoder ((:+:) f g a))
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 = State Int (Encoder ((:+:) h i a)) -> Int -> Encoder ((:+:) h i a)
forall s a. State s a -> s -> a
evalState (InputNormalizer
-> InterpretOptions -> State Int (Encoder ((:+:) h i a))
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 :: 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 <- InputNormalizer
-> InterpretOptions -> State Int (Encoder ((:*:) f g a))
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 <- InputNormalizer
-> InterpretOptions -> State Int (Encoder ((:*:) h i a))
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) =
                Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
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 = Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
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

        Encoder ((:*:) (f :*: g) (h :*: i) a)
-> State Int (Encoder ((:*:) (f :*: g) (h :*: i) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
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 :: 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 :: M1 S s (K1 i a) r
nR = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined

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

        Encoder (:*:) f g a -> Expr Src Void
embedL Expr Src Void
declaredL <- InputNormalizer
-> InterpretOptions -> State Int (Encoder ((:*:) f g a))
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 = InputNormalizer -> Encoder a
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)) =
                Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Text
-> RecordField Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameR (Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expr Src Void -> RecordField Src Void
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 = Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Text
-> RecordField Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameR (Expr Src Void -> RecordField Src Void
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

        Encoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
-> State Int (Encoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
(:*:) (f :*: g) (M1 S s (K1 i a)) a -> 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 :: 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 :: M1 S s (K1 i a) r
nL = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined

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

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

        Encoder (:*:) f g a -> Expr Src Void
embedR Expr Src Void
declaredR <- InputNormalizer
-> InterpretOptions -> State Int (Encoder ((:*:) f g a))
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) =
                Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Text
-> RecordField Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameL (Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expr Src Void -> RecordField Src Void
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 = Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Text
-> RecordField Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameL (Expr Src Void -> RecordField Src Void
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

        Encoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
-> State Int (Encoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
(:*:) (M1 S s (K1 i a)) (f :*: g) a -> 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 :: 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 :: M1 S s1 (K1 i1 a1) r
nL = M1 S s1 (K1 i1 a1) r
forall a. HasCallStack => a
undefined

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

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

        let Encoder a1 -> Expr Src Void
embedL Expr Src Void
declaredL = InputNormalizer -> Encoder a1
forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer
        let Encoder a2 -> Expr Src Void
embedR Expr Src Void
declaredR = InputNormalizer -> Encoder a2
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)) =
                Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField Src Void) -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Expr Src Void
forall a b. (a -> b) -> a -> b
$
                    [(Text, RecordField Src Void)] -> Map Text (RecordField Src Void)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                        [ (Text
nameL, Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expr Src Void -> RecordField Src Void
forall a b. (a -> b) -> a -> b
$ a1 -> Expr Src Void
embedL a1
l)
                        , (Text
nameR, Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expr Src Void -> RecordField Src Void
forall a b. (a -> b) -> a -> b
$ a2 -> Expr Src Void
embedR a2
r) ]


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


        Encoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
-> State
     Int (Encoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
(:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a -> 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 :: InputNormalizer -> InterpretOptions -> State Int (Encoder (U1 a))
genericToDhallWithNormalizer InputNormalizer
_ InterpretOptions
_ = Encoder (U1 a) -> State Int (Encoder (U1 a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {Expr Src Void
U1 a -> Expr Src Void
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
_ = Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit Map Text (RecordField s a)
forall a. Monoid a => a
mempty

        declared :: Expr s a
declared = Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
Record Map Text (RecordField s a)
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 :: Encoder a
genericToDhall
    = InterpretOptions -> Encoder a
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 :: InterpretOptions -> Encoder a
genericToDhallWith InterpretOptions
options = InterpretOptions -> InputNormalizer -> Encoder a
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 :: InterpretOptions -> InputNormalizer -> Encoder a
genericToDhallWithInputNormalizer InterpretOptions
options InputNormalizer
inputNormalizer
    = (a -> Rep a Any) -> Encoder (Rep a Any) -> Encoder a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> Rep a Any
forall a x. Generic a => a -> Rep a x
GHC.Generics.from (State Int (Encoder (Rep a Any)) -> Int -> Encoder (Rep a Any)
forall s a. State s a -> s -> a
evalState (InputNormalizer
-> InterpretOptions -> State Int (Encoder (Rep a Any))
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 :: (a -> b) -> RecordEncoder b -> RecordEncoder a
contramap a -> b
f (RecordEncoder Map Text (Encoder b)
encodeTypeRecord) = Map Text (Encoder a) -> RecordEncoder a
forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder (Map Text (Encoder a) -> RecordEncoder a)
-> Map Text (Encoder a) -> RecordEncoder a
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Encoder b -> Encoder a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f (Encoder b -> Encoder a)
-> Map Text (Encoder b) -> Map Text (Encoder a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder b)
encodeTypeRecord

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

-- | Convert a `RecordEncoder` into the equivalent `Encoder`.
recordEncoder :: RecordEncoder a -> Encoder a
recordEncoder :: RecordEncoder a -> Encoder a
recordEncoder (RecordEncoder Map Text (Encoder a)
encodeTypeRecord) = (a -> Expr Src Void) -> Expr Src Void -> Encoder a
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 = Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField Src Void) -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ (Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> (Encoder a -> Expr Src Void)
-> Encoder a
-> RecordField Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder a -> Expr Src Void
forall a. Encoder a -> Expr Src Void
declared) (Encoder a -> RecordField Src Void)
-> Map Text (Encoder a) -> Map Text (RecordField Src Void)
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 = Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField Src Void) -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ (Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> (Encoder a -> Expr Src Void)
-> Encoder a
-> RecordField Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> Expr Src Void) -> a -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ a
x) ((a -> Expr Src Void) -> Expr Src Void)
-> (Encoder a -> a -> Expr Src Void) -> Encoder a -> Expr Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder a -> a -> Expr Src Void
forall a. Encoder a -> a -> Expr Src Void
embed) (Encoder a -> RecordField Src Void)
-> Map Text (Encoder a) -> Map Text (RecordField Src Void)
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 :: Text -> RecordEncoder a
encodeField Text
name = Text -> Encoder a -> RecordEncoder a
forall a. Text -> Encoder a -> RecordEncoder a
encodeFieldWith Text
name Encoder a
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 :: Text -> Encoder a -> RecordEncoder a
encodeFieldWith Text
name Encoder a
encodeType = Map Text (Encoder a) -> RecordEncoder a
forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder (Map Text (Encoder a) -> RecordEncoder a)
-> Map Text (Encoder a) -> RecordEncoder a
forall a b. (a -> b) -> a -> b
$ Text -> Encoder a -> Map Text (Encoder a)
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 (b -> UnionEncoder b -> UnionEncoder a
(a -> b) -> UnionEncoder b -> UnionEncoder a
(forall a b. (a -> b) -> UnionEncoder b -> UnionEncoder a)
-> (forall b a. b -> UnionEncoder b -> UnionEncoder a)
-> Contravariant UnionEncoder
forall b a. b -> UnionEncoder b -> UnionEncoder a
forall a b. (a -> b) -> UnionEncoder b -> UnionEncoder a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> f a)
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: b -> UnionEncoder b -> UnionEncoder a
$c>$ :: forall b a. b -> UnionEncoder b -> UnionEncoder a
contramap :: (a -> b) -> UnionEncoder b -> UnionEncoder a
$ccontramap :: forall a b. (a -> b) -> UnionEncoder b -> UnionEncoder a
Contravariant)

-- | Convert a `UnionEncoder` into the equivalent `Encoder`.
unionEncoder :: UnionEncoder a -> Encoder a
unionEncoder :: 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 :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
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 Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit Expr Src Void
y of
                  Maybe (Expr Src Void)
Nothing  -> Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src Void))
fields') (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
name
                  Just Expr Src Void
val -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> FieldSelection Src -> Expr Src Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src Void))
fields') (FieldSelection Src -> Expr Src Void)
-> FieldSelection Src -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
name) Expr Src Void
val
      , declared :: Expr Src Void
declared =
          Map Text (Maybe (Expr Src Void)) -> Expr Src Void
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' = (Expr Src Void -> Maybe (Expr Src Void))
-> Map Text (Expr Src Void) -> Map Text (Maybe (Expr Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Src Void -> Maybe (Expr Src Void)
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 :: Text -> UnionEncoder a
encodeConstructor Text
name = Text -> Encoder a -> UnionEncoder a
forall a. Text -> Encoder a -> UnionEncoder a
encodeConstructorWith Text
name Encoder a
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 :: Text -> Encoder a -> UnionEncoder a
encodeConstructorWith Text
name Encoder a
encodeType = Product
  (Const (Map Text (Expr Src Void))) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
forall a.
Product
  (Const (Map Text (Expr Src Void))) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
UnionEncoder (Product
   (Const (Map Text (Expr Src Void))) (Op (Text, Expr Src Void)) a
 -> UnionEncoder a)
-> Product
     (Const (Map Text (Expr Src Void))) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
forall a b. (a -> b) -> a -> b
$
    Const (Map Text (Expr Src Void)) a
-> Op (Text, Expr Src Void) a
-> Product
     (Const (Map Text (Expr Src Void))) (Op (Text, Expr Src Void)) a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Data.Functor.Product.Pair
      ( Map Text (Expr Src Void) -> Const (Map Text (Expr Src Void)) a
forall k a (b :: k). a -> Const a b
Control.Applicative.Const
          ( Text -> Expr Src Void -> Map Text (Expr Src Void)
forall k v. k -> v -> Map k v
Dhall.Map.singleton
              Text
name
              ( Encoder a -> Expr Src Void
forall a. Encoder a -> Expr Src Void
declared Encoder a
encodeType )
          )
      )
      ( (a -> (Text, Expr Src Void)) -> Op (Text, Expr Src Void) a
forall a b. (b -> a) -> Op a b
Op ( (Text
name,) (Expr Src Void -> (Text, Expr Src Void))
-> (a -> Expr Src Void) -> a -> (Text, Expr Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder a -> a -> Expr Src Void
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))
    >|< :: 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)) =
    Product
  (Const (Map Text (Expr Src Void)))
  (Op (Text, Expr Src Void))
  (Either a b)
-> UnionEncoder (Either a b)
forall a.
Product
  (Const (Map Text (Expr Src Void))) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
UnionEncoder
      ( Const (Map Text (Expr Src Void)) (Either a b)
-> Op (Text, Expr Src Void) (Either a b)
-> Product
     (Const (Map Text (Expr Src Void)))
     (Op (Text, Expr Src Void))
     (Either a b)
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Data.Functor.Product.Pair
          ( Map Text (Expr Src Void)
-> Const (Map Text (Expr Src Void)) (Either a b)
forall k a (b :: k). a -> Const a b
Control.Applicative.Const (Map Text (Expr Src Void)
mx Map Text (Expr Src Void)
-> Map Text (Expr Src Void) -> Map Text (Expr Src Void)
forall a. Semigroup a => a -> a -> a
<> Map Text (Expr Src Void)
my) )
          ( (Either a b -> (Text, Expr Src Void))
-> Op (Text, Expr Src Void) (Either a b)
forall a b. (b -> a) -> Op a b
Op ((a -> (Text, Expr Src Void))
-> (b -> (Text, Expr Src Void))
-> Either a b
-> (Text, Expr Src Void)
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)
>*< :: f a -> f b -> f (a, b)
(>*<) = f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
divided

infixr 5 >*<