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

{-| 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
_ = Decoder a
forall a. (Generic a, GenericFromDhall a (Rep a)) => Decoder a
genericAuto

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

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

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



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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance {-# OVERLAPS #-} FromDhall [Char] where
    autoWith :: InputNormalizer -> Decoder [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 (Maybe a) where
    autoWith :: InputNormalizer -> Decoder (Maybe a)
autoWith InputNormalizer
opts = Decoder a -> Decoder (Maybe a)
forall a. Decoder a -> Decoder (Maybe a)
maybe (InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts)

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

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

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

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 = Decoder a -> Decoder (Set a)
forall a. (Ord a, Show a) => Decoder a -> Decoder (Set a)
setFromDistinctList (InputNormalizer -> Decoder a
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts)

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

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

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

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

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

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

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

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 :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
..}
      where
        extract :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract Expr Src Void
expr0 = Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract0 Expr Src Void
expr0
          where
            die :: Validation (ExtractErrors Src Void) (Fix f)
die = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
expected Expr Src Void
expr0

            extract0 :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract0 (Lam 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 (Text -> Text -> Expr Src Void -> Expr Src Void
forall s a. Text -> Text -> Expr s a -> Expr s a
rename Text
x Text
"result" Expr Src Void
expr)
            extract0  Expr Src Void
_             = Validation (ExtractErrors Src Void) (Fix f)
die

            extract1 :: Expr Src Void -> Validation (ExtractErrors Src Void) (Fix f)
extract1 (Lam 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 (Text -> Text -> Expr Src Void -> Expr Src Void
forall s a. Text -> Text -> Expr s a -> Expr s a
rename Text
y Text
"Make" Expr Src Void
expr)
            extract1  Expr Src Void
_             = Validation (ExtractErrors Src Void) (Fix f)
die

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

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

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

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



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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance (GenericFromDhall t (f :*: g), Selector s, FromDhall a) => GenericFromDhall t ((f :*: g) :*: M1 S s (K1 i a)) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer options :: InterpretOptions
options@InterpretOptions{SingletonConstructors
Text -> Text
singletonConstructors :: 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 :: M1 S s (K1 i a) r
nR = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined

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

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

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

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

        let expected :: Expector (Expr Src Void)
expected = Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField Src Void) -> Expr Src Void)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
-> RecordField Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameR (RecordField Src Void
 -> Map Text (RecordField Src Void)
 -> Map Text (RecordField Src Void))
-> (Expr Src Void -> RecordField Src Void)
-> Expr Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void
 -> Map Text (RecordField Src Void)
 -> Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
-> Validation
     ExpectedTypeErrors
     (Map Text (RecordField Src Void)
      -> Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedR Validation
  ExpectedTypeErrors
  (Map Text (RecordField Src Void)
   -> Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsL)

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

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

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

instance (Selector s, FromDhall a, GenericFromDhall t (f :*: g)) => GenericFromDhall t (M1 S s (K1 i a) :*: (f :*: g)) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer options :: InterpretOptions
options@InterpretOptions{SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..} = do
        let nL :: M1 S s (K1 i a) r
            nL :: M1 S s (K1 i a) r
nL = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined

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

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

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

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

        let expected :: Expector (Expr Src Void)
expected = Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField Src Void) -> Expr Src Void)
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
-> RecordField Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameL (RecordField Src Void
 -> Map Text (RecordField Src Void)
 -> Map Text (RecordField Src Void))
-> (Expr Src Void -> RecordField Src Void)
-> Expr Src Void
-> Map Text (RecordField Src Void)
-> Map Text (RecordField Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void
 -> Map Text (RecordField Src Void)
 -> Map Text (RecordField Src Void))
-> Expector (Expr Src Void)
-> Validation
     ExpectedTypeErrors
     (Map Text (RecordField Src Void)
      -> Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedL Validation
  ExpectedTypeErrors
  (Map Text (RecordField Src Void)
   -> Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
-> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Validation ExpectedTypeErrors (Map Text (RecordField Src Void))
ktsR)

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

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

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

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

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

instance {-# OVERLAPPABLE #-} (Selector s1, Selector s2, FromDhall a1, FromDhall a2) => GenericFromDhall t (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State
     Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
genericAutoWithNormalizer Proxy t
_ InputNormalizer
inputNormalizer InterpretOptions{SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..} = do
        let nL :: M1 S s1 (K1 i1 a1) r
            nL :: M1 S s1 (K1 i1 a1) r
nL = M1 S s1 (K1 i1 a1) r
forall a. HasCallStack => a
undefined

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

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

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

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

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

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

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

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

instance {-# OVERLAPPABLE #-} (Selector s, FromDhall a) => GenericFromDhall t (M1 S s (K1 i a)) where
    genericAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (M1 S s (K1 i a) a))
genericAutoWithNormalizer Proxy t
_ InputNormalizer
inputNormalizer InterpretOptions{SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..} = do
        let n :: M1 S s (K1 i a) r
            n :: M1 S s (K1 i a) r
n = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined

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

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

        let expected :: Expector (Expr Src Void)
expected =
                case SingletonConstructors
singletonConstructors of
                    SingletonConstructors
Bare ->
                        Expector (Expr Src Void)
expected'
                    SingletonConstructors
Smart | M1 S s (K1 i a) Any -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"" ->
                        Expector (Expr Src Void)
expected'
                    SingletonConstructors
_ ->
                        Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField Src Void) -> Expr Src Void)
-> (Expr Src Void -> Map Text (RecordField Src Void))
-> Expr Src Void
-> Expr Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RecordField Src Void -> Map Text (RecordField Src Void)
forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name (RecordField Src Void -> Map Text (RecordField Src Void))
-> (Expr Src Void -> RecordField Src Void)
-> Expr Src Void
-> Map Text (RecordField Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expected'

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

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

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

        let extract :: Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract =
                case SingletonConstructors
singletonConstructors of
                    SingletonConstructors
Bare                    -> Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract0
                    SingletonConstructors
Smart | M1 S s (K1 i a) Any -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n [Char] -> [Char] -> Bool
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

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

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

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

extractUnionConstructor
    :: Expr s a -> Maybe (Text, Expr s a, Dhall.Map.Map Text (Maybe (Expr s a)))
extractUnionConstructor :: Expr s a -> Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
extractUnionConstructor (App (Field (Union Map Text (Maybe (Expr s a))
kts) (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Core.fieldSelectionLabel -> Text
fld)) Expr s a
e) =
  (Text, Expr s a, Map Text (Maybe (Expr s a)))
-> Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
fld, Expr s a
e, Text -> Map Text (Maybe (Expr s a)) -> Map Text (Maybe (Expr s a))
forall k v. Ord k => k -> Map k v -> Map k v
Dhall.Map.delete Text
fld Map Text (Maybe (Expr s a))
kts)
extractUnionConstructor (Field (Union Map Text (Maybe (Expr s a))
kts) (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Core.fieldSelectionLabel -> Text
fld)) =
  (Text, Expr s a, Map Text (Maybe (Expr s a)))
-> Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
fld, Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit Map Text (RecordField s a)
forall a. Monoid a => a
mempty, Text -> Map Text (Maybe (Expr s a)) -> Map Text (Maybe (Expr s a))
forall k v. Ord k => k -> Map k v -> Map k v
Dhall.Map.delete Text
fld Map Text (Maybe (Expr s a))
kts)
extractUnionConstructor Expr s a
_ =
  Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
forall (f :: * -> *) a. Alternative f => f a
empty

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

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

instance (Constructor c1, GenericFromDhall t f1) => GenericFromDhallUnion t (M1 C c1 f1) where
  genericUnionAutoWithNormalizer :: Proxy t
-> InputNormalizer
-> InterpretOptions
-> UnionDecoder (M1 C c1 f1 a)
genericUnionAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer options :: InterpretOptions
options@(InterpretOptions {SingletonConstructors
Text -> Text
singletonConstructors :: SingletonConstructors
constructorModifier :: Text -> Text
fieldModifier :: Text -> Text
singletonConstructors :: InterpretOptions -> SingletonConstructors
constructorModifier :: InterpretOptions -> Text -> Text
fieldModifier :: InterpretOptions -> Text -> Text
..}) =
    Text -> Decoder (M1 C c1 f1 a) -> UnionDecoder (M1 C c1 f1 a)
forall a. Text -> Decoder a -> UnionDecoder a
constructor Text
name (State Int (Decoder (M1 C c1 f1 a)) -> Int -> Decoder (M1 C c1 f1 a)
forall s a. State s a -> s -> a
evalState (Proxy t
-> InputNormalizer
-> InterpretOptions
-> State Int (Decoder (M1 C c1 f1 a))
forall k k (t :: k) (f :: k -> *) (a :: k).
GenericFromDhall t f =>
Proxy t
-> InputNormalizer -> InterpretOptions -> State Int (Decoder (f a))
genericAutoWithNormalizer Proxy t
p InputNormalizer
inputNormalizer InterpretOptions
options) Int
1)
    where
      n :: M1 C c1 f1 a
      n :: M1 C c1 f1 a
n = M1 C c1 f1 a
forall a. HasCallStack => a
undefined

      name :: Text
name = Text -> Text
constructorModifier ([Char] -> Text
Data.Text.pack (M1 C c1 f1 Any -> [Char]
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName M1 C c1 f1 Any
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 :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) Bool
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected :: forall s a. Validation ExpectedTypeErrors (Expr s a)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Bool
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Bool
..}
  where
    extract :: Expr Src Void -> Validation (ExtractErrors Src Void) Bool
extract (BoolLit Bool
b) = Bool -> Validation (ExtractErrors Src Void) Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
    extract Expr Src Void
expr        = Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) Bool
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode a `Prelude.Natural`.

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

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

