{-# LANGUAGE ApplicativeDo              #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE ViewPatterns               #-}

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

module Dhall
    (
    -- * Input
      input
    , inputWithSettings
    , inputFile
    , inputFileWithSettings
    , inputExpr
    , inputExprWithSettings
    , rootDirectory
    , sourceName
    , startingContext
    , substitutions
    , normalizer
    , newManager
    , defaultInputSettings
    , InputSettings
    , defaultEvaluateSettings
    , EvaluateSettings
    , HasEvaluateSettings(..)
    , detailed

    -- * Decoders
    , Decoder (..)
    , RecordDecoder(..)
    , UnionDecoder(..)
    , Encoder(..)
    , FromDhall(..)
    , Interpret
    , InvalidDecoder(..)
    , ExtractErrors
    , ExtractError(..)
    , Extractor
    , MonadicExtractor
    , typeError
    , extractError
    , toMonadic
    , fromMonadic
    , ExpectedTypeErrors
    , ExpectedTypeError(..)
    , Expector
    , auto
    , genericAuto
    , genericAutoWith
    , InterpretOptions(..)
    , InputNormalizer(..)
    , defaultInputNormalizer
    , SingletonConstructors(..)
    , defaultInterpretOptions
    , bool
    , natural
    , integer
    , word
    , word8
    , word16
    , word32
    , word64
    , int
    , int8
    , int16
    , int32
    , int64
    , scientific
    , double
    , lazyText
    , strictText
    , maybe
    , sequence
    , list
    , vector
    , function
    , functionWith
    , setFromDistinctList
    , setIgnoringDuplicates
    , hashSetFromDistinctList
    , hashSetIgnoringDuplicates
    , Dhall.map
    , hashMap
    , pairFromMapEntry
    , unit
    , void
    , string
    , pair
    , record
    , field
    , union
    , constructor
    , GenericFromDhall(..)
    , GenericFromDhallUnion(..)
    , ToDhall(..)
    , Inject
    , inject
    , genericToDhall
    , genericToDhallWith
    , RecordEncoder(..)
    , encodeFieldWith
    , encodeField
    , recordEncoder
    , UnionEncoder(..)
    , encodeConstructorWith
    , encodeConstructor
    , unionEncoder
    , (>|<)
    , GenericToDhall(..)

    -- * Miscellaneous
    , DhallErrors(..)
    , showDhallErrors
    , rawInput
    , (>$<)
    , (>*<)
    , Result

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

import Control.Applicative                  (Alternative, empty, liftA2)
import Control.Exception                    (Exception)
import Control.Monad                        (guard)
import Control.Monad.Trans.State.Strict
import Data.Coerce                          (coerce)
import Data.Either.Validation
    ( Validation (..)
    , eitherToValidation
    , validationToEither
    )
import Data.Fix                             (Fix (..))
import Data.Functor.Contravariant           (Contravariant (..), Op (..), (>$<))
import Data.Functor.Contravariant.Divisible (Divisible (..), divided)
import Data.Hashable                        (Hashable)
import Data.HashMap.Strict                  (HashMap)
import Data.List.NonEmpty                   (NonEmpty (..))
import Data.Map                             (Map)
import Data.Scientific                      (Scientific)
import Data.Sequence                        (Seq)
import Data.Text                            (Text)
import Data.Text.Prettyprint.Doc            (Pretty)
import Data.Typeable                        (Proxy (..), Typeable)
import Data.Vector                          (Vector)
import Data.Void                            (Void)
import Data.Word                            (Word8, Word16, Word32, Word64)
import Data.Int                             (Int8, Int16, Int32, Int64)
import Dhall.Import                         (Imported (..))
import Dhall.Parser                         (Src (..))
import Dhall.Syntax
    ( Chunks (..)
    , DhallDouble (..)
    , Expr (..)
    , FunctionBinding (..)
    , RecordField (..)
    , Var (..)
    )
import Dhall.TypeCheck                      (DetailedTypeError (..), TypeError)
import GHC.Generics
import Lens.Family                          (LensLike', view)
import Numeric.Natural                      (Natural)
import Prelude                              hiding (maybe, sequence)
import System.FilePath                      (takeDirectory)

import qualified Control.Applicative
import qualified Control.Exception
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.Foldable
import qualified Data.Functor.Compose
import qualified Data.Functor.Product
import qualified Data.HashMap.Strict              as HashMap
import qualified Data.HashSet
import qualified Data.List
import qualified Data.List.NonEmpty
import qualified Data.Map
import qualified Data.Maybe
import qualified Data.Scientific
import qualified Data.Sequence
import qualified Data.Set
import qualified Data.Text
import qualified Data.Text.IO
import qualified Data.Text.Lazy
import qualified Data.Vector
import qualified Data.Void
import qualified Dhall.Context
import qualified Dhall.Core                       as Core
import qualified Dhall.Import
import qualified Dhall.Map
import qualified Dhall.Parser
import qualified Dhall.Pretty.Internal
import qualified Dhall.Substitution
import qualified Dhall.TypeCheck
import qualified Dhall.Util
import qualified Lens.Family

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> :set -XRecordWildCards
-- >>> import Data.Word (Word8, Word16, Word32, Word64)
-- >>> import Dhall.Pretty.Internal (prettyExpr)

{-| A newtype suitable for collecting one or more errors
-}
newtype DhallErrors e = DhallErrors
   { DhallErrors e -> NonEmpty e
getErrors :: NonEmpty e
   } deriving (DhallErrors e -> DhallErrors e -> Bool
(DhallErrors e -> DhallErrors e -> Bool)
-> (DhallErrors e -> DhallErrors e -> Bool) -> Eq (DhallErrors e)
forall e. Eq e => DhallErrors e -> DhallErrors e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DhallErrors e -> DhallErrors e -> Bool
$c/= :: forall e. Eq e => DhallErrors e -> DhallErrors e -> Bool
== :: DhallErrors e -> DhallErrors e -> Bool
$c== :: forall e. Eq e => DhallErrors e -> DhallErrors e -> Bool
Eq, a -> DhallErrors b -> DhallErrors a
(a -> b) -> DhallErrors a -> DhallErrors b
(forall a b. (a -> b) -> DhallErrors a -> DhallErrors b)
-> (forall a b. a -> DhallErrors b -> DhallErrors a)
-> Functor DhallErrors
forall a b. a -> DhallErrors b -> DhallErrors a
forall a b. (a -> b) -> DhallErrors a -> DhallErrors b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DhallErrors b -> DhallErrors a
$c<$ :: forall a b. a -> DhallErrors b -> DhallErrors a
fmap :: (a -> b) -> DhallErrors a -> DhallErrors b
$cfmap :: forall a b. (a -> b) -> DhallErrors a -> DhallErrors b
Functor, b -> DhallErrors e -> DhallErrors e
NonEmpty (DhallErrors e) -> DhallErrors e
DhallErrors e -> DhallErrors e -> DhallErrors e
(DhallErrors e -> DhallErrors e -> DhallErrors e)
-> (NonEmpty (DhallErrors e) -> DhallErrors e)
-> (forall b. Integral b => b -> DhallErrors e -> DhallErrors e)
-> Semigroup (DhallErrors e)
forall b. Integral b => b -> DhallErrors e -> DhallErrors e
forall e. NonEmpty (DhallErrors e) -> DhallErrors e
forall e. DhallErrors e -> DhallErrors e -> DhallErrors e
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall e b. Integral b => b -> DhallErrors e -> DhallErrors e
stimes :: b -> DhallErrors e -> DhallErrors e
$cstimes :: forall e b. Integral b => b -> DhallErrors e -> DhallErrors e
sconcat :: NonEmpty (DhallErrors e) -> DhallErrors e
$csconcat :: forall e. NonEmpty (DhallErrors e) -> DhallErrors e
<> :: DhallErrors e -> DhallErrors e -> DhallErrors e
$c<> :: forall e. DhallErrors e -> DhallErrors e -> DhallErrors e
Semigroup)

instance (Show (DhallErrors e), Typeable e) => Exception (DhallErrors e)

{-| Render a given prefix and some errors to a string.
-}
showDhallErrors :: Show e => String -> DhallErrors e -> String
showDhallErrors :: String -> DhallErrors e -> String
showDhallErrors String
_   (DhallErrors (e
e :| [])) = e -> String
forall a. Show a => a -> String
show e
e
showDhallErrors String
ctx (DhallErrors NonEmpty e
es) = String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ([String] -> String
unlines ([String] -> String)
-> (NonEmpty e -> [String]) -> NonEmpty e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
Data.List.NonEmpty.toList (NonEmpty String -> [String])
-> (NonEmpty e -> NonEmpty String) -> NonEmpty e -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> String) -> NonEmpty e -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> String
forall a. Show a => a -> String
show (NonEmpty e -> String) -> NonEmpty e -> String
forall a b. (a -> b) -> a -> b
$ NonEmpty e
es)
  where
    prefix :: String
prefix =
        String
"Multiple errors were encountered" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": \n\
        \                                               \n"

{-| Useful synonym for the `Validation` type used when marshalling Dhall
    expressions
-}
type Extractor s a = Validation (ExtractErrors s a)

{-| Useful synonym for the equivalent `Either` type used when marshalling Dhall
    code
-}
type MonadicExtractor s a = Either (ExtractErrors s a)

{-| Generate a type error during extraction by specifying the expected type
    and the actual type.
    The expected type is not yet determined.
-}
typeError :: Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError :: Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr s a)
expected Expr s a
actual = DhallErrors (ExtractError s a) -> Extractor s a b
forall e a. e -> Validation e a
Failure (DhallErrors (ExtractError s a) -> Extractor s a b)
-> DhallErrors (ExtractError s a) -> Extractor s a b
forall a b. (a -> b) -> a -> b
$ case Expector (Expr s a)
expected of
    Failure ExpectedTypeErrors
e         -> (ExpectedTypeError -> ExtractError s a)
-> ExpectedTypeErrors -> DhallErrors (ExtractError s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExpectedTypeError -> ExtractError s a
forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeErrors
e
    Success Expr s a
expected' -> NonEmpty (ExtractError s a) -> DhallErrors (ExtractError s a)
forall e. NonEmpty e -> DhallErrors e
DhallErrors (NonEmpty (ExtractError s a) -> DhallErrors (ExtractError s a))
-> NonEmpty (ExtractError s a) -> DhallErrors (ExtractError s a)
forall a b. (a -> b) -> a -> b
$ ExtractError s a -> NonEmpty (ExtractError s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtractError s a -> NonEmpty (ExtractError s a))
-> ExtractError s a -> NonEmpty (ExtractError s a)
forall a b. (a -> b) -> a -> b
$ InvalidDecoder s a -> ExtractError s a
forall s a. InvalidDecoder s a -> ExtractError s a
TypeMismatch (InvalidDecoder s a -> ExtractError s a)
-> InvalidDecoder s a -> ExtractError s a
forall a b. (a -> b) -> a -> b
$ Expr s a -> Expr s a -> InvalidDecoder s a
forall s a. Expr s a -> Expr s a -> InvalidDecoder s a
InvalidDecoder Expr s a
expected' Expr s a
actual

-- | Turn a `Data.Text.Text` message into an extraction failure
extractError :: Text -> Extractor s a b
extractError :: Text -> Extractor s a b
extractError = DhallErrors (ExtractError s a) -> Extractor s a b
forall e a. e -> Validation e a
Failure (DhallErrors (ExtractError s a) -> Extractor s a b)
-> (Text -> DhallErrors (ExtractError s a))
-> Text
-> Extractor s a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (ExtractError s a) -> DhallErrors (ExtractError s a)
forall e. NonEmpty e -> DhallErrors e
DhallErrors (NonEmpty (ExtractError s a) -> DhallErrors (ExtractError s a))
-> (Text -> NonEmpty (ExtractError s a))
-> Text
-> DhallErrors (ExtractError s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtractError s a -> NonEmpty (ExtractError s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtractError s a -> NonEmpty (ExtractError s a))
-> (Text -> ExtractError s a)
-> Text
-> NonEmpty (ExtractError s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ExtractError s a
forall s a. Text -> ExtractError s a
ExtractError

{-| Useful synonym for the `Validation` type used when marshalling Dhall
    expressions
-}
type Expector = Validation ExpectedTypeErrors

{-| One or more errors returned when determining the Dhall type of a
    Haskell expression
-}
type ExpectedTypeErrors = DhallErrors ExpectedTypeError

{-| Error type used when determining the Dhall type of a Haskell expression
-}
data ExpectedTypeError = RecursiveTypeError
    deriving (ExpectedTypeError -> ExpectedTypeError -> Bool
(ExpectedTypeError -> ExpectedTypeError -> Bool)
-> (ExpectedTypeError -> ExpectedTypeError -> Bool)
-> Eq ExpectedTypeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpectedTypeError -> ExpectedTypeError -> Bool
$c/= :: ExpectedTypeError -> ExpectedTypeError -> Bool
== :: ExpectedTypeError -> ExpectedTypeError -> Bool
$c== :: ExpectedTypeError -> ExpectedTypeError -> Bool
Eq, Int -> ExpectedTypeError -> String -> String
[ExpectedTypeError] -> String -> String
ExpectedTypeError -> String
(Int -> ExpectedTypeError -> String -> String)
-> (ExpectedTypeError -> String)
-> ([ExpectedTypeError] -> String -> String)
-> Show ExpectedTypeError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ExpectedTypeError] -> String -> String
$cshowList :: [ExpectedTypeError] -> String -> String
show :: ExpectedTypeError -> String
$cshow :: ExpectedTypeError -> String
showsPrec :: Int -> ExpectedTypeError -> String -> String
$cshowsPrec :: Int -> ExpectedTypeError -> String -> String
Show)

instance Exception ExpectedTypeError

instance Show ExpectedTypeErrors where
    show :: ExpectedTypeErrors -> String
show = String -> ExpectedTypeErrors -> String
forall e. Show e => String -> DhallErrors e -> String
showDhallErrors String
" while determining the expected type"

-- | Switches from an @Applicative@ extraction result, able to accumulate errors,
-- to a @Monad@ extraction result, able to chain sequential operations
toMonadic :: Extractor s a b -> MonadicExtractor s a b
toMonadic :: Extractor s a b -> MonadicExtractor s a b
toMonadic = Extractor s a b -> MonadicExtractor s a b
forall e a. Validation e a -> Either e a
validationToEither

-- | Switches from a @Monad@ extraction result, able to chain sequential errors,
-- to an @Applicative@ extraction result, able to accumulate errors
fromMonadic :: MonadicExtractor s a b -> Extractor s a b
fromMonadic :: MonadicExtractor s a b -> Extractor s a b
fromMonadic = MonadicExtractor s a b -> Extractor s a b
forall e a. Either e a -> Validation e a
eitherToValidation

{-| One or more errors returned from extracting a Dhall expression to a
    Haskell expression
-}
type ExtractErrors s a = DhallErrors (ExtractError s a)

instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (ExtractErrors s a) where
    show :: ExtractErrors s a -> String
show = String -> ExtractErrors s a -> String
forall e. Show e => String -> DhallErrors e -> String
showDhallErrors String
" during extraction"

{-| Extraction of a value can fail for two reasons, either a type mismatch (which should not happen,
    as expressions are type-checked against the expected type before being passed to @extract@), or
    a term-level error, described with a freeform text value.
-}
data ExtractError s a =
    TypeMismatch (InvalidDecoder s a)
  | ExpectedTypeError ExpectedTypeError
  | ExtractError Text

instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (ExtractError s a) where
  show :: ExtractError s a -> String
show (TypeMismatch InvalidDecoder s a
e)      = InvalidDecoder s a -> String
forall a. Show a => a -> String
show InvalidDecoder s a
e
  show (ExpectedTypeError ExpectedTypeError
e) = ExpectedTypeError -> String
forall a. Show a => a -> String
show ExpectedTypeError
e
  show (ExtractError Text
es)     =
      String
_ERROR String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Failed extraction                                                   \n\
      \                                                                                \n\
      \The expression type-checked successfully but the transformation to the target   \n\
      \type failed with the following error:                                           \n\
      \                                                                                \n\
      \" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Data.Text.unpack Text
es String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\
      \                                                                                \n"

instance (Pretty s, Pretty a, Typeable s, Typeable a) => Exception (ExtractError s a)

{-| Every `Decoder` must obey the contract that if an expression's type matches
    the `expected` type then the `extract` function must not fail with a type
    error.  However, decoding may still fail for other reasons (such as the
    decoder for `Data.Map.Set`s rejecting a Dhall @List@ with duplicate
    elements).

    This error type is used to indicate an internal error in the implementation
    of a `Decoder` where the expected type matched the Dhall expression, but the
    expression supplied to the extraction function did not match the expected
    type.  If this happens that means that the `Decoder` itself needs to be
    fixed.
-}
data InvalidDecoder s a = InvalidDecoder
  { InvalidDecoder s a -> Expr s a
invalidDecoderExpected   :: Expr s a
  , InvalidDecoder s a -> Expr s a
invalidDecoderExpression :: Expr s a
  }
  deriving (Typeable)

instance (Pretty s, Typeable s, Pretty a, Typeable a) => Exception (InvalidDecoder s a)

_ERROR :: String
_ERROR :: String
_ERROR = String
"\ESC[1;31mError\ESC[0m"

instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (InvalidDecoder s a) where
    show :: InvalidDecoder s a -> String
show InvalidDecoder { Expr s a
invalidDecoderExpression :: Expr s a
invalidDecoderExpected :: Expr s a
invalidDecoderExpression :: forall s a. InvalidDecoder s a -> Expr s a
invalidDecoderExpected :: forall s a. InvalidDecoder s a -> Expr s a
.. } =
        String
_ERROR String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Invalid Dhall.Decoder                                               \n\
        \                                                                                \n\
        \Every Decoder must provide an extract function that succeeds if an expression   \n\
        \matches the expected type.  You provided a Decoder that disobeys this contract  \n\
        \                                                                                \n\
        \The Decoder provided has the expected dhall type:                               \n\
        \                                                                                \n\
        \" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> String
forall a. Show a => a -> String
show Doc Ann
txt0 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\
        \                                                                                \n\
        \and it couldn't extract a value from the well-typed expression:                 \n\
        \                                                                                \n\
        \" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> String
forall a. Show a => a -> String
show Doc Ann
txt1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\
        \                                                                                \n"
        where
          txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert Expr s a
invalidDecoderExpected
          txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert Expr s a
invalidDecoderExpression

-- | @since 1.16
data InputSettings = InputSettings
  { InputSettings -> String
_rootDirectory :: FilePath
  , InputSettings -> String
_sourceName :: FilePath
  , InputSettings -> EvaluateSettings
_evaluateSettings :: EvaluateSettings
  }

-- | Default input settings: resolves imports relative to @.@ (the
-- current working directory), report errors as coming from @(input)@,
-- and default evaluation settings from 'defaultEvaluateSettings'.
--
-- @since 1.16
defaultInputSettings :: InputSettings
defaultInputSettings :: InputSettings
defaultInputSettings = InputSettings :: String -> String -> EvaluateSettings -> InputSettings
InputSettings
  { _rootDirectory :: String
_rootDirectory = String
"."
  , _sourceName :: String
_sourceName = String
"(input)"
  , _evaluateSettings :: EvaluateSettings
_evaluateSettings = EvaluateSettings
defaultEvaluateSettings
  }


-- | Access the directory to resolve imports relative to.
--
-- @since 1.16
rootDirectory
  :: (Functor f)
  => LensLike' f InputSettings FilePath
rootDirectory :: LensLike' f InputSettings String
rootDirectory String -> f String
k InputSettings
s =
  (String -> InputSettings) -> f String -> f InputSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> InputSettings
s { _rootDirectory :: String
_rootDirectory = String
x }) (String -> f String
k (InputSettings -> String
_rootDirectory InputSettings
s))

-- | Access the name of the source to report locations from; this is
-- only used in error messages, so it's okay if this is a best guess
-- or something symbolic.
--
-- @since 1.16
sourceName
  :: (Functor f)
  => LensLike' f InputSettings FilePath
sourceName :: LensLike' f InputSettings String
sourceName String -> f String
k InputSettings
s =
  (String -> InputSettings) -> f String -> f InputSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> InputSettings
s { _sourceName :: String
_sourceName = String
x}) (String -> f String
k (InputSettings -> String
_sourceName InputSettings
s))

-- | @since 1.16
data EvaluateSettings = EvaluateSettings
  { EvaluateSettings -> Substitutions Src Void
_substitutions   :: Dhall.Substitution.Substitutions Src Void
  , EvaluateSettings -> Context (Expr Src Void)
_startingContext :: Dhall.Context.Context (Expr Src Void)
  , EvaluateSettings -> Maybe (ReifiedNormalizer Void)
_normalizer      :: Maybe (Core.ReifiedNormalizer Void)
  , EvaluateSettings -> IO Manager
_newManager      :: IO Dhall.Import.Manager
  }

-- | Default evaluation settings: no extra entries in the initial
-- context, and no special normalizer behaviour.
--
-- @since 1.16
defaultEvaluateSettings :: EvaluateSettings
defaultEvaluateSettings :: EvaluateSettings
defaultEvaluateSettings = EvaluateSettings :: Substitutions Src Void
-> Context (Expr Src Void)
-> Maybe (ReifiedNormalizer Void)
-> IO Manager
-> EvaluateSettings
EvaluateSettings
  { _substitutions :: Substitutions Src Void
_substitutions   = Substitutions Src Void
forall s a. Substitutions s a
Dhall.Substitution.empty
  , _startingContext :: Context (Expr Src Void)
_startingContext = Context (Expr Src Void)
forall a. Context a
Dhall.Context.empty
  , _normalizer :: Maybe (ReifiedNormalizer Void)
_normalizer      = Maybe (ReifiedNormalizer Void)
forall a. Maybe a
Nothing
  , _newManager :: IO Manager
_newManager      = IO Manager
Dhall.Import.defaultNewManager
  }

-- | Access the starting context used for evaluation and type-checking.
--
-- @since 1.16
startingContext
  :: (Functor f, HasEvaluateSettings s)
  => LensLike' f s (Dhall.Context.Context (Expr Src Void))
startingContext :: LensLike' f s (Context (Expr Src Void))
startingContext = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((Context (Expr Src Void) -> f (Context (Expr Src Void)))
    -> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (Context (Expr Src Void))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context (Expr Src Void) -> f (Context (Expr Src Void)))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (Context (Expr Src Void))
l
  where
    l :: (Functor f)
      => LensLike' f EvaluateSettings (Dhall.Context.Context (Expr Src Void))
    l :: LensLike' f EvaluateSettings (Context (Expr Src Void))
l Context (Expr Src Void) -> f (Context (Expr Src Void))
k EvaluateSettings
s = (Context (Expr Src Void) -> EvaluateSettings)
-> f (Context (Expr Src Void)) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Context (Expr Src Void)
x -> EvaluateSettings
s { _startingContext :: Context (Expr Src Void)
_startingContext = Context (Expr Src Void)
x}) (Context (Expr Src Void) -> f (Context (Expr Src Void))
k (EvaluateSettings -> Context (Expr Src Void)
_startingContext EvaluateSettings
s))

