{-# LANGUAGE ApplicativeDo              #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# 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.Marshal.Decode
    ( -- * General
      Decoder (..)
    , FromDhall(..)
    , Interpret
    , auto

      -- * Building decoders
      -- ** Simple decoders
    , bool
    , unit
    , void
      -- ** Numbers
    , natural
    , word
    , word8
    , word16
    , word32
    , word64
    , integer
    , int
    , int8
    , int16
    , int32
    , int64
    , scientific
    , double
      -- ** Bytes
    , lazyBytes
    , strictBytes
    , shortBytes
      -- ** Textual
    , string
    , lazyText
    , strictText
    , shortText
      -- ** Time
    , timeOfDay
    , day
    , timeZone
    , localTime
    , zonedTime
    , utcTime
    , dayOfWeek
      -- ** Containers
    , maybe
    , pair
    , sequence
    , list
    , vector
    , setFromDistinctList
    , setIgnoringDuplicates
    , hashSetFromDistinctList
    , hashSetIgnoringDuplicates
    , Dhall.Marshal.Decode.map
    , hashMap
    , pairFromMapEntry
      -- ** Functions
    , function
    , functionWith
      -- ** Records
    , RecordDecoder(..)
    , record
    , field
      -- ** Unions
    , UnionDecoder(..)
    , union
    , constructor

      -- * Generic decoding
    , GenericFromDhall(..)
    , GenericFromDhallUnion(..)
    , genericAuto
    , genericAutoWith
    , genericAutoWithInputNormalizer

    -- * Decoding errors
    , DhallErrors(..)
    , showDhallErrors
    , InvalidDecoder(..)
    -- ** Extraction errors
    , ExtractErrors
    , ExtractError(..)
    , Extractor
    , typeError
    , extractError
    , MonadicExtractor
    , toMonadic
    , fromMonadic
    -- ** Typing errors
    , ExpectedTypeErrors
    , ExpectedTypeError(..)
    , Expector

    -- * Miscellaneous
    , InputNormalizer(..)
    , defaultInputNormalizer
    , InterpretOptions(..)
    , SingletonConstructors(..)
    , defaultInterpretOptions
    , Result

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


import Control.Applicative              (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.Functor.Contravariant
    ( Equivalence (..)
    , Op (..)
    , Predicate (..)
    )
import Data.Functor.Identity            (Identity (..))
import Data.Hashable                    (Hashable)
import Data.List.NonEmpty               (NonEmpty (..))
import Data.Typeable                    (Proxy (..), Typeable)
import Dhall.Parser                     (Src (..))
import Dhall.Syntax
    ( Chunks (..)
    , DhallDouble (..)
    , Expr (..)
    , FieldSelection (..)
    , FunctionBinding (..)
    , Var (..)
    )
import GHC.Generics
import Prelude                          hiding (maybe, sequence)
import Prettyprinter                    (Pretty)

import qualified Control.Applicative
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
import qualified Data.ByteString.Short
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            as 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.Lazy
import qualified Data.Text.Short
import qualified Data.Time            as Time
import qualified Data.Vector
import qualified Dhall.Core           as Core
import qualified Dhall.Map
import qualified Dhall.Util

import Dhall.Marshal.Encode
import Dhall.Marshal.Internal

-- $setup
-- >>> import Dhall (input)

{-| 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 `Dhall.input` function:

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

{-| Any value that implements `FromDhall` can be automatically decoded based on
    the inferred return type of `Dhall.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'/'genericAutoWithInputNormalizer'
    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
_ = forall a. (Generic a, GenericFromDhall a (Rep a)) => Decoder a
genericAuto

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

{-| Use the default input normalizer for interpreting an input.

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



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 FromDhall Data.ByteString.Short.ShortByteString where
    autoWith :: InputNormalizer -> Decoder ShortByteString
autoWith InputNormalizer
_ = Decoder ShortByteString
shortBytes

instance FromDhall Data.ByteString.Lazy.ByteString where
    autoWith :: InputNormalizer -> Decoder ByteString
autoWith InputNormalizer
_ = Decoder ByteString
lazyBytes

instance FromDhall Data.ByteString.ByteString where
    autoWith :: InputNormalizer -> Decoder ByteString
autoWith InputNormalizer
_ = Decoder ByteString
strictBytes

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

instance FromDhall Data.Text.Short.ShortText where
    autoWith :: InputNormalizer -> Decoder ShortText
autoWith InputNormalizer
_ = Decoder ShortText
shortText

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 (Identity a) where
    autoWith :: InputNormalizer -> Decoder (Identity a)
autoWith InputNormalizer
opts = forall a. a -> Identity a
Identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts

instance FromDhall a => FromDhall (Maybe a) where
    autoWith :: InputNormalizer -> Decoder (Maybe a)
autoWith InputNormalizer
opts = forall a. Decoder a -> Decoder (Maybe a)
maybe (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 = forall a. Decoder a -> Decoder (Seq a)
sequence (forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts)

instance FromDhall a => FromDhall [a] where
    autoWith :: InputNormalizer -> Decoder [a]
autoWith InputNormalizer
opts = forall a. Decoder a -> Decoder [a]
list (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 = forall a. Decoder a -> Decoder (Vector a)
vector (forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts)

instance FromDhall Time.TimeOfDay where
    autoWith :: InputNormalizer -> Decoder TimeOfDay
autoWith InputNormalizer
_ = Decoder TimeOfDay
timeOfDay

instance FromDhall Time.Day where
    autoWith :: InputNormalizer -> Decoder Day
autoWith InputNormalizer
_ = Decoder Day
day

instance FromDhall Time.TimeZone where
    autoWith :: InputNormalizer -> Decoder TimeZone
autoWith InputNormalizer
_ = Decoder TimeZone
timeZone

instance FromDhall Time.LocalTime where
    autoWith :: InputNormalizer -> Decoder LocalTime
autoWith InputNormalizer
_ = Decoder LocalTime
localTime

instance FromDhall Time.ZonedTime where
    autoWith :: InputNormalizer -> Decoder ZonedTime
autoWith InputNormalizer
_ = Decoder ZonedTime
zonedTime

instance FromDhall Time.UTCTime where
    autoWith :: InputNormalizer -> Decoder UTCTime
autoWith InputNormalizer
_ = Decoder UTCTime
utcTime

instance FromDhall Time.DayOfWeek where
    autoWith :: InputNormalizer -> Decoder DayOfWeek
autoWith InputNormalizer
_ = Decoder DayOfWeek
dayOfWeek

{-| 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 = forall a. (Ord a, Show a) => Decoder a -> Decoder (Set a)
setFromDistinctList (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 = forall a.
(Hashable a, Ord a, Show a) =>
Decoder a -> Decoder (HashSet a)
hashSetFromDistinctList (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 = forall k v. Ord k => Decoder k -> Decoder v -> Decoder (Map k v)
Dhall.Marshal.Decode.map (forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer) (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 = forall k v.
(Eq k, Hashable k) =>
Decoder k -> Decoder v -> Decoder (HashMap k v)
Dhall.Marshal.Decode.hashMap (forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer) (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 =
        forall a b.
InputNormalizer -> Encoder a -> Decoder b -> Decoder (a -> b)
functionWith InputNormalizer
inputNormalizer (forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith InputNormalizer
inputNormalizer) (forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer)

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

instance FromDhall (f (Result f)) => FromDhall (Result f) where
    autoWith :: InputNormalizer -> Decoder (Result f)
autoWith InputNormalizer
inputNormalizer = 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) =
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *). f (Result f) -> Result f
Result (forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
Dhall.Marshal.Decode.extract (forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer) Expr Src Void
expr)
        extract Expr Src Void
expr = 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr Src Void
"result"

deriving newtype instance (ToDhall x) => FromDhall (Predicate x)

deriving newtype instance (ToDhall x) => FromDhall (Equivalence x)

deriving newtype instance (FromDhall b, ToDhall x) => FromDhall (Op b x)

-- | 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 {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 = 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 Maybe CharacterSet
_ (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 (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 Maybe CharacterSet
_ (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 (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *). Functor f => Result f -> Fix f
resultToFix (forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
Dhall.Marshal.Decode.extract (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 forall a. Eq a => a -> a -> Bool
/= Text
b    = forall s a. Var -> Expr s a -> Expr s a -> Expr s a
Core.subst (Text -> Int -> Var
V Text
a Int
0) (forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
b Int
0)) (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 -> forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Monoid a => a
mempty Text
"result" (forall s a. Const -> Expr s a
Const Const
Core.Type) (forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Monoid a => a
mempty Text
"Make" (forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Monoid a => a
mempty Text
"_" Expr Src Void
x Expr Src Void
"result") Expr Src Void
"result"))
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Expector (Expr Src Void)
Dhall.Marshal.Decode.expected (forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer :: Decoder (f (Result f)))

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



{-| 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 :: forall (a :: k).
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 <- 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 :: forall (a :: k).
Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (V1 a))
genericAutoWithNormalizer Proxy t
_ InputNormalizer
_ InterpretOptions
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure Decoder {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 = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

        expected :: Validation ExpectedTypeErrors (Expr s a)
expected = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union forall a. Monoid a => a
mempty

instance GenericFromDhallUnion t (f :+: g) => GenericFromDhall t (f :+: g) where
  genericAutoWithNormalizer :: forall (a :: k).
Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:+:) f g a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. UnionDecoder a -> Decoder a
union (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 :: forall (a :: k).
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 <- 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 :: forall (a :: k).
Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (U1 a))
genericAutoWithNormalizer Proxy t
_ InputNormalizer
_ InterpretOptions
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder {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 -> Extractor Src Void (U1 a)
..})
      where
        extract :: p -> f (U1 p)
extract p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
U1

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

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

instance (GenericFromDhall t (f :*: g), GenericFromDhall t (h :*: i)) => GenericFromDhall t ((f :*: g) :*: (h :*: i)) where
    genericAutoWithNormalizer :: forall (a :: k).
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 <- 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 <- 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 (:*:)" 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 (:*:)" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedR

        let expected :: Expector (Expr Src Void)
expected = forall s a. Map Text (RecordField s a) -> Expr s a
Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsL 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 =
                forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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)

        forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall (a :: k).
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 :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
..} = do
        let nR :: M1 S s (K1 i a) r
            nR :: forall {k} (r :: k). M1 S s (K1 i a) r
nR = forall a. HasCallStack => a
undefined

        Text
nameR <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> State Int Text
getSelName 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 <- 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 = 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 (:*:)" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedL

        let expected :: Expector (Expr Src Void)
expected = forall s a. Map Text (RecordField s a) -> Expr s a
Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedR 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 = 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 forall s a. RecordField s a -> Expr s a
Core.recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 ->
                                forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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)
                                    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

        forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall (a :: k).
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 :: forall {k} (r :: k). M1 S s (K1 i a) r
nL = forall a. HasCallStack => a
undefined

        Text
nameL <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> State Int Text
getSelName 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 = 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 <- 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 (:*:)" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedR

        let expected :: Expector (Expr Src Void)
expected = forall s a. Map Text (RecordField s a) -> Expr s a
Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedL 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 = 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 forall s a. RecordField s a -> Expr s a
Core.recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 ->
                                forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
                                    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

        forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall (a :: k).
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
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
_ -> forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall e. NonEmpty e -> DhallErrors e
DhallErrors forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeError
RecursiveTypeError
        , expected :: Expector (Expr Src Void)
expected = forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall e. NonEmpty e -> DhallErrors e
DhallErrors forall a b. (a -> b) -> a -> b
$ 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 :: forall (a :: k).
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
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
_ -> forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall e. NonEmpty e -> DhallErrors e
DhallErrors forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeError
RecursiveTypeError
        , expected :: Expector (Expr Src Void)
expected = forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall e. NonEmpty e -> DhallErrors e
DhallErrors forall a b. (a -> b) -> a -> b
$ 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 :: forall (a :: k).
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 :: forall {k} (r :: k). M1 S s1 (K1 i1 a1) r
nL = forall a. HasCallStack => a
undefined

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

        Text
nameL <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> State Int Text
getSelName forall {k} (r :: k). M1 S s1 (K1 i1 a1) r
nL)
        Text
nameR <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> State Int Text
getSelName 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 = 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 = forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
inputNormalizer

        let expected :: Expector (Expr Src Void)
expected = do
                RecordField Src Void
l <- forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedL
                RecordField Src Void
r <- forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedR
                pure $ forall s a. Map Text (RecordField s a) -> Expr s a
Record
                    (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 = 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 forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
nameL Map Text (RecordField Src Void)
kvs) (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) ->
                                forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
                                    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1) (Expr Src Void -> Extractor Src Void a1
extractL forall a b. (a -> b) -> a -> b
$ forall s a. RecordField s a -> Expr s a
Core.recordFieldValue RecordField Src Void
expressionL))
                                    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1) (Expr Src Void -> Extractor Src Void a2
extractR forall a b. (a -> b) -> a -> b
$ 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

        forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall (a :: k).
Proxy a
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (M1 S s (K1 i a) a))
genericAutoWithNormalizer Proxy a
_ InputNormalizer
_ InterpretOptions
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Decoder
        { extract :: Expr Src Void -> Extractor Src Void (M1 S s (K1 i a) a)
extract = \Expr Src Void
_ -> forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall e. NonEmpty e -> DhallErrors e
DhallErrors forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeError
RecursiveTypeError
        , expected :: Expector (Expr Src Void)
expected = forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall e. NonEmpty e -> DhallErrors e
DhallErrors forall a b. (a -> b) -> a -> b
$ 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 :: forall (a :: k).
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 :: forall {k} (r :: k). M1 S s (K1 i a) r
n = forall a. HasCallStack => a
undefined

        Text
name <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (forall (s :: Meta) i (f :: * -> *) a.
Selector s =>
M1 i s f a -> State Int Text
getSelName 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'} = 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 | forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName forall {k} (r :: k). M1 S s (K1 i a) r
n forall a. Eq a => a -> a -> Bool
== [Char]
"" ->
                        Expector (Expr Src Void)
expected'
                    SingletonConstructors
_ ->
                        forall s a. Map Text (RecordField s a) -> Expr s a
Record forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Expr s a -> RecordField s a
Core.makeRecordField 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 forall s a. RecordField s a -> Expr s a
Core.recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 ->
                                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 | forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName forall {k} (r :: k). M1 S s (K1 i a) r
n forall a. Eq a => a -> a -> Bool
== [Char]
"" -> 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

        forall (m :: * -> *) a. Monad m => a -> m a
return (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)
..})

{-| `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 :: forall a. (Generic a, GenericFromDhall a (Rep a)) => Decoder a
genericAuto = 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 :: forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> Decoder a
genericAutoWith InterpretOptions
options = forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> InputNormalizer -> Decoder a
genericAutoWithInputNormalizer InterpretOptions
options InputNormalizer
defaultInputNormalizer

{-| `genericAutoWithInputNormalizer` is like `genericAutoWith`, but instead of
    using the `defaultInputNormalizer` it expects an custom `InputNormalizer`.
-}
genericAutoWithInputNormalizer :: (Generic a, GenericFromDhall a (Rep a)) => InterpretOptions -> InputNormalizer -> Decoder a
genericAutoWithInputNormalizer :: forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> InputNormalizer -> Decoder a
genericAutoWithInputNormalizer InterpretOptions
options InputNormalizer
inputNormalizer = forall a. (Proxy a -> Decoder a) -> Decoder a
withProxy (\Proxy a
p -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a x. Generic a => Rep a x -> a
to (forall s a. State s a -> s -> a
evalState (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
inputNormalizer InterpretOptions
options) Int
1))
    where
        withProxy :: (Proxy a -> Decoder a) -> Decoder a
        withProxy :: forall a. (Proxy a -> Decoder a) -> Decoder a
withProxy Proxy a -> Decoder a
f = Proxy a -> Decoder a
f forall {k} (t :: k). Proxy t
Proxy

extractUnionConstructor
    :: Expr s a -> Maybe (Text, Expr s a, Dhall.Map.Map Text (Maybe (Expr s a)))
extractUnionConstructor :: forall s a.
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) (forall s. FieldSelection s -> Text
Core.fieldSelectionLabel -> Text
fld)) Expr s a
e) =
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
fld, Expr s a
e, 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) (forall s. FieldSelection s -> Text
Core.fieldSelectionLabel -> Text
fld)) =
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
fld, forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit forall a. Monoid a => a
mempty, 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
_ =
  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 :: forall (a :: k).