{-| Decode an `Prelude.Integer`.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{-| Decode a `Scientific`.

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

{-| Decode a `Prelude.Double`.

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

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

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

>>> input shortText "\"Test\""
"Test"
-}
shortText :: Decoder Data.Text.Short.ShortText
shortText :: Decoder ShortText
shortText = (Text -> ShortText) -> Decoder Text -> Decoder 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.Text`.

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

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

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

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

{-| Decode `Time.TimeOfDay`

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

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

{-| Decode `Time.Day`

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

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

{-| Decode `Time.TimeZone`

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

    expected :: Validation ExpectedTypeErrors (Expr s a)
expected = Expr s a -> Validation ExpectedTypeErrors (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr s a
forall s a. Expr s a
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 = RecordDecoder LocalTime -> Decoder LocalTime
forall a. RecordDecoder a -> Decoder a
record (RecordDecoder LocalTime -> Decoder LocalTime)
-> RecordDecoder LocalTime -> Decoder LocalTime
forall a b. (a -> b) -> a -> b
$
  Day -> TimeOfDay -> LocalTime
Time.LocalTime
    (Day -> TimeOfDay -> LocalTime)
-> RecordDecoder Day -> RecordDecoder (TimeOfDay -> LocalTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Decoder Day -> RecordDecoder Day
forall a. Text -> Decoder a -> RecordDecoder a
field Text
"date" Decoder Day
day
    RecordDecoder (TimeOfDay -> LocalTime)
-> RecordDecoder TimeOfDay -> RecordDecoder LocalTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Decoder TimeOfDay -> RecordDecoder TimeOfDay
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 = RecordDecoder ZonedTime -> Decoder ZonedTime
forall a. RecordDecoder a -> Decoder a
record (RecordDecoder ZonedTime -> Decoder ZonedTime)
-> RecordDecoder ZonedTime -> Decoder ZonedTime
forall a b. (a -> b) -> a -> b
$
  Day -> TimeOfDay -> TimeZone -> ZonedTime
adapt
    (Day -> TimeOfDay -> TimeZone -> ZonedTime)
-> RecordDecoder Day
-> RecordDecoder (TimeOfDay -> TimeZone -> ZonedTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Decoder Day -> RecordDecoder Day
forall a. Text -> Decoder a -> RecordDecoder a
field Text
"date" Decoder Day
day
    RecordDecoder (TimeOfDay -> TimeZone -> ZonedTime)
-> RecordDecoder TimeOfDay -> RecordDecoder (TimeZone -> ZonedTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Decoder TimeOfDay -> RecordDecoder TimeOfDay
forall a. Text -> Decoder a -> RecordDecoder a
field Text
"time" Decoder TimeOfDay
timeOfDay
    RecordDecoder (TimeZone -> ZonedTime)
-> RecordDecoder TimeZone -> RecordDecoder ZonedTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Decoder TimeZone -> RecordDecoder TimeZone
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 (ZonedTime -> UTCTime) -> Decoder ZonedTime -> Decoder UTCTime
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 :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder{Expector (Expr Src Void)
Expr Src Void -> Validation (ExtractErrors Src Void) 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"    -> DayOfWeek -> Validation (ExtractErrors Src Void) DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Sunday
            Text
"Monday"    -> DayOfWeek -> Validation (ExtractErrors Src Void) DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Monday
            Text
"Tuesday"   -> DayOfWeek -> Validation (ExtractErrors Src Void) DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Tuesday
            Text
"Wednesday" -> DayOfWeek -> Validation (ExtractErrors Src Void) DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Wednesday
            Text
"Thursday"  -> DayOfWeek -> Validation (ExtractErrors Src Void) DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Thursday
            Text
"Friday"    -> DayOfWeek -> Validation (ExtractErrors Src Void) DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Friday
            Text
"Saturday"  -> DayOfWeek -> Validation (ExtractErrors Src Void) DayOfWeek
forall (f :: * -> *) a. Applicative f => a -> f a
pure DayOfWeek
Time.Saturday
            Text
_           -> Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) DayOfWeek
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr
    extract Expr Src Void
expr =
        Expector (Expr Src Void)
-> Expr Src Void -> Validation (ExtractErrors Src Void) DayOfWeek
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr Src Void)
forall s a. Validation ExpectedTypeErrors (Expr s a)
expected Expr Src Void
expr

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

{-| Decode a `Maybe`.

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

    expectedOut :: Expector (Expr Src Void)
expectedOut = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
Optional (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedIn

{-| Decode a `Seq`.

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

    expectedOut :: Expector (Expr Src Void)
expectedOut = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
List (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedIn

{-| Decode a list.

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

{-| Decode a `Vector`.

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

{-| Decode a Dhall function into a Haskell function.

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

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

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

    extractOut :: Expr Src Void -> Extractor Src Void (a -> b)
extractOut Expr Src Void
e = (a -> b) -> Extractor Src Void (a -> b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\a
i -> case Expr Src Void -> Extractor Src Void b
extractIn (Maybe (ReifiedNormalizer Void) -> Expr Src Void -> Expr Src Void
forall a s t.
Eq a =>
Maybe (ReifiedNormalizer a) -> Expr s a -> Expr t a
Core.normalizeWith Maybe (ReifiedNormalizer Void)
normalizer_ (Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
e (a -> Expr Src Void
embed a
i))) of
        Success b
o  -> b
o
        Failure ExtractErrors Src Void
_e -> [Char] -> b
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 = Maybe CharacterSet
-> Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
forall a. Monoid a => a
mempty Text
"_" Expr Src Void
declared (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedIn

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

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

Duplicate elements are ignored.

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

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

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

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

Duplicate elements are ignored.

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

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

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

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

An error is thrown if the list contains duplicates.

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

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

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

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

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

An error is thrown if the list contains duplicates.

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

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

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


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

    expectedOut :: Expector (Expr Src Void)
expectedOut = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
List (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
expectedIn

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

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

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

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

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

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

>>> 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 :: Decoder k -> Decoder v -> Decoder (HashMap k v)
hashMap Decoder k
k Decoder v
v = ([(k, v)] -> HashMap k v)
-> Decoder [(k, v)] -> Decoder (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (Decoder (k, v) -> Decoder [(k, v)]
forall a. Decoder a -> Decoder [a]
list (Decoder k -> Decoder v -> Decoder (k, v)
forall k v. Decoder k -> Decoder v -> Decoder (k, v)
pairFromMapEntry Decoder k
k Decoder v
v))

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

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

    expectedOut :: Expector (Expr Src Void)
expectedOut = do
        RecordField Src Void
k' <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder k -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder k
k
        RecordField Src Void
v' <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder v -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder v
v
        pure $ Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField Src Void) -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ [(Text, RecordField Src Void)] -> Map Text (RecordField Src Void)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
            [ (Text
"mapKey", RecordField Src Void
k')
            , (Text
"mapValue", RecordField Src Void
v')]

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

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

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

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

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

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

{-| Decode a `String`

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

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

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

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

    expectedOut :: Expector (Expr Src Void)
expectedOut = do
        RecordField Src Void
l' <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder a
l
        RecordField Src Void
r' <- Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Expr Src Void -> RecordField Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder b -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder b
r
        pure $ Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField Src Void) -> Expr Src Void)
-> Map Text (RecordField Src Void) -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ [(Text, RecordField Src Void)] -> Map Text (RecordField Src Void)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
            [ (Text
"_1", RecordField Src Void
l')
            , (Text
"_2", RecordField Src Void
r')]



{-| The 'RecordDecoder' applicative functor allows you to build a 'Decoder'
    from a Dhall record.

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

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

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

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

    Our decoder has type 'Decoder' @Project@, but we can't build that out of any
    smaller decoders, as 'Decoder's cannot be combined (they are only 'Functor's).
    However, we can use a 'RecordDecoder' to build a 'Decoder' for @Project@:

>>> :{
project :: Decoder Project
project =
  record
    ( Project <$> field "name" strictText
              <*> field "description" strictText
              <*> field "stars" natural
    )
:}
-}
newtype RecordDecoder a =
  RecordDecoder
    ( Data.Functor.Product.Product
        ( Control.Applicative.Const
            (Dhall.Map.Map Text (Expector (Expr Src Void)))
        )
        ( Data.Functor.Compose.Compose ((->) (Expr Src Void)) (Extractor Src Void)
        )
        a
    )
  deriving (a -> RecordDecoder b -> RecordDecoder a
(a -> b) -> RecordDecoder a -> RecordDecoder b
(forall a b. (a -> b) -> RecordDecoder a -> RecordDecoder b)
-> (forall a b. a -> RecordDecoder b -> RecordDecoder a)
-> Functor RecordDecoder
forall a b. a -> RecordDecoder b -> RecordDecoder a
forall a b. (a -> b) -> RecordDecoder a -> RecordDecoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RecordDecoder b -> RecordDecoder a
$c<$ :: forall a b. a -> RecordDecoder b -> RecordDecoder a
fmap :: (a -> b) -> RecordDecoder a -> RecordDecoder b
$cfmap :: forall a b. (a -> b) -> RecordDecoder a -> RecordDecoder b
Functor, Functor RecordDecoder
a -> RecordDecoder a
Functor RecordDecoder
-> (forall a. a -> RecordDecoder a)
-> (forall a b.
    RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b)
-> (forall a b c.
    (a -> b -> c)
    -> RecordDecoder a -> RecordDecoder b -> RecordDecoder c)
-> (forall a b.
    RecordDecoder a -> RecordDecoder b -> RecordDecoder b)
-> (forall a b.
    RecordDecoder a -> RecordDecoder b -> RecordDecoder a)
-> Applicative RecordDecoder
RecordDecoder a -> RecordDecoder b -> RecordDecoder b
RecordDecoder a -> RecordDecoder b -> RecordDecoder a
RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
(a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
forall a. a -> RecordDecoder a
forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder a
forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder b
forall a b.
RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
forall a b c.
(a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: RecordDecoder a -> RecordDecoder b -> RecordDecoder a
$c<* :: forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder a
*> :: RecordDecoder a -> RecordDecoder b -> RecordDecoder b
$c*> :: forall a b. RecordDecoder a -> RecordDecoder b -> RecordDecoder b
liftA2 :: (a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> RecordDecoder a -> RecordDecoder b -> RecordDecoder c
<*> :: RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
$c<*> :: forall a b.
RecordDecoder (a -> b) -> RecordDecoder a -> RecordDecoder b
pure :: a -> RecordDecoder a
$cpure :: forall a. a -> RecordDecoder a
$cp1Applicative :: Functor RecordDecoder
Applicative)

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

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



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

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

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

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

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

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

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

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

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

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

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

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

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

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

        pure (Decoder a
t, Expr Src Void
e1)

    expected :: Expector (Expr Src Void)
expected = Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (Map Text (Maybe (Expr Src Void)) -> Expr Src Void)
-> Validation ExpectedTypeErrors (Map Text (Maybe (Expr Src Void)))
-> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation ExpectedTypeErrors (Map Text (Maybe (Expr Src Void)))
expected'

    expected' :: Validation ExpectedTypeErrors (Map Text (Maybe (Expr Src Void)))
expected' = (Decoder a
 -> Validation ExpectedTypeErrors (Maybe (Expr Src Void)))
-> Map Text (Decoder a)
-> Validation ExpectedTypeErrors (Map Text (Maybe (Expr Src Void)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr Src Void -> Maybe (Expr Src Void))
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (Maybe (Expr Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord (Expector (Expr Src Void)
 -> Validation ExpectedTypeErrors (Maybe (Expr Src Void)))
-> (Decoder a -> Expector (Expr Src Void))
-> Decoder a
-> Validation ExpectedTypeErrors (Maybe (Expr Src Void))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
Dhall.Marshal.Decode.expected) Map Text (Decoder a)
mp

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



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

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

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

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)      = InvalidDecoder s a -> [Char]
forall a. Show a => a -> [Char]
show InvalidDecoder s a
e
  show (ExpectedTypeError ExpectedTypeError
e) = ExpectedTypeError -> [Char]
forall a. Show a => a -> [Char]
show ExpectedTypeError
e
  show (ExtractError Text
es)     =
      [Char]
_ERROR [Char] -> [Char] -> [Char]
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\
      \" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Data.Text.unpack Text
es [Char] -> [Char] -> [Char]
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 :: Expector (Expr s a) -> Expr s a -> Extractor s a b
typeError Expector (Expr s a)
expected Expr s a
actual = DhallErrors (ExtractError s a) -> Extractor s a b
forall e a. e -> Validation e a
Failure (DhallErrors (ExtractError s a) -> Extractor s a b)
-> DhallErrors (ExtractError s a) -> Extractor s a b
forall a b. (a -> b) -> a -> b
$ case Expector (Expr s a)
expected of
    Failure ExpectedTypeErrors
e         -> (ExpectedTypeError -> ExtractError s a)
-> ExpectedTypeErrors -> DhallErrors (ExtractError s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExpectedTypeError -> ExtractError s a
forall s a. ExpectedTypeError -> ExtractError s a
ExpectedTypeError ExpectedTypeErrors
e
    Success Expr s a
expected' -> NonEmpty (ExtractError s a) -> DhallErrors (ExtractError s a)
forall e. NonEmpty e -> DhallErrors e
DhallErrors (NonEmpty (ExtractError s a) -> DhallErrors (ExtractError s a))
-> NonEmpty (ExtractError s a) -> DhallErrors (ExtractError s a)
forall a b. (a -> b) -> a -> b
$ ExtractError s a -> NonEmpty (ExtractError s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtractError s a -> NonEmpty (ExtractError s a))
-> ExtractError s a -> NonEmpty (ExtractError s a)
forall a b. (a -> b) -> a -> b
$ InvalidDecoder s a -> ExtractError s a
forall s a. InvalidDecoder s a -> ExtractError s a
TypeMismatch (InvalidDecoder s a -> ExtractError s a)
-> InvalidDecoder s a -> ExtractError s a
forall a b. (a -> b) -> a -> b
$ Expr s a -> Expr s a -> InvalidDecoder s a
forall s a. Expr s a -> Expr s a -> InvalidDecoder s a
InvalidDecoder Expr s a
expected' Expr s a
actual

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

{-| Useful synonym for the 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 :: Extractor s a b -> MonadicExtractor s a b
toMonadic = Extractor s a b -> MonadicExtractor s a b
forall e a. Validation e a -> Either e a
validationToEither

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

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

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

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

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 [Char] -> [Char] -> [Char]
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\
        \" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> [Char]
forall a. Show a => a -> [Char]
show Doc Ann
txt0 [Char] -> [Char] -> [Char]
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\
        \" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> [Char]
forall a. Show a => a -> [Char]
show Doc Ann
txt1 [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n\
        \                                                                                \n"
        where
          txt0 :: Doc Ann
txt0 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert Expr s a
invalidDecoderExpected
          txt1 :: Doc Ann
txt1 = Expr s a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert Expr s a
invalidDecoderExpression

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

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

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

instance Exception ExpectedTypeError

instance Show ExpectedTypeErrors where
    show :: ExpectedTypeErrors -> [Char]
show = [Char] -> ExpectedTypeErrors -> [Char]
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"