-- | Access the custom substitutions.
--
-- @since 1.30
substitutions
  :: (Functor f, HasEvaluateSettings s)
  => LensLike' f s (Dhall.Substitution.Substitutions Src Void)
substitutions :: LensLike' f s (Substitutions Src Void)
substitutions = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((Substitutions Src Void -> f (Substitutions Src Void))
    -> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (Substitutions Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Substitutions Src Void -> f (Substitutions Src Void))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (Substitutions Src Void)
l
  where
    l :: (Functor f)
      => LensLike' f EvaluateSettings (Dhall.Substitution.Substitutions Src Void)
    l :: LensLike' f EvaluateSettings (Substitutions Src Void)
l Substitutions Src Void -> f (Substitutions Src Void)
k EvaluateSettings
s = (Substitutions Src Void -> EvaluateSettings)
-> f (Substitutions Src Void) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Substitutions Src Void
x -> EvaluateSettings
s { _substitutions :: Substitutions Src Void
_substitutions = Substitutions Src Void
x }) (Substitutions Src Void -> f (Substitutions Src Void)
k (EvaluateSettings -> Substitutions Src Void
_substitutions EvaluateSettings
s))

-- | Access the custom normalizer.
--
-- @since 1.16
normalizer
  :: (Functor f, HasEvaluateSettings s)
  => LensLike' f s (Maybe (Core.ReifiedNormalizer Void))
normalizer :: LensLike' f s (Maybe (ReifiedNormalizer Void))
normalizer = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((Maybe (ReifiedNormalizer Void)
     -> f (Maybe (ReifiedNormalizer Void)))
    -> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (Maybe (ReifiedNormalizer Void))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ReifiedNormalizer Void)
 -> f (Maybe (ReifiedNormalizer Void)))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (Maybe (ReifiedNormalizer Void))
l
  where
    l :: (Functor f)
      => LensLike' f EvaluateSettings (Maybe (Core.ReifiedNormalizer Void))
    l :: LensLike' f EvaluateSettings (Maybe (ReifiedNormalizer Void))
l Maybe (ReifiedNormalizer Void)
-> f (Maybe (ReifiedNormalizer Void))
k EvaluateSettings
s = (Maybe (ReifiedNormalizer Void) -> EvaluateSettings)
-> f (Maybe (ReifiedNormalizer Void)) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe (ReifiedNormalizer Void)
x -> EvaluateSettings
s { _normalizer :: Maybe (ReifiedNormalizer Void)
_normalizer = Maybe (ReifiedNormalizer Void)
x }) (Maybe (ReifiedNormalizer Void)
-> f (Maybe (ReifiedNormalizer Void))
k (EvaluateSettings -> Maybe (ReifiedNormalizer Void)
_normalizer EvaluateSettings
s))

-- | Access the HTTP manager initializer.
--
-- @since 1.36
newManager
  :: (Functor f, HasEvaluateSettings s)
  => LensLike' f s (IO Dhall.Import.Manager)
newManager :: LensLike' f s (IO Manager)
newManager = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((IO Manager -> f (IO Manager))
    -> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (IO Manager)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO Manager -> f (IO Manager))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (IO Manager)
l
  where
    l :: (Functor f)
      => LensLike' f EvaluateSettings (IO Dhall.Import.Manager)
    l :: LensLike' f EvaluateSettings (IO Manager)
l IO Manager -> f (IO Manager)
k EvaluateSettings
s = (IO Manager -> EvaluateSettings)
-> f (IO Manager) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IO Manager
x -> EvaluateSettings
s { _newManager :: IO Manager
_newManager = IO Manager
x }) (IO Manager -> f (IO Manager)
k (EvaluateSettings -> IO Manager
_newManager EvaluateSettings
s))

-- | @since 1.16
class HasEvaluateSettings s where
  evaluateSettings
    :: (Functor f)
    => LensLike' f s EvaluateSettings

instance HasEvaluateSettings InputSettings where
  evaluateSettings :: LensLike' f InputSettings EvaluateSettings
evaluateSettings EvaluateSettings -> f EvaluateSettings
k InputSettings
s =
    (EvaluateSettings -> InputSettings)
-> f EvaluateSettings -> f InputSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\EvaluateSettings
x -> InputSettings
s { _evaluateSettings :: EvaluateSettings
_evaluateSettings = EvaluateSettings
x }) (EvaluateSettings -> f EvaluateSettings
k (InputSettings -> EvaluateSettings
_evaluateSettings InputSettings
s))

instance HasEvaluateSettings EvaluateSettings where
  evaluateSettings :: LensLike' f EvaluateSettings EvaluateSettings
evaluateSettings = LensLike' f EvaluateSettings EvaluateSettings
forall a. a -> a
id

{-| Type-check and evaluate a Dhall program, decoding the result into Haskell

    The first argument determines the type of value that you decode:

>>> input integer "+2"
2
>>> input (vector double) "[1.0, 2.0]"
[1.0,2.0]

    Use `auto` to automatically select which type to decode based on the
    inferred return type:

>>> input auto "True" :: IO Bool
True

    This uses the settings from 'defaultInputSettings'.
-}
input
    :: Decoder a
    -- ^ The decoder for the Dhall value
    -> Text
    -- ^ The Dhall program
    -> IO a
    -- ^ The decoded value in Haskell
input :: Decoder a -> Text -> IO a
input =
  InputSettings -> Decoder a -> Text -> IO a
forall a. InputSettings -> Decoder a -> Text -> IO a
inputWithSettings InputSettings
defaultInputSettings

{-| Extend 'input' with a root directory to resolve imports relative
    to, a file to mention in errors as the source, a custom typing
    context, and a custom normalization process.

@since 1.16
-}
inputWithSettings
    :: InputSettings
    -> Decoder a
    -- ^ The decoder for the Dhall value
    -> Text
    -- ^ The Dhall program
    -> IO a
    -- ^ The decoded value in Haskell
inputWithSettings :: InputSettings -> Decoder a -> Text -> IO a
inputWithSettings InputSettings
settings (Decoder {Expector (Expr Src Void)
Expr Src Void -> Extractor Src Void a
expected :: forall a. Decoder a -> Expector (Expr Src Void)
extract :: forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Extractor Src Void a
..}) Text
txt = do
    Expr Src Void
expected' <- case Expector (Expr Src Void)
expected of
        Success Expr Src Void
x -> Expr Src Void -> IO (Expr Src Void)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Void
x
        Failure ExpectedTypeErrors
e -> ExpectedTypeErrors -> IO (Expr Src Void)
forall e a. Exception e => e -> IO a
Control.Exception.throwIO ExpectedTypeErrors
e

    let suffix :: Text
suffix = Expr Src Void -> Text
forall a. Pretty a => a -> Text
Dhall.Pretty.Internal.prettyToStrictText Expr Src Void
expected'
    let annotate :: Expr Src Void -> Expr Src Void
annotate Expr Src Void
substituted = case Expr Src Void
substituted of
            Note (Src SourcePos
begin SourcePos
end Text
bytes) Expr Src Void
_ ->
                Src -> Expr Src Void -> Expr Src Void
forall s a. s -> Expr s a -> Expr s a
Note (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
begin SourcePos
end Text
bytes') (Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src Void
substituted Expr Src Void
expected')
              where
                bytes' :: Text
bytes' = Text
bytes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
            Expr Src Void
_ ->
                Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src Void
substituted Expr Src Void
expected'

    Expr Src Void
normExpr <- (Expr Src Void -> Expr Src Void)
-> InputSettings -> Text -> IO (Expr Src Void)
inputHelper Expr Src Void -> Expr Src Void
annotate InputSettings
settings Text
txt

    case Expr Src Void -> Extractor Src Void a
extract Expr Src Void
normExpr  of
        Success a
x  -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Failure ExtractErrors Src Void
e -> ExtractErrors Src Void -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO ExtractErrors Src Void
e

{-| Type-check and evaluate a Dhall program that is read from the
    file-system.

    This uses the settings from 'defaultEvaluateSettings'.

    @since 1.16
-}
inputFile
  :: Decoder a
  -- ^ The decoder for the Dhall value
  -> FilePath
  -- ^ The path to the Dhall program.
  -> IO a
  -- ^ The decoded value in Haskell.
inputFile :: Decoder a -> String -> IO a
inputFile =
  EvaluateSettings -> Decoder a -> String -> IO a
forall a. EvaluateSettings -> Decoder a -> String -> IO a
inputFileWithSettings EvaluateSettings
defaultEvaluateSettings

{-| Extend 'inputFile' with a custom typing context and a custom
    normalization process.

@since 1.16
-}
inputFileWithSettings
  :: EvaluateSettings
  -> Decoder a
  -- ^ The decoder for the Dhall value
  -> FilePath
  -- ^ The path to the Dhall program.
  -> IO a
  -- ^ The decoded value in Haskell.
inputFileWithSettings :: EvaluateSettings -> Decoder a -> String -> IO a
inputFileWithSettings EvaluateSettings
settings Decoder a
ty String
path = do
  Text
text <- String -> IO Text
Data.Text.IO.readFile String
path
  let inputSettings :: InputSettings
inputSettings = InputSettings :: String -> String -> EvaluateSettings -> InputSettings
InputSettings
        { _rootDirectory :: String
_rootDirectory = String -> String
takeDirectory String
path
        , _sourceName :: String
_sourceName = String
path
        , _evaluateSettings :: EvaluateSettings
_evaluateSettings = EvaluateSettings
settings
        }
  InputSettings -> Decoder a -> Text -> IO a
forall a. InputSettings -> Decoder a -> Text -> IO a
inputWithSettings InputSettings
inputSettings Decoder a
ty Text
text

{-| Similar to `input`, but without interpreting the Dhall `Expr` into a Haskell
    type.

    Uses the settings from 'defaultInputSettings'.
-}
inputExpr
    :: Text
    -- ^ The Dhall program
    -> IO (Expr Src Void)
    -- ^ The fully normalized AST
inputExpr :: Text -> IO (Expr Src Void)
inputExpr =
  InputSettings -> Text -> IO (Expr Src Void)
inputExprWithSettings InputSettings
defaultInputSettings

{-| Extend 'inputExpr' with a root directory to resolve imports relative
    to, a file to mention in errors as the source, a custom typing
    context, and a custom normalization process.

@since 1.16
-}
inputExprWithSettings
    :: InputSettings
    -> Text
    -- ^ The Dhall program
    -> IO (Expr Src Void)
    -- ^ The fully normalized AST
inputExprWithSettings :: InputSettings -> Text -> IO (Expr Src Void)
inputExprWithSettings = (Expr Src Void -> Expr Src Void)
-> InputSettings -> Text -> IO (Expr Src Void)
inputHelper Expr Src Void -> Expr Src Void
forall a. a -> a
id

{-| Helper function for the input* function family

@since 1.30
-}
inputHelper
    :: (Expr Src Void -> Expr Src Void)
    -> InputSettings
    -> Text
    -- ^ The Dhall program
    -> IO (Expr Src Void)
    -- ^ The fully normalized AST
inputHelper :: (Expr Src Void -> Expr Src Void)
-> InputSettings -> Text -> IO (Expr Src Void)
inputHelper Expr Src Void -> Expr Src Void
annotate InputSettings
settings Text
txt = do
    Expr Src Import
expr  <- Either ParseError (Expr Src Import) -> IO (Expr Src Import)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (String -> Text -> Either ParseError (Expr Src Import)
Dhall.Parser.exprFromText (FoldLike String InputSettings InputSettings String String
-> InputSettings -> String
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike String InputSettings InputSettings String String
forall (f :: * -> *). Functor f => LensLike' f InputSettings String
sourceName InputSettings
settings) Text
txt)

    let InputSettings {String
EvaluateSettings
_evaluateSettings :: EvaluateSettings
_sourceName :: String
_rootDirectory :: String
_evaluateSettings :: InputSettings -> EvaluateSettings
_sourceName :: InputSettings -> String
_rootDirectory :: InputSettings -> String
..} = InputSettings
settings

    let EvaluateSettings {Maybe (ReifiedNormalizer Void)
IO Manager
Context (Expr Src Void)
Substitutions Src Void
_newManager :: IO Manager
_normalizer :: Maybe (ReifiedNormalizer Void)
_startingContext :: Context (Expr Src Void)
_substitutions :: Substitutions Src Void
_newManager :: EvaluateSettings -> IO Manager
_normalizer :: EvaluateSettings -> Maybe (ReifiedNormalizer Void)
_startingContext :: EvaluateSettings -> Context (Expr Src Void)
_substitutions :: EvaluateSettings -> Substitutions Src Void
..} = EvaluateSettings
_evaluateSettings

    let transform :: Status -> Status
transform =
               ASetter
  Status Status (Substitutions Src Void) (Substitutions Src Void)
-> Substitutions Src Void -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.Family.set ASetter
  Status Status (Substitutions Src Void) (Substitutions Src Void)
forall (f :: * -> *).
Functor f =>
LensLike' f Status (Substitutions Src Void)
Dhall.Import.substitutions   Substitutions Src Void
_substitutions
            (Status -> Status) -> (Status -> Status) -> Status -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ASetter
  Status
  Status
  (Maybe (ReifiedNormalizer Void))
  (Maybe (ReifiedNormalizer Void))
-> Maybe (ReifiedNormalizer Void) -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.Family.set ASetter
  Status
  Status
  (Maybe (ReifiedNormalizer Void))
  (Maybe (ReifiedNormalizer Void))
forall (f :: * -> *).
Functor f =>
LensLike' f Status (Maybe (ReifiedNormalizer Void))
Dhall.Import.normalizer      Maybe (ReifiedNormalizer Void)
_normalizer
            (Status -> Status) -> (Status -> Status) -> Status -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ASetter
  Status Status (Context (Expr Src Void)) (Context (Expr Src Void))
-> Context (Expr Src Void) -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.Family.set ASetter
  Status Status (Context (Expr Src Void)) (Context (Expr Src Void))
forall (f :: * -> *).
Functor f =>
LensLike' f Status (Context (Expr Src Void))
Dhall.Import.startingContext Context (Expr Src Void)
_startingContext

    let status :: Status
status = Status -> Status
transform (IO Manager -> String -> Status
Dhall.Import.emptyStatusWithManager IO Manager
_newManager String
_rootDirectory)

    Expr Src Void
expr' <- StateT Status IO (Expr Src Void) -> Status -> IO (Expr Src Void)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (Expr Src Import -> StateT Status IO (Expr Src Void)
Dhall.Import.loadWith Expr Src Import
expr) Status
status

    let substituted :: Expr Src Void