Proxy t
-> InputNormalizer
-> InterpretOptions
-> UnionDecoder ((:+:) f1 f2 a)
genericUnionAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options =
    forall a. Semigroup a => a -> a -> a
(<>)
      (forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
      (forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (a :: k).
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
..}) =
    forall a. Text -> Decoder a -> UnionDecoder a
constructor Text
name (forall s a. State s a -> s -> a
evalState (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 :: forall (a :: k). M1 C c1 f1 a
n = forall a. HasCallStack => a
undefined

      name :: Text
name = Text -> Text
constructorModifier ([Char] -> Text
Data.Text.pack (forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName forall (a :: k). M1 C c1 f1 a
n))



{-| Decode a `Prelude.Bool`.

>>> input bool "True"
True
-}
bool :: Decoder Bool
bool :: Decoder Bool
bool = Decoder {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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    extract Expr Src Void
expr        = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode a `Prelude.Natural`.

>>> input natural "42"
42
-}
natural :: Decoder Natural
natural :: Decoder Natural
natural = Decoder {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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
n
    extract  Expr Src Void
expr          = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode an `Prelude.Integer`.

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

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

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

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = 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 = 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 = 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 = 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 = forall a. (Bounded a, Integral a) => Text -> Decoder a
wordHelper Text
"Word64"

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

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = 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 = 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 = 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 = 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 = forall a. (Bounded a, Integral a) => Text -> Decoder a
intHelper Text
"Int64"

{-| Decode a `Scientific`.

>>> input scientific "1e100"
1.0e100
-}
scientific :: Decoder Scientific
scientific :: Decoder Scientific
scientific = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 {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)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
n
    extract  Expr Src Void
expr                       = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode a `Data.ByteString.Short.ShortByteString`

>>> input shortBytes "0x\"00FF\""
"\NUL\255"
-}
shortBytes :: Decoder Data.ByteString.Short.ShortByteString
shortBytes :: Decoder ShortByteString
shortBytes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ShortByteString
Data.ByteString.Short.toShort Decoder ByteString
strictBytes

{-| Decode a lazy `Data.ByteString.Lazy.ByteString`.

>>> input lazyBytes "0x\"00FF\""
"\NUL\255"
-}
lazyBytes :: Decoder Data.ByteString.Lazy.ByteString
lazyBytes :: Decoder ByteString
lazyBytes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
Data.ByteString.Lazy.fromStrict Decoder ByteString
strictBytes

{-| Decode a strict `Data.ByteString.ByteString`

>>> input strictBytes "0x\"00FF\""
"\NUL\255"
-}
strictBytes :: Decoder Data.ByteString.ByteString
strictBytes :: Decoder ByteString
strictBytes = Decoder {Expr Src Void -> Validation (ExtractErrors Src Void) ByteString
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) ByteString
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) ByteString
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) ByteString
extract (BytesLit ByteString
b) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
b
    extract  Expr Src Void
expr        = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode `Data.Text.Short.ShortText`.

>>> input shortText "\"Test\""
"Test"
-}
shortText :: Decoder Data.Text.Short.ShortText
shortText :: Decoder ShortText
shortText = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ShortText
Data.Text.Short.fromText Decoder Text
strictText

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

>>> input lazyText "\"Test\""
"Test"
-}
lazyText :: Decoder Data.Text.Lazy.Text
lazyText :: Decoder Text
lazyText = 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 {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)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
    extract  Expr Src Void
expr                   = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode `Time.TimeOfDay`

>>> input timeOfDay "00:00:00"
00:00:00
-}
timeOfDay :: Decoder Time.TimeOfDay
timeOfDay :: Decoder TimeOfDay
timeOfDay = Decoder {Expr Src Void -> Validation (ExtractErrors Src Void) TimeOfDay
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) TimeOfDay
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) TimeOfDay
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) TimeOfDay
extract (TimeLiteral TimeOfDay
t Word
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
t
    extract  Expr Src Void
expr             = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode `Time.Day`

>>> input day "2000-01-01"
2000-01-01
-}
day :: Decoder Time.Day
day :: Decoder Day
day = Decoder {Expr Src Void -> Validation (ExtractErrors Src Void) Day
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) Day
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Day
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Day
extract (DateLiteral Day
d) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
d
    extract  Expr Src Void