substituted = Expr Src Void -> Substitutions Src Void -> Expr Src Void
forall s a. Expr s a -> Substitutions s a -> Expr s a
Dhall.Substitution.substitute Expr Src Void
expr' (Substitutions Src Void -> Expr Src Void)
-> Substitutions Src Void -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ FoldLike
  (Substitutions Src Void)
  InputSettings
  InputSettings
  (Substitutions Src Void)
  (Substitutions Src Void)
-> InputSettings -> Substitutions Src Void
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
  (Substitutions Src Void)
  InputSettings
  InputSettings
  (Substitutions Src Void)
  (Substitutions Src Void)
forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Substitutions Src Void)
substitutions InputSettings
settings
    let annot :: Expr Src Void
annot = Expr Src Void -> Expr Src Void
annotate Expr Src Void
substituted
    Expr Src Void
_ <- Either (TypeError Src Void) (Expr Src Void) -> IO (Expr Src Void)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (Context (Expr Src Void)
-> Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
forall s.
Context (Expr s Void)
-> Expr s Void -> Either (TypeError s Void) (Expr s Void)
Dhall.TypeCheck.typeWith (FoldLike
  (Context (Expr Src Void))
  InputSettings
  InputSettings
  (Context (Expr Src Void))
  (Context (Expr Src Void))
-> InputSettings -> Context (Expr Src Void)
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
  (Context (Expr Src Void))
  InputSettings
  InputSettings
  (Context (Expr Src Void))
  (Context (Expr Src Void))
forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Context (Expr Src Void))
startingContext InputSettings
settings) Expr Src Void
annot)
    pure (Maybe (ReifiedNormalizer Void) -> Expr Src Void -> Expr Src Void
forall a s t.
Eq a =>
Maybe (ReifiedNormalizer a) -> Expr s a -> Expr t a
Core.normalizeWith (FoldLike
  (Maybe (ReifiedNormalizer Void))
  InputSettings
  InputSettings
  (Maybe (ReifiedNormalizer Void))
  (Maybe (ReifiedNormalizer Void))
-> InputSettings -> Maybe (ReifiedNormalizer Void)
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
  (Maybe (ReifiedNormalizer Void))
  InputSettings
  InputSettings
  (Maybe (ReifiedNormalizer Void))
  (Maybe (ReifiedNormalizer Void))
forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Maybe (ReifiedNormalizer Void))
normalizer InputSettings
settings) Expr Src Void
substituted)

-- | Use this function to extract Haskell values directly from Dhall AST.
--   The intended use case is to allow easy extraction of Dhall values for
--   making the function `Core.normalizeWith` easier to use.
--
--   For other use cases, use `input` from "Dhall" module. It will give you
--   a much better user experience.
rawInput
    :: Alternative f
    => Decoder a
    -- ^ The decoder for the Dhall value
    -> Expr s Void
    -- ^ a closed form Dhall program, which evaluates to the expected type
    -> f a
    -- ^ The decoded value in Haskell
rawInput :: Decoder a -> Expr s Void -> f a
rawInput (Decoder {Expector (Expr Src Void)
Expr Src Void -> Extractor Src Void a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Extractor Src Void a
expected :: forall a. Decoder a -> Expector (Expr Src Void)
extract :: forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
..}) Expr s Void
expr =
    case Expr Src Void -> Extractor Src Void a
extract (Expr s Void -> Expr Src Void
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr s Void
expr) of
        Success a
x  -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        Failure ExtractErrors Src Void
_e -> f a
forall (f :: * -> *) a. Alternative f => f a
empty

{-| Use this to provide more detailed error messages

>> input auto "True" :: IO Integer
> *** Exception: Error: Expression doesn't match annotation
>
> True : Integer
>
> (input):1:1

>> detailed (input auto "True") :: IO Integer
> *** Exception: Error: Expression doesn't match annotation
>
> Explanation: You can annotate an expression with its type or kind using the
> ❰:❱ symbol, like this:
>
>
>     ┌───────┐
>     │ x : t │  ❰x❱ is an expression and ❰t❱ is the annotated type or kind of ❰x❱
>     └───────┘
>
> The type checker verifies that the expression's type or kind matches the
> provided annotation
>
> For example, all of the following are valid annotations that the type checker
> accepts:
>
>
>     ┌─────────────┐
>     │ 1 : Natural │  ❰1❱ is an expression that has type ❰Natural❱, so the type
>     └─────────────┘  checker accepts the annotation
>
>
>     ┌───────────────────────┐
>     │ Natural/even 2 : Bool │  ❰Natural/even 2❱ has type ❰Bool❱, so the type
>     └───────────────────────┘  checker accepts the annotation
>
>
>     ┌────────────────────┐
>     │ List : Type → Type │  ❰List❱ is an expression that has kind ❰Type → Type❱,
>     └────────────────────┘  so the type checker accepts the annotation
>
>
>     ┌──────────────────┐
>     │ List Text : Type │  ❰List Text❱ is an expression that has kind ❰Type❱, so
>     └──────────────────┘  the type checker accepts the annotation
>
>
> However, the following annotations are not valid and the type checker will
> reject them:
>
>
>     ┌──────────┐
>     │ 1 : Text │  The type checker rejects this because ❰1❱ does not have type
>     └──────────┘  ❰Text❱
>
>
>     ┌─────────────┐
>     │ List : Type │  ❰List❱ does not have kind ❰Type❱
>     └─────────────┘
>
>
> You or the interpreter annotated this expression:
>
> ↳ True
>
> ... with this type or kind:
>
> ↳ Integer
>
> ... but the inferred type or kind of the expression is actually:
>
> ↳ Bool
>
> Some common reasons why you might get this error:
>
> ● The Haskell Dhall interpreter implicitly inserts a top-level annotation
>   matching the expected type
>
>   For example, if you run the following Haskell code:
>
>
>     ┌───────────────────────────────┐
>     │ >>> input auto "1" :: IO Text │
>     └───────────────────────────────┘
>
>
>   ... then the interpreter will actually type check the following annotated
>   expression:
>
>
>     ┌──────────┐
>     │ 1 : Text │
>     └──────────┘
>
>
>   ... and then type-checking will fail
>
> ────────────────────────────────────────────────────────────────────────────────
>
> True : Integer
>
> (input):1:1

-}
detailed :: IO a -> IO a
detailed :: IO a -> IO a
detailed =
    (TypeError Src Void -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle TypeError Src Void -> IO a
forall a. TypeError Src Void -> IO a
handler1 (IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Imported (TypeError Src Void) -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle Imported (TypeError Src Void) -> IO a
forall a. Imported (TypeError Src Void) -> IO a
handler0
  where
    handler0 :: Imported (TypeError Src Void) -> IO a
    handler0 :: Imported (TypeError Src Void) -> IO a
handler0 (Imported NonEmpty Chained
ps TypeError Src Void
e) =
        Imported (DetailedTypeError Src Void) -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (NonEmpty Chained
-> DetailedTypeError Src Void
-> Imported (DetailedTypeError Src Void)
forall e. NonEmpty Chained -> e -> Imported e
Imported NonEmpty Chained
ps (TypeError Src Void -> DetailedTypeError Src Void
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError TypeError Src Void
e))

    handler1 :: TypeError Src Void -> IO a
    handler1 :: TypeError Src Void -> IO a
handler1 TypeError Src Void
e = DetailedTypeError Src Void -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (TypeError Src Void -> DetailedTypeError Src Void
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError TypeError Src Void
e)

{-| A @(Decoder a)@ represents a way to marshal a value of type @\'a\'@ from Dhall
    into Haskell

    You can produce `Decoder`s either explicitly:

> example :: Decoder (Vector Text)
> example = vector text

    ... or implicitly using `auto`:

> example :: Decoder (Vector Text)
> example = auto

    You can consume `Decoder`s using the `input` function:

> input :: Decoder a -> Text -> IO a
-}
data Decoder a = Decoder
    { Decoder a -> Expr Src Void -> Extractor Src Void a
extract  :: Expr Src Void -> Extractor Src Void a
    -- ^ Extracts Haskell value from the Dhall expression
    , Decoder a -> Expector (Expr Src Void)
expected :: Expector (Expr Src Void)
    -- ^ Dhall type of the Haskell value
    }
    deriving (a -> Decoder b -> Decoder a
(a -> b) -> Decoder a -> Decoder b
(forall a b. (a -> b) -> Decoder a -> Decoder b)
-> (forall a b. a -> Decoder b -> Decoder a) -> Functor Decoder
forall a b. a -> Decoder b -> Decoder a
forall a b. (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Decoder b -> Decoder a
$c<$ :: forall a b. a -> Decoder b -> Decoder a
fmap :: (a -> b) -> Decoder a -> Decoder b
$cfmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
Functor)

{-| Decode a `Prelude.Bool`

>>> input bool "True"
True
-}
bool :: Decoder Bool
bool :: Decoder Bool
bool = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) Bool
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Bool
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Bool
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Bool
extract (BoolLit Bool
b) = Bool -> Validation (ExtractErrors Src Void) Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    extract Expr Src Void
expr        = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) Bool
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
forall s a. Expr s a
Bool

{-| Decode a `Prelude.Natural`

>>> input natural "42"
42
-}
natural :: Decoder Natural
natural :: Decoder Natural
natural = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) Natural
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Natural
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Natural
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Natural
extract (NaturalLit Natural
n) = Natural -> Validation (ExtractErrors Src Void) Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
n
    extract  Expr Src Void
expr          = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) Natural
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
forall s a. Expr s a
Natural

{-| Decode an `Prelude.Integer`

>>> input integer "+42"
42
-}
integer :: Decoder Integer
integer :: Decoder Integer
integer = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) Integer
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Integer
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Integer
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Integer
extract (IntegerLit Integer
n) = Integer -> Validation (ExtractErrors Src Void) Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
n
    extract  Expr Src Void
expr          = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) Integer
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
forall s a. Expr s a
Integer

wordHelper :: forall a . (Bounded a, Integral a) => Text -> Decoder a
wordHelper :: Text -> Decoder a
wordHelper Text
name = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) a
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) a
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) a
extract (NaturalLit Natural
n)
        | Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Integer
forall a. Integral a => a -> Integer
toInteger (Bounded a => a
forall a. Bounded a => a
maxBound @a) =
            a -> Validation (ExtractErrors Src Void) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
        | Bool
otherwise =
            Text -> Validation (ExtractErrors Src Void) a
forall s a b. Text -> Extractor s a b
extractError (Text
"Decoded " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is out of bounds: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Data.Text.pack (Natural -> String
forall a. Show a => a -> String
show Natural
n))
    extract Expr Src Void
expr =
        Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) a
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
forall s a. Expr s a
Natural

{-| Decode a `Word` from a Dhall @Natural@

>>> input word "42"
42
-}
word :: Decoder Word
word :: Decoder Word
word = Text -> Decoder Word
forall a. (Bounded a, Integral a) => Text -> Decoder a
wordHelper Text
"Word"

{-| Decode a `Word8` from a Dhall @Natural@

>>> input word8 "42"
42
-}
word8 :: Decoder Word8
word8 :: Decoder Word8
word8 = Text -> Decoder Word8
forall a. (Bounded a, Integral a) => Text -> Decoder a
wordHelper Text
"Word8"

{-| Decode a `Word16` from a Dhall @Natural@

>>> input word16 "42"
42
-}
word16 :: Decoder Word16
word16 :: Decoder Word16
word16 = Text -> Decoder Word16
forall a. (Bounded a, Integral a) => Text -> Decoder a
wordHelper Text
"Word16"

{-| Decode a `Word32` from a Dhall @Natural@

>>> input word32 "42"
42
-}
word32 :: Decoder Word32
word32 :: Decoder Word32
word32 = Text -> Decoder Word32
forall a. (Bounded a, Integral a) => Text -> Decoder a
wordHelper Text
"Word32"

{-| Decode a `Word64` from a Dhall @Natural@

>>> input word64 "42"
42
-}
word64 :: Decoder Word64
word64 :: Decoder Word64
word64 = Text -> Decoder Word64
forall a. (Bounded a, Integral a) => Text -> Decoder a
wordHelper Text
"Word64"

intHelper :: forall a . (Bounded a, Integral a) => Text -> Decoder a
intHelper :: Text -> Decoder a
intHelper Text
name = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) a
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) a
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) a
extract (IntegerLit Integer
n)
        | a -> Integer
forall a. Integral a => a -> Integer
toInteger (Bounded a => a
forall a. Bounded a => a
minBound @a) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Integer
forall a. Integral a => a -> Integer
toInteger (Bounded a => a
forall a. Bounded a => a
maxBound @a) =
            a -> Validation (ExtractErrors Src Void) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
        | Bool
otherwise =
            Text -> Validation (ExtractErrors Src Void) a
forall s a b. Text -> Extractor s a b
extractError (Text
"Decoded " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is out of bounds: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Data.Text.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n))
    extract Expr Src Void
expr =
        Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) a
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
forall s a. Expr s a
Integer

{-| Decode an `Int` from a Dhall @Integer@

>>> input int "-42"
-42
-}
int :: Decoder Int
int :: Decoder Int
int = Text -> Decoder Int
forall a. (Bounded a, Integral a) => Text -> Decoder a
intHelper Text
"Int"

{-| Decode an `Int8` from a Dhall @Integer@

>>> input int8 "-42"
-42
-}
int8 :: Decoder Int8
int8 :: Decoder Int8
int8 = Text -> Decoder Int8
forall a. (Bounded a, Integral a) => Text -> Decoder a
intHelper Text
"Int8"

{-| Decode an `Int16` from a Dhall @Integer@

>>> input int16 "-42"
-42
-}
int16 :: Decoder Int16
int16 :: Decoder Int16
int16 = Text -> Decoder Int16
forall a. (Bounded a, Integral a) => Text -> Decoder a
intHelper Text
"Int16"

{-| Decode an `Int32` from a Dhall @Integer@

>>> input int32 "-42"
-42
-}
int32 :: Decoder Int32
int32 :: Decoder Int32
int32 = Text -> Decoder Int32
forall a. (Bounded a, Integral a) => Text -> Decoder a
intHelper Text
"Int32"

{-| Decode an `Int64` from a Dhall @Integer@

>>> input int64 "-42"
-42
-}
int64 :: Decoder Int64
int64 :: Decoder Int64
int64 = Text -> Decoder Int64
forall a. (Bounded a, Integral a) => Text -> Decoder a
intHelper Text
"Int64"

{-| Decode a `Scientific`
r

>>> input scientific "1e100"
1.0e100
-}
scientific :: Decoder Scientific
scientific :: Decoder Scientific
scientific = (Double -> Scientific) -> Decoder Double -> Decoder Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Scientific
forall a. RealFloat a => a -> Scientific
Data.Scientific.fromFloatDigits Decoder Double
double

{-| Decode a `Prelude.Double`

>>> input double "42.0"
42.0
-}
double :: Decoder Double
double :: Decoder Double
double = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) Double
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Double
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Double
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Double
extract (DoubleLit (DhallDouble Double
n)) = Double -> Validation (ExtractErrors Src Void) Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
n
    extract  Expr Src Void
expr                       = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) Double
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
forall s a. Expr s a
Double

{-| Decode lazy `Data.Text.Text`

>>> input lazyText "\"Test\""
"Test"
-}
lazyText :: Decoder Data.Text.Lazy.Text
lazyText :: Decoder Text
lazyText = (Text -> Text) -> Decoder Text -> Decoder Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Data.Text.Lazy.fromStrict Decoder Text
strictText

{-| Decode strict `Data.Text.Text`

>>> input strictText "\"Test\""
"Test"
-}
strictText :: Decoder Text
strictText :: Decoder Text
strictText = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) Text
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Text
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Text
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Text
extract (TextLit (Chunks [] Text
t)) = Text -> Validation (ExtractErrors Src Void) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
    extract  Expr Src Void
expr                   = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) Text
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
forall s a. Expr s a
Text