expr           = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode `Time.TimeZone`

>>> input timeZone "+00:00"
+0000
-}
timeZone :: Decoder Time.TimeZone
timeZone :: Decoder TimeZone
timeZone = Decoder {Expr Src Void -> Validation (ExtractErrors Src Void) TimeZone
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) TimeZone
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) TimeZone
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) TimeZone
extract (TimeZoneLiteral TimeZone
z) = forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeZone
z
    extract  Expr Src Void
expr               = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode `Time.LocalTime`

>>> input localTime "2020-01-01T12:34:56"
2020-01-01 12:34:56
-}
localTime :: Decoder Time.LocalTime
localTime :: Decoder LocalTime
localTime = forall a. RecordDecoder a -> Decoder a
record forall a b. (a -> b) -> a -> b
$
  Day -> TimeOfDay -> LocalTime
Time.LocalTime
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Decoder a -> RecordDecoder a
field Text
"date" Decoder Day
day
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Text -> Decoder a -> RecordDecoder a
field Text
"time" Decoder TimeOfDay
timeOfDay

{-| Decode `Time.ZonedTime`

>>> input zonedTime "2020-01-01T12:34:56+02:00"
2020-01-01 12:34:56 +0200
-}
zonedTime :: Decoder Time.ZonedTime
zonedTime :: Decoder ZonedTime
zonedTime = forall a. RecordDecoder a -> Decoder a
record forall a b. (a -> b) -> a -> b
$
  Day -> TimeOfDay -> TimeZone -> ZonedTime