{-| Decode a `Maybe`

>>> input (maybe natural) "Some 1"
Just 1
-}
maybe :: Decoder a -> Decoder (Maybe a)
maybe :: Decoder a -> Decoder (Maybe a)
maybe (Decoder Expr Src Void -> Extractor Src Void a
extractIn Expector (Expr Src Void)
expectedIn) = (Expr Src Void -> Extractor Src Void (Maybe a))
-> Expector (Expr Src Void) -> Decoder (Maybe a)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (Maybe a)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Extractor Src Void (Maybe a)
extractOut (Some Expr Src Void
e    ) = (a -> Maybe a)
-> Extractor Src Void a -> Extractor Src Void (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Expr Src Void -> Extractor Src Void a
extractIn Expr Src Void
e)
    extractOut (App Expr Src Void
None Expr Src Void
_) = Maybe a -> Extractor Src Void (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    extractOut Expr Src Void
expr         = Expector (Expr Src Void)
-> Expr Src Void -> Extractor Src Void (Maybe a)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expectedOut Expr Src Void
expr

    expectedOut :: Expector (Expr Src Void)
expectedOut = 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 -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedIn

{-| Decode a `Seq`

>>> input (sequence natural) "[1, 2, 3]"
fromList [1,2,3]
-}
sequence :: Decoder a -> Decoder (Seq a)
sequence :: Decoder a -> Decoder (Seq a)
sequence (Decoder Expr Src Void -> Extractor Src Void a
extractIn Expector (Expr Src Void)
expectedIn) = (Expr Src Void -> Extractor Src Void (Seq a))
-> Expector (Expr Src Void) -> Decoder (Seq a)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (Seq a)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Extractor Src Void (Seq a)
extractOut (ListLit Maybe (Expr Src Void)
_ Seq (Expr Src Void)
es) = (Expr Src Void -> Extractor Src Void a)
-> Seq (Expr Src Void) -> Extractor Src Void (Seq a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Src Void -> Extractor Src Void a
extractIn Seq (Expr Src Void)
es
    extractOut Expr Src Void
expr           = Expector (Expr Src Void)
-> Expr Src Void -> Extractor Src Void (Seq a)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expectedOut Expr Src Void
expr

    expectedOut :: Expector (Expr Src Void)
expectedOut = 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 -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedIn

{-| Decode a list

>>> input (list natural) "[1, 2, 3]"
[1,2,3]
-}
list :: Decoder a -> Decoder [a]
list :: Decoder a -> Decoder [a]
list = (Seq a -> [a]) -> Decoder (Seq a) -> Decoder [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList (Decoder (Seq a) -> Decoder [a])
-> (Decoder a -> Decoder (Seq a)) -> Decoder a -> Decoder [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> Decoder (Seq a)
forall a. Decoder a -> Decoder (Seq a)
sequence

{-| Decode a `Vector`

>>> input (vector natural) "[1, 2, 3]"
[1,2,3]
-}
vector :: Decoder a -> Decoder (Vector a)
vector :: Decoder a -> Decoder (Vector a)
vector = ([a] -> Vector a) -> Decoder [a] -> Decoder (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Vector a
forall a. [a] -> Vector a
Data.Vector.fromList (Decoder [a] -> Decoder (Vector a))
-> (Decoder a -> Decoder [a]) -> Decoder a -> Decoder (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> Decoder [a]
forall a. Decoder a -> Decoder [a]
list

{-| Decode a Dhall function into a Haskell function

>>> f <- input (function inject bool) "Natural/even" :: IO (Natural -> Bool)
>>> f 0
True
>>> f 1
False
-}
function
    :: Encoder a
    -> Decoder b
    -> Decoder (a -> b)
function :: Encoder a -> Decoder b -> Decoder (a -> b)
function = InputNormalizer -> Encoder a -> Decoder b -> Decoder (a -> b)
forall a b.
InputNormalizer -> Encoder a -> Decoder b -> Decoder (a -> b)
functionWith InputNormalizer
defaultInputNormalizer

{-| Decode a Dhall function into a Haskell function using the specified normalizer

>>> f <- input (functionWith defaultInputNormalizer inject bool) "Natural/even" :: IO (Natural -> Bool)
>>> f 0
True
>>> f 1
False
-}
functionWith
    :: InputNormalizer
    -> Encoder a
    -> Decoder b
    -> Decoder (a -> b)
functionWith :: InputNormalizer -> Encoder a -> Decoder b -> Decoder (a -> b)
functionWith InputNormalizer
inputNormalizer (Encoder {Expr Src Void
a -> Expr Src Void
declared :: forall a. Encoder a -> Expr Src Void
embed :: forall a. Encoder a -> a -> Expr Src Void
declared :: Expr Src Void
embed :: a -> Expr Src Void
..}) (Decoder Expr Src Void -> Extractor Src Void b
extractIn Expector (Expr Src Void)
expectedIn) =
    (Expr Src Void -> Extractor Src Void (a -> b))
-> Expector (Expr Src Void) -> Decoder (a -> b)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (a -> b)
extractOut Expector (Expr Src Void)
expectedOut
  where
    normalizer_ :: Maybe (ReifiedNormalizer Void)
normalizer_ = ReifiedNormalizer Void -> Maybe (ReifiedNormalizer Void)
forall a. a -> Maybe a
Just (InputNormalizer -> ReifiedNormalizer Void
getInputNormalizer InputNormalizer
inputNormalizer)

    extractOut :: Expr Src Void -> Extractor Src Void (a -> b)
extractOut Expr Src Void
e = (a -> b) -> Extractor Src Void (a -> b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\a
i -> case Expr Src Void -> Extractor Src Void b
extractIn (Maybe (ReifiedNormalizer Void) -> Expr Src Void -> Expr Src Void
forall a s t.
Eq a =>
Maybe (ReifiedNormalizer a) -> Expr s a -> Expr t a
Core.normalizeWith Maybe (ReifiedNormalizer Void)
normalizer_ (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
e (a -> Expr Src Void
embed a
i))) of
        Success b
o  -> b
o
        Failure ExtractErrors Src Void
_e -> String -> b
forall a. HasCallStack => String -> a
error String
"FromDhall: You cannot decode a function if it does not have the correct type" )

    expectedOut :: Expector (Expr Src Void)
expectedOut = Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi Text
"_" Expr Src Void
declared (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedIn

{-| Decode a `Data.Set.Set` from a `List`

>>> input (setIgnoringDuplicates natural) "[1, 2, 3]"
fromList [1,2,3]

Duplicate elements are ignored.

>>> input (setIgnoringDuplicates natural) "[1, 1, 3]"
fromList [1,3]

-}
setIgnoringDuplicates :: (Ord a) => Decoder a -> Decoder (Data.Set.Set a)
setIgnoringDuplicates :: Decoder a -> Decoder (Set a)
setIgnoringDuplicates = ([a] -> Set a) -> Decoder [a] -> Decoder (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Set a
forall a. Ord a => [a] -> Set a
Data.Set.fromList (Decoder [a] -> Decoder (Set a))
-> (Decoder a -> Decoder [a]) -> Decoder a -> Decoder (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> Decoder [a]
forall a. Decoder a -> Decoder [a]
list

{-| Decode a `Data.HashSet.HashSet` from a `List`

>>> input (hashSetIgnoringDuplicates natural) "[1, 2, 3]"
fromList [1,2,3]

Duplicate elements are ignored.

>>> input (hashSetIgnoringDuplicates natural) "[1, 1, 3]"
fromList [1,3]

-}
hashSetIgnoringDuplicates :: (Hashable a, Ord a)
                          => Decoder a
                          -> Decoder (Data.HashSet.HashSet a)
hashSetIgnoringDuplicates :: Decoder a -> Decoder (HashSet a)
hashSetIgnoringDuplicates = ([a] -> HashSet a) -> Decoder [a] -> Decoder (HashSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Data.HashSet.fromList (Decoder [a] -> Decoder (HashSet a))
-> (Decoder a -> Decoder [a]) -> Decoder a -> Decoder (HashSet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> Decoder [a]
forall a. Decoder a -> Decoder [a]
list

{-| Decode a `Data.Set.Set` from a `List` with distinct elements

>>> input (setFromDistinctList natural) "[1, 2, 3]"
fromList [1,2,3]

An error is thrown if the list contains duplicates.

> >>> input (setFromDistinctList natural) "[1, 1, 3]"
> *** Exception: Error: Failed extraction
>
> The expression type-checked successfully but the transformation to the target
> type failed with the following error:
>
> One duplicate element in the list: 1
>

> >>> input (setFromDistinctList natural) "[1, 1, 3, 3]"
> *** Exception: Error: Failed extraction
>
> The expression type-checked successfully but the transformation to the target
> type failed with the following error:
>
> 2 duplicates were found in the list, including 1
>

-}
setFromDistinctList :: (Ord a, Show a) => Decoder a -> Decoder (Data.Set.Set a)
setFromDistinctList :: Decoder a -> Decoder (Set a)
setFromDistinctList = (Set a -> Int) -> ([a] -> Set a) -> Decoder a -> Decoder (Set a)
forall a (t :: * -> *).
(Eq a, Foldable t, Show a) =>
(t a -> Int) -> ([a] -> t a) -> Decoder a -> Decoder (t a)
setHelper Set a -> Int
forall a. Set a -> Int
Data.Set.size [a] -> Set a
forall a. Ord a => [a] -> Set a
Data.Set.fromList

{-| Decode a `Data.HashSet.HashSet` from a `List` with distinct elements

>>> input (hashSetFromDistinctList natural) "[1, 2, 3]"
fromList [1,2,3]

An error is thrown if the list contains duplicates.

> >>> input (hashSetFromDistinctList natural) "[1, 1, 3]"
> *** Exception: Error: Failed extraction
>
> The expression type-checked successfully but the transformation to the target
> type failed with the following error:
>
> One duplicate element in the list: 1
>

> >>> input (hashSetFromDistinctList natural) "[1, 1, 3, 3]"
> *** Exception: Error: Failed extraction
>
> The expression type-checked successfully but the transformation to the target
> type failed with the following error:
>
> 2 duplicates were found in the list, including 1
>

-}
hashSetFromDistinctList :: (Hashable a, Ord a, Show a)
                        => Decoder a
                        -> Decoder (Data.HashSet.HashSet a)
hashSetFromDistinctList :: Decoder a -> Decoder (HashSet a)
hashSetFromDistinctList = (HashSet a -> Int)
-> ([a] -> HashSet a) -> Decoder a -> Decoder (HashSet a)
forall a (t :: * -> *).
(Eq a, Foldable t, Show a) =>
(t a -> Int) -> ([a] -> t a) -> Decoder a -> Decoder (t a)
setHelper HashSet a -> Int
forall a. HashSet a -> Int
Data.HashSet.size [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Data.HashSet.fromList


setHelper :: (Eq a, Foldable t, Show a)
          => (t a -> Int)
          -> ([a] -> t a)
          -> Decoder a
          -> Decoder (t a)
setHelper :: (t a -> Int) -> ([a] -> t a) -> Decoder a -> Decoder (t a)
setHelper t a -> Int
size [a] -> t a
toSet (Decoder Expr Src Void -> Extractor Src Void a
extractIn Expector (Expr Src Void)
expectedIn) = (Expr Src Void -> Extractor Src Void (t a))
-> Expector (Expr Src Void) -> Decoder (t a)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (t a)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Extractor Src Void (t a)
extractOut (ListLit Maybe (Expr Src Void)
_ Seq (Expr Src Void)
es) = case (Expr Src Void -> Extractor Src Void a)
-> Seq (Expr Src Void)
-> Validation (ExtractErrors Src Void) (Seq a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Src Void -> Extractor Src Void a
extractIn Seq (Expr Src Void)
es of
        Success Seq a
vSeq
            | Bool
sameSize               -> t a -> Extractor Src Void (t a)
forall e a. a -> Validation e a
Success t a
vSet
            | Bool
otherwise              -> Text -> Extractor Src Void (t a)
forall s a b. Text -> Extractor s a b
extractError Text
err
          where
            vList :: [a]
vList = Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Seq a
vSeq
            vSet :: t a
vSet = [a] -> t a
toSet [a]
vList
            sameSize :: Bool
sameSize = t a -> Int
size t a
vSet Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a -> Int
forall a. Seq a -> Int
Data.Sequence.length Seq a
vSeq
            duplicates :: [a]
duplicates = [a]
vList [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
Data.List.\\ t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList t a
vSet
            err :: Text
err | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
duplicates Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 =
                     Text
"One duplicate element in the list: "
                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Data.Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
head [a]
duplicates)
                | Bool
otherwise              = String -> Text
Data.Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
                     [ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
duplicates
                     , String
"duplicates were found in the list, including"
                     , a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
head [a]
duplicates
                     ]
        Failure ExtractErrors Src Void
f -> ExtractErrors Src Void -> Extractor Src Void (t a)
forall e a. e -> Validation e a
Failure ExtractErrors Src Void
f
    extractOut Expr Src Void
expr = Expector (Expr Src Void)
-> Expr Src Void -> Extractor Src Void (t a)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expectedOut Expr Src Void
expr

    expectedOut :: Expector (Expr Src Void)
expectedOut = 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 -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedIn

{-| Decode a `Map` from a @toMap@ expression or generally a @Prelude.Map.Type@

>>> input (Dhall.map strictText bool) "toMap { a = True, b = False }"
fromList [("a",True),("b",False)]
>>> input (Dhall.map strictText bool) "[ { mapKey = \"foo\", mapValue = True } ]"
fromList [("foo",True)]

If there are duplicate @mapKey@s, later @mapValue@s take precedence:

>>> let expr = "[ { mapKey = 1, mapValue = True }, { mapKey = 1, mapValue = False } ]"
>>> input (Dhall.map natural bool) expr
fromList [(1,False)]

-}
map :: Ord k => Decoder k -> Decoder v -> Decoder (Map k v)
map :: Decoder k -> Decoder v -> Decoder (Map k v)
map Decoder k
k Decoder v
v = ([(k, v)] -> Map k v) -> Decoder [(k, v)] -> Decoder (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList (Decoder (k, v) -> Decoder [(k, v)]
forall a. Decoder a -> Decoder [a]
list (Decoder k -> Decoder v -> Decoder (k, v)
forall k v. Decoder k -> Decoder v -> Decoder (k, v)
pairFromMapEntry Decoder k
k Decoder v
v))

{-| Decode a `HashMap` from a @toMap@ expression or generally a @Prelude.Map.Type@

>>> input (Dhall.hashMap strictText bool) "toMap { a = True, b = False }"
fromList [("a",True),("b",False)]
>>> input (Dhall.hashMap strictText bool) "[ { mapKey = \"foo\", mapValue = True } ]"
fromList [("foo",True)]

If there are duplicate @mapKey@s, later @mapValue@s take precedence:

>>> let expr = "[ { mapKey = 1, mapValue = True }, { mapKey = 1, mapValue = False } ]"
>>> input (Dhall.hashMap natural bool) expr
fromList [(1,False)]

-}
hashMap :: (Eq k, Hashable k) => Decoder k -> Decoder v -> Decoder (HashMap k v)
hashMap :: Decoder k -> Decoder v -> Decoder (HashMap k v)
hashMap Decoder k
k Decoder v
v = ([(k, v)] -> HashMap k v)
-> Decoder [(k, v)] -> Decoder (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (Decoder (k, v) -> Decoder [(k, v)]
forall a. Decoder a -> Decoder [a]
list (Decoder k -> Decoder v -> Decoder (k, v)
forall k v. Decoder k -> Decoder v -> Decoder (k, v)
pairFromMapEntry Decoder k
k Decoder v
v))

{-| Decode a tuple from a @Prelude.Map.Entry@ record

>>> input (pairFromMapEntry strictText natural) "{ mapKey = \"foo\", mapValue = 3 }"
("foo",3)
-}
pairFromMapEntry :: Decoder k -> Decoder v -> Decoder (k, v)
pairFromMapEntry :: Decoder k -> Decoder v -> Decoder (k, v)
pairFromMapEntry Decoder k
k Decoder v
v = (Expr Src Void -> Extractor Src Void (k, v))
-> Expector (Expr Src Void) -> Decoder (k, v)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (k, v)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Extractor Src Void (k, v)
extractOut (RecordLit Map Text (RecordField Src Void)
kvs)
        | Just Expr Src Void
key <- RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField Src Void -> Expr Src Void)
-> Maybe (RecordField Src Void) -> Maybe (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
"mapKey" Map Text (RecordField Src Void)
kvs
        , Just Expr Src Void
value <- RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField Src Void -> Expr Src Void)
-> Maybe (RecordField Src Void) -> Maybe (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
"mapValue" Map Text (RecordField Src Void)
kvs
            = (k -> v -> (k, v))
-> Validation (ExtractErrors Src Void) k
-> Validation (ExtractErrors Src Void) v
-> Extractor Src Void (k, v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Decoder k -> Expr Src Void -> Validation (ExtractErrors Src Void) k
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract Decoder k
k Expr Src Void
key) (Decoder v -> Expr Src Void -> Validation (ExtractErrors Src Void) v
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract Decoder v
v Expr Src Void
value)
    extractOut Expr Src Void
expr = Expector (Expr Src Void)
-> Expr Src Void -> Extractor Src Void (k, v)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expectedOut Expr Src Void
expr

    expectedOut :: Expector (Expr Src Void)
expectedOut = do
        RecordField Src Void
k' <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder k -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder k
k
        RecordField Src Void
v' <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder v -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder v
v
        pure $ 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", RecordField Src Void
k')
            , (Text
"mapValue", RecordField Src Void
v')]

{-| Decode @()@ from an empty record.

>>> input unit "{=}"  -- GHC doesn't print the result if it is ()

-}
unit :: Decoder ()
unit :: Decoder ()
unit = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) ()
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) ()
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) ()
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) ()
extract (RecordLit Map Text (RecordField Src Void)
fields)
        | Map Text (RecordField Src Void) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.Foldable.null Map Text (RecordField Src Void)
fields = () -> Validation (ExtractErrors Src Void) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    extract Expr Src Void
expr = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) ()
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr s a -> Validation ExpectedTypeErrors (Expr s a))
-> Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall a b. (a -> b) -> a -> b
$ 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

{-| Decode 'Void' from an empty union.

Since @<>@ is uninhabited, @'input' 'void'@ will always fail.
-}
void :: Decoder Void
void :: Decoder Void
void = UnionDecoder Void -> Decoder Void
forall a. UnionDecoder a -> Decoder a
union UnionDecoder Void
forall a. Monoid a => a
mempty

{-| Decode a `String`

>>> input string "\"ABC\""
"ABC"

-}
string :: Decoder String
string :: Decoder String
string = Text -> String
Data.Text.Lazy.unpack (Text -> String) -> Decoder Text -> Decoder String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Text
lazyText

{-| Given a pair of `Decoder`s, decode a tuple-record into their pairing.

>>> input (pair natural bool) "{ _1 = 42, _2 = False }"
(42,False)
-}
pair :: Decoder a -> Decoder b -> Decoder (a, b)
pair :: Decoder a -> Decoder b -> Decoder (a, b)
pair Decoder a
l Decoder b
r = (Expr Src Void -> Extractor Src Void (a, b))
-> Expector (Expr Src Void) -> Decoder (a, b)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (a, b)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Extractor Src Void (a, b)
extractOut expr :: Expr Src Void
expr@(RecordLit Map Text (RecordField Src Void)
fields) =
      (,) (a -> b -> (a, b))
-> Validation (ExtractErrors Src Void) a
-> Validation (ExtractErrors Src Void) (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation (ExtractErrors Src Void) a
-> (Expr Src Void -> Validation (ExtractErrors Src Void) a)
-> Maybe (Expr Src Void)
-> Validation (ExtractErrors Src Void) a
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) a
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expectedOut Expr Src Void
expr) (Decoder a -> Expr Src Void -> Validation (ExtractErrors Src Void) a
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract Decoder a
l)
                (RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField Src Void -> Expr Src Void)
-> Maybe (RecordField Src Void) -> Maybe (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
"_1" Map Text (RecordField Src Void)
fields)
          Validation (ExtractErrors Src Void) (b -> (a, b))
-> Validation (ExtractErrors Src Void) b
-> Extractor Src Void (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Validation (ExtractErrors Src Void) b
-> (Expr Src Void -> Validation (ExtractErrors Src Void) b)
-> Maybe (Expr Src Void)
-> Validation (ExtractErrors Src Void) b
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) b
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expectedOut Expr Src Void
expr) (Decoder b -> Expr Src Void -> Validation (ExtractErrors Src Void) b
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract Decoder b
r)
                (RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField Src Void -> Expr Src Void)
-> Maybe (RecordField Src Void) -> Maybe (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
"_2" Map Text (RecordField Src Void)
fields)
    extractOut Expr Src Void
expr = Expector (Expr Src Void)
-> Expr Src Void -> Extractor Src Void (a, b)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expectedOut Expr Src Void
expr

    expectedOut :: Expector (Expr Src Void)
expectedOut = do
        RecordField Src Void
l' <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder a
l
        RecordField Src Void
r' <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder b -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder b
r
        pure $ 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
"_1", RecordField Src Void
l')
            , (Text
"_2", RecordField Src Void
r')]

{-| Any value that implements `FromDhall` can be automatically decoded based on
    the inferred return type of `input`

>>> input auto "[1, 2, 3]" :: IO (Vector Natural)
[1,2,3]
>>> input auto "toMap { a = False, b = True }" :: IO (Map Text Bool)
fromList [("a",False),("b",True)]

    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 'genericAutoWith' 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 FromDhall a where
    autoWith :: InputNormalizer -> Decoder a
    default autoWith
        :: (Generic a, GenericFromDhall a (Rep a)) => InputNormalizer -> Decoder a
    autoWith InputNormalizer
_ = Decoder a
forall a. (Generic a, GenericFromDhall a (Rep a)) => Decoder a
genericAuto

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

instance FromDhall Void where
    autoWith :: InputNormalizer -> Decoder Void
autoWith InputNormalizer
_ = Decoder Void
void

instance FromDhall () where
    autoWith :: InputNormalizer -> Decoder ()
autoWith InputNormalizer
_ = Decoder ()
unit

instance FromDhall Bool where
    autoWith :: InputNormalizer -> Decoder Bool
autoWith InputNormalizer
_ = Decoder Bool
bool

instance FromDhall Natural where
    autoWith :: InputNormalizer -> Decoder Natural
autoWith InputNormalizer
_ = Decoder Natural
natural

instance FromDhall Word where
    autoWith :: InputNormalizer -> Decoder Word
autoWith InputNormalizer
_ = Decoder Word
word

instance FromDhall Word8 where
    autoWith :: InputNormalizer -> Decoder Word8
autoWith InputNormalizer
_ = Decoder Word8
word8

instance FromDhall Word16 where
    autoWith :: InputNormalizer -> Decoder Word16
autoWith InputNormalizer
_ = Decoder Word16
word16

instance FromDhall Word32 where
    autoWith :: InputNormalizer -> Decoder Word32
autoWith InputNormalizer
_ = Decoder Word32
word32

instance FromDhall Word64 where
    autoWith :: InputNormalizer -> Decoder Word64
autoWith InputNormalizer
_ = Decoder Word64
word64

instance FromDhall Integer where
    autoWith :: InputNormalizer -> Decoder Integer
autoWith InputNormalizer
_ = Decoder Integer
integer

instance FromDhall Int where
    autoWith :: InputNormalizer -> Decoder Int
autoWith InputNormalizer
_ = Decoder Int
int

instance FromDhall Int8 where
    autoWith :: InputNormalizer -> Decoder Int8
autoWith InputNormalizer
_ = Decoder Int8
int8

instance FromDhall Int16 where
    autoWith :: InputNormalizer -> Decoder Int16
autoWith InputNormalizer
_ = Decoder Int16
int16

instance FromDhall Int32 where
    autoWith :: InputNormalizer -> Decoder Int32
autoWith InputNormalizer
_ = Decoder Int32
int32

instance FromDhall Int64 where
    autoWith :: InputNormalizer -> Decoder Int64
autoWith InputNormalizer
_ = Decoder Int64
int64

instance FromDhall Scientific where
    autoWith :: InputNormalizer -> Decoder Scientific
autoWith InputNormalizer
_ = Decoder Scientific
scientific

instance FromDhall Double where
    autoWith :: InputNormalizer -> Decoder Double
autoWith InputNormalizer
_ = Decoder Double
double

instance {-# OVERLAPS #-} FromDhall [Char] where
    autoWith :: InputNormalizer -> Decoder String
autoWith InputNormalizer
_ = Decoder String
string

instance FromDhall Data.Text.Lazy.Text where
    autoWith :: InputNormalizer -> Decoder Text
autoWith InputNormalizer
_ = Decoder Text
lazyText

instance FromDhall Text where
    autoWith :: InputNormalizer -> Decoder Text
autoWith InputNormalizer
_ = Decoder Text
strictText

instance FromDhall a => FromDhall (Maybe a) where
    autoWith :: InputNormalizer -> Decoder (Maybe a)
autoWith InputNormalizer
opts = Decoder a -> Decoder (Maybe a)
forall a. Decoder a -> Decoder (Maybe a)
maybe (InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts)

instance FromDhall a => FromDhall (Seq a) where
    autoWith :: InputNormalizer -> Decoder (Seq a)
autoWith InputNormalizer
opts = Decoder a -> Decoder (Seq a)
forall a. Decoder a -> Decoder (Seq a)
sequence (InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts)

instance FromDhall a => FromDhall [a] where
    autoWith :: InputNormalizer -> Decoder [a]
autoWith InputNormalizer
opts = Decoder a -> Decoder [a]
forall a. Decoder a -> Decoder [a]
list (InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts)

instance FromDhall a => FromDhall (Vector a) where
    autoWith :: InputNormalizer -> Decoder (Vector a)
autoWith InputNormalizer
opts = Decoder a -> Decoder (Vector a)
forall a. Decoder a -> Decoder (Vector a)
vector (InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts)

{-| Note that this instance will throw errors in the presence of duplicates in
    the list. To ignore duplicates, use `setIgnoringDuplicates`.
-}
instance (FromDhall a, Ord a, Show a) => FromDhall (Data.Set.Set a) where
    autoWith :: InputNormalizer -> Decoder (Set a)
autoWith InputNormalizer
opts = Decoder a -> Decoder (Set a)
forall a. (Ord a, Show a) => Decoder a -> Decoder (Set a)
setFromDistinctList (InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts)

{-| Note that this instance will throw errors in the presence of duplicates in
    the list. To ignore duplicates, use `hashSetIgnoringDuplicates`.
-}
instance (FromDhall a, Hashable a, Ord a, Show a) => FromDhall (Data.HashSet.HashSet a) where
    autoWith :: InputNormalizer -> Decoder (HashSet a)
autoWith InputNormalizer
inputNormalizer = Decoder a -> Decoder (HashSet a)
forall a.
(Hashable a, Ord a, Show a) =>
Decoder a -> Decoder (HashSet a)
hashSetFromDistinctList (InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer)

instance (Ord k, FromDhall k, FromDhall v) => FromDhall (Map k v) where
    autoWith :: InputNormalizer -> Decoder (Map k v)
autoWith InputNormalizer
inputNormalizer = Decoder k -> Decoder v -> Decoder (Map k v)
forall k v. Ord k => Decoder k -> Decoder v -> Decoder (Map k v)
Dhall.map (InputNormalizer -> Decoder k
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer) (InputNormalizer -> Decoder v
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer)

instance (Eq k, Hashable k, FromDhall k, FromDhall v) => FromDhall (HashMap k v) where
    autoWith :: InputNormalizer -> Decoder (HashMap k v)
autoWith InputNormalizer
inputNormalizer = Decoder k -> Decoder v -> Decoder (HashMap k v)
forall k v.
(Eq k, Hashable k) =>
Decoder k -> Decoder v -> Decoder (HashMap k v)
Dhall.hashMap (InputNormalizer -> Decoder k
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer) (InputNormalizer -> Decoder v
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer)

instance (ToDhall a, FromDhall b) => FromDhall (a -> b) where
    autoWith :: InputNormalizer -> Decoder (a -> b)
autoWith InputNormalizer
inputNormalizer =
        InputNormalizer -> Encoder a -> Decoder b -> Decoder (a -> b)
forall a b.
InputNormalizer -> Encoder a -> Decoder b -> Decoder (a -> b)
functionWith InputNormalizer
inputNormalizer (InputNormalizer -> Encoder a
forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer) (InputNormalizer -> Decoder b
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer)

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

{-| Use the default input normalizer for interpreting a configuration file

> auto = autoWith defaultInputNormalizer
-}
auto :: FromDhall a => Decoder a
auto :: Decoder a
auto = InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
defaultInputNormalizer

{-| This type is exactly the same as `Data.Fix.Fix` except with a different
    `FromDhall` instance.  This intermediate type simplifies the implementation
    of the inner loop for the `FromDhall` instance for `Fix`
-}
newtype Result f = Result { Result f -> f (Result f)
_unResult :: f (Result f) }

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

instance FromDhall (f (Result f)) => FromDhall (Result f) where
    autoWith :: InputNormalizer -> Decoder (Result f)
autoWith InputNormalizer
inputNormalizer = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) (Result f)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (Result f)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (Result f)
..}
      where
        extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (Result f)
extract (App Expr Src Void
_ Expr Src Void
expr) =
            (f (Result f) -> Result f)
-> Validation (ExtractErrors Src Void) (f (Result f))
-> Validation (ExtractErrors Src Void) (Result f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Result f) -> Result f
forall (f :: * -> *). f (Result f) -> Result f
Result (Decoder (f (Result f))
-> Expr Src Void
-> Validation (ExtractErrors Src Void) (f (Result f))
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
Dhall.extract (InputNormalizer -> Decoder (f (Result f))
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer) Expr Src Void
expr)
        extract Expr Src Void
expr = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) (Result f)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
expr

        expected :: Expector (Expr Src Void)
expected = Expr Src Void -> Expector (Expr Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Src Void
"result"

-- | You can use this instance to marshal recursive types from Dhall to Haskell.
--
-- Here is an example use of this instance:
--
-- > {-# LANGUAGE DeriveAnyClass     #-}
-- > {-# LANGUAGE DeriveFoldable     #-}
-- > {-# LANGUAGE DeriveFunctor      #-}
-- > {-# LANGUAGE DeriveTraversable  #-}
-- > {-# LANGUAGE DeriveGeneric      #-}
-- > {-# LANGUAGE KindSignatures     #-}
-- > {-# LANGUAGE QuasiQuotes        #-}
-- > {-# LANGUAGE StandaloneDeriving #-}
-- > {-# LANGUAGE TypeFamilies       #-}
-- > {-# LANGUAGE TemplateHaskell    #-}
-- >
-- > import Data.Fix (Fix(..))
-- > import Data.Text (Text)
-- > import Dhall (FromDhall)
-- > import GHC.Generics (Generic)
-- > import Numeric.Natural (Natural)
-- >
-- > import qualified Data.Fix                 as Fix
-- > import qualified Data.Functor.Foldable    as Foldable
-- > import qualified Data.Functor.Foldable.TH as TH
-- > import qualified Dhall
-- > import qualified NeatInterpolation
-- >
-- > data Expr
-- >     = Lit Natural
-- >     | Add Expr Expr
-- >     | Mul Expr Expr
-- >     deriving (Show)
-- >
-- > TH.makeBaseFunctor ''Expr
-- >
-- > deriving instance Generic (ExprF a)
-- > deriving instance FromDhall a => FromDhall (ExprF a)
-- >
-- > example :: Text
-- > example = [NeatInterpolation.text|
-- >     \(Expr : Type)
-- > ->  let ExprF =
-- >           < LitF :
-- >               Natural
-- >           | AddF :
-- >               { _1 : Expr, _2 : Expr }
-- >           | MulF :
-- >               { _1 : Expr, _2 : Expr }
-- >           >
-- >
-- >     in      \(Fix : ExprF -> Expr)
-- >         ->  let Lit = \(x : Natural) -> Fix (ExprF.LitF x)
-- >
-- >             let Add =
-- >                       \(x : Expr)
-- >                   ->  \(y : Expr)
-- >                   ->  Fix (ExprF.AddF { _1 = x, _2 = y })
-- >
-- >             let Mul =
-- >                       \(x : Expr)
-- >                   ->  \(y : Expr)
-- >                   ->  Fix (ExprF.MulF { _1 = x, _2 = y })
-- >
-- >             in  Add (Mul (Lit 3) (Lit 7)) (Add (Lit 1) (Lit 2))
-- > |]
-- >
-- > convert :: Fix ExprF -> Expr
-- > convert = Fix.foldFix Foldable.embed
-- >
-- > main :: IO ()
-- > main = do
-- >     x <- Dhall.input Dhall.auto example :: IO (Fix ExprF)
-- >
-- >     print (convert x :: Expr)
instance (Functor f, FromDhall (f (Result f))) => FromDhall (Fix f) where
    autoWith :: InputNormalizer -> Decoder (Fix f)
autoWith InputNormalizer
inputNormalizer = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
..}
      where
        extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract Expr Src Void
expr0 = Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract0 Expr Src Void
expr0
          where
            die :: Validation (ExtractErrors Src Void) (Fix f)
die = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
expr0

            extract0 :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract0 (Lam (FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
x }) Expr Src Void
expr) =
                Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract1 (Text -> Text -> Expr Src Void -> Expr Src Void
forall s a. Text -> Text -> Expr s a -> Expr s a
rename Text
x Text
"result" Expr Src Void
expr)
            extract0  Expr Src Void
_             = Validation (ExtractErrors Src Void) (Fix f)
die

            extract1 :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract1 (Lam (FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
y }) Expr Src Void
expr) =
                Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract2 (Text -> Text -> Expr Src Void -> Expr Src Void
forall s a. Text -> Text -> Expr s a -> Expr s a
rename Text
y Text
"Make" Expr Src Void
expr)
            extract1  Expr Src Void
_             = Validation (ExtractErrors Src Void) (Fix f)
die

            extract2 :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract2 Expr Src Void
expr = (Result f -> Fix f)
-> Validation (ExtractErrors Src Void) (Result f)
-> Validation (ExtractErrors Src Void) (Fix f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Result f -> Fix f
forall (f :: * -> *). Functor f => Result f -> Fix f
resultToFix (Decoder (Result f)
-> Expr Src Void -> Validation (ExtractErrors Src Void) (Result f)
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
Dhall.extract (InputNormalizer -> Decoder (Result f)
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer) Expr Src Void
expr)

            rename :: Text -> Text -> Expr s a -> Expr s a
rename Text
a Text
b Expr s a
expr
                | Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
b    = Var -> Expr s a -> Expr s a -> Expr s a
forall s a. Var -> Expr s a -> Expr s a -> Expr s a
Core.subst (Text -> Int -> Var
V Text
a Int
0) (Var -> Expr s a
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
b Int
0)) (Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
Core.shift Int
1 (Text -> Int -> Var
V Text
b Int
0) Expr s a
expr)
                | Bool
otherwise = Expr s a
expr

        expected :: Expector (Expr Src Void)
expected = (\Expr Src Void
x -> Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi Text
"result" (Const -> Expr Src Void
forall s a. Const -> Expr s a
Const Const
Core.Type) (Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi Text
"Make" (Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi Text
"_" Expr Src Void
x Expr Src Void
"result") Expr Src Void
"result"))
            (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (f (Result f)) -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
Dhall.expected (InputNormalizer -> Decoder (f (Result f))
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer :: Decoder (f (Result f)))

{-| `genericAuto` is the default implementation for `auto` if you derive
    `FromDhall`.  The difference is that you can use `genericAuto` without
    having to explicitly provide a `FromDhall` instance for a type as long as
    the type derives `Generic`
-}
genericAuto :: (Generic a, GenericFromDhall a (Rep a)) => Decoder a
genericAuto :: Decoder a
genericAuto = InterpretOptions -> Decoder a
forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> Decoder a
genericAutoWith InterpretOptions
defaultInterpretOptions

{-| `genericAutoWith` is a configurable version of `genericAuto`.
-}
genericAutoWith :: (Generic a, GenericFromDhall a (Rep a)) => InterpretOptions -> Decoder a
genericAutoWith :: InterpretOptions -> Decoder a
genericAutoWith InterpretOptions
options = (Proxy a -> Decoder a) -> Decoder a
forall a. (Proxy a -> Decoder a) -> Decoder a
withProxy (\Proxy a
p -> (Rep a Any -> a) -> Decoder (Rep a Any) -> Decoder a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (State Int (Decoder (Rep a Any)) -> Int -> Decoder (Rep a Any)
forall s a. State s a -> s -> a
evalState (Proxy a
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (Rep a Any))
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhall t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
genericAutoWithNormalizer Proxy a
p InputNormalizer
defaultInputNormalizer InterpretOptions
options) Int
1))
    where
        withProxy :: (Proxy a -> Decoder a) -> Decoder a
        withProxy :: (Proxy a -> Decoder a) -> Decoder a
withProxy Proxy a -> Decoder a
f = Proxy a -> Decoder a
f Proxy a
forall k (t :: k). Proxy t
Proxy


{-| Use these options to tweak how Dhall derives a generic implementation of
    `FromDhall`
-}
data InterpretOptions = InterpretOptions
    { InterpretOptions -> Text -> Text
fieldModifier       :: Text -> Text
    -- ^ Function used to transform Haskell field names into their corresponding
    --   Dhall field names
    , InterpretOptions -> Text -> Text
constructorModifier :: Text -> Text
    -- ^ Function used to transform Haskell constructor names into their
    --   corresponding Dhall alternative names
    , InterpretOptions -> SingletonConstructors
singletonConstructors :: SingletonConstructors
    -- ^ Specify how to handle constructors with only one field.  The default is
    --   `Smart`
    }

-- | This is only used by the `FromDhall` instance for functions in order
--   to normalize the function input before marshaling the input into a
--   Dhall expression
newtype InputNormalizer = InputNormalizer
  { InputNormalizer -> ReifiedNormalizer Void
getInputNormalizer :: Core.ReifiedNormalizer Void }

-- | Default normalization-related settings (no custom normalization)
defaultInputNormalizer :: InputNormalizer
defaultInputNormalizer :: InputNormalizer
defaultInputNormalizer = InputNormalizer :: ReifiedNormalizer Void -> InputNormalizer
InputNormalizer
 { getInputNormalizer :: ReifiedNormalizer Void
getInputNormalizer = Normalizer Void -> ReifiedNormalizer Void
forall a. Normalizer a -> ReifiedNormalizer a
Core.ReifiedNormalizer (Identity (Maybe (Expr s Void))
-> Expr s Void -> Identity (Maybe (Expr s Void))
forall a b. a -> b -> a
const (Maybe (Expr s Void) -> Identity (Maybe (Expr s Void))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Expr s Void)
forall a. Maybe a
Nothing)) }

{-| This type specifies how to model a Haskell constructor with 1 field in
    Dhall

    For example, consider the following Haskell datatype definition:

    > data Example = Foo { x :: Double } | Bar Double

    Depending on which option you pick, the corresponding Dhall type could be:

    > < Foo : Double | Bar : Double >                   -- Bare

    > < Foo : { x : Double } | Bar : { _1 : Double } >  -- Wrapped

    > < Foo : { x : Double } | Bar : Double >           -- Smart
-}
data SingletonConstructors
    = Bare
    -- ^ Never wrap the field in a record
    | Wrapped
    -- ^ Always wrap the field in a record
    | Smart
    -- ^ Only fields in a record if they are named

{-| Default interpret options for generics-based instances,
    which you can tweak or override, like this:

> genericAutoWith
>     (defaultInterpretOptions { fieldModifier = Data.Text.Lazy.dropWhile (== '_') })
-}
defaultInterpretOptions :: InterpretOptions
defaultInterpretOptions :: InterpretOptions
defaultInterpretOptions = InterpretOptions :: (Text -> Text)
-> (Text -> Text) -> SingletonConstructors -> InterpretOptions
InterpretOptions
    { fieldModifier :: Text -> Text
fieldModifier =
          Text -> Text
forall a. a -> a
id
    , constructorModifier :: Text -> Text
constructorModifier =
          Text -> Text
forall a. a -> a
id
    , singletonConstructors :: SingletonConstructors
singletonConstructors =
          SingletonConstructors
Smart
    }

{-| This is the underlying class that powers the `FromDhall` class's support
    for automatically deriving a generic implementation
-}
class GenericFromDhall t f where
    genericAutoWithNormalizer :: Proxy t -> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))

instance GenericFromDhall t f => GenericFromDhall t (M1 D d f) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (M1 D d f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options = do
        Decoder (f a)
res <- Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhall t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options
        pure ((f a -> M1 D d f a) -> Decoder (f a) -> Decoder (M1 D d f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> M1 D d f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 Decoder (f a)
res)

instance GenericFromDhall t V1 where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (V1 a))
genericAutoWithNormalizer Proxy t
_ InputNormalizer
_ InterpretOptions
_ = Decoder (V1 a) -> State Int (Decoder (V1 a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Extractor Src Void (V1 a)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Extractor Src Void (V1 a)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Extractor Src Void (V1 a)
..}
      where
        extract :: Expr Src Void -> Extractor Src Void (V1 a)
extract Expr Src Void
expr = Expector (Expr Src Void)
-> Expr Src Void -> Extractor Src Void (V1 a)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

        expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr s a -> Validation ExpectedTypeErrors (Expr s a))
-> Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall a b. (a -> b) -> a -> b
$ 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

unsafeExpectUnion
    :: Text -> Expr Src Void -> Dhall.Map.Map Text (Maybe (Expr Src Void))
unsafeExpectUnion :: Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion Text
_ (Union Map Text (Maybe (Expr Src Void))
kts) =
    Map Text (Maybe (Expr Src Void))
kts
unsafeExpectUnion Text
name Expr Src Void
expression =
    Text -> forall b. b
Core.internalError
        (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": Unexpected constructor: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Src Void -> Text
forall a. Pretty a => a -> Text
Core.pretty Expr Src Void
expression)

unsafeExpectRecord
    :: Text -> Expr Src Void -> Dhall.Map.Map Text (RecordField Src Void)
unsafeExpectRecord :: Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecord Text
_ (Record Map Text (RecordField Src Void)
kts) =
    Map Text (RecordField Src Void)
kts
unsafeExpectRecord Text
name Expr Src Void
expression =
    Text -> forall b. b
Core.internalError
        (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": Unexpected constructor: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Src Void -> Text
forall a. Pretty a => a -> Text
Core.pretty Expr Src Void
expression)

unsafeExpectUnionLit
    :: Text
    -> Expr Src Void
    -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit :: Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit Text
_ (Field (Union Map Text (Maybe (Expr Src Void))
_) (FieldSelection Src -> Text
forall s. FieldSelection s -> Text
Core.fieldSelectionLabel -> Text
k)) =
    (Text
k, Maybe (Expr Src Void)
forall a. Maybe a
Nothing)
unsafeExpectUnionLit Text
_ (App (Field (Union Map Text (Maybe (Expr Src Void))
_) (FieldSelection Src -> Text
forall s. FieldSelection s -> Text
Core.fieldSelectionLabel -> Text
k)) Expr Src Void
v) =
    (Text
k, Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just Expr Src Void
v)
unsafeExpectUnionLit Text
name Expr Src Void
expression =
    Text -> forall b. b
Core.internalError
        (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": Unexpected constructor: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Src Void -> Text
forall a. Pretty a => a -> Text
Core.pretty Expr Src Void
expression)

unsafeExpectRecordLit
    :: Text -> Expr Src Void -> Dhall.Map.Map Text (RecordField Src Void)
unsafeExpectRecordLit :: Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecordLit Text
_ (RecordLit Map Text (RecordField Src Void)
kvs) =
    Map Text (RecordField Src Void)
kvs
unsafeExpectRecordLit Text
name Expr Src Void
expression =
    Text -> forall b. b
Core.internalError
        (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": Unexpected constructor: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Src Void -> Text
forall a. Pretty a => a -> Text
Core.pretty Expr Src Void
expression)

notEmptyRecordLit :: Expr s a -> Maybe (Expr s a)
notEmptyRecordLit :: Expr s a -> Maybe (Expr s a)
notEmptyRecordLit Expr s a
e = case Expr s a
e of
    RecordLit Map Text (RecordField s a)
m | Map Text (RecordField s a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (RecordField s a)
m -> Maybe (Expr s a)
forall a. Maybe a
Nothing
    Expr s a
_                    -> Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just Expr s a
e

notEmptyRecord :: Expr s a -> Maybe (Expr s a)
notEmptyRecord :: Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr s a
e = case Expr s a
e of
    Record Map Text (RecordField s a)
m | Map Text (RecordField s a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (RecordField s a)
m -> Maybe (Expr s a)
forall a. Maybe a
Nothing
    Expr s a
_                 -> Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just Expr s a
e
extractUnionConstructor
    :: Expr s a -> Maybe (Text, Expr s a, Dhall.Map.Map Text (Maybe (Expr s a)))
extractUnionConstructor :: Expr s a -> Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
extractUnionConstructor (App (Field (Union Map Text (Maybe (Expr s a))
kts) (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Core.fieldSelectionLabel -> Text
fld)) Expr s a
e) =
  (Text, Expr s a, Map Text (Maybe (Expr s a)))
-> Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
fld, Expr s a
e, Text -> Map Text (Maybe (Expr s a)) -> Map Text (Maybe (Expr s a))
forall k v. Ord k => k -> Map k v -> Map k v
Dhall.Map.delete Text
fld Map Text (Maybe (Expr s a))
kts)
extractUnionConstructor (Field (Union Map Text (Maybe (Expr s a))
kts) (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Core.fieldSelectionLabel -> Text
fld)) =
  (Text, Expr s a, Map Text (Maybe (Expr s a)))
-> Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
fld, 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, Text -> Map Text (Maybe (Expr s a)) -> Map Text (Maybe (Expr s a))
forall k v. Ord k => k -> Map k v -> Map k v
Dhall.Map.delete Text
fld Map Text (Maybe (Expr s a))
kts)
extractUnionConstructor Expr s a
_ =
  Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
forall (f :: * -> *) a. Alternative f => f a
empty

{-| This is the underlying class that powers the `FromDhall` class's support
    for automatically deriving a generic implementation for a union type
-}
class GenericFromDhallUnion t f where
    genericUnionAutoWithNormalizer :: Proxy t -> InputNormalizer -> InterpretOptions -> UnionDecoder (f a)

instance (GenericFromDhallUnion t f1, GenericFromDhallUnion t f2) => GenericFromDhallUnion t (f1 :+: f2) where
  genericUnionAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> UnionDecoder ((:+:) f1 f2 a)
genericUnionAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options =
    UnionDecoder ((:+:) f1 f2 a)
-> UnionDecoder ((:+:) f1 f2 a) -> UnionDecoder ((:+:) f1 f2 a)
forall a. Semigroup a => a -> a -> a
(<>)
      (f1 a -> (:+:) f1 f2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f1 a -> (:+:) f1 f2 a)
-> UnionDecoder (f1 a) -> UnionDecoder ((:+:) f1 f2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy t
-> InputNormalizer -> InterpretOptions -> UnionDecoder (f1 a)
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhallUnion t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> UnionDecoder (f a)
genericUnionAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options)
      (f2 a -> (:+:) f1 f2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (f2 a -> (:+:) f1 f2 a)
-> UnionDecoder (f2 a) -> UnionDecoder ((:+:) f1 f2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy t
-> InputNormalizer -> InterpretOptions -> UnionDecoder (f2 a)
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhallUnion t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> UnionDecoder (f a)
genericUnionAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options)

instance (Constructor c1, GenericFromDhall t f1) => GenericFromDhallUnion t (M1 C c1 f1) where
  genericUnionAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> UnionDecoder (M1 C c1 f1 a)
genericUnionAutoWithNormalizer Proxy t
p 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
..}) =
    Text -> Decoder (M1 C c1 f1 a) -> UnionDecoder (M1 C c1 f1 a)
forall a. Text -> Decoder a -> UnionDecoder a
constructor Text
name (State Int (Decoder (M1 C c1 f1 a)) -> Int -> Decoder (M1 C c1 f1 a)
forall s a. State s a -> s -> a
evalState (Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (M1 C c1 f1 a))
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhall t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options) Int
1)
    where
      n :: M1 C c1 f1 a
      n :: M1 C c1 f1 a
n = M1 C c1 f1 a
forall a. HasCallStack => a
undefined

      name :: Text
name = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (M1 C 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 C c1 f1 Any
forall (a :: k). M1 C c1 f1 a
n))

instance GenericFromDhallUnion t (f :+: g) => GenericFromDhall t (f :+: g) where
  genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:+:) f g a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options =
    Decoder ((:+:) f g a) -> State Int (Decoder ((:+:) f g a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnionDecoder ((:+:) f g a) -> Decoder ((:+:) f g a)
forall a. UnionDecoder a -> Decoder a
union (Proxy t
-> InputNormalizer
-> InterpretOptions
-> UnionDecoder ((:+:) f g a)
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhallUnion t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> UnionDecoder (f a)
genericUnionAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options))

instance GenericFromDhall t f => GenericFromDhall t (M1 C c f) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (M1 C c f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options = do
        Decoder (f a)
res <- Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhall t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options
        pure ((f a -> M1 C c f a) -> Decoder (f a) -> Decoder (M1 C c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> M1 C c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 Decoder (f a)
res)

instance GenericFromDhall t U1 where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (U1 a))
genericAutoWithNormalizer Proxy t
_ InputNormalizer
_ InterpretOptions
_ = Decoder (U1 a) -> State Int (Decoder (U1 a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) (U1 a)
forall s a. Validation ExpectedTypeErrors (Expr s a)
forall k (f :: * -> *) p (p :: k). Applicative f => p -> f (U1 p)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: forall k (f :: * -> *) p (p :: k). Applicative f => p -> f (U1 p)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (U1 a)
..})
      where
        extract :: p -> f (U1 p)
extract p
_ = U1 p -> f (U1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1

        expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
forall s a. Expr s a
expected'

        expected' :: Expr s a
expected' = Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
Record ([(Text, RecordField s a)] -> Map Text (RecordField s a)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [])

getSelName :: Selector s => M1 i s f a -> State Int Text
getSelName :: M1 i s f a -> State Int Text
getSelName M1 i s f a
n = case M1 i s f a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 i s f a
n of
    String
"" -> do Int
i <- StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
             Int -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
             pure (String -> Text
Data.Text.pack (String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i))
    String
nn -> Text -> State Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
Data.Text.pack String
nn)

instance (GenericFromDhall t (f :*: g), GenericFromDhall t (h :*: i)) => GenericFromDhall t ((f :*: g) :*: (h :*: i)) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:*:) (f :*: g) (h :*: i) a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options = do
        Decoder Expr Src Void -> Extractor Src Void ((:*:) f g a)
extractL Expector (Expr Src Void)
expectedL <- Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:*:) f g a))
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhall t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options
        Decoder Expr Src Void -> Extractor Src Void ((:*:) h i a)
extractR Expector (Expr Src Void)
expectedR <- Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:*:) h i a))
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhall t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options

        let ktsL :: Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsL = Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecord Text
"genericAutoWithNormalizer (:*:)" (Expr Src Void -> Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedL
        let ktsR :: Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsR = Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecord Text
"genericAutoWithNormalizer (:*:)" (Expr Src Void -> Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedR

        let expected :: Expector (Expr Src Void)
expected = 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)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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)
 -> Map Text (RecordField Src Void)
 -> Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Validation
     ExpectedTypeErrors
     (Map Text (RecordField Src Void)
      -> Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsL Validation
  ExpectedTypeErrors
  (Map Text (RecordField Src Void)
   -> Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsR)

        let extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (h :*: i) a)
extract Expr Src Void
expression =
                ((:*:) f g a -> (:*:) h i a -> (:*:) (f :*: g) (h :*: i) a)
-> Extractor Src Void ((:*:) f g a)
-> Extractor Src Void ((:*:) h i a)
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (h :*: i) a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:*:) f g a -> (:*:) h i a -> (:*:) (f :*: g) (h :*: i) a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (Expr Src Void -> Extractor Src Void ((:*:) f g a)
extractL Expr Src Void
expression) (Expr Src Void -> Extractor Src Void ((:*:) h i a)
extractR Expr Src Void
expression)

        Decoder ((:*:) (f :*: g) (h :*: i) a)
-> State Int (Decoder ((:*:) (f :*: g) (h :*: i) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (h :*: i) a)
extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (h :*: i) a)
expected :: Expector (Expr Src Void)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (h :*: i) a)
..})

instance (GenericFromDhall t (f :*: g), Selector s, FromDhall a) => GenericFromDhall t ((f :*: g) :*: M1 S s (K1 i a)) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a))
genericAutoWithNormalizer Proxy t
p 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) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
nR)

        Decoder Expr Src Void -> Extractor Src Void ((:*:) f g a)
extractL Expector (Expr Src Void)
expectedL <- Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:*:) f g a))
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhall t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options

        let Decoder Expr Src Void -> Extractor Src Void a
extractR Expector (Expr Src Void)
expectedR = InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer

        let ktsL :: Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsL = Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecord Text
"genericAutoWithNormalizer (:*:)" (Expr Src Void -> Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedL

        let expected :: Expector (Expr Src Void)
expected = 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)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 (RecordField Src Void
 -> Map Text (RecordField Src Void)
 -> Map Text (RecordField Src Void))
-> (Expr Src Void -> RecordField Src Void)
-> Expr Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void
 -> Map Text (RecordField Src Void)
 -> Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
-> Validation
     ExpectedTypeErrors
     (Map Text (RecordField Src Void)
      -> Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedR Validation
  ExpectedTypeErrors
  (Map Text (RecordField Src Void)
   -> Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsL)

        let extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
extract Expr Src Void
expression = do
                let die :: Validation
  (ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
die = Expector (Expr Src Void)
-> Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
expression

                case Expr Src Void
expression of
                    RecordLit Map Text (RecordField Src Void)
kvs ->
                        case RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField Src Void -> Expr Src Void)
-> Maybe (RecordField Src Void) -> Maybe (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
nameR Map Text (RecordField Src Void)
kvs of
                            Just Expr Src Void
expressionR ->
                                ((:*:) f g a
 -> M1 S s (K1 i a) a -> (:*:) (f :*: g) (M1 S s (K1 i a)) a)
-> Extractor Src Void ((:*:) f g a)
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:*:) f g a
-> M1 S s (K1 i a) a -> (:*:) (f :*: g) (M1 S s (K1 i a)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
                                    (Expr Src Void -> Extractor Src Void ((:*:) f g a)
extractL Expr Src Void
expression)
                                    ((a -> M1 S s (K1 i a) a)
-> Extractor Src Void a
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 i a a -> M1 S s (K1 i a) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a a -> M1 S s (K1 i a) a)
-> (a -> K1 i a a) -> a -> M1 S s (K1 i a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1) (Expr Src Void -> Extractor Src Void a
extractR Expr Src Void
expressionR))
                            Maybe (Expr Src Void)
_ -> Validation
  (ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
die
                    Expr Src Void
_ -> Validation
  (ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
die

        Decoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
-> State Int (Decoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
expected :: Expector (Expr Src Void)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
..})

instance (Selector s, FromDhall a, GenericFromDhall t (f :*: g)) => GenericFromDhall t (M1 S s (K1 i a) :*: (f :*: g)) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a))
genericAutoWithNormalizer Proxy t
p 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) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
nL)

        let Decoder Expr Src Void -> Extractor Src Void a