adapt
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Decoder a -> RecordDecoder a
field Text
"date" Decoder Day
day
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Text -> Decoder a -> RecordDecoder a
field Text
"time" Decoder TimeOfDay
timeOfDay
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Text -> Decoder a -> RecordDecoder a
field Text
"timeZone" Decoder TimeZone
timeZone
  where
    adapt :: Day -> TimeOfDay -> TimeZone -> ZonedTime
adapt Day
date TimeOfDay
time = LocalTime -> TimeZone -> ZonedTime
Time.ZonedTime (Day -> TimeOfDay -> LocalTime
Time.LocalTime Day
date TimeOfDay
time)

{-| Decode `Time.UTCTime`

>>> input utcTime "2020-01-01T12:34:56+02:00"
2020-01-01 10:34:56 UTC
-}
utcTime :: Decoder Time.UTCTime
utcTime :: Decoder UTCTime
utcTime = ZonedTime -> UTCTime
Time.zonedTimeToUTC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder ZonedTime
zonedTime

{-| Decode `Time.DayOfWeek`

>>> input dayOfWeek "< Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday >.Monday"
Monday
-}
dayOfWeek :: Decoder Time.DayOfWeek
dayOfWeek :: Decoder DayOfWeek
dayOfWeek = Decoder{Expr Src Void -> Validation (ExtractErrors Src Void) DayOfWeek
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) DayOfWeek
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) DayOfWeek
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) DayOfWeek
extract expr :: Expr Src Void
expr@(Field Expr Src Void
_ FieldSelection{ Text
fieldSelectionLabel :: Text
fieldSelectionLabel :: forall s. FieldSelection s -> Text
fieldSelectionLabel }) =
        case Text
fieldSelectionLabel of
            Text
"Sunday"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Sunday
            Text
"Monday"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Monday
            Text
"Tuesday"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Tuesday
            Text
"Wednesday" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Wednesday
            Text
"Thursday"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Thursday
            Text
"Friday"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Friday
            Text
"Saturday"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Saturday
            Text
_           -> forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr
    extract Expr Src Void
expr =
        forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode a `Maybe`.

>>> input (maybe natural) "Some 1"
Just 1
-}
maybe :: Decoder a -> Decoder (Maybe a)
maybe :: forall a. Decoder a -> Decoder (Maybe a)
maybe (Decoder Expr Src Void -> Extractor Src Void a
extractIn Expector (Expr Src Void)
expectedIn) = forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Validation (ExtractErrors Src Void) (Maybe a)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Validation (ExtractErrors Src Void) (Maybe a)
extractOut (Some Expr Src Void
e    ) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    extractOut Expr Src Void
expr         = 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 = forall s a. Expr s a -> Expr s a -> Expr s a
App forall {s} {a}. Expr s a
Optional 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 :: forall a. Decoder a -> Decoder (Seq a)
sequence (Decoder Expr Src Void -> Extractor Src Void a
extractIn Expector (Expr Src Void)
expectedIn) = forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Validation (ExtractErrors Src Void) (Seq a)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Validation (ExtractErrors Src Void) (Seq a)
extractOut (ListLit Maybe (Expr Src Void)
_ Seq (Expr Src Void)
es) = 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           = 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 = forall s a. Expr s a -> Expr s a -> Expr s a
App forall {s} {a}. Expr s a
List 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 :: forall a. Decoder a -> Decoder [a]
list = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Decoder a -> Decoder (Vector a)
vector = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Vector a
Data.Vector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. Encoder a -> Decoder b -> Decoder (a -> b)
function = 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 :: forall a b.
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) =
    forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Validation (ExtractErrors Src Void) (a -> b)