extractL Expector (Expr Src Void)
expectedL = InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer

        Decoder Expr Src Void -> Extractor Src Void ((:*:) f g a)
extractR Expector (Expr Src Void)
expectedR <- Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:*:) f g a))
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhall t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options

        let ktsR :: Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsR = Text -> Expr Src Void -> Map Text (RecordField Src Void)
unsafeExpectRecord Text
"genericAutoWithNormalizer (:*:)" (Expr Src Void -> Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedR

        let expected :: Expector (Expr Src Void)
expected = 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)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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 (RecordField Src Void
 -> Map Text (RecordField Src Void)
 -> Map Text (RecordField Src Void))
-> (Expr Src Void -> RecordField Src Void)
-> Expr Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void
 -> Map Text (RecordField Src Void)
 -> Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
-> Validation
     ExpectedTypeErrors
     (Map Text (RecordField Src Void)
      -> Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedL Validation
  ExpectedTypeErrors
  (Map Text (RecordField Src Void)
   -> Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsR)

        let extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
extract Expr Src Void
expression = do
                let die :: Validation
  (ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
die = Expector (Expr Src Void)
-> Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
expression

                case Expr Src Void
expression of
                    RecordLit Map Text (RecordField Src Void)
kvs ->
                        case RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField Src Void -> Expr Src Void)
-> Maybe (RecordField Src Void) -> Maybe (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
nameL Map Text (RecordField Src Void)
kvs of
                            Just Expr Src Void
expressionL ->
                                (M1 S s (K1 i a) a
 -> (:*:) f g a -> (:*:) (M1 S s (K1 i a)) (f :*: g) a)
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
-> Extractor Src Void ((:*:) f g a)
-> Validation
     (ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 M1 S s (K1 i a) a
-> (:*:) f g a -> (:*:) (M1 S s (K1 i a)) (f :*: g) a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
                                    ((a -> M1 S s (K1 i a) a)
-> Extractor Src Void a
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 i a a -> M1 S s (K1 i a) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a a -> M1 S s (K1 i a) a)
-> (a -> K1 i a a) -> a -> M1 S s (K1 i a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1) (Expr Src Void -> Extractor Src Void a
extractL Expr Src Void
expressionL))
                                    (Expr Src Void -> Extractor Src Void ((:*:) f g a)
extractR Expr Src Void
expression)
                            Maybe (Expr Src Void)
_ -> Validation
  (ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
die
                    Expr Src Void
_ -> Validation
  (ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
die

        Decoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
-> State Int (Decoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
expected :: Expector (Expr Src Void)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
..})

instance {-# OVERLAPPING #-} GenericFromDhall a1 (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where
    genericAutoWithNormalizer :: Proxy a1
-> InputNormalizer
-> InterpretOptions
-> State
     Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
genericAutoWithNormalizer Proxy a1
_ InputNormalizer
_ InterpretOptions
_ = Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
-> State
     Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
 -> State
      Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)))
-> Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
-> State
     Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
forall a b. (a -> b) -> a -> b
$ Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder
        { extract :: Expr Src Void
-> Extractor
     Src Void ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
extract = \Expr Src Void
_ -> ExtractErrors Src Void
-> Extractor
     Src Void ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
forall e a. e -> Validation e a
Failure (ExtractErrors Src Void
 -> Extractor
      Src Void ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
-> ExtractErrors Src Void
-> Extractor
     Src Void ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (ExtractError Src Void) -> ExtractErrors Src Void
forall e. NonEmpty e -> DhallErrors e
DhallErrors (NonEmpty (ExtractError Src Void) -> ExtractErrors Src Void)
-> NonEmpty (ExtractError Src Void) -> ExtractErrors Src Void
forall a b. (a -> b) -> a -> b
$ ExtractError Src Void -> NonEmpty (ExtractError Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtractError Src Void -> NonEmpty (ExtractError Src Void))
-> ExtractError Src Void -> NonEmpty (ExtractError Src Void)
forall a b. (a -> b) -> a -> b
$ ExpectedTypeError -> ExtractError Src Void
forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeError
RecursiveTypeError
        , expected :: Expector (Expr Src Void)
expected = ExpectedTypeErrors -> Expector (Expr Src Void)
forall e a. e -> Validation e a
Failure (ExpectedTypeErrors -> Expector (Expr Src Void))
-> ExpectedTypeErrors -> Expector (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ NonEmpty ExpectedTypeError -> ExpectedTypeErrors
forall e. NonEmpty e -> DhallErrors e
DhallErrors (NonEmpty ExpectedTypeError -> ExpectedTypeErrors)
-> NonEmpty ExpectedTypeError -> ExpectedTypeErrors
forall a b. (a -> b) -> a -> b
$ ExpectedTypeError -> NonEmpty ExpectedTypeError
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpectedTypeError
RecursiveTypeError
        }

instance {-# OVERLAPPING #-} GenericFromDhall a2 (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where
    genericAutoWithNormalizer :: Proxy a2
-> InputNormalizer
-> InterpretOptions
-> State
     Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
genericAutoWithNormalizer Proxy a2
_ InputNormalizer
_ InterpretOptions
_ = Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
-> State
     Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
 -> State
      Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)))
-> Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
-> State
     Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
forall a b. (a -> b) -> a -> b
$ Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder
        { extract :: Expr Src Void
-> Extractor
     Src Void ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
extract = \Expr Src Void
_ -> ExtractErrors Src Void
-> Extractor
     Src Void ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
forall e a. e -> Validation e a
Failure (ExtractErrors Src Void
 -> Extractor
      Src Void ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
-> ExtractErrors Src Void
-> Extractor
     Src Void ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (ExtractError Src Void) -> ExtractErrors Src Void
forall e. NonEmpty e -> DhallErrors e
DhallErrors (NonEmpty (ExtractError Src Void) -> ExtractErrors Src Void)
-> NonEmpty (ExtractError Src Void) -> ExtractErrors Src Void
forall a b. (a -> b) -> a -> b
$ ExtractError Src Void -> NonEmpty (ExtractError Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtractError Src Void -> NonEmpty (ExtractError Src Void))
-> ExtractError Src Void -> NonEmpty (ExtractError Src Void)
forall a b. (a -> b) -> a -> b
$ ExpectedTypeError -> ExtractError Src Void
forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeError
RecursiveTypeError
        , expected :: Expector (Expr Src Void)
expected = ExpectedTypeErrors -> Expector (Expr Src Void)
forall e a. e -> Validation e a
Failure (ExpectedTypeErrors -> Expector (Expr Src Void))
-> ExpectedTypeErrors -> Expector (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ NonEmpty ExpectedTypeError -> ExpectedTypeErrors
forall e. NonEmpty e -> DhallErrors e
DhallErrors (NonEmpty ExpectedTypeError -> ExpectedTypeErrors)
-> NonEmpty ExpectedTypeError -> ExpectedTypeErrors
forall a b. (a -> b) -> a -> b
$ ExpectedTypeError -> NonEmpty ExpectedTypeError
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpectedTypeError
RecursiveTypeError
        }

instance {-# OVERLAPPABLE #-} (Selector s1, Selector s2, FromDhall a1, FromDhall a2) => GenericFromDhall t (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State
     Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
genericAutoWithNormalizer Proxy t
_ 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) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s1 (K1 i1 a1) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s1 (K1 i1 a1) Any
forall k (r :: k). M1 S s1 (K1 i1 a1) r
nL)
        Text
nameR <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s2 (K1 i2 a2) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s2 (K1 i2 a2) Any
forall k (r :: k). M1 S s2 (K1 i2 a2) r
nR)

        let Decoder Expr Src Void -> Extractor Src Void a1
extractL Expector (Expr Src Void)
expectedL = InputNormalizer -> Decoder a1
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer
        let Decoder Expr Src Void -> Extractor Src Void a2
extractR Expector (Expr Src Void)
expectedR = InputNormalizer -> Decoder a2
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer

        let expected :: Expector (Expr Src Void)
expected = do
                RecordField Src Void
l <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedL
                RecordField Src Void
r <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedR
                pure $ 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. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                        [ (Text
nameL, RecordField Src Void
l)
                        , (Text
nameR, RecordField Src Void
r)
                        ]
                    )

        let extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void)
     ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