extractOut Expector (Expr Src Void)
expectedOut
  where
    normalizer_ :: Maybe (ReifiedNormalizer Void)
normalizer_ = forall a. a -> Maybe a
Just (InputNormalizer -> ReifiedNormalizer Void
getInputNormalizer InputNormalizer
inputNormalizer)

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

    expectedOut :: Expector (Expr Src Void)
expectedOut = forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Monoid a => a
mempty Text
"_" Expr Src Void
declared 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 :: forall a. Ord a => Decoder a -> Decoder (Set a)
setIgnoringDuplicates = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Ord a => [a] -> Set a
Data.Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (Hashable a, Ord a) => Decoder a -> Decoder (HashSet a)
hashSetIgnoringDuplicates = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Hashable a) => [a] -> HashSet a
Data.HashSet.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. (Ord a, Show a) => Decoder a -> Decoder (Set a)
setFromDistinctList = forall a (t :: * -> *).
(Eq a, Foldable t, Show a) =>
(t a -> Int) -> ([a] -> t a) -> Decoder a -> Decoder (t a)
setHelper forall a. Set a -> Int
Data.Set.size 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 :: forall a.
(Hashable a, Ord a, Show a) =>
Decoder a -> Decoder (HashSet a)
hashSetFromDistinctList = forall a (t :: * -> *).
(Eq a, Foldable t, Show a) =>
(t a -> Int) -> ([a] -> t a) -> Decoder a -> Decoder (t a)
setHelper forall a. HashSet a -> Int
Data.HashSet.size 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 :: forall a (t :: * -> *).
(Eq a, Foldable t, Show a) =>
(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) = forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Validation (ExtractErrors Src Void) (t a)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Validation (ExtractErrors Src Void) (t a)
extractOut (ListLit Maybe (Expr Src Void)
_ Seq (Expr Src Void)
es) = case 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               -> forall e a. a -> Validation e a
Success t a
vSet
            | Bool
otherwise              -> forall s a b. Text -> Extractor s a b
extractError Text
err
          where
            vList :: [a]
vList = 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 forall a. Eq a => a -> a -> Bool
== forall a. Seq a -> Int
Data.Sequence.length Seq a
vSeq
            duplicates :: [a]
duplicates = [a]
vList forall a. Eq a => [a] -> [a] -> [a]
List.\\ forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList t a
vSet
            err :: Text
err | forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
duplicates forall a. Eq a => a -> a -> Bool
== Int
1 =
                     Text
"One duplicate element in the list: "
                     forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
Data.Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [a]
duplicates)
                | Bool
otherwise              = [Char] -> Text
Data.Text.pack forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords
                     [ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
duplicates
                     , [Char]
"duplicates were found in the list, including"
                     , forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [a]
duplicates
                     ]
        Failure ExtractErrors Src Void
f -> forall e a. e -> Validation e a
Failure ExtractErrors Src Void
f
    extractOut Expr Src Void
expr = 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 = forall s a. Expr s a -> Expr s a -> Expr s a
App forall {s} {a}. Expr s a
List 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 :: forall k v. Ord k => Decoder k -> Decoder v -> Decoder (Map k v)
map Decoder k
k Decoder v
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList (forall a. Decoder a -> Decoder [a]
list (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@.

>>> fmap (List.sort . HashMap.toList) (input (Dhall.hashMap strictText bool) "toMap { a = True, b = False }")
[("a",True),("b",False)]
>>> fmap (List.sort . HashMap.toList) (input (Dhall.hashMap strictText bool) "[ { mapKey = \"foo\", mapValue = True } ]")
[("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 :: forall k v.
(Eq k, Hashable k) =>
Decoder k -> Decoder v -> Decoder (HashMap k v)
hashMap Decoder k
k Decoder v
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (forall a. Decoder a -> Decoder [a]
list (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 :: forall k v. Decoder k -> Decoder v -> Decoder (k, v)
pairFromMapEntry Decoder k
k Decoder v
v = forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Validation (ExtractErrors Src Void) (k, v)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Validation (ExtractErrors Src Void) (k, v)
extractOut (RecordLit Map Text (RecordField Src Void)
kvs)
        | Just Expr Src Void
key <- forall s a. RecordField s a -> Expr s a
Core.recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall s a. RecordField s a -> Expr s a
Core.recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
"mapValue" Map Text (RecordField Src Void)
kvs
            = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract Decoder k
k Expr Src Void
key) (forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract Decoder v
v Expr Src Void
value)
    extractOut Expr Src Void
expr = 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' <- forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder k
k
        RecordField Src Void
v' <- forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder v
v
        pure $ forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
            [ (Text
"mapKey", 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 {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)
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.Foldable.null Map Text (RecordField Src Void)
fields = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    extract Expr Src Void
expr = forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError forall {s} {a}. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a. Monoid a => a
mempty

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

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

{-| Decode a `String`

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

-}
string :: Decoder String
string :: Decoder [Char]
string = Text -> [Char]
Data.Text.Lazy.unpack 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 :: forall k v. Decoder k -> Decoder v -> Decoder (k, v)
pair Decoder a
l Decoder b
r = forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder Expr Src Void -> Validation (ExtractErrors Src Void) (a, b)
extractOut Expector (Expr Src Void)
expectedOut
  where
    extractOut :: Expr Src Void -> Validation (ExtractErrors Src Void) (a, b)
extractOut expr :: Expr Src Void
expr@(RecordLit Map Text (RecordField Src Void)
fields) =
      (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (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) (forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract Decoder a
l)
                (forall s a. RecordField s a -> Expr s a
Core.recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
"_1" Map Text (RecordField Src Void)
fields)
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (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) (forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract Decoder b
r)
                (forall s a. RecordField s a -> Expr s a
Core.recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = 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' <- forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder a
l
        RecordField Src Void
r' <- forall s a. Expr s a -> RecordField s a
Core.makeRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder b
r
        pure $ forall s a. Map Text (RecordField s a) -> Expr s a
Record forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
            [ (Text
"_1", RecordField Src Void
l')
            , (Text
"_2", RecordField Src Void
r')]



{-| 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 (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
<$ :: forall a b. a -> RecordDecoder b -> RecordDecoder a
$c<$ :: forall a b. a -> RecordDecoder b -> RecordDecoder a
fmap :: forall a b. (a -> b) -> RecordDecoder a -> RecordDecoder b
$cfmap :: forall a b. (a -> b) -> RecordDecoder a -> RecordDecoder b
Functor, Functor RecordDecoder
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
<* :: forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder a
$c<* :: forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder a
*> :: forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder b
$c*> :: forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder b
liftA2 :: forall a b c.
(a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
<*> :: forall a b.
RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
$c<*> :: forall a b.
RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
pure :: forall a. a -> RecordDecoder a
$cpure :: forall a. a -> RecordDecoder a
Applicative)

-- | Run a 'RecordDecoder' to build a 'Decoder'.
record :: RecordDecoder a -> Dhall.Marshal.Decode.Decoder a
record :: forall a. 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 {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 = forall s a. Map Text (RecordField s a) -> Expr s a
Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 :: forall a. 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
..}) =
  forall a.
Product
  (Const (Map Text (Expector (Expr Src Void))))
  (Compose
     ((->) (Expr Src Void)) (Validation (ExtractErrors Src Void)))
  a
-> RecordDecoder a
RecordDecoder
    ( forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Data.Functor.Product.Pair
        ( forall {k} a (b :: k). a -> Const a b
Control.Applicative.Const
            (forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
key Expector (Expr Src Void)
expected)
        )
        ( 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 forall s a. RecordField s a -> Expr s a
Core.recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
_      -> 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 = 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 (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
<$ :: forall a b. a -> UnionDecoder b -> UnionDecoder a
$c<$ :: forall a b. a -> UnionDecoder b -> UnionDecoder a
fmap :: forall a b. (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
(<>) = coerce :: forall a b. Coercible a b => a -> b
coerce (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 = coerce :: forall a b. Coercible a b => a -> b
coerce (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 :: forall a. UnionDecoder a -> Decoder a
union (UnionDecoder (Data.Functor.Compose.Compose Map Text (Decoder a)
mp)) = 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 -> forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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' = forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (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) (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
Dhall.Marshal.Decode.extract) forall a b. (a -> b) -> a -> b
$ do
        (Text
fld, Expr Src Void
e1, Map Text (Maybe (Expr Src Void))
rest) <- 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 <- forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
fld Map Text (Decoder a)
mp

        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$
            forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Core.Union Map Text (Maybe (Expr Src Void))
rest forall a s t. Eq a => Expr s a -> Expr t a -> Bool
`Core.judgmentallyEqual` forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Core.Union (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 = forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union 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' = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Decoder a -> Expector (Expr Src Void)
Dhall.Marshal.Decode.expected) Map Text (Decoder a)
mp

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



{-| A newtype suitable for collecting one or more errors.
-}
newtype DhallErrors e = DhallErrors
   { forall e. DhallErrors e -> NonEmpty e
getErrors :: NonEmpty e
   } deriving (DhallErrors e -> DhallErrors e -> Bool
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, 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
<$ :: forall a b. a -> DhallErrors b -> DhallErrors a
$c<$ :: forall a b. a -> DhallErrors b -> DhallErrors a
fmap :: forall a b. (a -> b) -> DhallErrors a -> DhallErrors b
$cfmap :: forall a b. (a -> b) -> DhallErrors a -> DhallErrors b
Functor, NonEmpty (DhallErrors e) -> DhallErrors e
DhallErrors e -> DhallErrors e -> 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 :: forall b. Integral b => 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 :: forall e. Show e => [Char] -> DhallErrors e -> [Char]
showDhallErrors [Char]
_   (DhallErrors (e
e :| [])) = forall a. Show a => a -> [Char]
show e
e
showDhallErrors [Char]
ctx (DhallErrors NonEmpty e
es) = [Char]
prefix forall a. Semigroup a => a -> a -> a
<> ([[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
Data.List.NonEmpty.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ NonEmpty e
es)
  where
    prefix :: [Char]
prefix =
        [Char]
"Multiple errors were encountered" forall a. [a] -> [a] -> [a]
++ [Char]
ctx forall a. [a] -> [a] -> [a]
++ [Char]
": \n\
        \                                               \n"

{-| 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 -> [Char]
show = forall e. Show e => [Char] -> DhallErrors e -> [Char]
showDhallErrors [Char]
" 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
  deriving (ExtractError s a -> ExtractError s a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s a.
(Eq s, Eq a) =>
ExtractError s a -> ExtractError s a -> Bool
/= :: ExtractError s a -> ExtractError s a -> Bool
$c/= :: forall s a.
(Eq s, Eq a) =>
ExtractError s a -> ExtractError s a -> Bool
== :: ExtractError s a -> ExtractError s a -> Bool
$c== :: forall s a.
(Eq s, Eq a) =>
ExtractError s a -> ExtractError s a -> Bool
Eq)

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

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

{-| Useful synonym for the `Validation` type used when marshalling Dhall
    expressions.
-}
type Extractor s a = Validation (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 :: forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr s a)
expected Expr s a
actual = forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ case Expector (Expr s a)
expected of
    Failure ExpectedTypeErrors
e         -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeErrors
e
    Success Expr s a
expected' -> forall e. NonEmpty e -> DhallErrors e
DhallErrors forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s a. InvalidDecoder s a -> ExtractError s a
TypeMismatch forall a b. (a -> b) -> a -> b
$ 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 :: forall s a b. Text -> Extractor s a b
extractError = forall e a. e -> Validation e a
Failure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. NonEmpty e -> DhallErrors e
DhallErrors forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Text -> ExtractError s a
ExtractError

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

-- | 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 :: forall s a b. Extractor s a b -> MonadicExtractor s a b
toMonadic = 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 :: forall s a b. MonadicExtractor s a b -> Extractor s a b
fromMonadic = forall e a. Either e a -> Validation e a
eitherToValidation

{-| 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
  { forall s a. InvalidDecoder s a -> Expr s a
invalidDecoderExpected   :: Expr s a
  , forall s a. InvalidDecoder s a -> Expr s a
invalidDecoderExpression :: Expr s a
  }
  deriving (InvalidDecoder s a -> InvalidDecoder s a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s a.
(Eq s, Eq a) =>
InvalidDecoder s a -> InvalidDecoder s a -> Bool
/= :: InvalidDecoder s a -> InvalidDecoder s a -> Bool
$c/= :: forall s a.
(Eq s, Eq a) =>
InvalidDecoder s a -> InvalidDecoder s a -> Bool
== :: InvalidDecoder s a -> InvalidDecoder s a -> Bool
$c== :: forall s a.
(Eq s, Eq a) =>
InvalidDecoder s a -> InvalidDecoder s a -> Bool
Eq, Typeable)

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

instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (InvalidDecoder s a) where
    show :: InvalidDecoder s a -> [Char]
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
.. } =
        [Char]
_ERROR forall a. Semigroup a => a -> a -> a
<> [Char]
": Invalid Dhall.Decoder                                               \n\
        \                                                                                \n\
        \Every Decoder must provide an extract function that does not fail with a type   \n\
        \error if an expression matches the expected type.  You provided a Decoder that  \n\
        \disobeys this contract                                                          \n\
        \                                                                                \n\
        \The Decoder provided has the expected dhall type:                               \n\
        \                                                                                \n\
        \" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Doc Ann
txt0 forall a. Semigroup a => a -> a -> a
<> [Char]
"\n\
        \                                                                                \n\
        \and it threw a type error during extraction from the well-typed expression:     \n\
        \                                                                                \n\
        \" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Doc Ann
txt1 forall a. Semigroup a => a -> a -> a
<> [Char]
"\n\
        \                                                                                \n"
        where
          txt0 :: Doc Ann
txt0 = forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert Expr s a
invalidDecoderExpected
          txt1 :: Doc Ann
txt1 = forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert Expr s a
invalidDecoderExpression

{-| 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
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 -> ShowS
[ExpectedTypeError] -> ShowS
ExpectedTypeError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedTypeError] -> ShowS
$cshowList :: [ExpectedTypeError] -> ShowS
show :: ExpectedTypeError -> [Char]
$cshow :: ExpectedTypeError -> [Char]
showsPrec :: Int -> ExpectedTypeError -> ShowS
$cshowsPrec :: Int -> ExpectedTypeError -> ShowS
Show)

instance Exception ExpectedTypeError

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

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