extract Expr Src Void
expression = do
                let die :: Validation
  (ExtractErrors Src Void)
  ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
die = Expector (Expr Src Void)
-> Expr Src Void
-> Validation
     (ExtractErrors Src Void)
     ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
expression

                case Expr Src Void
expression of
                    RecordLit Map Text (RecordField Src Void)
kvs ->
                        case (RecordField Src Void
 -> RecordField Src Void
 -> (RecordField Src Void, RecordField Src Void))
-> Maybe (RecordField Src Void)
-> Maybe (RecordField Src Void)
-> Maybe (RecordField Src Void, RecordField Src Void)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
nameL Map Text (RecordField Src Void)
kvs) (Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
nameR Map Text (RecordField Src Void)
kvs) of
                            Just (RecordField Src Void
expressionL, RecordField Src Void
expressionR) ->
                                (M1 S s1 (K1 i1 a1) a
 -> M1 S s2 (K1 i2 a2) a
 -> (:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
-> Validation (ExtractErrors Src Void) (M1 S s1 (K1 i1 a1) a)
-> Validation (ExtractErrors Src Void) (M1 S s2 (K1 i2 a2) a)
-> Validation
     (ExtractErrors Src Void)
     ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 M1 S s1 (K1 i1 a1) a
-> M1 S s2 (K1 i2 a2) a
-> (:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
                                    ((a1 -> M1 S s1 (K1 i1 a1) a)
-> Extractor Src Void a1
-> Validation (ExtractErrors Src Void) (M1 S s1 (K1 i1 a1) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 i1 a1 a -> M1 S s1 (K1 i1 a1) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i1 a1 a -> M1 S s1 (K1 i1 a1) a)
-> (a1 -> K1 i1 a1 a) -> a1 -> M1 S s1 (K1 i1 a1) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> K1 i1 a1 a
forall k i c (p :: k). c -> K1 i c p
K1) (Expr Src Void -> Extractor Src Void a1
extractL (Expr Src Void -> Extractor Src Void a1)
-> Expr Src Void -> Extractor Src Void a1
forall a b. (a -> b) -> a -> b
$ RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue RecordField Src Void
expressionL))
                                    ((a2 -> M1 S s2 (K1 i2 a2) a)
-> Extractor Src Void a2
-> Validation (ExtractErrors Src Void) (M1 S s2 (K1 i2 a2) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 i2 a2 a -> M1 S s2 (K1 i2 a2) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i2 a2 a -> M1 S s2 (K1 i2 a2) a)
-> (a2 -> K1 i2 a2 a) -> a2 -> M1 S s2 (K1 i2 a2) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a2 -> K1 i2 a2 a
forall k i c (p :: k). c -> K1 i c p
K1) (Expr Src Void -> Extractor Src Void a2
extractR (Expr Src Void -> Extractor Src Void a2)
-> Expr Src Void -> Extractor Src Void a2
forall a b. (a -> b) -> a -> b
$ RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue RecordField Src Void
expressionR))
                            Maybe (RecordField Src Void, RecordField Src Void)
Nothing -> Validation
  (ExtractErrors Src Void)
  ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
die
                    Expr Src Void
_ -> Validation
  (ExtractErrors Src Void)
  ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
die

        Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
-> State
     Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void
-> Validation
     (ExtractErrors Src Void)
     ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void)
     ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
expected :: Expector (Expr Src Void)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void
-> Validation
     (ExtractErrors Src Void)
     ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
..})

instance {-# OVERLAPPING #-} GenericFromDhall a (M1 S s (K1 i a)) where
    genericAutoWithNormalizer :: Proxy a
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (M1 S s (K1 i a) a))
genericAutoWithNormalizer Proxy a
_ InputNormalizer
_ InterpretOptions
_ = Decoder (M1 S s (K1 i a) a)
-> State Int (Decoder (M1 S s (K1 i a) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder (M1 S s (K1 i a) a)
 -> State Int (Decoder (M1 S s (K1 i a) a)))
-> Decoder (M1 S s (K1 i a) a)
-> State Int (Decoder (M1 S s (K1 i a) a))
forall a b. (a -> b) -> a -> b
$ Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder
        { extract :: Expr Src Void -> Extractor Src Void (M1 S s (K1 i a) a)
extract = \Expr Src Void
_ -> ExtractErrors Src Void -> Extractor Src Void (M1 S s (K1 i a) a)
forall e a. e -> Validation e a
Failure (ExtractErrors Src Void -> Extractor Src Void (M1 S s (K1 i a) a))
-> ExtractErrors Src Void -> Extractor Src Void (M1 S s (K1 i a) a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (ExtractError Src Void) -> ExtractErrors Src Void
forall e. NonEmpty e -> DhallErrors e
DhallErrors (NonEmpty (ExtractError Src Void) -> ExtractErrors Src Void)
-> NonEmpty (ExtractError Src Void) -> ExtractErrors Src Void
forall a b. (a -> b) -> a -> b
$ ExtractError Src Void -> NonEmpty (ExtractError Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtractError Src Void -> NonEmpty (ExtractError Src Void))
-> ExtractError Src Void -> NonEmpty (ExtractError Src Void)
forall a b. (a -> b) -> a -> b
$ ExpectedTypeError -> ExtractError Src Void
forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeError
RecursiveTypeError
        , expected :: Expector (Expr Src Void)
expected = ExpectedTypeErrors -> Expector (Expr Src Void)
forall e a. e -> Validation e a
Failure (ExpectedTypeErrors -> Expector (Expr Src Void))
-> ExpectedTypeErrors -> Expector (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ NonEmpty ExpectedTypeError -> ExpectedTypeErrors
forall e. NonEmpty e -> DhallErrors e
DhallErrors (NonEmpty ExpectedTypeError -> ExpectedTypeErrors)
-> NonEmpty ExpectedTypeError -> ExpectedTypeErrors
forall a b. (a -> b) -> a -> b
$ ExpectedTypeError -> NonEmpty ExpectedTypeError
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExpectedTypeError
RecursiveTypeError
        }

instance {-# OVERLAPPABLE #-} (Selector s, FromDhall a) => GenericFromDhall t (M1 S s (K1 i a)) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (M1 S s (K1 i a) a))
genericAutoWithNormalizer Proxy t
_ 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 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) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n)

        let Decoder { extract :: forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract = Expr Src Void -> Extractor Src Void a
extract', expected :: forall a. Decoder a -> Expector (Expr Src Void)
expected = Expector (Expr Src Void)
expected'} = InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer

        let expected :: Expector (Expr Src Void)
expected =
                case SingletonConstructors
singletonConstructors of
                    SingletonConstructors
Bare ->
                        Expector (Expr Src Void)
expected'
                    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 k (r :: k). M1 S s (K1 i a) r
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" ->
                        Expector (Expr Src Void)
expected'
                    SingletonConstructors
_ ->
                        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)
-> (Expr Src Void -> Map Text (RecordField Src Void))
-> Expr Src Void
-> Expr Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))
-> (Expr Src Void -> RecordField Src Void)
-> Expr Src Void
-> Map Text (RecordField Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expected'

        let extract0 :: Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract0 Expr Src Void
expression = (a -> M1 S s (K1 i a) a)
-> Extractor Src Void a
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 i a a -> M1 S s (K1 i a) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a a -> M1 S s (K1 i a) a)
-> (a -> K1 i a a) -> a -> M1 S s (K1 i a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1) (Expr Src Void -> Extractor Src Void a
extract' Expr Src Void
expression)

        let extract1 :: Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract1 Expr Src Void
expression = do
                let die :: Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
die = Expector (Expr Src Void)
-> Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
expression

                case Expr Src Void
expression of
                    RecordLit Map Text (RecordField Src Void)
kvs ->
                        case RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField Src Void -> Expr Src Void)
-> Maybe (RecordField Src Void) -> Maybe (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
name Map Text (RecordField Src Void)
kvs of
                            Just Expr Src Void
subExpression ->
                                (a -> M1 S s (K1 i a) a)
-> Extractor Src Void a
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 i a a -> M1 S s (K1 i a) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a a -> M1 S s (K1 i a) a)
-> (a -> K1 i a a) -> a -> M1 S s (K1 i a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1) (Expr Src Void -> Extractor Src Void a
extract' Expr Src Void
subExpression)
                            Maybe (Expr Src Void)
Nothing ->
                                Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
die
                    Expr Src Void
_ -> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
die

        let extract :: Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract =
                case SingletonConstructors
singletonConstructors of
                    SingletonConstructors
Bare                    -> Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract0
                    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 k (r :: k). M1 S s (K1 i a) r
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" -> Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract0
                    SingletonConstructors
_                       -> Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract1

        Decoder (M1 S s (K1 i a) a)
-> State Int (Decoder (M1 S s (K1 i a) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract :: Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
expected :: Expector (Expr Src Void)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
..})

{-| 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 `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' 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

{-| 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
    = (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 k (f :: k -> *) (a :: k).
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
defaultInputNormalizer InterpretOptions
options) Int
1)

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.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

{-|

>>> 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

{-|

>>> 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

{-|

>>> 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

{-|

>>> 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

{-|

>>> 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

{-| 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

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

-}
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

{-| This is the underlying class that powers the `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 k (f :: k -> *) (a :: k).
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options
        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 k (f :: k -> *) (a :: k).
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options
        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 :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> 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) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n

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

        let embed1 :: M1 S s (K1 i a) a -> 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 S s (K1 i a) a -> Expr Src Void
embed =
                case SingletonConstructors
singletonConstructors of
                    SingletonConstructors
Bare                    -> M1 S s (K1 i a) a -> 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 k (r :: k). M1 S s (K1 i a) r
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" -> M1 S s (K1 i a) a -> Expr Src Void
embed0
                    SingletonConstructors
_                       -> M1 S s (K1 i a) a -> 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 k (r :: k). 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
declared :: Expr Src Void
embed :: M1 S s (K1 i a) a -> 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
declared :: Expr Src Void
embed :: (:+:) (M1 C c1 f1) (M1 C c2 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 C c1 f1) (M1 C c2 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
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
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 :: k). 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 :: k). 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 k (f :: k -> *) (a :: k).
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 k (f :: k -> *) (a :: k).
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
declared :: Expr Src Void
embed :: (:+:) (f :+: g) (M1 C 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 C 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
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
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 :: k). 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 k (f :: k -> *) (a :: k).
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 k (f :: k -> *) (a :: k).
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
declared :: Expr Src Void
embed :: (:+:) (M1 C 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 C 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
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
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 :: k). 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 k (f :: k -> *) (a :: k).
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 k (f :: k -> *) (a :: k).
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
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
..})
      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
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
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 k (f :: k -> *) (a :: k).
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 k (f :: k -> *) (a :: k).
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 k (f :: k -> *) (a :: k).
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 k (f :: k -> *) (a :: k).
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) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). 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 k (f :: k -> *) (a :: k).
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 S s (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
declared :: Expr Src Void
embed :: (:*:) (f :*: g) (M1 S s (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) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). 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 k (f :: k -> *) (a :: k).
GenericToDhall f =>
InputNormalizer -> InterpretOptions -> State Int (Encoder (f a))
genericToDhallWithNormalizer InputNormalizer
inputNormalizer InterpretOptions
options

        let embed :: (:*:) (M1 S s (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
declared :: Expr Src Void
embed :: (:*:) (M1 S s (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) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s1 (K1 i1 a1) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s1 (K1 i1 a1) Any
forall k (r :: k). M1 S s1 (K1 i1 a1) r
nL)
        Text
nameR <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s2 (K1 i2 a2) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s2 (K1 i2 a2) Any
forall k (r :: k). 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 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a -> 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
declared :: Expr Src Void
embed :: (:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a -> 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

{-| The 'RecordDecoder' applicative functor allows you to build a 'Decoder'
    from 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 decoder has type 'Decoder' @Project@, but we can't build that out of any
    smaller decoders, as 'Decoder's cannot be combined (they are only 'Functor's).
    However, we can use a 'RecordDecoder' to build a 'Decoder' for @Project@:

>>> :{
project :: Decoder Project
project =
  record
    ( Project <$> field "name" strictText
              <*> field "description" strictText
              <*> field "stars" natural
    )
:}
-}

newtype RecordDecoder a =
  RecordDecoder
    ( Data.Functor.Product.Product
        ( Control.Applicative.Const
            (Dhall.Map.Map Text (Expector (Expr Src Void)))
        )
        ( Data.Functor.Compose.Compose ((->) (Expr Src Void)) (Extractor Src Void)
        )
        a
    )
  deriving (a -> RecordDecoder b -> RecordDecoder a
(a -> b) -> RecordDecoder a -> RecordDecoder b
(forall a b. (a -> b) -> RecordDecoder a -> RecordDecoder b)
-> (forall a b. a -> RecordDecoder b -> RecordDecoder a)
-> Functor RecordDecoder
forall a b. a -> RecordDecoder b -> RecordDecoder a
forall a b. (a -> b) -> RecordDecoder a -> RecordDecoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RecordDecoder b -> RecordDecoder a
$c<$ :: forall a b. a -> RecordDecoder b -> RecordDecoder a
fmap :: (a -> b) -> RecordDecoder a -> RecordDecoder b
$cfmap :: forall a b. (a -> b) -> RecordDecoder a -> RecordDecoder b
Functor, Functor RecordDecoder
a -> RecordDecoder a
Functor RecordDecoder
-> (forall a. a -> RecordDecoder a)
-> (forall a b.
    RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b)
-> (forall a b c.
    (a -> b -> c)
    -> RecordDecoder a -> RecordDecoder b -> RecordDecoder c)
-> (forall a b.
    RecordDecoder a -> RecordDecoder b -> RecordDecoder b)
-> (forall a b.
    RecordDecoder a -> RecordDecoder b -> RecordDecoder a)
-> Applicative RecordDecoder
RecordDecoder a -> RecordDecoder b -> RecordDecoder b
RecordDecoder a -> RecordDecoder b -> RecordDecoder a
RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
(a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
forall a. a -> RecordDecoder a
forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder a
forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder b
forall a b.
RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
forall a b c.
(a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: RecordDecoder a -> RecordDecoder b -> RecordDecoder a
$c<* :: forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder a
*> :: RecordDecoder a -> RecordDecoder b -> RecordDecoder b
$c*> :: forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder b
liftA2 :: (a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
<*> :: RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
$c<*> :: forall a b.
RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
pure :: a -> RecordDecoder a
$cpure :: forall a. a -> RecordDecoder a
$cp1Applicative :: Functor RecordDecoder
Applicative)


-- | Run a 'RecordDecoder' to build a 'Decoder'.
record :: RecordDecoder a -> Dhall.Decoder a
record :: RecordDecoder a -> Decoder a
record
    (RecordDecoder
        (Data.Functor.Product.Pair
            (Control.Applicative.Const Map Text (Expector (Expr Src Void))
fields)
            (Data.Functor.Compose.Compose Expr Src Void -> Extractor Src Void a
extract)
        )
    ) = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Extractor Src Void a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Extractor Src Void a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Extractor Src Void a
..}
  where
    expected :: Expector (Expr Src Void)
expected = 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)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expector (Expr Src Void)
 -> Validation ExpectedTypeErrors (RecordField Src Void))
-> Map Text (Expector (Expr Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField) Map Text (Expector (Expr Src Void))
fields


-- | Parse a single field of a record.
field :: Text -> Decoder a -> RecordDecoder a
field :: Text -> Decoder a -> RecordDecoder a
field Text
key (Decoder {Expector (Expr Src Void)
Expr Src Void -> Extractor Src Void a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Extractor Src Void a
expected :: forall a. Decoder a -> Expector (Expr Src Void)
extract :: forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
..}) =
  Product
  (Const (Map Text (Expector (Expr Src Void))))
  (Compose ((->) (Expr Src Void)) (Extractor Src Void))
  a
-> RecordDecoder a
forall a.
Product
  (Const (Map Text (Expector (Expr Src Void))))
  (Compose ((->) (Expr Src Void)) (Extractor Src Void))
  a
-> RecordDecoder a
RecordDecoder
    ( Const (Map Text (Expector (Expr Src Void))) a
-> Compose ((->) (Expr Src Void)) (Extractor Src Void) a
-> Product
     (Const (Map Text (Expector (Expr Src Void))))
     (Compose ((->) (Expr Src Void)) (Extractor 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 (Expector (Expr Src Void))
-> Const (Map Text (Expector (Expr Src Void))) a
forall k a (b :: k). a -> Const a b
Control.Applicative.Const
            (Text
-> Expector (Expr Src Void) -> Map Text (Expector (Expr Src Void))
forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
key Expector (Expr Src Void)
expected)
        )
        ( (Expr Src Void -> Extractor Src Void a)
-> Compose ((->) (Expr Src Void)) (Extractor Src Void) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Data.Functor.Compose.Compose Expr Src Void -> Extractor Src Void a
extractBody )
    )
  where
    extractBody :: Expr Src Void -> Extractor Src Void a
extractBody expr :: Expr Src Void
expr@(RecordLit Map Text (RecordField Src Void)
fields) = case RecordField Src Void -> Expr Src Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue (RecordField Src Void -> Expr Src Void)
-> Maybe (RecordField Src Void) -> Maybe (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map Text (RecordField Src Void) -> Maybe (RecordField Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
key Map Text (RecordField Src Void)
fields of
      Just Expr Src Void
v -> Expr Src Void -> Extractor Src Void a
extract Expr Src Void
v
      Maybe (Expr Src Void)
_      -> Expector (Expr Src Void) -> Expr Src Void -> Extractor Src Void a
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
expr
    extractBody Expr Src Void
expr = Expector (Expr Src Void) -> Expr Src Void -> Extractor Src Void a
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
expr

{-| The 'UnionDecoder' monoid allows you to build a 'Decoder' from a Dhall union

    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 decoder has type 'Decoder' @Status@, but we can't build that out of any
    smaller decoders, as 'Decoder's cannot be combined (they are only 'Functor's).
    However, we can use a 'UnionDecoder' to build a 'Decoder' for @Status@:

>>> :{
status :: Decoder Status
status = union
  (  ( Queued  <$> constructor "Queued"  natural )
  <> ( Result  <$> constructor "Result"  strictText )
  <> ( Errored <$> constructor "Errored" strictText )
  )
:}

-}
newtype UnionDecoder a =
    UnionDecoder
      ( Data.Functor.Compose.Compose (Dhall.Map.Map Text) Decoder a )
  deriving (a -> UnionDecoder b -> UnionDecoder a
(a -> b) -> UnionDecoder a -> UnionDecoder b
(forall a b. (a -> b) -> UnionDecoder a -> UnionDecoder b)
-> (forall a b. a -> UnionDecoder b -> UnionDecoder a)
-> Functor UnionDecoder
forall a b. a -> UnionDecoder b -> UnionDecoder a
forall a b. (a -> b) -> UnionDecoder a -> UnionDecoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> UnionDecoder b -> UnionDecoder a
$c<$ :: forall a b. a -> UnionDecoder b -> UnionDecoder a
fmap :: (a -> b) -> UnionDecoder a -> UnionDecoder b
$cfmap :: forall a b. (a -> b) -> UnionDecoder a -> UnionDecoder b
Functor)

instance Semigroup (UnionDecoder a) where
    <> :: UnionDecoder a -> UnionDecoder a -> UnionDecoder a
(<>) = (Map Text (Decoder a)
 -> Map Text (Decoder a) -> Map Text (Decoder a))
-> UnionDecoder a -> UnionDecoder a -> UnionDecoder a
coerce (Map Text (Decoder a)
-> Map Text (Decoder a) -> Map Text (Decoder a)
forall a. Semigroup a => a -> a -> a
(<>) :: Dhall.Map.Map Text (Decoder a) -> Dhall.Map.Map Text (Decoder a) -> Dhall.Map.Map Text (Decoder a))

instance Monoid (UnionDecoder a) where
    mempty :: UnionDecoder a
mempty = Map Text (Decoder a) -> UnionDecoder a
coerce (Map Text (Decoder a)
forall a. Monoid a => a
mempty :: Dhall.Map.Map Text (Decoder a))

-- | Run a 'UnionDecoder' to build a 'Decoder'.
union :: UnionDecoder a -> Decoder a
union :: UnionDecoder a -> Decoder a
union (UnionDecoder (Data.Functor.Compose.Compose Map Text (Decoder a)
mp)) = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) a
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) a
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) a
extract Expr Src Void
expr = case Validation ExpectedTypeErrors (Map Text (Maybe (Expr Src Void)))
expected' of
        Failure ExpectedTypeErrors
e -> ExtractErrors Src Void -> Validation (ExtractErrors Src Void) a
forall e a. e -> Validation e a
Failure (ExtractErrors Src Void -> Validation (ExtractErrors Src Void) a)
-> ExtractErrors Src Void -> Validation (ExtractErrors Src Void) a
forall a b. (a -> b) -> a -> b
$ (ExpectedTypeError -> ExtractError Src Void)
-> ExpectedTypeErrors -> ExtractErrors Src Void
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExpectedTypeError -> ExtractError Src Void
forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeErrors
e
        Success Map Text (Maybe (Expr Src Void))
x -> Expr Src Void
-> Map Text (Maybe (Expr Src Void))
-> Validation (ExtractErrors Src Void) a
extract' Expr Src Void
expr Map Text (Maybe (Expr Src Void))
x

    extract' :: Expr Src Void
-> Map Text (Maybe (Expr Src Void))
-> Validation (ExtractErrors Src Void) a
extract' Expr Src Void
e0 Map Text (Maybe (Expr Src Void))
mp' = Validation (ExtractErrors Src Void) a
-> ((Decoder a, Expr Src Void)
    -> Validation (ExtractErrors Src Void) a)
-> Maybe (Decoder a, Expr Src Void)
-> Validation (ExtractErrors Src Void) a
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) a
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
e0) ((Decoder a
 -> Expr Src Void -> Validation (ExtractErrors Src Void) a)
-> (Decoder a, Expr Src Void)
-> Validation (ExtractErrors Src Void) a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Decoder a -> Expr Src Void -> Validation (ExtractErrors Src Void) a
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
Dhall.extract) (Maybe (Decoder a, Expr Src Void)
 -> Validation (ExtractErrors Src Void) a)
-> Maybe (Decoder a, Expr Src Void)
-> Validation (ExtractErrors Src Void) a
forall a b. (a -> b) -> a -> b
$ do
        (Text
fld, Expr Src Void
e1, Map Text (Maybe (Expr Src Void))
rest) <- Expr Src Void
-> Maybe (Text, Expr Src Void, Map Text (Maybe (Expr Src Void)))
forall s a.
Expr s a -> Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
extractUnionConstructor Expr Src Void
e0

        Decoder a
t <- Text -> Map Text (Decoder a) -> Maybe (Decoder a)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
fld Map Text (Decoder a)
mp

        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$
            Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Core.Union Map Text (Maybe (Expr Src Void))
rest Expr Src Void -> Expr Src Void -> Bool
forall a s t. Eq a => Expr s a -> Expr t a -> Bool
`Core.judgmentallyEqual` Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Core.Union (Text
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => k -> Map k v -> Map k v
Dhall.Map.delete Text
fld Map Text (Maybe (Expr Src Void))
mp')

        pure (Decoder a
t, Expr Src Void
e1)

    expected :: Expector (Expr Src Void)
expected = 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)) -> Expr Src Void)
-> Validation ExpectedTypeErrors (Map Text (Maybe (Expr Src Void)))
-> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation ExpectedTypeErrors (Map Text (Maybe (Expr Src Void)))
expected'

    expected' :: Validation ExpectedTypeErrors (Map Text (Maybe (Expr Src Void)))
expected' = (Decoder a
 -> Validation ExpectedTypeErrors (Maybe (Expr Src Void)))
-> Map Text (Decoder a)
-> Validation ExpectedTypeErrors (Map Text (Maybe (Expr Src Void)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr Src Void -> Maybe (Expr Src Void))
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (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 (Expector (Expr Src Void)
 -> Validation ExpectedTypeErrors (Maybe (Expr Src Void)))
-> (Decoder a -> Expector (Expr Src Void))
-> Decoder a
-> Validation ExpectedTypeErrors (Maybe (Expr Src Void))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
Dhall.expected) Map Text (Decoder a)
mp

-- | Parse a single constructor of a union
constructor :: Text -> Decoder a -> UnionDecoder a
constructor :: Text -> Decoder a -> UnionDecoder a
constructor Text
key Decoder a
valueDecoder = Compose (Map Text) Decoder a -> UnionDecoder a
forall a. Compose (Map Text) Decoder a -> UnionDecoder a
UnionDecoder
    ( Map Text (Decoder a) -> Compose (Map Text) Decoder a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Data.Functor.Compose.Compose (Text -> Decoder a -> Map Text (Decoder a)
forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
key Decoder a
valueDecoder) )

-- | 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 >*<

{-| 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

{-| 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

{-| 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

-- | 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

{-| '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)

-- | 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 Substitutions 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 Substitutions Src Void
my) (Op b -> (Text, Expr Src Void)
fy)) =
    Product
  (Const (Substitutions Src Void))
  (Op (Text, Expr Src Void))
  (Either a b)
-> UnionEncoder (Either a b)
forall a.
Product
  (Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
UnionEncoder
      ( Const (Substitutions Src Void) (Either a b)
-> Op (Text, Expr Src Void) (Either a b)
-> Product
     (Const (Substitutions 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
          ( Substitutions Src Void
-> Const (Substitutions Src Void) (Either a b)
forall k a (b :: k). a -> Const a b
Control.Applicative.Const (Substitutions Src Void
mx Substitutions Src Void
-> Substitutions Src Void -> Substitutions Src Void
forall a. Semigroup a => a -> a -> a
<> Substitutions 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 >|<

-- | 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 Substitutions 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))
-> Substitutions 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 Substitutions Src Void
fields

{-| 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 (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
forall a.
Product
  (Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
UnionEncoder (Product
   (Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
 -> UnionEncoder a)
-> Product
     (Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
forall a b. (a -> b) -> a -> b
$
    Const (Substitutions Src Void) a
-> Op (Text, Expr Src Void) a
-> Product
     (Const (Substitutions 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
      ( Substitutions Src Void -> Const (Substitutions Src Void) a
forall k a (b :: k). a -> Const a b
Control.Applicative.Const
          ( Text -> Expr Src Void -> Substitutions 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 )
      )

{-| 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