{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
module Dhall
(
input
, inputWithSettings
, inputFile
, inputFileWithSettings
, inputExpr
, inputExprWithSettings
, rootDirectory
, sourceName
, startingContext
, substitutions
, normalizer
, defaultInputSettings
, InputSettings
, defaultEvaluateSettings
, EvaluateSettings
, HasEvaluateSettings
, detailed
, Decoder (..)
, RecordDecoder(..)
, UnionDecoder(..)
, Encoder(..)
, FromDhall(..)
, Interpret
, InvalidDecoder(..)
, ExtractErrors(..)
, Extractor
, MonadicExtractor
, typeError
, extractError
, toMonadic
, fromMonadic
, auto
, genericAuto
, InterpretOptions(..)
, SingletonConstructors(..)
, defaultInterpretOptions
, bool
, natural
, integer
, scientific
, double
, lazyText
, strictText
, maybe
, sequence
, list
, vector
, function
, setFromDistinctList
, setIgnoringDuplicates
, hashSetFromDistinctList
, hashSetIgnoringDuplicates
, Dhall.map
, hashMap
, pairFromMapEntry
, unit
, void
, string
, pair
, record
, field
, union
, constructor
, GenericFromDhall(..)
, GenericToDhall(..)
, ToDhall(..)
, Inject
, inject
, genericToDhall
, RecordEncoder(..)
, encodeFieldWith
, encodeField
, recordEncoder
, UnionEncoder(..)
, encodeConstructorWith
, encodeConstructor
, unionEncoder
, (>|<)
, rawInput
, (>$<)
, (>*<)
, Natural
, Seq
, Text
, Vector
, Generic
) where
import Control.Applicative (empty, liftA2, Alternative)
import Control.Exception (Exception)
import Control.Monad.Trans.State.Strict
import Control.Monad (guard)
import Data.Coerce (coerce)
import Data.Either.Validation (Validation(..), ealt, eitherToValidation, validationToEither)
import Data.Fix (Fix(..))
import Data.Functor.Contravariant (Contravariant(..), (>$<), Op(..))
import Data.Functor.Contravariant.Divisible (Divisible(..), divided)
import Data.Hashable (Hashable)
import Data.List.NonEmpty (NonEmpty (..))
import Data.HashMap.Strict (HashMap)
import Data.Map (Map)
import Data.Monoid ((<>))
import Data.Scientific (Scientific)
import Data.Semigroup (Semigroup)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Pretty)
import Data.Typeable (Typeable)
import Data.Vector (Vector)
import Data.Void (Void)
import Data.Word (Word8, Word16, Word32, Word64)
import Dhall.Syntax (Expr(..), Chunks(..), DhallDouble(..))
import Dhall.Import (Imported(..))
import Dhall.Parser (Src(..))
import Dhall.TypeCheck (DetailedTypeError(..), TypeError)
import GHC.Generics
import Lens.Family (LensLike', view)
import Numeric.Natural (Natural)
import Prelude hiding (maybe, sequence)
import System.FilePath (takeDirectory)
import qualified Control.Applicative
import qualified Control.Exception
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.Foldable
import qualified Data.Functor.Compose
import qualified Data.Functor.Product
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map
import qualified Data.Maybe
import qualified Data.List
import qualified Data.List.NonEmpty
import qualified Data.Semigroup
import qualified Data.Scientific
import qualified Data.Sequence
import qualified Data.Set
import qualified Data.HashSet
import qualified Data.Text
import qualified Data.Text.IO
import qualified Data.Text.Lazy
import qualified Data.Vector
import qualified Data.Void
import qualified Dhall.Context
import qualified Dhall.Core
import qualified Dhall.Import
import qualified Dhall.Map
import qualified Dhall.Parser
import qualified Dhall.Pretty.Internal
import qualified Dhall.Substitution
import qualified Dhall.TypeCheck
import qualified Dhall.Util
import qualified Lens.Family
type s a = Validation (ExtractErrors s a)
type s a = Either (ExtractErrors s a)
typeError :: Expr s a -> Expr s a -> Extractor s a b
typeError :: Expr s a -> Expr s a -> Extractor s a b
typeError expected :: Expr s a
expected actual :: Expr s a
actual =
ExtractErrors s a -> Extractor s a b
forall e a. e -> Validation e a
Failure (ExtractErrors s a -> Extractor s a b)
-> (InvalidDecoder s a -> ExtractErrors s a)
-> InvalidDecoder s a
-> Extractor s a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (ExtractError s a) -> ExtractErrors s a
forall s a. NonEmpty (ExtractError s a) -> ExtractErrors s a
ExtractErrors (NonEmpty (ExtractError s a) -> ExtractErrors s a)
-> (InvalidDecoder s a -> NonEmpty (ExtractError s a))
-> InvalidDecoder s a
-> ExtractErrors 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))
-> (InvalidDecoder s a -> ExtractError s a)
-> InvalidDecoder s a
-> NonEmpty (ExtractError s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidDecoder s a -> ExtractError s a
forall s a. InvalidDecoder s a -> ExtractError s a
TypeMismatch (InvalidDecoder s a -> Extractor s a b)
-> InvalidDecoder s a -> Extractor s a b
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
extractError :: Text -> Extractor s a b
= ExtractErrors s a -> Extractor s a b
forall e a. e -> Validation e a
Failure (ExtractErrors s a -> Extractor s a b)
-> (Text -> ExtractErrors s a) -> Text -> Extractor s a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (ExtractError s a) -> ExtractErrors s a
forall s a. NonEmpty (ExtractError s a) -> ExtractErrors s a
ExtractErrors (NonEmpty (ExtractError s a) -> ExtractErrors s a)
-> (Text -> NonEmpty (ExtractError s a))
-> Text
-> ExtractErrors 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
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
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
newtype s a =
{ ExtractErrors s a -> NonEmpty (ExtractError s a)
getErrors :: NonEmpty (ExtractError s a)
} deriving b -> ExtractErrors s a -> ExtractErrors s a
NonEmpty (ExtractErrors s a) -> ExtractErrors s a
ExtractErrors s a -> ExtractErrors s a -> ExtractErrors s a
(ExtractErrors s a -> ExtractErrors s a -> ExtractErrors s a)
-> (NonEmpty (ExtractErrors s a) -> ExtractErrors s a)
-> (forall b.
Integral b =>
b -> ExtractErrors s a -> ExtractErrors s a)
-> Semigroup (ExtractErrors s a)
forall b. Integral b => b -> ExtractErrors s a -> ExtractErrors s a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall s a. NonEmpty (ExtractErrors s a) -> ExtractErrors s a
forall s a.
ExtractErrors s a -> ExtractErrors s a -> ExtractErrors s a
forall s a b.
Integral b =>
b -> ExtractErrors s a -> ExtractErrors s a
stimes :: b -> ExtractErrors s a -> ExtractErrors s a
$cstimes :: forall s a b.
Integral b =>
b -> ExtractErrors s a -> ExtractErrors s a
sconcat :: NonEmpty (ExtractErrors s a) -> ExtractErrors s a
$csconcat :: forall s a. NonEmpty (ExtractErrors s a) -> ExtractErrors s a
<> :: ExtractErrors s a -> ExtractErrors s a -> ExtractErrors s a
$c<> :: forall s a.
ExtractErrors s a -> ExtractErrors s a -> ExtractErrors s a
Semigroup
instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (ExtractErrors s a) where
show :: ExtractErrors s a -> String
show (ExtractErrors (e :: ExtractError s a
e :| [])) = ExtractError s a -> String
forall a. Show a => a -> String
show ExtractError s a
e
show (ExtractErrors es :: NonEmpty (ExtractError s a)
es) = String
prefix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ([String] -> String
unlines ([String] -> String)
-> (NonEmpty (ExtractError s a) -> [String])
-> NonEmpty (ExtractError s a)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
Data.List.NonEmpty.toList (NonEmpty String -> [String])
-> (NonEmpty (ExtractError s a) -> NonEmpty String)
-> NonEmpty (ExtractError s a)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExtractError s a -> String)
-> NonEmpty (ExtractError s a) -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExtractError s a -> String
forall a. Show a => a -> String
show (NonEmpty (ExtractError s a) -> String)
-> NonEmpty (ExtractError s a) -> String
forall a b. (a -> b) -> a -> b
$ NonEmpty (ExtractError s a)
es)
where
prefix :: String
prefix =
"Multiple errors were encountered during extraction: \n\
\ \n"
instance (Pretty s, Pretty a, Typeable s, Typeable a) => Exception (ExtractErrors s a)
data s a =
TypeMismatch (InvalidDecoder s a)
| Text
instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (ExtractError s a) where
show :: ExtractError s a -> String
show (TypeMismatch e :: InvalidDecoder s a
e) = InvalidDecoder s a -> String
forall a. Show a => a -> String
show InvalidDecoder s a
e
show (ExtractError es :: Text
es) =
String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ": Failed extraction \n\
\ \n\
\The expression type-checked successfully but the transformation to the target \n\
\type failed with the following error: \n\
\ \n\
\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Data.Text.unpack Text
es String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "\n\
\ \n"
instance (Pretty s, Pretty a, Typeable s, Typeable a) => Exception (ExtractError s a)
data InvalidDecoder s a = InvalidDecoder
{ InvalidDecoder s a -> Expr s a
invalidDecoderExpected :: Expr s a
, InvalidDecoder s a -> Expr s a
invalidDecoderExpression :: Expr s a
}
deriving (Typeable)
instance (Pretty s, Typeable s, Pretty a, Typeable a) => Exception (InvalidDecoder s a)
_ERROR :: String
_ERROR :: String
_ERROR = "\ESC[1;31mError\ESC[0m"
instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (InvalidDecoder s a) where
show :: InvalidDecoder s a -> String
show InvalidDecoder { .. } =
String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ": Invalid Dhall.Decoder \n\
\ \n\
\Every Decoder must provide an extract function that succeeds if an expression \n\
\matches the expected type. You provided a Decoder that disobeys this contract \n\
\ \n\
\The Decoder provided has the expected dhall type: \n\
\ \n\
\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> String
forall a. Show a => a -> String
show Doc Ann
txt0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "\n\
\ \n\
\and it couldn't extract a value from the well-typed expression: \n\
\ \n\
\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Doc Ann -> String
forall a. Show a => a -> String
show Doc Ann
txt1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "\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
data InputSettings = InputSettings
{ InputSettings -> String
_rootDirectory :: FilePath
, InputSettings -> String
_sourceName :: FilePath
, InputSettings -> EvaluateSettings
_evaluateSettings :: EvaluateSettings
}
defaultInputSettings :: InputSettings
defaultInputSettings :: InputSettings
defaultInputSettings = InputSettings :: String -> String -> EvaluateSettings -> InputSettings
InputSettings
{ _rootDirectory :: String
_rootDirectory = "."
, _sourceName :: String
_sourceName = "(input)"
, _evaluateSettings :: EvaluateSettings
_evaluateSettings = EvaluateSettings
defaultEvaluateSettings
}
rootDirectory
:: (Functor f)
=> LensLike' f InputSettings FilePath
rootDirectory :: LensLike' f InputSettings String
rootDirectory k :: String -> f String
k s :: InputSettings
s =
(String -> InputSettings) -> f String -> f InputSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: String
x -> InputSettings
s { _rootDirectory :: String
_rootDirectory = String
x }) (String -> f String
k (InputSettings -> String
_rootDirectory InputSettings
s))
sourceName
:: (Functor f)
=> LensLike' f InputSettings FilePath
sourceName :: LensLike' f InputSettings String
sourceName k :: String -> f String
k s :: InputSettings
s =
(String -> InputSettings) -> f String -> f InputSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: String
x -> InputSettings
s { _sourceName :: String
_sourceName = String
x}) (String -> f String
k (InputSettings -> String
_sourceName InputSettings
s))
data EvaluateSettings = EvaluateSettings
{ EvaluateSettings -> Substitutions Src Void
_substitutions :: Dhall.Substitution.Substitutions Src Void
, EvaluateSettings -> Context (Expr Src Void)
_startingContext :: Dhall.Context.Context (Expr Src Void)
, EvaluateSettings -> Maybe (ReifiedNormalizer Void)
_normalizer :: Maybe (Dhall.Core.ReifiedNormalizer Void)
}
defaultEvaluateSettings :: EvaluateSettings
defaultEvaluateSettings :: EvaluateSettings
defaultEvaluateSettings = EvaluateSettings :: Substitutions Src Void
-> Context (Expr Src Void)
-> Maybe (ReifiedNormalizer Void)
-> EvaluateSettings
EvaluateSettings
{ _substitutions :: Substitutions Src Void
_substitutions = Substitutions Src Void
forall s a. Substitutions s a
Dhall.Substitution.empty
, _startingContext :: Context (Expr Src Void)
_startingContext = Context (Expr Src Void)
forall a. Context a
Dhall.Context.empty
, _normalizer :: Maybe (ReifiedNormalizer Void)
_normalizer = Maybe (ReifiedNormalizer Void)
forall a. Maybe a
Nothing
}
startingContext
:: (Functor f, HasEvaluateSettings s)
=> LensLike' f s (Dhall.Context.Context (Expr Src Void))
startingContext :: LensLike' f s (Context (Expr Src Void))
startingContext = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((Context (Expr Src Void) -> f (Context (Expr Src Void)))
-> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (Context (Expr Src Void))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context (Expr Src Void) -> f (Context (Expr Src Void)))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (Context (Expr Src Void))
l
where
l :: (Functor f)
=> LensLike' f EvaluateSettings (Dhall.Context.Context (Expr Src Void))
l :: LensLike' f EvaluateSettings (Context (Expr Src Void))
l k :: Context (Expr Src Void) -> f (Context (Expr Src Void))
k s :: EvaluateSettings
s = (Context (Expr Src Void) -> EvaluateSettings)
-> f (Context (Expr Src Void)) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: Context (Expr Src Void)
x -> EvaluateSettings
s { _startingContext :: Context (Expr Src Void)
_startingContext = Context (Expr Src Void)
x}) (Context (Expr Src Void) -> f (Context (Expr Src Void))
k (EvaluateSettings -> Context (Expr Src Void)
_startingContext EvaluateSettings
s))
substitutions
:: (Functor f, HasEvaluateSettings s)
=> LensLike' f s (Dhall.Substitution.Substitutions Src Void)
substitutions :: LensLike' f s (Substitutions Src Void)
substitutions = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((Substitutions Src Void -> f (Substitutions Src Void))
-> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (Substitutions Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Substitutions Src Void -> f (Substitutions Src Void))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (Substitutions Src Void)
l
where
l :: (Functor f)
=> LensLike' f EvaluateSettings (Dhall.Substitution.Substitutions Src Void)
l :: LensLike' f EvaluateSettings (Substitutions Src Void)
l k :: Substitutions Src Void -> f (Substitutions Src Void)
k s :: EvaluateSettings
s = (Substitutions Src Void -> EvaluateSettings)
-> f (Substitutions Src Void) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: Substitutions Src Void
x -> EvaluateSettings
s { _substitutions :: Substitutions Src Void
_substitutions = Substitutions Src Void
x }) (Substitutions Src Void -> f (Substitutions Src Void)
k (EvaluateSettings -> Substitutions Src Void
_substitutions EvaluateSettings
s))
normalizer
:: (Functor f, HasEvaluateSettings s)
=> LensLike' f s (Maybe (Dhall.Core.ReifiedNormalizer Void))
normalizer :: LensLike' f s (Maybe (ReifiedNormalizer Void))
normalizer = LensLike' f s EvaluateSettings
forall s (f :: * -> *).
(HasEvaluateSettings s, Functor f) =>
LensLike' f s EvaluateSettings
evaluateSettings LensLike' f s EvaluateSettings
-> ((Maybe (ReifiedNormalizer Void)
-> f (Maybe (ReifiedNormalizer Void)))
-> EvaluateSettings -> f EvaluateSettings)
-> LensLike' f s (Maybe (ReifiedNormalizer Void))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ReifiedNormalizer Void)
-> f (Maybe (ReifiedNormalizer Void)))
-> EvaluateSettings -> f EvaluateSettings
forall (f :: * -> *).
Functor f =>
LensLike' f EvaluateSettings (Maybe (ReifiedNormalizer Void))
l
where
l :: (Functor f)
=> LensLike' f EvaluateSettings (Maybe (Dhall.Core.ReifiedNormalizer Void))
l :: LensLike' f EvaluateSettings (Maybe (ReifiedNormalizer Void))
l k :: Maybe (ReifiedNormalizer Void)
-> f (Maybe (ReifiedNormalizer Void))
k s :: EvaluateSettings
s = (Maybe (ReifiedNormalizer Void) -> EvaluateSettings)
-> f (Maybe (ReifiedNormalizer Void)) -> f EvaluateSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: Maybe (ReifiedNormalizer Void)
x -> EvaluateSettings
s { _normalizer :: Maybe (ReifiedNormalizer Void)
_normalizer = Maybe (ReifiedNormalizer Void)
x }) (Maybe (ReifiedNormalizer Void)
-> f (Maybe (ReifiedNormalizer Void))
k (EvaluateSettings -> Maybe (ReifiedNormalizer Void)
_normalizer EvaluateSettings
s))
class HasEvaluateSettings s where
evaluateSettings
:: (Functor f)
=> LensLike' f s EvaluateSettings
instance HasEvaluateSettings InputSettings where
evaluateSettings :: LensLike' f InputSettings EvaluateSettings
evaluateSettings k :: EvaluateSettings -> f EvaluateSettings
k s :: InputSettings
s =
(EvaluateSettings -> InputSettings)
-> f EvaluateSettings -> f InputSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: EvaluateSettings
x -> InputSettings
s { _evaluateSettings :: EvaluateSettings
_evaluateSettings = EvaluateSettings
x }) (EvaluateSettings -> f EvaluateSettings
k (InputSettings -> EvaluateSettings
_evaluateSettings InputSettings
s))
instance HasEvaluateSettings EvaluateSettings where
evaluateSettings :: LensLike' f EvaluateSettings EvaluateSettings
evaluateSettings = LensLike' f EvaluateSettings EvaluateSettings
forall a. a -> a
id
input
:: Decoder a
-> Text
-> IO a
input :: Decoder a -> Text -> IO a
input =
InputSettings -> Decoder a -> Text -> IO a
forall a. InputSettings -> Decoder a -> Text -> IO a
inputWithSettings InputSettings
defaultInputSettings
inputWithSettings
:: InputSettings
-> Decoder a
-> Text
-> IO a
inputWithSettings :: InputSettings -> Decoder a -> Text -> IO a
inputWithSettings settings :: InputSettings
settings (Decoder {..}) txt :: Text
txt = do
let suffix :: Text
suffix = Expr Src Void -> Text
forall a. Pretty a => a -> Text
Dhall.Pretty.Internal.prettyToStrictText Expr Src Void
expected
let annotate :: Expr Src Void -> Expr Src Void
annotate substituted :: Expr Src Void
substituted = case Expr Src Void
substituted of
Note (Src begin :: SourcePos
begin end :: SourcePos
end bytes :: Text
bytes) _ ->
Src -> Expr Src Void -> Expr Src Void
forall s a. s -> Expr s a -> Expr s a
Note (SourcePos -> SourcePos -> Text -> Src
Src SourcePos
begin SourcePos
end Text
bytes') (Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src Void
substituted Expr Src Void
expected)
where
bytes' :: Text
bytes' = Text
bytes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
_ ->
Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src Void
substituted Expr Src Void
expected
Expr Src Void
normExpr <- (Expr Src Void -> Expr Src Void)
-> InputSettings -> Text -> IO (Expr Src Void)
inputHelper Expr Src Void -> Expr Src Void
annotate InputSettings
settings Text
txt
case Expr Src Void -> Extractor Src Void a
extract Expr Src Void
normExpr of
Success x :: a
x -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Failure e :: ExtractErrors Src Void
e -> ExtractErrors Src Void -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO ExtractErrors Src Void
e
inputFile
:: Decoder a
-> FilePath
-> IO a
inputFile :: Decoder a -> String -> IO a
inputFile =
EvaluateSettings -> Decoder a -> String -> IO a
forall a. EvaluateSettings -> Decoder a -> String -> IO a
inputFileWithSettings EvaluateSettings
defaultEvaluateSettings
inputFileWithSettings
:: EvaluateSettings
-> Decoder a
-> FilePath
-> IO a
inputFileWithSettings :: EvaluateSettings -> Decoder a -> String -> IO a
inputFileWithSettings settings :: EvaluateSettings
settings ty :: Decoder a
ty path :: String
path = do
Text
text <- String -> IO Text
Data.Text.IO.readFile String
path
let inputSettings :: InputSettings
inputSettings = InputSettings :: String -> String -> EvaluateSettings -> InputSettings
InputSettings
{ _rootDirectory :: String
_rootDirectory = ShowS
takeDirectory String
path
, _sourceName :: String
_sourceName = String
path
, _evaluateSettings :: EvaluateSettings
_evaluateSettings = EvaluateSettings
settings
}
InputSettings -> Decoder a -> Text -> IO a
forall a. InputSettings -> Decoder a -> Text -> IO a
inputWithSettings InputSettings
inputSettings Decoder a
ty Text
text
inputExpr
:: Text
-> IO (Expr Src Void)
inputExpr :: Text -> IO (Expr Src Void)
inputExpr =
InputSettings -> Text -> IO (Expr Src Void)
inputExprWithSettings InputSettings
defaultInputSettings
inputExprWithSettings
:: InputSettings
-> Text
-> IO (Expr Src Void)
inputExprWithSettings :: InputSettings -> Text -> IO (Expr Src Void)
inputExprWithSettings = (Expr Src Void -> Expr Src Void)
-> InputSettings -> Text -> IO (Expr Src Void)
inputHelper Expr Src Void -> Expr Src Void
forall a. a -> a
id
inputHelper
:: (Expr Src Void -> Expr Src Void)
-> InputSettings
-> Text
-> IO (Expr Src Void)
inputHelper :: (Expr Src Void -> Expr Src Void)
-> InputSettings -> Text -> IO (Expr Src Void)
inputHelper annotate :: Expr Src Void -> Expr Src Void
annotate settings :: InputSettings
settings txt :: Text
txt = do
Expr Src Import
expr <- Either ParseError (Expr Src Import) -> IO (Expr Src Import)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (String -> Text -> Either ParseError (Expr Src Import)
Dhall.Parser.exprFromText (FoldLike String InputSettings InputSettings String String
-> InputSettings -> String
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike String InputSettings InputSettings String String
forall (f :: * -> *). Functor f => LensLike' f InputSettings String
sourceName InputSettings
settings) Text
txt)
let InputSettings {..} = InputSettings
settings
let EvaluateSettings {..} = EvaluateSettings
_evaluateSettings
let transform :: Status -> Status
transform =
ASetter
Status Status (Substitutions Src Void) (Substitutions Src Void)
-> Substitutions Src Void -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.Family.set ASetter
Status Status (Substitutions Src Void) (Substitutions Src Void)
forall (f :: * -> *).
Functor f =>
LensLike' f Status (Substitutions Src Void)
Dhall.Import.substitutions Substitutions Src Void
_substitutions
(Status -> Status) -> (Status -> Status) -> Status -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
Status
Status
(Maybe (ReifiedNormalizer Void))
(Maybe (ReifiedNormalizer Void))
-> Maybe (ReifiedNormalizer Void) -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.Family.set ASetter
Status
Status
(Maybe (ReifiedNormalizer Void))
(Maybe (ReifiedNormalizer Void))
forall (f :: * -> *).
Functor f =>
LensLike' f Status (Maybe (ReifiedNormalizer Void))
Dhall.Import.normalizer Maybe (ReifiedNormalizer Void)
_normalizer
(Status -> Status) -> (Status -> Status) -> Status -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
Status Status (Context (Expr Src Void)) (Context (Expr Src Void))
-> Context (Expr Src Void) -> Status -> Status
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.Family.set ASetter
Status Status (Context (Expr Src Void)) (Context (Expr Src Void))
forall (f :: * -> *).
Functor f =>
LensLike' f Status (Context (Expr Src Void))
Dhall.Import.startingContext Context (Expr Src Void)
_startingContext
let status :: Status
status = Status -> Status
transform (String -> Status
Dhall.Import.emptyStatus String
_rootDirectory)
Expr Src Void
expr' <- StateT Status IO (Expr Src Void) -> Status -> IO (Expr Src Void)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (Expr Src Import -> StateT Status IO (Expr Src Void)
Dhall.Import.loadWith Expr Src Import
expr) Status
status
let substituted :: Expr Src Void
substituted = Expr Src Void -> Substitutions Src Void -> Expr Src Void
forall s a. Expr s a -> Substitutions s a -> Expr s a
Dhall.Substitution.substitute Expr Src Void
expr' (Substitutions Src Void -> Expr Src Void)
-> Substitutions Src Void -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ FoldLike
(Substitutions Src Void)
InputSettings
InputSettings
(Substitutions Src Void)
(Substitutions Src Void)
-> InputSettings -> Substitutions Src Void
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
(Substitutions Src Void)
InputSettings
InputSettings
(Substitutions Src Void)
(Substitutions Src Void)
forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Substitutions Src Void)
substitutions InputSettings
settings
let annot :: Expr Src Void
annot = Expr Src Void -> Expr Src Void
annotate Expr Src Void
substituted
Expr Src Void
_ <- Either (TypeError Src Void) (Expr Src Void) -> IO (Expr Src Void)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Dhall.Core.throws (Context (Expr Src Void)
-> Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
forall s.
Context (Expr s Void)
-> Expr s Void -> Either (TypeError s Void) (Expr s Void)
Dhall.TypeCheck.typeWith (FoldLike
(Context (Expr Src Void))
InputSettings
InputSettings
(Context (Expr Src Void))
(Context (Expr Src Void))
-> InputSettings -> Context (Expr Src Void)
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
(Context (Expr Src Void))
InputSettings
InputSettings
(Context (Expr Src Void))
(Context (Expr Src Void))
forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Context (Expr Src Void))
startingContext InputSettings
settings) Expr Src Void
annot)
Expr Src Void -> IO (Expr Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ReifiedNormalizer Void) -> Expr Src Void -> Expr Src Void
forall a s t.
Eq a =>
Maybe (ReifiedNormalizer a) -> Expr s a -> Expr t a
Dhall.Core.normalizeWith (FoldLike
(Maybe (ReifiedNormalizer Void))
InputSettings
InputSettings
(Maybe (ReifiedNormalizer Void))
(Maybe (ReifiedNormalizer Void))
-> InputSettings -> Maybe (ReifiedNormalizer Void)
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike
(Maybe (ReifiedNormalizer Void))
InputSettings
InputSettings
(Maybe (ReifiedNormalizer Void))
(Maybe (ReifiedNormalizer Void))
forall (f :: * -> *) s.
(Functor f, HasEvaluateSettings s) =>
LensLike' f s (Maybe (ReifiedNormalizer Void))
normalizer InputSettings
settings) Expr Src Void
substituted)
rawInput
:: Alternative f
=> Decoder a
-> Expr s Void
-> f a
rawInput :: Decoder a -> Expr s Void -> f a
rawInput (Decoder {..}) expr :: Expr s Void
expr = do
case Expr Src Void -> Extractor Src Void a
extract (Expr s Void -> Expr Src Void
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.Core.normalize Expr s Void
expr) of
Success x :: a
x -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
Failure _e :: ExtractErrors Src Void
_e -> f a
forall (f :: * -> *) a. Alternative f => f a
empty
detailed :: IO a -> IO a
detailed :: IO a -> IO a
detailed =
(TypeError Src Void -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle TypeError Src Void -> IO a
forall a. TypeError Src Void -> IO a
handler1 (IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Imported (TypeError Src Void) -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle Imported (TypeError Src Void) -> IO a
forall a. Imported (TypeError Src Void) -> IO a
handler0
where
handler0 :: Imported (TypeError Src Void) -> IO a
handler0 :: Imported (TypeError Src Void) -> IO a
handler0 (Imported ps :: NonEmpty Chained
ps e :: TypeError Src Void
e) =
Imported (DetailedTypeError Src Void) -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (NonEmpty Chained
-> DetailedTypeError Src Void
-> Imported (DetailedTypeError Src Void)
forall e. NonEmpty Chained -> e -> Imported e
Imported NonEmpty Chained
ps (TypeError Src Void -> DetailedTypeError Src Void
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError TypeError Src Void
e))
handler1 :: TypeError Src Void -> IO a
handler1 :: TypeError Src Void -> IO a
handler1 e :: TypeError Src Void
e = DetailedTypeError Src Void -> IO a
forall e a. Exception e => e -> IO a
Control.Exception.throwIO (TypeError Src Void -> DetailedTypeError Src Void
forall s a. TypeError s a -> DetailedTypeError s a
DetailedTypeError TypeError Src Void
e)
data Decoder a = Decoder
{ :: Expr Src Void -> Extractor Src Void a
, Decoder a -> Expr Src Void
expected :: Expr Src Void
}
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)
bool :: Decoder Bool
bool :: Decoder Bool
bool = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder {..}
where
extract :: Expr s a -> Validation (ExtractErrors s a) Bool
extract (BoolLit b :: Bool
b) = Bool -> Validation (ExtractErrors s a) Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
extract expr :: Expr s a
expr = Expr s a -> Expr s a -> Validation (ExtractErrors s a) Bool
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr s a
forall s a. Expr s a
expected Expr s a
expr
expected :: Expr s a
expected = Expr s a
forall s a. Expr s a
Bool
natural :: Decoder Natural
natural :: Decoder Natural
natural = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder {..}
where
extract :: Expr s a -> Validation (ExtractErrors s a) Natural
extract (NaturalLit n :: Natural
n) = Natural -> Validation (ExtractErrors s a) Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure Natural
n
extract expr :: Expr s a
expr = Expr s a -> Expr s a -> Validation (ExtractErrors s a) Natural
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr s a
forall s a. Expr s a
Natural Expr s a
expr
expected :: Expr s a
expected = Expr s a
forall s a. Expr s a
Natural
integer :: Decoder Integer
integer :: Decoder Integer
integer = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder {..}
where
extract :: Expr s a -> Validation (ExtractErrors s a) Integer
extract (IntegerLit n :: Integer
n) = Integer -> Validation (ExtractErrors s a) Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
n
extract expr :: Expr s a
expr = Expr s a -> Expr s a -> Validation (ExtractErrors s a) Integer
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr s a
forall s a. Expr s a
Integer Expr s a
expr
expected :: Expr s a
expected = Expr s a
forall s a. Expr s a
Integer
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
double :: Decoder Double
double :: Decoder Double
double = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder {..}
where
extract :: Expr s a -> Validation (ExtractErrors s a) Double
extract (DoubleLit (DhallDouble n :: Double
n)) = Double -> Validation (ExtractErrors s a) Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
n
extract expr :: Expr s a
expr = Expr s a -> Expr s a -> Validation (ExtractErrors s a) Double
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr s a
forall s a. Expr s a
Double Expr s a
expr
expected :: Expr s a
expected = Expr s a
forall s a. Expr s a
Double
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
strictText :: Decoder Text
strictText :: Decoder Text
strictText = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder {..}
where
extract :: Expr s a -> Validation (ExtractErrors s a) Text
extract (TextLit (Chunks [] t :: Text
t)) = Text -> Validation (ExtractErrors s a) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
extract expr :: Expr s a
expr = Expr s a -> Expr s a -> Validation (ExtractErrors s a) Text
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr s a
forall s a. Expr s a
Text Expr s a
expr
expected :: Expr s a
expected = Expr s a
forall s a. Expr s a
Text
maybe :: Decoder a -> Decoder (Maybe a)
maybe :: Decoder a -> Decoder (Maybe a)
maybe (Decoder extractIn :: Expr Src Void -> Extractor Src Void a
extractIn expectedIn :: Expr Src Void
expectedIn) = (Expr Src Void -> Extractor Src Void (Maybe a))
-> Expr Src Void -> Decoder (Maybe a)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (Maybe a)
extractOut Expr Src Void
expectedOut
where
extractOut :: Expr Src Void -> Extractor Src Void (Maybe a)
extractOut (Some e :: 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 None _) = 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 :: Expr Src Void
expr = Expr Src Void -> Expr Src Void -> Extractor Src Void (Maybe a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expectedOut Expr Src Void
expr
expectedOut :: 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
expectedIn
sequence :: Decoder a -> Decoder (Seq a)
sequence :: Decoder a -> Decoder (Seq a)
sequence (Decoder extractIn :: Expr Src Void -> Extractor Src Void a
extractIn expectedIn :: Expr Src Void
expectedIn) = (Expr Src Void -> Extractor Src Void (Seq a))
-> Expr Src Void -> Decoder (Seq a)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (Seq a)
extractOut Expr Src Void
expectedOut
where
extractOut :: Expr Src Void -> Extractor Src Void (Seq a)
extractOut (ListLit _ es :: 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 :: Expr Src Void
expr = Expr Src Void -> Expr Src Void -> Extractor Src Void (Seq a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expectedOut Expr Src Void
expr
expectedOut :: 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
expectedIn
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
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
function
:: InterpretOptions
-> Encoder a
-> Decoder b
-> Decoder (a -> b)
function :: InterpretOptions -> Encoder a -> Decoder b -> Decoder (a -> b)
function options :: InterpretOptions
options (Encoder {..}) (Decoder extractIn :: Expr Src Void -> Extractor Src Void b
extractIn expectedIn :: Expr Src Void
expectedIn) =
(Expr Src Void -> Extractor Src Void (a -> b))
-> Expr Src Void -> Decoder (a -> b)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (a -> b)
extractOut Expr Src Void
expectedOut
where
normalizer_ :: Maybe (ReifiedNormalizer Void)
normalizer_ = ReifiedNormalizer Void -> Maybe (ReifiedNormalizer Void)
forall a. a -> Maybe a
Just (InterpretOptions -> ReifiedNormalizer Void
inputNormalizer InterpretOptions
options)
extractOut :: Expr Src Void -> Extractor Src Void (a -> b)
extractOut e :: Expr Src Void
e = (a -> b) -> Extractor Src Void (a -> b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\i :: 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
Dhall.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 o :: b
o -> b
o
Failure _e :: ExtractErrors Src Void
_e -> String -> b
forall a. HasCallStack => String -> a
error "FromDhall: You cannot decode a function if it does not have the correct type" )
expectedOut :: Expr Src Void
expectedOut = Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi "_" Expr Src Void
declared Expr Src Void
expectedIn
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
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
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
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 size :: t a -> Int
size toSet :: [a] -> t a
toSet (Decoder extractIn :: Expr Src Void -> Extractor Src Void a
extractIn expectedIn :: Expr Src Void
expectedIn) = (Expr Src Void -> Extractor Src Void (t a))
-> Expr Src Void -> Decoder (t a)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (t a)
extractOut Expr Src Void
expectedOut
where
extractOut :: Expr Src Void -> Extractor Src Void (t a)
extractOut (ListLit _ es :: 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 vSeq :: Seq a
vSeq
| Bool
sameSize -> t a -> Extractor Src Void (t a)
forall e a. a -> Validation e a
Success t a
vSet
| Bool
otherwise -> Text -> Extractor Src Void (t a)
forall s a b. Text -> Extractor s a b
extractError Text
err
where
vList :: [a]
vList = Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Seq a
vSeq
vSet :: t a
vSet = [a] -> t a
toSet [a]
vList
sameSize :: Bool
sameSize = t a -> Int
size t a
vSet Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq a -> Int
forall a. Seq a -> Int
Data.Sequence.length Seq a
vSeq
duplicates :: [a]
duplicates = [a]
vList [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
Data.List.\\ t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList t a
vSet
err :: Text
err | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
duplicates Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 =
"One duplicate element in the list: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
Data.Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
head [a]
duplicates)
| Bool
otherwise = String -> Text
Data.Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
[ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
duplicates
, "duplicates were found in the list, including"
, a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
head [a]
duplicates
]
Failure f :: 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 :: Expr Src Void
expr = Expr Src Void -> Expr Src Void -> Extractor Src Void (t a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expectedOut Expr Src Void
expr
expectedOut :: 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
expectedIn
map :: Ord k => Decoder k -> Decoder v -> Decoder (Map k v)
map :: Decoder k -> Decoder v -> Decoder (Map k v)
map k :: Decoder k
k v :: 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))
hashMap :: (Eq k, Hashable k) => Decoder k -> Decoder v -> Decoder (HashMap k v)
hashMap :: Decoder k -> Decoder v -> Decoder (HashMap k v)
hashMap k :: Decoder k
k v :: 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))
pairFromMapEntry :: Decoder k -> Decoder v -> Decoder (k, v)
pairFromMapEntry :: Decoder k -> Decoder v -> Decoder (k, v)
pairFromMapEntry k :: Decoder k
k v :: Decoder v
v = (Expr Src Void -> Extractor Src Void (k, v))
-> Expr Src Void -> Decoder (k, v)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (k, v)
extractOut Expr Src Void
expectedOut
where
extractOut :: Expr Src Void -> Extractor Src Void (k, v)
extractOut (RecordLit kvs :: Substitutions Src Void
kvs)
| Just key :: Expr Src Void
key <- Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup "mapKey" Substitutions Src Void
kvs
, Just value :: Expr Src Void
value <- Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup "mapValue" Substitutions 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 :: Expr Src Void
expr = Expr Src Void -> Expr Src Void -> Extractor Src Void (k, v)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expectedOut Expr Src Void
expr
expectedOut :: Expr Src Void
expectedOut = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record ([(Text, Expr Src Void)] -> Substitutions Src Void
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [("mapKey", Decoder k -> Expr Src Void
forall a. Decoder a -> Expr Src Void
expected Decoder k
k), ("mapValue", Decoder v -> Expr Src Void
forall a. Decoder a -> Expr Src Void
expected Decoder v
v)])
unit :: Decoder ()
unit :: Decoder ()
unit = (Expr Src Void -> Extractor Src Void ())
-> Expr Src Void -> Decoder ()
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder Expr Src Void -> Extractor Src Void ()
forall s a. Expr s a -> Validation (ExtractErrors s a) ()
extractOut Expr Src Void
forall s a. Expr s a
expectedOut
where
extractOut :: Expr s a -> Validation (ExtractErrors s a) ()
extractOut (RecordLit fields :: Map Text (Expr s a)
fields)
| Map Text (Expr s a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Data.Foldable.null Map Text (Expr s a)
fields = () -> Validation (ExtractErrors s a) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
extractOut expr :: Expr s a
expr = Expr s a -> Expr s a -> Validation (ExtractErrors s a) ()
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError (Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
Record Map Text (Expr s a)
forall a. Monoid a => a
mempty) Expr s a
expr
expectedOut :: Expr s a
expectedOut = Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
Record Map Text (Expr s a)
forall a. Monoid a => a
mempty
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
string :: Decoder String
string :: Decoder String
string = Text -> String
Data.Text.Lazy.unpack (Text -> String) -> Decoder Text -> Decoder String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Text
lazyText
pair :: Decoder a -> Decoder b -> Decoder (a, b)
pair :: Decoder a -> Decoder b -> Decoder (a, b)
pair l :: Decoder a
l r :: Decoder b
r = (Expr Src Void -> Extractor Src Void (a, b))
-> Expr Src Void -> Decoder (a, b)
forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder Expr Src Void -> Extractor Src Void (a, b)
extractOut Expr Src Void
expectedOut
where
extractOut :: Expr Src Void -> Extractor Src Void (a, b)
extractOut expr :: Expr Src Void
expr@(RecordLit fields :: Substitutions 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 (Expr Src Void
-> Expr Src Void -> Validation (ExtractErrors Src Void) a
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError 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) (Maybe (Expr Src Void) -> Validation (ExtractErrors Src Void) a)
-> Maybe (Expr Src Void) -> Validation (ExtractErrors Src Void) a
forall a b. (a -> b) -> a -> b
$ Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup "_1" Substitutions 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 (Expr Src Void
-> Expr Src Void -> Validation (ExtractErrors Src Void) b
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError 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) (Maybe (Expr Src Void) -> Validation (ExtractErrors Src Void) b)
-> Maybe (Expr Src Void) -> Validation (ExtractErrors Src Void) b
forall a b. (a -> b) -> a -> b
$ Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup "_2" Substitutions Src Void
fields)
extractOut expr :: Expr Src Void
expr = Expr Src Void -> Expr Src Void -> Extractor Src Void (a, b)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expectedOut Expr Src Void
expr
expectedOut :: Expr Src Void
expectedOut =
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record
([(Text, Expr Src Void)] -> Substitutions Src Void
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[ ("_1", Decoder a -> Expr Src Void
forall a. Decoder a -> Expr Src Void
expected Decoder a
l)
, ("_2", Decoder b -> Expr Src Void
forall a. Decoder a -> Expr Src Void
expected Decoder b
r)
]
)
class FromDhall a where
autoWith:: InterpretOptions -> Decoder a
default autoWith
:: (Generic a, GenericFromDhall (Rep a)) => InterpretOptions -> Decoder a
autoWith options :: InterpretOptions
options = (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
GHC.Generics.to (State Int (Decoder (Rep a Any)) -> Int -> Decoder (Rep a Any)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Decoder (Rep a Any))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options) 1)
type Interpret = FromDhall
instance FromDhall Void where
autoWith :: InterpretOptions -> Decoder Void
autoWith _ = Decoder Void
void
instance FromDhall () where
autoWith :: InterpretOptions -> Decoder ()
autoWith _ = Decoder ()
unit
instance FromDhall Bool where
autoWith :: InterpretOptions -> Decoder Bool
autoWith _ = Decoder Bool
bool
instance FromDhall Natural where
autoWith :: InterpretOptions -> Decoder Natural
autoWith _ = Decoder Natural
natural
instance FromDhall Integer where
autoWith :: InterpretOptions -> Decoder Integer
autoWith _ = Decoder Integer
integer
instance FromDhall Scientific where
autoWith :: InterpretOptions -> Decoder Scientific
autoWith _ = Decoder Scientific
scientific
instance FromDhall Double where
autoWith :: InterpretOptions -> Decoder Double
autoWith _ = Decoder Double
double
instance {-# OVERLAPS #-} FromDhall [Char] where
autoWith :: InterpretOptions -> Decoder String
autoWith _ = Decoder String
string
instance FromDhall Data.Text.Lazy.Text where
autoWith :: InterpretOptions -> Decoder Text
autoWith _ = Decoder Text
lazyText
instance FromDhall Text where
autoWith :: InterpretOptions -> Decoder Text
autoWith _ = Decoder Text
strictText
instance FromDhall a => FromDhall (Maybe a) where
autoWith :: InterpretOptions -> Decoder (Maybe a)
autoWith opts :: InterpretOptions
opts = Decoder a -> Decoder (Maybe a)
forall a. Decoder a -> Decoder (Maybe a)
maybe (InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts)
instance FromDhall a => FromDhall (Seq a) where
autoWith :: InterpretOptions -> Decoder (Seq a)
autoWith opts :: InterpretOptions
opts = Decoder a -> Decoder (Seq a)
forall a. Decoder a -> Decoder (Seq a)
sequence (InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts)
instance FromDhall a => FromDhall [a] where
autoWith :: InterpretOptions -> Decoder [a]
autoWith opts :: InterpretOptions
opts = Decoder a -> Decoder [a]
forall a. Decoder a -> Decoder [a]
list (InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts)
instance FromDhall a => FromDhall (Vector a) where
autoWith :: InterpretOptions -> Decoder (Vector a)
autoWith opts :: InterpretOptions
opts = Decoder a -> Decoder (Vector a)
forall a. Decoder a -> Decoder (Vector a)
vector (InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts)
instance (FromDhall a, Ord a, Show a) => FromDhall (Data.Set.Set a) where
autoWith :: InterpretOptions -> Decoder (Set a)
autoWith opts :: InterpretOptions
opts = Decoder a -> Decoder (Set a)
forall a. (Ord a, Show a) => Decoder a -> Decoder (Set a)
setFromDistinctList (InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts)
instance (FromDhall a, Hashable a, Ord a, Show a) => FromDhall (Data.HashSet.HashSet a) where
autoWith :: InterpretOptions -> Decoder (HashSet a)
autoWith opts :: InterpretOptions
opts = Decoder a -> Decoder (HashSet a)
forall a.
(Hashable a, Ord a, Show a) =>
Decoder a -> Decoder (HashSet a)
hashSetFromDistinctList (InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts)
instance (Ord k, FromDhall k, FromDhall v) => FromDhall (Map k v) where
autoWith :: InterpretOptions -> Decoder (Map k v)
autoWith opts :: InterpretOptions
opts = Decoder k -> Decoder v -> Decoder (Map k v)
forall k v. Ord k => Decoder k -> Decoder v -> Decoder (Map k v)
Dhall.map (InterpretOptions -> Decoder k
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts) (InterpretOptions -> Decoder v
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts)
instance (Eq k, Hashable k, FromDhall k, FromDhall v) => FromDhall (HashMap k v) where
autoWith :: InterpretOptions -> Decoder (HashMap k v)
autoWith opts :: InterpretOptions
opts = Decoder k -> Decoder v -> Decoder (HashMap k v)
forall k v.
(Eq k, Hashable k) =>
Decoder k -> Decoder v -> Decoder (HashMap k v)
Dhall.hashMap (InterpretOptions -> Decoder k
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts) (InterpretOptions -> Decoder v
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts)
instance (ToDhall a, FromDhall b) => FromDhall (a -> b) where
autoWith :: InterpretOptions -> Decoder (a -> b)
autoWith opts :: InterpretOptions
opts =
InterpretOptions -> Encoder a -> Decoder b -> Decoder (a -> b)
forall a b.
InterpretOptions -> Encoder a -> Decoder b -> Decoder (a -> b)
function InterpretOptions
opts (InterpretOptions -> Encoder a
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
opts) (InterpretOptions -> Decoder b
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
opts)
instance (FromDhall a, FromDhall b) => FromDhall (a, b)
auto :: FromDhall a => Decoder a
auto :: Decoder a
auto = InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
defaultInterpretOptions
newtype Result f = Result { Result f -> f (Result f)
_unResult :: f (Result f) }
resultToFix :: Functor f => Result f -> Fix f
resultToFix :: Result f -> Fix f
resultToFix (Result x :: f (Result f)
x) = f (Fix f) -> Fix f
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ((Result f -> Fix f) -> f (Result f) -> f (Fix f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Result f -> Fix f
forall (f :: * -> *). Functor f => Result f -> Fix f
resultToFix f (Result f)
x)
instance FromDhall (f (Result f)) => FromDhall (Result f) where
autoWith :: InterpretOptions -> Decoder (Result f)
autoWith options :: InterpretOptions
options = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder { expected :: Expr Src Void
expected = Expr Src Void
expected_, extract :: Expr Src Void -> Extractor Src Void (Result f)
extract = Expr Src Void -> Extractor Src Void (Result f)
extract_ }
where
expected_ :: Expr Src Void
expected_ = "result"
extract_ :: Expr Src Void -> Extractor Src Void (Result f)
extract_ (App _ expression :: Expr Src Void
expression) = do
(f (Result f) -> Result f)
-> Validation (ExtractErrors Src Void) (f (Result f))
-> Extractor 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
extract (InterpretOptions -> Decoder (f (Result f))
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
options) Expr Src Void
expression)
extract_ expression :: Expr Src Void
expression = do
Expr Src Void -> Expr Src Void -> Extractor Src Void (Result f)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expression Expr Src Void
expected_
instance (Functor f, FromDhall (f (Result f))) => FromDhall (Fix f) where
autoWith :: InterpretOptions -> Decoder (Fix f)
autoWith options :: InterpretOptions
options = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder { expected :: Expr Src Void
expected = Expr Src Void
expected_, extract :: Expr Src Void -> Extractor Src Void (Fix f)
extract = Expr Src Void -> Extractor Src Void (Fix f)
extract_ }
where
expected_ :: Expr Src Void
expected_ =
Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi "result" (Const -> Expr Src Void
forall s a. Const -> Expr s a
Const Const
Dhall.Core.Type)
(Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi "Make" (Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi "_" (Decoder (f (Result f)) -> Expr Src Void
forall a. Decoder a -> Expr Src Void
expected (InterpretOptions -> Decoder (f (Result f))
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
options :: Decoder (f (Result f)))) "result")
"result"
)
extract_ :: Expr Src Void -> Extractor Src Void (Fix f)
extract_ expression0 :: Expr Src Void
expression0 = Expr Src Void -> Extractor Src Void (Fix f)
go0 (Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a
Dhall.Core.alphaNormalize Expr Src Void
expression0)
where
go0 :: Expr Src Void -> Extractor Src Void (Fix f)
go0 (Lam _ _ (Lam _ _ expression1 :: Expr Src Void
expression1)) =
(Result f -> Fix f)
-> Validation (ExtractErrors Src Void) (Result f)
-> Extractor 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
extract (InterpretOptions -> Decoder (Result f)
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
options) Expr Src Void
expression1)
go0 _ = Expr Src Void -> Expr Src Void -> Extractor Src Void (Fix f)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected_ Expr Src Void
expression0
genericAuto :: (Generic a, GenericFromDhall (Rep a)) => Decoder a
genericAuto :: Decoder a
genericAuto = (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 (InterpretOptions -> State Int (Decoder (Rep a Any))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
defaultInterpretOptions) 1)
data InterpretOptions = InterpretOptions
{ InterpretOptions -> Text -> Text
fieldModifier :: Text -> Text
, InterpretOptions -> Text -> Text
constructorModifier :: Text -> Text
, InterpretOptions -> SingletonConstructors
singletonConstructors :: SingletonConstructors
, InterpretOptions -> ReifiedNormalizer Void
inputNormalizer :: Dhall.Core.ReifiedNormalizer Void
}
data SingletonConstructors
= Bare
| Wrapped
| Smart
defaultInterpretOptions :: InterpretOptions
defaultInterpretOptions :: InterpretOptions
defaultInterpretOptions = InterpretOptions :: (Text -> Text)
-> (Text -> Text)
-> SingletonConstructors
-> ReifiedNormalizer Void
-> InterpretOptions
InterpretOptions
{ fieldModifier :: Text -> Text
fieldModifier =
Text -> Text
forall a. a -> a
id
, constructorModifier :: Text -> Text
constructorModifier =
Text -> Text
forall a. a -> a
id
, singletonConstructors :: SingletonConstructors
singletonConstructors =
SingletonConstructors
Smart
, inputNormalizer :: ReifiedNormalizer Void
inputNormalizer =
Normalizer Void -> ReifiedNormalizer Void
forall a. Normalizer a -> ReifiedNormalizer a
Dhall.Core.ReifiedNormalizer (Identity (Maybe (Expr s Void))
-> Expr s Void -> Identity (Maybe (Expr s Void))
forall a b. a -> b -> a
const (Maybe (Expr s Void) -> Identity (Maybe (Expr s Void))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Expr s Void)
forall a. Maybe a
Nothing))
}
class GenericFromDhall f where
genericAutoWith :: InterpretOptions -> State Int (Decoder (f a))
instance GenericFromDhall f => GenericFromDhall (M1 D d f) where
genericAutoWith :: InterpretOptions -> State Int (Decoder (M1 D d f a))
genericAutoWith options :: InterpretOptions
options = do
Decoder (f a)
res <- InterpretOptions -> State Int (Decoder (f a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options
Decoder (M1 D d f a) -> State Int (Decoder (M1 D d f a))
forall (f :: * -> *) a. Applicative f => a -> f a
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 V1 where
genericAutoWith :: InterpretOptions -> State Int (Decoder (V1 a))
genericAutoWith _ = 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)
-> Expr Src Void -> Decoder a
Decoder {..}
where
extract :: Expr s a -> Extractor s a b
extract expr :: Expr s a
expr = Expr s a -> Expr s a -> Extractor s a b
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr s a
forall s a. Expr s a
expected Expr s a
expr
expected :: Expr s a
expected = Map Text (Maybe (Expr s a)) -> Expr s a
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr s a))
forall a. Monoid a => a
mempty
unsafeExpectUnion
:: Text -> Expr Src Void -> Dhall.Map.Map Text (Maybe (Expr Src Void))
unsafeExpectUnion :: Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion _ (Union kts :: Map Text (Maybe (Expr Src Void))
kts) =
Map Text (Maybe (Expr Src Void))
kts
unsafeExpectUnion name :: Text
name expression :: Expr Src Void
expression =
Text -> forall b. b
Dhall.Core.internalError
(Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": Unexpected constructor: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Src Void -> Text
forall a. Pretty a => a -> Text
Dhall.Core.pretty Expr Src Void
expression)
unsafeExpectRecord
:: Text -> Expr Src Void -> Dhall.Map.Map Text (Expr Src Void)
unsafeExpectRecord :: Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecord _ (Record kts :: Substitutions Src Void
kts) =
Substitutions Src Void
kts
unsafeExpectRecord name :: Text
name expression :: Expr Src Void
expression =
Text -> forall b. b
Dhall.Core.internalError
(Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": Unexpected constructor: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Src Void -> Text
forall a. Pretty a => a -> Text
Dhall.Core.pretty Expr Src Void
expression)
unsafeExpectUnionLit
:: Text
-> Expr Src Void
-> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit :: Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit _ (Field (Union _) k :: Text
k) =
(Text
k, Maybe (Expr Src Void)
forall a. Maybe a
Nothing)
unsafeExpectUnionLit _ (App (Field (Union _) k :: Text
k) v :: Expr Src Void
v) =
(Text
k, Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just Expr Src Void
v)
unsafeExpectUnionLit name :: Text
name expression :: Expr Src Void
expression =
Text -> forall b. b
Dhall.Core.internalError
(Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": Unexpected constructor: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Src Void -> Text
forall a. Pretty a => a -> Text
Dhall.Core.pretty Expr Src Void
expression)
unsafeExpectRecordLit
:: Text -> Expr Src Void -> Dhall.Map.Map Text (Expr Src Void)
unsafeExpectRecordLit :: Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecordLit _ (RecordLit kvs :: Substitutions Src Void
kvs) =
Substitutions Src Void
kvs
unsafeExpectRecordLit name :: Text
name expression :: Expr Src Void
expression =
Text -> forall b. b
Dhall.Core.internalError
(Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": Unexpected constructor: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Src Void -> Text
forall a. Pretty a => a -> Text
Dhall.Core.pretty Expr Src Void
expression)
notEmptyRecordLit :: Expr s a -> Maybe (Expr s a)
notEmptyRecordLit :: Expr s a -> Maybe (Expr s a)
notEmptyRecordLit e :: Expr s a
e = case Expr s a
e of
RecordLit m :: Map Text (Expr s a)
m | Map Text (Expr s a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Expr s a)
m -> Maybe (Expr s a)
forall a. Maybe a
Nothing
_ -> Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just Expr s a
e
notEmptyRecord :: Expr s a -> Maybe (Expr s a)
notEmptyRecord :: Expr s a -> Maybe (Expr s a)
notEmptyRecord e :: Expr s a
e = case Expr s a
e of
Record m :: Map Text (Expr s a)
m | Map Text (Expr s a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Expr s a)
m -> Maybe (Expr s a)
forall a. Maybe a
Nothing
_ -> Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just Expr s a
e
extractUnionConstructor
:: Expr s a -> Maybe (Text, Expr s a, Dhall.Map.Map Text (Maybe (Expr s a)))
(App (Field (Union kts :: Map Text (Maybe (Expr s a))
kts) fld :: Text
fld) e :: 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 kts :: Map Text (Maybe (Expr s a))
kts) fld :: 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 (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit Map Text (Expr 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 _ =
Maybe (Text, Expr s a, Map Text (Maybe (Expr s a)))
forall (f :: * -> *) a. Alternative f => f a
empty
instance (Constructor c1, Constructor c2, GenericFromDhall f1, GenericFromDhall f2) => GenericFromDhall (M1 C c1 f1 :+: M1 C c2 f2) where
genericAutoWith :: InterpretOptions
-> State Int (Decoder ((:+:) (M1 C c1 f1) (M1 C c2 f2) a))
genericAutoWith options :: InterpretOptions
options@(InterpretOptions {..}) = Decoder ((:+:) (M1 C c1 f1) (M1 C c2 f2) a)
-> State Int (Decoder ((:+:) (M1 C c1 f1) (M1 C c2 f2) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder {..})
where
nL :: M1 i c1 f1 a
nL :: M1 i c1 f1 a
nL = M1 i c1 f1 a
forall a. HasCallStack => a
undefined
nR :: M1 i c2 f2 a
nR :: M1 i c2 f2 a
nR = M1 i c2 f2 a
forall a. HasCallStack => a
undefined
nameL :: Text
nameL = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (M1 Any c1 f1 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c1 f1 Any
forall i (a :: k). M1 i c1 f1 a
nL))
nameR :: Text
nameR = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (M1 Any c2 f2 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c2 f2 Any
forall i (a :: k). M1 i c2 f2 a
nR))
extract :: Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:+:) (M1 C c1 f1) (M1 C c2 f2) a)
extract e0 :: Expr Src Void
e0 = do
case 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 of
Just (name :: Text
name, e1 :: Expr Src Void
e1, _) ->
if
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
nameL -> (f1 a -> (:+:) (M1 C c1 f1) (M1 C c2 f2) a)
-> Validation (ExtractErrors Src Void) (f1 a)
-> Validation
(ExtractErrors Src Void) ((:+:) (M1 C c1 f1) (M1 C c2 f2) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (M1 C c1 f1 a -> (:+:) (M1 C c1 f1) (M1 C c2 f2) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (M1 C c1 f1 a -> (:+:) (M1 C c1 f1) (M1 C c2 f2) a)
-> (f1 a -> M1 C c1 f1 a)
-> f1 a
-> (:+:) (M1 C c1 f1) (M1 C c2 f2) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f1 a -> M1 C c1 f1 a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) (Expr Src Void -> Validation (ExtractErrors Src Void) (f1 a)
extractL Expr Src Void
e1)
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
nameR -> (f2 a -> (:+:) (M1 C c1 f1) (M1 C c2 f2) a)
-> Validation (ExtractErrors Src Void) (f2 a)
-> Validation
(ExtractErrors Src Void) ((:+:) (M1 C c1 f1) (M1 C c2 f2) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (M1 C c2 f2 a -> (:+:) (M1 C c1 f1) (M1 C c2 f2) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (M1 C c2 f2 a -> (:+:) (M1 C c1 f1) (M1 C c2 f2) a)
-> (f2 a -> M1 C c2 f2 a)
-> f2 a
-> (:+:) (M1 C c1 f1) (M1 C c2 f2) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f2 a -> M1 C c2 f2 a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) (Expr Src Void -> Validation (ExtractErrors Src Void) (f2 a)
extractR Expr Src Void
e1)
| Bool
otherwise -> Expr Src Void
-> Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:+:) (M1 C c1 f1) (M1 C c2 f2) a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
e0
_ -> Expr Src Void
-> Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:+:) (M1 C c1 f1) (M1 C c2 f2) a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
e0
expected :: 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
([(Text, Maybe (Expr Src Void))] -> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[ (Text
nameL, Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
expectedL)
, (Text
nameR, Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
expectedR)
]
)
Decoder extractL :: Expr Src Void -> Validation (ExtractErrors Src Void) (f1 a)
extractL expectedL :: Expr Src Void
expectedL = State Int (Decoder (f1 a)) -> Int -> Decoder (f1 a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Decoder (f1 a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options) 1
Decoder extractR :: Expr Src Void -> Validation (ExtractErrors Src Void) (f2 a)
extractR expectedR :: Expr Src Void
expectedR = State Int (Decoder (f2 a)) -> Int -> Decoder (f2 a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Decoder (f2 a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options) 1
instance (Constructor c, GenericFromDhall (f :+: g), GenericFromDhall h) => GenericFromDhall ((f :+: g) :+: M1 C c h) where
genericAutoWith :: InterpretOptions
-> State Int (Decoder ((:+:) (f :+: g) (M1 C c h) a))
genericAutoWith options :: InterpretOptions
options@(InterpretOptions {..}) = Decoder ((:+:) (f :+: g) (M1 C c h) a)
-> State Int (Decoder ((:+:) (f :+: g) (M1 C c h) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder {..})
where
n :: M1 i c h a
n :: M1 i c h a
n = M1 i c h a
forall a. HasCallStack => a
undefined
name :: Text
name = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (M1 Any c h Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c h Any
forall i (a :: k). M1 i c h a
n))
extract :: Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:+:) (f :+: g) (M1 C c h) a)
extract u :: Expr Src Void
u = case 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
u of
Just (name' :: Text
name', e :: Expr Src Void
e, _) ->
if
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name' -> (h a -> (:+:) (f :+: g) (M1 C c h) a)
-> Validation (ExtractErrors Src Void) (h a)
-> Validation
(ExtractErrors Src Void) ((:+:) (f :+: g) (M1 C c h) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (M1 C c h a -> (:+:) (f :+: g) (M1 C c h) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (M1 C c h a -> (:+:) (f :+: g) (M1 C c h) a)
-> (h a -> M1 C c h a) -> h a -> (:+:) (f :+: g) (M1 C c h) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h a -> M1 C c h a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) (Expr Src Void -> Validation (ExtractErrors Src Void) (h a)
extractR Expr Src Void
e)
| Bool
otherwise -> ((:+:) f g a -> (:+:) (f :+: g) (M1 C c h) a)
-> Validation (ExtractErrors Src Void) ((:+:) f g a)
-> Validation
(ExtractErrors Src Void) ((:+:) (f :+: g) (M1 C c h) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) f g a -> (:+:) (f :+: g) (M1 C c h) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Expr Src Void -> Validation (ExtractErrors Src Void) ((:+:) f g a)
extractL Expr Src Void
u)
Nothing -> Expr Src Void
-> Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:+:) (f :+: g) (M1 C c h) a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
u
expected :: 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 (Text
-> Maybe (Expr Src Void)
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
name (Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
expectedR) Map Text (Maybe (Expr Src Void))
ktsL)
Decoder extractL :: Expr Src Void -> Validation (ExtractErrors Src Void) ((:+:) f g a)
extractL expectedL :: Expr Src Void
expectedL = State Int (Decoder ((:+:) f g a)) -> Int -> Decoder ((:+:) f g a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Decoder ((:+:) f g a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options) 1
Decoder extractR :: Expr Src Void -> Validation (ExtractErrors Src Void) (h a)
extractR expectedR :: Expr Src Void
expectedR = State Int (Decoder (h a)) -> Int -> Decoder (h a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Decoder (h a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options) 1
ktsL :: Map Text (Maybe (Expr Src Void))
ktsL = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion "genericAutoWith (:+:)" Expr Src Void
expectedL
instance (Constructor c, GenericFromDhall f, GenericFromDhall (g :+: h)) => GenericFromDhall (M1 C c f :+: (g :+: h)) where
genericAutoWith :: InterpretOptions
-> State Int (Decoder ((:+:) (M1 C c f) (g :+: h) a))
genericAutoWith options :: InterpretOptions
options@(InterpretOptions {..}) = Decoder ((:+:) (M1 C c f) (g :+: h) a)
-> State Int (Decoder ((:+:) (M1 C c f) (g :+: h) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder {..})
where
n :: M1 i c f a
n :: M1 i c f a
n = M1 i c f a
forall a. HasCallStack => a
undefined
name :: Text
name = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (M1 Any c f Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c f Any
forall i (a :: k). M1 i c f a
n))
extract :: Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:+:) (M1 C c f) (g :+: h) a)
extract u :: Expr Src Void
u = case 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
u of
Just (name' :: Text
name', e :: Expr Src Void
e, _) ->
if
| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name' -> (f a -> (:+:) (M1 C c f) (g :+: h) a)
-> Validation (ExtractErrors Src Void) (f a)
-> Validation
(ExtractErrors Src Void) ((:+:) (M1 C c f) (g :+: h) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (M1 C c f a -> (:+:) (M1 C c f) (g :+: h) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (M1 C c f a -> (:+:) (M1 C c f) (g :+: h) a)
-> (f a -> M1 C c f a) -> f a -> (:+:) (M1 C c f) (g :+: h) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> M1 C c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) (Expr Src Void -> Validation (ExtractErrors Src Void) (f a)
extractL Expr Src Void
e)
| Bool
otherwise -> ((:+:) g h a -> (:+:) (M1 C c f) (g :+: h) a)
-> Validation (ExtractErrors Src Void) ((:+:) g h a)
-> Validation
(ExtractErrors Src Void) ((:+:) (M1 C c f) (g :+: h) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) g h a -> (:+:) (M1 C c f) (g :+: h) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Expr Src Void -> Validation (ExtractErrors Src Void) ((:+:) g h a)
extractR Expr Src Void
u)
_ -> Expr Src Void
-> Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:+:) (M1 C c f) (g :+: h) a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
u
expected :: 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 (Text
-> Maybe (Expr Src Void)
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
name (Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
expectedL) Map Text (Maybe (Expr Src Void))
ktsR)
Decoder extractL :: Expr Src Void -> Validation (ExtractErrors Src Void) (f a)
extractL expectedL :: Expr Src Void
expectedL = State Int (Decoder (f a)) -> Int -> Decoder (f a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Decoder (f a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options) 1
Decoder extractR :: Expr Src Void -> Validation (ExtractErrors Src Void) ((:+:) g h a)
extractR expectedR :: Expr Src Void
expectedR = State Int (Decoder ((:+:) g h a)) -> Int -> Decoder ((:+:) g h a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Decoder ((:+:) g h a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options) 1
ktsR :: Map Text (Maybe (Expr Src Void))
ktsR = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion "genericAutoWith (:+:)" Expr Src Void
expectedR
instance (GenericFromDhall (f :+: g), GenericFromDhall (h :+: i)) => GenericFromDhall ((f :+: g) :+: (h :+: i)) where
genericAutoWith :: InterpretOptions
-> State Int (Decoder ((:+:) (f :+: g) (h :+: i) a))
genericAutoWith options :: InterpretOptions
options = Decoder ((:+:) (f :+: g) (h :+: i) a)
-> State Int (Decoder ((:+:) (f :+: g) (h :+: i) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder {..})
where
extract :: Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:+:) (f :+: g) (h :+: i) a)
extract e :: Expr Src Void
e = ((:+:) f g a -> (:+:) (f :+: g) (h :+: i) a)
-> Validation (ExtractErrors Src Void) ((:+:) f g a)
-> Validation
(ExtractErrors Src Void) ((:+:) (f :+: g) (h :+: i) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) f g a -> (:+:) (f :+: g) (h :+: i) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (Expr Src Void -> Validation (ExtractErrors Src Void) ((:+:) f g a)
extractL Expr Src Void
e) Validation (ExtractErrors Src Void) ((:+:) (f :+: g) (h :+: i) a)
-> Validation
(ExtractErrors Src Void) ((:+:) (f :+: g) (h :+: i) a)
-> Validation
(ExtractErrors Src Void) ((:+:) (f :+: g) (h :+: i) a)
forall e a. Validation e a -> Validation e a -> Validation e a
`ealt` ((:+:) h i a -> (:+:) (f :+: g) (h :+: i) a)
-> Validation (ExtractErrors Src Void) ((:+:) h i a)
-> Validation
(ExtractErrors Src Void) ((:+:) (f :+: g) (h :+: i) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:+:) h i a -> (:+:) (f :+: g) (h :+: i) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (Expr Src Void -> Validation (ExtractErrors Src Void) ((:+:) h i a)
extractR Expr Src Void
e)
expected :: 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))
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union Map Text (Maybe (Expr Src Void))
ktsL Map Text (Maybe (Expr Src Void))
ktsR)
Decoder extractL :: Expr Src Void -> Validation (ExtractErrors Src Void) ((:+:) f g a)
extractL expectedL :: Expr Src Void
expectedL = State Int (Decoder ((:+:) f g a)) -> Int -> Decoder ((:+:) f g a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Decoder ((:+:) f g a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options) 1
Decoder extractR :: Expr Src Void -> Validation (ExtractErrors Src Void) ((:+:) h i a)
extractR expectedR :: Expr Src Void
expectedR = State Int (Decoder ((:+:) h i a)) -> Int -> Decoder ((:+:) h i a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Decoder ((:+:) h i a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options) 1
ktsL :: Map Text (Maybe (Expr Src Void))
ktsL = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion "genericAutoWith (:+:)" Expr Src Void
expectedL
ktsR :: Map Text (Maybe (Expr Src Void))
ktsR = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion "genericAutoWith (:+:)" Expr Src Void
expectedR
instance GenericFromDhall f => GenericFromDhall (M1 C c f) where
genericAutoWith :: InterpretOptions -> State Int (Decoder (M1 C c f a))
genericAutoWith options :: InterpretOptions
options = do
Decoder (f a)
res <- InterpretOptions -> State Int (Decoder (f a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options
Decoder (M1 C c f a) -> State Int (Decoder (M1 C c f a))
forall (f :: * -> *) a. Applicative f => a -> f a
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 U1 where
genericAutoWith :: InterpretOptions -> State Int (Decoder (U1 a))
genericAutoWith _ = 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)
-> Expr Src Void -> Decoder a
Decoder {..})
where
extract :: p -> f (U1 p)
extract _ = U1 p -> f (U1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1
expected :: Expr s a
expected = Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
Record ([(Text, Expr s a)] -> Map Text (Expr s a)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [])
getSelName :: Selector s => M1 i s f a -> State Int Text
getSelName :: M1 i s f a -> State Int Text
getSelName n :: M1 i s f a
n = case M1 i s f a -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 i s f a
n of
"" -> do Int
i <- StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
Int -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
Text -> State Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
Data.Text.pack ("_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i))
nn :: String
nn -> Text -> State Int Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
Data.Text.pack String
nn)
instance (GenericFromDhall (f :*: g), GenericFromDhall (h :*: i)) => GenericFromDhall ((f :*: g) :*: (h :*: i)) where
genericAutoWith :: InterpretOptions
-> State Int (Decoder ((:*:) (f :*: g) (h :*: i) a))
genericAutoWith options :: InterpretOptions
options = do
Decoder extractL :: Expr Src Void -> Extractor Src Void ((:*:) f g a)
extractL expectedL :: Expr Src Void
expectedL <- InterpretOptions -> State Int (Decoder ((:*:) f g a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options
Decoder extractR :: Expr Src Void -> Extractor Src Void ((:*:) h i a)
extractR expectedR :: Expr Src Void
expectedR <- InterpretOptions -> State Int (Decoder ((:*:) h i a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options
let ktsL :: Substitutions Src Void
ktsL = Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecord "genericAutoWith (:*:)" Expr Src Void
expectedL
let ktsR :: Substitutions Src Void
ktsR = Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecord "genericAutoWith (:*:)" Expr Src Void
expectedR
let expected :: Expr Src Void
expected = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record (Substitutions Src Void
-> Substitutions Src Void -> Substitutions Src Void
forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union Substitutions Src Void
ktsL Substitutions Src Void
ktsR)
let extract :: Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:*:) (f :*: g) (h :*: i) a)
extract expression :: 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)
-> Expr Src Void -> Decoder a
Decoder {..})
instance (GenericFromDhall (f :*: g), Selector s, FromDhall a) => GenericFromDhall ((f :*: g) :*: M1 S s (K1 i a)) where
genericAutoWith :: InterpretOptions
-> State Int (Decoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a))
genericAutoWith options :: InterpretOptions
options@InterpretOptions{..} = do
let nR :: M1 S s (K1 i a) r
nR :: M1 S s (K1 i a) r
nR = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined
Text
nameR <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
nR)
Decoder extractL :: Expr Src Void -> Extractor Src Void ((:*:) f g a)
extractL expectedL :: Expr Src Void
expectedL <- InterpretOptions -> State Int (Decoder ((:*:) f g a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options
let Decoder extractR :: Expr Src Void -> Extractor Src Void a
extractR expectedR :: Expr Src Void
expectedR = InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
options
let ktsL :: Substitutions Src Void
ktsL = Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecord "genericAutoWith (:*:)" Expr Src Void
expectedL
let expected :: Expr Src Void
expected = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record (Text
-> Expr Src Void
-> Substitutions Src Void
-> Substitutions Src Void
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameR Expr Src Void
expectedR Substitutions Src Void
ktsL)
let extract :: Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
extract expression :: Expr Src Void
expression = do
let die :: Validation
(ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
die = Expr Src Void
-> Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
expression
case Expr Src Void
expression of
RecordLit kvs :: Substitutions Src Void
kvs ->
case Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
nameR Substitutions Src Void
kvs of
Just expressionR :: 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))
_ -> Validation
(ExtractErrors Src Void) ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
die
_ -> 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)
-> Expr Src Void -> Decoder a
Decoder {..})
instance (Selector s, FromDhall a, GenericFromDhall (f :*: g)) => GenericFromDhall (M1 S s (K1 i a) :*: (f :*: g)) where
genericAutoWith :: InterpretOptions
-> State Int (Decoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a))
genericAutoWith options :: InterpretOptions
options@InterpretOptions{..} = do
let nL :: M1 S s (K1 i a) r
nL :: M1 S s (K1 i a) r
nL = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined
Text
nameL <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
nL)
let Decoder extractL :: Expr Src Void -> Extractor Src Void a
extractL expectedL :: Expr Src Void
expectedL = InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
options
Decoder extractR :: Expr Src Void -> Extractor Src Void ((:*:) f g a)
extractR expectedR :: Expr Src Void
expectedR <- InterpretOptions -> State Int (Decoder ((:*:) f g a))
forall k (f :: k -> *) (a :: k).
GenericFromDhall f =>
InterpretOptions -> State Int (Decoder (f a))
genericAutoWith InterpretOptions
options
let ktsR :: Substitutions Src Void
ktsR = Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecord "genericAutoWith (:*:)" Expr Src Void
expectedR
let expected :: Expr Src Void
expected = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record (Text
-> Expr Src Void
-> Substitutions Src Void
-> Substitutions Src Void
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameL Expr Src Void
expectedL Substitutions Src Void
ktsR)
let extract :: Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
extract expression :: Expr Src Void
expression = do
let die :: Validation
(ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
die = Expr Src Void
-> Expr Src Void
-> Validation
(ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
expression
case Expr Src Void
expression of
RecordLit kvs :: Substitutions Src Void
kvs ->
case Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
nameL Substitutions Src Void
kvs of
Just expressionL :: 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)
_ -> Validation
(ExtractErrors Src Void) ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
die
_ -> 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)
-> Expr Src Void -> Decoder a
Decoder {..})
instance (Selector s1, Selector s2, FromDhall a1, FromDhall a2) => GenericFromDhall (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where
genericAutoWith :: InterpretOptions
-> State
Int (Decoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
genericAutoWith options :: InterpretOptions
options@InterpretOptions{..} = do
let nL :: M1 S s1 (K1 i1 a1) r
nL :: M1 S s1 (K1 i1 a1) r
nL = M1 S s1 (K1 i1 a1) r
forall a. HasCallStack => a
undefined
let nR :: M1 S s2 (K1 i2 a2) r
nR :: M1 S s2 (K1 i2 a2) r
nR = M1 S s2 (K1 i2 a2) r
forall a. HasCallStack => a
undefined
Text
nameL <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s1 (K1 i1 a1) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s1 (K1 i1 a1) Any
forall k (r :: k). M1 S s1 (K1 i1 a1) r
nL)
Text
nameR <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s2 (K1 i2 a2) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s2 (K1 i2 a2) Any
forall k (r :: k). M1 S s2 (K1 i2 a2) r
nR)
let Decoder extractL :: Expr Src Void -> Extractor Src Void a1
extractL expectedL :: Expr Src Void
expectedL = InterpretOptions -> Decoder a1
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
options
let Decoder extractR :: Expr Src Void -> Extractor Src Void a2
extractR expectedR :: Expr Src Void
expectedR = InterpretOptions -> Decoder a2
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
options
let expected :: Expr Src Void
expected =
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record
([(Text, Expr Src Void)] -> Substitutions Src Void
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[ (Text
nameL, Expr Src Void
expectedL)
, (Text
nameR, Expr Src Void
expectedR)
]
)
let extract :: Expr Src Void
-> Validation
(ExtractErrors Src Void)
((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
extract expression :: 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 = 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. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
expression
case Expr Src Void
expression of
RecordLit kvs :: Substitutions Src Void
kvs -> do
case (Expr Src Void -> Expr Src Void -> (Expr Src Void, Expr Src Void))
-> Maybe (Expr Src Void)
-> Maybe (Expr Src Void)
-> Maybe (Expr Src Void, Expr Src Void)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
nameL Substitutions Src Void
kvs) (Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
nameR Substitutions Src Void
kvs) of
Just (expressionL :: Expr Src Void
expressionL, expressionR :: Expr 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
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
expressionR))
Nothing -> Validation
(ExtractErrors Src Void)
((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
die
_ -> 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)
-> Expr Src Void -> Decoder a
Decoder {..})
instance (Selector s, FromDhall a) => GenericFromDhall (M1 S s (K1 i a)) where
genericAutoWith :: InterpretOptions -> State Int (Decoder (M1 S s (K1 i a) a))
genericAutoWith options :: InterpretOptions
options@InterpretOptions{..} = do
let n :: M1 S s (K1 i a) r
n :: M1 S s (K1 i a) r
n = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined
Text
name <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n)
let Decoder { extract :: forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract = Expr Src Void -> Extractor Src Void a
extract', expected :: forall a. Decoder a -> Expr Src Void
expected = Expr Src Void
expected'} = InterpretOptions -> Decoder a
forall a. FromDhall a => InterpretOptions -> Decoder a
autoWith InterpretOptions
options
let expected :: Expr Src Void
expected =
case SingletonConstructors
singletonConstructors of
Bare ->
Expr Src Void
expected'
Smart | M1 S s (K1 i a) Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" ->
Expr Src Void
expected'
_ ->
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record (Text -> Expr Src Void -> Substitutions Src Void
forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name Expr Src Void
expected')
let extract0 :: Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract0 expression :: 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 expression :: Expr Src Void
expression = do
let die :: Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
die = Expr Src Void
-> Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
expression
case Expr Src Void
expression of
RecordLit kvs :: Substitutions Src Void
kvs -> do
case Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
name Substitutions Src Void
kvs of
Just subExpression :: 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)
Nothing ->
Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
die
_ -> do
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
Bare -> Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract0
Smart | M1 S s (K1 i a) Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" -> Expr Src Void
-> Validation (ExtractErrors Src Void) (M1 S s (K1 i a) a)
extract0
_ -> 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)
-> Expr Src Void -> Decoder a
Decoder {..})
data Encoder a = Encoder
{ Encoder a -> a -> Expr Src Void
embed :: a -> Expr Src Void
, Encoder a -> Expr Src Void
declared :: Expr Src Void
}
instance Contravariant Encoder where
contramap :: (a -> b) -> Encoder b -> Encoder a
contramap f :: a -> b
f (Encoder embed :: b -> Expr Src Void
embed declared :: Expr Src Void
declared) = (a -> Expr Src Void) -> Expr Src Void -> Encoder a
forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder a -> Expr Src Void
embed' Expr Src Void
declared
where
embed' :: a -> Expr Src Void
embed' x :: a
x = b -> Expr Src Void
embed (a -> b
f a
x)
class ToDhall a where
injectWith :: InterpretOptions -> Encoder a
default injectWith
:: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> Encoder a
injectWith options :: InterpretOptions
options
= (a -> Rep a Any) -> Encoder (Rep a Any) -> Encoder a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> Rep a Any
forall a x. Generic a => a -> Rep a x
GHC.Generics.from (State Int (Encoder (Rep a Any)) -> Int -> Encoder (Rep a Any)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder (Rep a Any))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options) 1)
type Inject = ToDhall
inject :: ToDhall a => Encoder a
inject :: Encoder a
inject = InterpretOptions -> Encoder a
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
defaultInterpretOptions
genericToDhall
:: (Generic a, GenericToDhall (Rep a)) => Encoder a
genericToDhall :: Encoder a
genericToDhall
= (a -> Rep a Any) -> Encoder (Rep a Any) -> Encoder a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> Rep a Any
forall a x. Generic a => a -> Rep a x
GHC.Generics.from (State Int (Encoder (Rep a Any)) -> Int -> Encoder (Rep a Any)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder (Rep a Any))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
defaultInterpretOptions) 1)
instance ToDhall Void where
injectWith :: InterpretOptions -> Encoder Void
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Void -> a
embed = Void -> a
forall a. Void -> a
Data.Void.absurd
declared :: Expr s a
declared = Map Text (Maybe (Expr s a)) -> Expr s a
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr s a))
forall a. Monoid a => a
mempty
instance ToDhall Bool where
injectWith :: InterpretOptions -> Encoder Bool
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Bool -> Expr s a
embed = Bool -> Expr s a
forall s a. Bool -> Expr s a
BoolLit
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Bool
instance ToDhall Data.Text.Lazy.Text where
injectWith :: InterpretOptions -> Encoder Text
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Text -> Expr s a
embed text :: Text
text =
Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] (Text -> Text
Data.Text.Lazy.toStrict Text
text))
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Text
instance ToDhall Text where
injectWith :: InterpretOptions -> Encoder Text
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Text -> Expr s a
embed text :: Text
text = Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
text)
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Text
instance {-# OVERLAPS #-} ToDhall String where
injectWith :: InterpretOptions -> Encoder String
injectWith options :: InterpretOptions
options =
(String -> Text) -> Encoder Text -> Encoder String
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap String -> Text
Data.Text.pack (InterpretOptions -> Encoder Text
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options :: Encoder Text)
instance ToDhall Natural where
injectWith :: InterpretOptions -> Encoder Natural
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Natural -> Expr s a
embed = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Natural
instance ToDhall Integer where
injectWith :: InterpretOptions -> Encoder Integer
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Integer -> Expr s a
embed = Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Integer
instance ToDhall Int where
injectWith :: InterpretOptions -> Encoder Int
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Int -> Expr s a
embed = Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit (Integer -> Expr s a) -> (Int -> Integer) -> Int -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Integer
instance ToDhall Word where
injectWith :: InterpretOptions -> Encoder Word
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Word -> Expr s a
embed = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word -> Natural) -> Word -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Natural
instance ToDhall Word8 where
injectWith :: InterpretOptions -> Encoder Word8
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Word8 -> Expr s a
embed = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word8 -> Natural) -> Word8 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Natural
instance ToDhall Word16 where
injectWith :: InterpretOptions -> Encoder Word16
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Word16 -> Expr s a
embed = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word16 -> Natural) -> Word16 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Natural
instance ToDhall Word32 where
injectWith :: InterpretOptions -> Encoder Word32
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Word32 -> Expr s a
embed = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word32 -> Natural) -> Word32 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Natural
instance ToDhall Word64 where
injectWith :: InterpretOptions -> Encoder Word64
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Word64 -> Expr s a
embed = Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit (Natural -> Expr s a) -> (Word64 -> Natural) -> Word64 -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Natural
instance ToDhall Double where
injectWith :: InterpretOptions -> Encoder Double
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: Double -> Expr s a
embed = DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
DoubleLit (DhallDouble -> Expr s a)
-> (Double -> DhallDouble) -> Double -> Expr s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> DhallDouble
DhallDouble
declared :: Expr s a
declared = Expr s a
forall s a. Expr s a
Double
instance ToDhall Scientific where
injectWith :: InterpretOptions -> Encoder Scientific
injectWith options :: InterpretOptions
options =
(Scientific -> Double) -> Encoder Double -> Encoder Scientific
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Scientific -> Double
forall a. RealFloat a => Scientific -> a
Data.Scientific.toRealFloat (InterpretOptions -> Encoder Double
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options :: Encoder Double)
instance ToDhall () where
injectWith :: InterpretOptions -> Encoder ()
injectWith _ = Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..}
where
embed :: b -> Expr s a
embed = Expr s a -> b -> Expr s a
forall a b. a -> b -> a
const (Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit Map Text (Expr s a)
forall a. Monoid a => a
mempty)
declared :: Expr s a
declared = Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
Record Map Text (Expr s a)
forall a. Monoid a => a
mempty
instance ToDhall a => ToDhall (Maybe a) where
injectWith :: InterpretOptions -> Encoder (Maybe a)
injectWith options :: InterpretOptions
options = (Maybe a -> Expr Src Void) -> Expr Src Void -> Encoder (Maybe a)
forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder Maybe a -> Expr Src Void
embedOut Expr Src Void
declaredOut
where
embedOut :: Maybe a -> Expr Src Void
embedOut (Just x :: a
x ) = Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a
Some (a -> Expr Src Void
embedIn a
x)
embedOut Nothing = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
None Expr Src Void
declaredIn
Encoder embedIn :: a -> Expr Src Void
embedIn declaredIn :: Expr Src Void
declaredIn = InterpretOptions -> Encoder a
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
declaredOut :: Expr Src Void
declaredOut = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
Optional Expr Src Void
declaredIn
instance ToDhall a => ToDhall (Seq a) where
injectWith :: InterpretOptions -> Encoder (Seq a)
injectWith options :: InterpretOptions
options = (Seq a -> Expr Src Void) -> Expr Src Void -> Encoder (Seq a)
forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder Seq a -> Expr Src Void
embedOut Expr Src Void
declaredOut
where
embedOut :: Seq a -> Expr Src Void
embedOut xs :: Seq a
xs = Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src Void)
listType ((a -> Expr Src Void) -> Seq a -> Seq (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Expr Src Void
embedIn Seq a
xs)
where
listType :: Maybe (Expr Src Void)
listType
| Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq a
xs = Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just (Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
List Expr Src Void
declaredIn)
| Bool
otherwise = Maybe (Expr Src Void)
forall a. Maybe a
Nothing
declaredOut :: Expr Src Void
declaredOut = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
List Expr Src Void
declaredIn
Encoder embedIn :: a -> Expr Src Void
embedIn declaredIn :: Expr Src Void
declaredIn = InterpretOptions -> Encoder a
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
instance ToDhall a => ToDhall [a] where
injectWith :: InterpretOptions -> Encoder [a]
injectWith = (Encoder (Seq a) -> Encoder [a])
-> (InterpretOptions -> Encoder (Seq a))
-> InterpretOptions
-> Encoder [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a] -> Seq a) -> Encoder (Seq a) -> Encoder [a]
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap [a] -> Seq a
forall a. [a] -> Seq a
Data.Sequence.fromList) InterpretOptions -> Encoder (Seq a)
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith
instance ToDhall a => ToDhall (Vector a) where
injectWith :: InterpretOptions -> Encoder (Vector a)
injectWith = (Encoder [a] -> Encoder (Vector a))
-> (InterpretOptions -> Encoder [a])
-> InterpretOptions
-> Encoder (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vector a -> [a]) -> Encoder [a] -> Encoder (Vector a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Vector a -> [a]
forall a. Vector a -> [a]
Data.Vector.toList) InterpretOptions -> Encoder [a]
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith
instance ToDhall a => ToDhall (Data.Set.Set a) where
injectWith :: InterpretOptions -> Encoder (Set a)
injectWith = (Encoder [a] -> Encoder (Set a))
-> (InterpretOptions -> Encoder [a])
-> InterpretOptions
-> Encoder (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Set a -> [a]) -> Encoder [a] -> Encoder (Set a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Set a -> [a]
forall a. Set a -> [a]
Data.Set.toAscList) InterpretOptions -> Encoder [a]
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith
instance ToDhall a => ToDhall (Data.HashSet.HashSet a) where
injectWith :: InterpretOptions -> Encoder (HashSet a)
injectWith = (Encoder [a] -> Encoder (HashSet a))
-> (InterpretOptions -> Encoder [a])
-> InterpretOptions
-> Encoder (HashSet a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HashSet a -> [a]) -> Encoder [a] -> Encoder (HashSet a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap HashSet a -> [a]
forall a. HashSet a -> [a]
Data.HashSet.toList) InterpretOptions -> Encoder [a]
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith
instance (ToDhall a, ToDhall b) => ToDhall (a, b)
instance (ToDhall k, ToDhall v) => ToDhall (Data.Map.Map k v) where
injectWith :: InterpretOptions -> Encoder (Map k v)
injectWith options :: InterpretOptions
options = (Map k v -> Expr Src Void) -> Expr Src Void -> Encoder (Map k v)
forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder Map k v -> Expr Src Void
embedOut Expr Src Void
declaredOut
where
embedOut :: Map k v -> Expr Src Void
embedOut m :: Map k v
m = Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src Void)
listType (Map k v -> Seq (Expr Src Void)
mapEntries Map k v
m)
where
listType :: Maybe (Expr Src Void)
listType
| Map k v -> Bool
forall k a. Map k a -> Bool
Data.Map.null Map k v
m = Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just Expr Src Void
declaredOut
| Bool
otherwise = Maybe (Expr Src Void)
forall a. Maybe a
Nothing
declaredOut :: Expr Src Void
declaredOut = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
List (Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record ([(Text, Expr Src Void)] -> Substitutions Src Void
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[("mapKey", Expr Src Void
declaredK), ("mapValue", Expr Src Void
declaredV)]))
mapEntries :: Map k v -> Seq (Expr Src Void)
mapEntries = [Expr Src Void] -> Seq (Expr Src Void)
forall a. [a] -> Seq a
Data.Sequence.fromList ([Expr Src Void] -> Seq (Expr Src Void))
-> (Map k v -> [Expr Src Void]) -> Map k v -> Seq (Expr Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> Expr Src Void) -> [(k, v)] -> [Expr Src Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, v) -> Expr Src Void
recordPair ([(k, v)] -> [Expr Src Void])
-> (Map k v -> [(k, v)]) -> Map k v -> [Expr Src Void]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList
recordPair :: (k, v) -> Expr Src Void
recordPair (k :: k
k, v :: v
v) = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit ([(Text, Expr Src Void)] -> Substitutions Src Void
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[("mapKey", k -> Expr Src Void
embedK k
k), ("mapValue", v -> Expr Src Void
embedV v
v)])
Encoder embedK :: k -> Expr Src Void
embedK declaredK :: Expr Src Void
declaredK = InterpretOptions -> Encoder k
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
Encoder embedV :: v -> Expr Src Void
embedV declaredV :: Expr Src Void
declaredV = InterpretOptions -> Encoder v
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
instance (ToDhall k, ToDhall v) => ToDhall (HashMap k v) where
injectWith :: InterpretOptions -> Encoder (HashMap k v)
injectWith options :: InterpretOptions
options = (HashMap k v -> Expr Src Void)
-> Expr Src Void -> Encoder (HashMap k v)
forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder HashMap k v -> Expr Src Void
embedOut Expr Src Void
declaredOut
where
embedOut :: HashMap k v -> Expr Src Void
embedOut m :: HashMap k v
m = Maybe (Expr Src Void) -> Seq (Expr Src Void) -> Expr Src Void
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr Src Void)
listType (HashMap k v -> Seq (Expr Src Void)
mapEntries HashMap k v
m)
where
listType :: Maybe (Expr Src Void)
listType
| HashMap k v -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap k v
m = Expr Src Void -> Maybe (Expr Src Void)
forall a. a -> Maybe a
Just Expr Src Void
declaredOut
| Bool
otherwise = Maybe (Expr Src Void)
forall a. Maybe a
Nothing
declaredOut :: Expr Src Void
declaredOut = Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
List (Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record ([(Text, Expr Src Void)] -> Substitutions Src Void
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[("mapKey", Expr Src Void
declaredK), ("mapValue", Expr Src Void
declaredV)]))
mapEntries :: HashMap k v -> Seq (Expr Src Void)
mapEntries = [Expr Src Void] -> Seq (Expr Src Void)
forall a. [a] -> Seq a
Data.Sequence.fromList ([Expr Src Void] -> Seq (Expr Src Void))
-> (HashMap k v -> [Expr Src Void])
-> HashMap k v
-> Seq (Expr Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> Expr Src Void) -> [(k, v)] -> [Expr Src Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, v) -> Expr Src Void
recordPair ([(k, v)] -> [Expr Src Void])
-> (HashMap k v -> [(k, v)]) -> HashMap k v -> [Expr Src Void]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
recordPair :: (k, v) -> Expr Src Void
recordPair (k :: k
k, v :: v
v) = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit ([(Text, Expr Src Void)] -> Substitutions Src Void
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[("mapKey", k -> Expr Src Void
embedK k
k), ("mapValue", v -> Expr Src Void
embedV v
v)])
Encoder embedK :: k -> Expr Src Void
embedK declaredK :: Expr Src Void
declaredK = InterpretOptions -> Encoder k
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
Encoder embedV :: v -> Expr Src Void
embedV declaredV :: Expr Src Void
declaredV = InterpretOptions -> Encoder v
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
class GenericToDhall f where
genericToDhallWith :: InterpretOptions -> State Int (Encoder (f a))
instance GenericToDhall f => GenericToDhall (M1 D d f) where
genericToDhallWith :: InterpretOptions -> State Int (Encoder (M1 D d f a))
genericToDhallWith options :: InterpretOptions
options = do
Encoder (f a)
res <- InterpretOptions -> State Int (Encoder (f a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options
Encoder (M1 D d f a) -> State Int (Encoder (M1 D d f a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((M1 D d f a -> f a) -> Encoder (f a) -> Encoder (M1 D d f a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap M1 D d f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 Encoder (f a)
res)
instance GenericToDhall f => GenericToDhall (M1 C c f) where
genericToDhallWith :: InterpretOptions -> State Int (Encoder (M1 C c f a))
genericToDhallWith options :: InterpretOptions
options = do
Encoder (f a)
res <- InterpretOptions -> State Int (Encoder (f a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options
Encoder (M1 C c f a) -> State Int (Encoder (M1 C c f a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((M1 C c f a -> f a) -> Encoder (f a) -> Encoder (M1 C c f a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap M1 C c f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 Encoder (f a)
res)
instance (Selector s, ToDhall a) => GenericToDhall (M1 S s (K1 i a)) where
genericToDhallWith :: InterpretOptions -> State Int (Encoder (M1 S s (K1 i a) a))
genericToDhallWith options :: InterpretOptions
options@InterpretOptions{..} = do
let Encoder { embed :: forall a. Encoder a -> a -> Expr Src Void
embed = a -> Expr Src Void
embed', declared :: forall a. Encoder a -> Expr Src Void
declared = Expr Src Void
declared' } =
InterpretOptions -> Encoder a
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
let n :: M1 S s (K1 i a) r
n :: M1 S s (K1 i a) r
n = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined
Text
name <- Text -> Text
fieldModifier (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n
let embed0 :: M1 S s (K1 i a) a -> Expr Src Void
embed0 (M1 (K1 x :: a
x)) = a -> Expr Src Void
embed' a
x
let embed1 :: M1 S s (K1 i a) a -> Expr Src Void
embed1 (M1 (K1 x :: a
x)) =
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit (Text -> Expr Src Void -> Substitutions Src Void
forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name (a -> Expr Src Void
embed' a
x))
let embed :: M1 S s (K1 i a) a -> Expr Src Void
embed =
case SingletonConstructors
singletonConstructors of
Bare -> M1 S s (K1 i a) a -> Expr Src Void
embed0
Smart | M1 S s (K1 i a) Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" -> M1 S s (K1 i a) a -> Expr Src Void
embed0
_ -> M1 S s (K1 i a) a -> Expr Src Void
embed1
let declared :: Expr Src Void
declared =
case SingletonConstructors
singletonConstructors of
Bare ->
Expr Src Void
declared'
Smart | M1 S s (K1 i a) Any -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" ->
Expr Src Void
declared'
_ ->
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record (Text -> Expr Src Void -> Substitutions Src Void
forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name Expr Src Void
declared')
Encoder (M1 S s (K1 i a) a)
-> State Int (Encoder (M1 S s (K1 i a) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
instance (Constructor c1, Constructor c2, GenericToDhall f1, GenericToDhall f2) => GenericToDhall (M1 C c1 f1 :+: M1 C c2 f2) where
genericToDhallWith :: InterpretOptions
-> State Int (Encoder ((:+:) (M1 C c1 f1) (M1 C c2 f2) a))
genericToDhallWith options :: InterpretOptions
options@(InterpretOptions {..}) = Encoder ((:+:) (M1 C c1 f1) (M1 C c2 f2) a)
-> State Int (Encoder ((:+:) (M1 C c1 f1) (M1 C c2 f2) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
where
embed :: (:+:) (M1 C c1 f1) (M1 C c2 f2) a -> Expr Src Void
embed (L1 (M1 l :: f1 a
l)) =
case Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (f1 a -> Expr Src Void
embedL f1 a
l) of
Nothing ->
Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyL
Just valL :: Expr Src Void
valL ->
Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyL) Expr Src Void
valL
embed (R1 (M1 r :: f2 a
r)) =
case Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (f2 a -> Expr Src Void
embedR f2 a
r) of
Nothing ->
Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyR
Just valR :: Expr Src Void
valR ->
Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyR) Expr Src Void
valR
declared :: Expr Src Void
declared =
Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union
([(Text, Maybe (Expr Src Void))] -> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[ (Text
keyL, Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
declaredL)
, (Text
keyR, Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
declaredR)
]
)
nL :: M1 i c1 f1 a
nL :: M1 i c1 f1 a
nL = M1 i c1 f1 a
forall a. HasCallStack => a
undefined
nR :: M1 i c2 f2 a
nR :: M1 i c2 f2 a
nR = M1 i c2 f2 a
forall a. HasCallStack => a
undefined
keyL :: Text
keyL = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (M1 Any c1 f1 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c1 f1 Any
forall i (a :: k). M1 i c1 f1 a
nL))
keyR :: Text
keyR = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (M1 Any c2 f2 Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c2 f2 Any
forall i (a :: k). M1 i c2 f2 a
nR))
Encoder embedL :: f1 a -> Expr Src Void
embedL declaredL :: Expr Src Void
declaredL = State Int (Encoder (f1 a)) -> Int -> Encoder (f1 a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder (f1 a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options) 1
Encoder embedR :: f2 a -> Expr Src Void
embedR declaredR :: Expr Src Void
declaredR = State Int (Encoder (f2 a)) -> Int -> Encoder (f2 a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder (f2 a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options) 1
instance (Constructor c, GenericToDhall (f :+: g), GenericToDhall h) => GenericToDhall ((f :+: g) :+: M1 C c h) where
genericToDhallWith :: InterpretOptions
-> State Int (Encoder ((:+:) (f :+: g) (M1 C c h) a))
genericToDhallWith options :: InterpretOptions
options@(InterpretOptions {..}) = Encoder ((:+:) (f :+: g) (M1 C c h) a)
-> State Int (Encoder ((:+:) (f :+: g) (M1 C c h) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
where
embed :: (:+:) (f :+: g) (M1 C c h) a -> Expr Src Void
embed (L1 l :: (:+:) f g a
l) =
case Maybe (Expr Src Void)
maybeValL of
Nothing -> Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyL
Just valL :: Expr Src Void
valL -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyL) Expr Src Void
valL
where
(keyL :: Text
keyL, maybeValL :: Maybe (Expr Src Void)
maybeValL) =
Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit "genericToDhallWith (:+:)" ((:+:) f g a -> Expr Src Void
embedL (:+:) f g a
l)
embed (R1 (M1 r :: h a
r)) =
case Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (h a -> Expr Src Void
embedR h a
r) of
Nothing -> Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyR
Just valR :: Expr Src Void
valR -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyR) Expr Src Void
valR
nR :: M1 i c h a
nR :: M1 i c h a
nR = M1 i c h a
forall a. HasCallStack => a
undefined
keyR :: Text
keyR = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (M1 Any c h Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c h Any
forall i (a :: k). M1 i c h a
nR))
declared :: Expr Src Void
declared = Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (Text
-> Maybe (Expr Src Void)
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
keyR (Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
declaredR) Map Text (Maybe (Expr Src Void))
ktsL)
Encoder embedL :: (:+:) f g a -> Expr Src Void
embedL declaredL :: Expr Src Void
declaredL = State Int (Encoder ((:+:) f g a)) -> Int -> Encoder ((:+:) f g a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder ((:+:) f g a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options) 1
Encoder embedR :: h a -> Expr Src Void
embedR declaredR :: Expr Src Void
declaredR = State Int (Encoder (h a)) -> Int -> Encoder (h a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder (h a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options) 1
ktsL :: Map Text (Maybe (Expr Src Void))
ktsL = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion "genericToDhallWith (:+:)" Expr Src Void
declaredL
instance (Constructor c, GenericToDhall f, GenericToDhall (g :+: h)) => GenericToDhall (M1 C c f :+: (g :+: h)) where
genericToDhallWith :: InterpretOptions
-> State Int (Encoder ((:+:) (M1 C c f) (g :+: h) a))
genericToDhallWith options :: InterpretOptions
options@(InterpretOptions {..}) = Encoder ((:+:) (M1 C c f) (g :+: h) a)
-> State Int (Encoder ((:+:) (M1 C c f) (g :+: h) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
where
embed :: (:+:) (M1 C c f) (g :+: h) a -> Expr Src Void
embed (L1 (M1 l :: f a
l)) =
case Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit (f a -> Expr Src Void
embedL f a
l) of
Nothing -> Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyL
Just valL :: Expr Src Void
valL -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyL) Expr Src Void
valL
embed (R1 r :: (:+:) g h a
r) =
case Maybe (Expr Src Void)
maybeValR of
Nothing -> Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyR
Just valR :: Expr Src Void
valR -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyR) Expr Src Void
valR
where
(keyR :: Text
keyR, maybeValR :: Maybe (Expr Src Void)
maybeValR) =
Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit "genericToDhallWith (:+:)" ((:+:) g h a -> Expr Src Void
embedR (:+:) g h a
r)
nL :: M1 i c f a
nL :: M1 i c f a
nL = M1 i c f a
forall a. HasCallStack => a
undefined
keyL :: Text
keyL = Text -> Text
constructorModifier (String -> Text
Data.Text.pack (M1 Any c f Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName M1 Any c f Any
forall i (a :: k). M1 i c f a
nL))
declared :: Expr Src Void
declared = Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (Text
-> Maybe (Expr Src Void)
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
keyL (Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Expr Src Void
declaredL) Map Text (Maybe (Expr Src Void))
ktsR)
Encoder embedL :: f a -> Expr Src Void
embedL declaredL :: Expr Src Void
declaredL = State Int (Encoder (f a)) -> Int -> Encoder (f a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder (f a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options) 1
Encoder embedR :: (:+:) g h a -> Expr Src Void
embedR declaredR :: Expr Src Void
declaredR = State Int (Encoder ((:+:) g h a)) -> Int -> Encoder ((:+:) g h a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder ((:+:) g h a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options) 1
ktsR :: Map Text (Maybe (Expr Src Void))
ktsR = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion "genericToDhallWith (:+:)" Expr Src Void
declaredR
instance (GenericToDhall (f :+: g), GenericToDhall (h :+: i)) => GenericToDhall ((f :+: g) :+: (h :+: i)) where
genericToDhallWith :: InterpretOptions
-> State Int (Encoder ((:+:) (f :+: g) (h :+: i) a))
genericToDhallWith options :: InterpretOptions
options = Encoder ((:+:) (f :+: g) (h :+: i) a)
-> State Int (Encoder ((:+:) (f :+: g) (h :+: i) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
where
embed :: (:+:) (f :+: g) (h :+: i) a -> Expr Src Void
embed (L1 l :: (:+:) f g a
l) =
case Maybe (Expr Src Void)
maybeValL of
Nothing -> Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyL
Just valL :: Expr Src Void
valL -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyL) Expr Src Void
valL
where
(keyL :: Text
keyL, maybeValL :: Maybe (Expr Src Void)
maybeValL) =
Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit "genericToDhallWith (:+:)" ((:+:) f g a -> Expr Src Void
embedL (:+:) f g a
l)
embed (R1 r :: (:+:) h i a
r) =
case Maybe (Expr Src Void)
maybeValR of
Nothing -> Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyR
Just valR :: Expr Src Void
valR -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field Expr Src Void
declared Text
keyR) Expr Src Void
valR
where
(keyR :: Text
keyR, maybeValR :: Maybe (Expr Src Void)
maybeValR) =
Text -> Expr Src Void -> (Text, Maybe (Expr Src Void))
unsafeExpectUnionLit "genericToDhallWith (:+:)" ((:+:) h i a -> Expr Src Void
embedR (:+:) h i a
r)
declared :: Expr Src Void
declared = Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
-> Map Text (Maybe (Expr Src Void))
forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union Map Text (Maybe (Expr Src Void))
ktsL Map Text (Maybe (Expr Src Void))
ktsR)
Encoder embedL :: (:+:) f g a -> Expr Src Void
embedL declaredL :: Expr Src Void
declaredL = State Int (Encoder ((:+:) f g a)) -> Int -> Encoder ((:+:) f g a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder ((:+:) f g a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options) 1
Encoder embedR :: (:+:) h i a -> Expr Src Void
embedR declaredR :: Expr Src Void
declaredR = State Int (Encoder ((:+:) h i a)) -> Int -> Encoder ((:+:) h i a)
forall s a. State s a -> s -> a
evalState (InterpretOptions -> State Int (Encoder ((:+:) h i a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options) 1
ktsL :: Map Text (Maybe (Expr Src Void))
ktsL = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion "genericToDhallWith (:+:)" Expr Src Void
declaredL
ktsR :: Map Text (Maybe (Expr Src Void))
ktsR = Text -> Expr Src Void -> Map Text (Maybe (Expr Src Void))
unsafeExpectUnion "genericToDhallWith (:+:)" Expr Src Void
declaredR
instance (GenericToDhall (f :*: g), GenericToDhall (h :*: i)) => GenericToDhall ((f :*: g) :*: (h :*: i)) where
genericToDhallWith :: InterpretOptions
-> State Int (Encoder ((:*:) (f :*: g) (h :*: i) a))
genericToDhallWith options :: InterpretOptions
options = do
Encoder embedL :: (:*:) f g a -> Expr Src Void
embedL declaredL :: Expr Src Void
declaredL <- InterpretOptions -> State Int (Encoder ((:*:) f g a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options
Encoder embedR :: (:*:) h i a -> Expr Src Void
embedR declaredR :: Expr Src Void
declaredR <- InterpretOptions -> State Int (Encoder ((:*:) h i a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options
let embed :: (:*:) (f :*: g) (h :*: i) a -> Expr Src Void
embed (l :: (:*:) f g a
l :*: r :: (:*:) h i a
r) =
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit (Substitutions Src Void
-> Substitutions Src Void -> Substitutions Src Void
forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union Substitutions Src Void
mapL Substitutions Src Void
mapR)
where
mapL :: Substitutions Src Void
mapL =
Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecordLit "genericToDhallWith (:*:)" ((:*:) f g a -> Expr Src Void
embedL (:*:) f g a
l)
mapR :: Substitutions Src Void
mapR =
Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecordLit "genericToDhallWith (:*:)" ((:*:) h i a -> Expr Src Void
embedR (:*:) h i a
r)
let declared :: Expr Src Void
declared = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record (Substitutions Src Void
-> Substitutions Src Void -> Substitutions Src Void
forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union Substitutions Src Void
mapL Substitutions Src Void
mapR)
where
mapL :: Substitutions Src Void
mapL = Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecord "genericToDhallWith (:*:)" Expr Src Void
declaredL
mapR :: Substitutions Src Void
mapR = Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecord "genericToDhallWith (:*:)" Expr Src Void
declaredR
Encoder ((:*:) (f :*: g) (h :*: i) a)
-> State Int (Encoder ((:*:) (f :*: g) (h :*: i) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
instance (GenericToDhall (f :*: g), Selector s, ToDhall a) => GenericToDhall ((f :*: g) :*: M1 S s (K1 i a)) where
genericToDhallWith :: InterpretOptions
-> State Int (Encoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a))
genericToDhallWith options :: InterpretOptions
options@InterpretOptions{..} = do
let nR :: M1 S s (K1 i a) r
nR :: M1 S s (K1 i a) r
nR = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined
Text
nameR <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
nR)
Encoder embedL :: (:*:) f g a -> Expr Src Void
embedL declaredL :: Expr Src Void
declaredL <- InterpretOptions -> State Int (Encoder ((:*:) f g a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options
let Encoder embedR :: a -> Expr Src Void
embedR declaredR :: Expr Src Void
declaredR = InterpretOptions -> Encoder a
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
let embed :: (:*:) (f :*: g) (M1 S s (K1 i a)) a -> Expr Src Void
embed (l :: (:*:) f g a
l :*: M1 (K1 r :: a
r)) =
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit (Text
-> Expr Src Void
-> Substitutions Src Void
-> Substitutions Src Void
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameR (a -> Expr Src Void
embedR a
r) Substitutions Src Void
mapL)
where
mapL :: Substitutions Src Void
mapL =
Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecordLit "genericToDhallWith (:*:)" ((:*:) f g a -> Expr Src Void
embedL (:*:) f g a
l)
let declared :: Expr Src Void
declared = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record (Text
-> Expr Src Void
-> Substitutions Src Void
-> Substitutions Src Void
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameR Expr Src Void
declaredR Substitutions Src Void
mapL)
where
mapL :: Substitutions Src Void
mapL = Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecord "genericToDhallWith (:*:)" Expr Src Void
declaredL
Encoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a)
-> State Int (Encoder ((:*:) (f :*: g) (M1 S s (K1 i a)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
instance (Selector s, ToDhall a, GenericToDhall (f :*: g)) => GenericToDhall (M1 S s (K1 i a) :*: (f :*: g)) where
genericToDhallWith :: InterpretOptions
-> State Int (Encoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a))
genericToDhallWith options :: InterpretOptions
options@InterpretOptions{..} = do
let nL :: M1 S s (K1 i a) r
nL :: M1 S s (K1 i a) r
nL = M1 S s (K1 i a) r
forall a. HasCallStack => a
undefined
Text
nameL <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s (K1 i a) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s (K1 i a) Any
forall k (r :: k). M1 S s (K1 i a) r
nL)
let Encoder embedL :: a -> Expr Src Void
embedL declaredL :: Expr Src Void
declaredL = InterpretOptions -> Encoder a
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
Encoder embedR :: (:*:) f g a -> Expr Src Void
embedR declaredR :: Expr Src Void
declaredR <- InterpretOptions -> State Int (Encoder ((:*:) f g a))
forall k (f :: k -> *) (a :: k).
GenericToDhall f =>
InterpretOptions -> State Int (Encoder (f a))
genericToDhallWith InterpretOptions
options
let embed :: (:*:) (M1 S s (K1 i a)) (f :*: g) a -> Expr Src Void
embed (M1 (K1 l :: a
l) :*: r :: (:*:) f g a
r) =
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit (Text
-> Expr Src Void
-> Substitutions Src Void
-> Substitutions Src Void
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameL (a -> Expr Src Void
embedL a
l) Substitutions Src Void
mapR)
where
mapR :: Substitutions Src Void
mapR =
Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecordLit "genericToDhallWith (:*:)" ((:*:) f g a -> Expr Src Void
embedR (:*:) f g a
r)
let declared :: Expr Src Void
declared = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record (Text
-> Expr Src Void
-> Substitutions Src Void
-> Substitutions Src Void
forall k v. Ord k => k -> v -> Map k v -> Map k v
Dhall.Map.insert Text
nameL Expr Src Void
declaredL Substitutions Src Void
mapR)
where
mapR :: Substitutions Src Void
mapR = Text -> Expr Src Void -> Substitutions Src Void
unsafeExpectRecord "genericToDhallWith (:*:)" Expr Src Void
declaredR
Encoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a)
-> State Int (Encoder ((:*:) (M1 S s (K1 i a)) (f :*: g) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
instance (Selector s1, Selector s2, ToDhall a1, ToDhall a2) => GenericToDhall (M1 S s1 (K1 i1 a1) :*: M1 S s2 (K1 i2 a2)) where
genericToDhallWith :: InterpretOptions
-> State
Int (Encoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
genericToDhallWith options :: InterpretOptions
options@InterpretOptions{..} = do
let nL :: M1 S s1 (K1 i1 a1) r
nL :: M1 S s1 (K1 i1 a1) r
nL = M1 S s1 (K1 i1 a1) r
forall a. HasCallStack => a
undefined
let nR :: M1 S s2 (K1 i2 a2) r
nR :: M1 S s2 (K1 i2 a2) r
nR = M1 S s2 (K1 i2 a2) r
forall a. HasCallStack => a
undefined
Text
nameL <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s1 (K1 i1 a1) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s1 (K1 i1 a1) Any
forall k (r :: k). M1 S s1 (K1 i1 a1) r
nL)
Text
nameR <- (Text -> Text) -> State Int Text -> State Int Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
fieldModifier (M1 S s2 (K1 i2 a2) Any -> State Int Text
forall k (s :: Meta) i (f :: k -> *) (a :: k).
Selector s =>
M1 i s f a -> State Int Text
getSelName M1 S s2 (K1 i2 a2) Any
forall k (r :: k). M1 S s2 (K1 i2 a2) r
nR)
let Encoder embedL :: a1 -> Expr Src Void
embedL declaredL :: Expr Src Void
declaredL = InterpretOptions -> Encoder a1
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
let Encoder embedR :: a2 -> Expr Src Void
embedR declaredR :: Expr Src Void
declaredR = InterpretOptions -> Encoder a2
forall a. ToDhall a => InterpretOptions -> Encoder a
injectWith InterpretOptions
options
let embed :: (:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a -> Expr Src Void
embed (M1 (K1 l :: a1
l) :*: M1 (K1 r :: a2
r)) =
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit
([(Text, Expr Src Void)] -> Substitutions Src Void
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[ (Text
nameL, a1 -> Expr Src Void
embedL a1
l), (Text
nameR, a2 -> Expr Src Void
embedR a2
r) ]
)
let declared :: Expr Src Void
declared =
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record
([(Text, Expr Src Void)] -> Substitutions Src Void
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
[ (Text
nameL, Expr Src Void
declaredL), (Text
nameR, Expr Src Void
declaredR) ]
)
Encoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a)
-> State
Int (Encoder ((:*:) (M1 S s1 (K1 i1 a1)) (M1 S s2 (K1 i2 a2)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
instance GenericToDhall U1 where
genericToDhallWith :: InterpretOptions -> State Int (Encoder (U1 a))
genericToDhallWith _ = Encoder (U1 a) -> State Int (Encoder (U1 a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder {..})
where
embed :: p -> Expr s a
embed _ = Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit Map Text (Expr s a)
forall a. Monoid a => a
mempty
declared :: Expr s a
declared = Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
Record Map Text (Expr s a)
forall a. Monoid a => a
mempty
newtype RecordDecoder a =
RecordDecoder
( Data.Functor.Product.Product
( Control.Applicative.Const
( Dhall.Map.Map
Text
( 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)
record :: RecordDecoder a -> Dhall.Decoder a
record :: RecordDecoder a -> Decoder a
record ( RecordDecoder ( Data.Functor.Product.Pair ( Control.Applicative.Const fields :: Substitutions Src Void
fields ) ( Data.Functor.Compose.Compose extractF :: Expr Src Void -> Extractor Src Void a
extractF ) ) ) =
Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder
{ extract :: Expr Src Void -> Extractor Src Void a
extract =
Expr Src Void -> Extractor Src Void a
extractF
, expected :: Expr Src Void
expected =
Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record Substitutions Src Void
fields
}
field :: Text -> Decoder a -> RecordDecoder a
field :: Text -> Decoder a -> RecordDecoder a
field key :: Text
key valueDecoder :: Decoder a
valueDecoder@(Decoder extract :: Expr Src Void -> Extractor Src Void a
extract expected :: Expr Src Void
expected) =
let
extractBody :: Expr Src Void -> Extractor Src Void a
extractBody expr :: Expr Src Void
expr@(RecordLit fields :: Substitutions Src Void
fields) = case Text -> Substitutions Src Void -> Maybe (Expr Src Void)
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
key Substitutions Src Void
fields of
Just v :: Expr Src Void
v -> Expr Src Void -> Extractor Src Void a
extract Expr Src Void
v
_ -> Expr Src Void -> Expr Src Void -> Extractor Src Void a
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
expr
extractBody expr :: Expr Src Void
expr = Expr Src Void -> Expr Src Void -> Extractor Src Void a
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError Expr Src Void
expected Expr Src Void
expr
in
Product
(Const (Substitutions Src Void))
(Compose ((->) (Expr Src Void)) (Extractor Src Void))
a
-> RecordDecoder a
forall a.
Product
(Const (Substitutions Src Void))
(Compose ((->) (Expr Src Void)) (Extractor Src Void))
a
-> RecordDecoder a
RecordDecoder
( Const (Substitutions Src Void) a
-> Compose ((->) (Expr Src Void)) (Extractor Src Void) a
-> Product
(Const (Substitutions 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
( Substitutions Src Void -> Const (Substitutions Src Void) a
forall k a (b :: k). a -> Const a b
Control.Applicative.Const
( Text -> Expr Src Void -> Substitutions Src Void
forall k v. k -> v -> Map k v
Dhall.Map.singleton
Text
key
( Decoder a -> Expr Src Void
forall a. Decoder a -> Expr Src Void
Dhall.expected Decoder a
valueDecoder )
)
)
( (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 )
)
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 Data.Semigroup.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
forall a b. Coercible a b => a -> b
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
forall a b. Coercible a b => a -> b
coerce (Map Text (Decoder a)
forall a. Monoid a => a
mempty :: Dhall.Map.Map Text (Decoder a))
mappend :: UnionDecoder a -> UnionDecoder a -> UnionDecoder a
mappend = UnionDecoder a -> UnionDecoder a -> UnionDecoder a
forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>)
union :: UnionDecoder a -> Decoder a
union :: UnionDecoder a -> Decoder a
union (UnionDecoder (Data.Functor.Compose.Compose mp :: Map Text (Decoder a)
mp)) = Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expr Src Void -> Decoder a
Decoder
{ extract :: Expr Src Void -> Extractor Src Void a
extract = Expr Src Void -> Extractor Src Void a
extractF
, expected :: 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))
expect
}
where
expect :: Map Text (Maybe (Expr Src Void))
expect = (Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord (Expr Src Void -> Maybe (Expr Src Void))
-> (Decoder a -> Expr Src Void)
-> Decoder a
-> Maybe (Expr Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder a -> Expr Src Void
forall a. Decoder a -> Expr Src Void
Dhall.expected) (Decoder a -> Maybe (Expr Src Void))
-> Map Text (Decoder a) -> Map Text (Maybe (Expr Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Decoder a)
mp
extractF :: Expr Src Void -> Extractor Src Void a
extractF e0 :: Expr Src Void
e0 =
let result :: Maybe (Decoder a, Expr Src Void)
result = do
(fld :: Text
fld, e1 :: Expr Src Void
e1, rest :: 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
Dhall.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
`Dhall.Core.judgmentallyEqual`
Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Dhall.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))
expect)
(Decoder a, Expr Src Void) -> Maybe (Decoder a, Expr Src Void)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder a
t, Expr Src Void
e1)
in Extractor Src Void a
-> ((Decoder a, Expr Src Void) -> Extractor Src Void a)
-> Maybe (Decoder a, Expr Src Void)
-> Extractor Src Void a
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (Expr Src Void -> Expr Src Void -> Extractor Src Void a
forall s a b. Expr s a -> Expr s a -> Extractor s a b
typeError (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))
expect) Expr Src Void
e0) ((Decoder a -> Expr Src Void -> Extractor Src Void a)
-> (Decoder a, Expr Src Void) -> Extractor Src Void a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Decoder a -> Expr Src Void -> Extractor Src Void a
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract) Maybe (Decoder a, Expr Src Void)
result
constructor :: Text -> Decoder a -> UnionDecoder a
constructor :: Text -> Decoder a -> UnionDecoder a
constructor key :: Text
key valueDecoder :: 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) )
(>*<) :: Divisible f => f a -> f b -> f (a, b)
>*< :: f a -> f b -> f (a, b)
(>*<) = f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Divisible f => f a -> f b -> f (a, b)
divided
infixr 5 >*<
newtype RecordEncoder a
= RecordEncoder (Dhall.Map.Map Text (Encoder a))
instance Contravariant RecordEncoder where
contramap :: (a -> b) -> RecordEncoder b -> RecordEncoder a
contramap f :: a -> b
f (RecordEncoder encodeTypeRecord :: Map Text (Encoder b)
encodeTypeRecord) = Map Text (Encoder a) -> RecordEncoder a
forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder (Map Text (Encoder a) -> RecordEncoder a)
-> Map Text (Encoder a) -> RecordEncoder a
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Encoder b -> Encoder a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f (Encoder b -> Encoder a)
-> Map Text (Encoder b) -> Map Text (Encoder a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder b)
encodeTypeRecord
instance Divisible RecordEncoder where
divide :: (a -> (b, c))
-> RecordEncoder b -> RecordEncoder c -> RecordEncoder a
divide f :: a -> (b, c)
f (RecordEncoder bEncoderRecord :: Map Text (Encoder b)
bEncoderRecord) (RecordEncoder cEncoderRecord :: Map Text (Encoder c)
cEncoderRecord) =
Map Text (Encoder a) -> RecordEncoder a
forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder
(Map Text (Encoder a) -> RecordEncoder a)
-> Map Text (Encoder a) -> RecordEncoder a
forall a b. (a -> b) -> a -> b
$ Map Text (Encoder a)
-> Map Text (Encoder a) -> Map Text (Encoder a)
forall k v. Ord k => Map k v -> Map k v -> Map k v
Dhall.Map.union
(((a -> b) -> Encoder b -> Encoder a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((a -> b) -> Encoder b -> Encoder a)
-> (a -> b) -> Encoder b -> Encoder a
forall a b. (a -> b) -> a -> b
$ (b, c) -> b
forall a b. (a, b) -> a
fst ((b, c) -> b) -> (a -> (b, c)) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) (Encoder b -> Encoder a)
-> Map Text (Encoder b) -> Map Text (Encoder a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder b)
bEncoderRecord)
(((a -> c) -> Encoder c -> Encoder a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((a -> c) -> Encoder c -> Encoder a)
-> (a -> c) -> Encoder c -> Encoder a
forall a b. (a -> b) -> a -> b
$ (b, c) -> c
forall a b. (a, b) -> b
snd ((b, c) -> c) -> (a -> (b, c)) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f) (Encoder c -> Encoder a)
-> Map Text (Encoder c) -> Map Text (Encoder a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder c)
cEncoderRecord)
conquer :: RecordEncoder a
conquer = Map Text (Encoder a) -> RecordEncoder a
forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder Map Text (Encoder a)
forall a. Monoid a => a
mempty
encodeFieldWith :: Text -> Encoder a -> RecordEncoder a
encodeFieldWith :: Text -> Encoder a -> RecordEncoder a
encodeFieldWith name :: Text
name encodeType :: Encoder a
encodeType = Map Text (Encoder a) -> RecordEncoder a
forall a. Map Text (Encoder a) -> RecordEncoder a
RecordEncoder (Map Text (Encoder a) -> RecordEncoder a)
-> Map Text (Encoder a) -> RecordEncoder a
forall a b. (a -> b) -> a -> b
$ Text -> Encoder a -> Map Text (Encoder a)
forall k v. k -> v -> Map k v
Dhall.Map.singleton Text
name Encoder a
encodeType
encodeField :: ToDhall a => Text -> RecordEncoder a
encodeField :: Text -> RecordEncoder a
encodeField name :: Text
name = Text -> Encoder a -> RecordEncoder a
forall a. Text -> Encoder a -> RecordEncoder a
encodeFieldWith Text
name Encoder a
forall a. ToDhall a => Encoder a
inject
recordEncoder :: RecordEncoder a -> Encoder a
recordEncoder :: RecordEncoder a -> Encoder a
recordEncoder (RecordEncoder encodeTypeRecord :: Map Text (Encoder a)
encodeTypeRecord) = (a -> Expr Src Void) -> Expr Src Void -> Encoder a
forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder a -> Expr Src Void
makeRecordLit Expr Src Void
recordType
where
recordType :: Expr Src Void
recordType = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
Record (Substitutions Src Void -> Expr Src Void)
-> Substitutions Src Void -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ Encoder a -> Expr Src Void
forall a. Encoder a -> Expr Src Void
declared (Encoder a -> Expr Src Void)
-> Map Text (Encoder a) -> Substitutions Src Void
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder a)
encodeTypeRecord
makeRecordLit :: a -> Expr Src Void
makeRecordLit x :: a
x = Substitutions Src Void -> Expr Src Void
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit (Substitutions Src Void -> Expr Src Void)
-> Substitutions Src Void -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ (((a -> Expr Src Void) -> a -> Expr Src Void
forall a b. (a -> b) -> a -> b
$ a
x) ((a -> Expr Src Void) -> Expr Src Void)
-> (Encoder a -> a -> Expr Src Void) -> Encoder a -> Expr Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder a -> a -> Expr Src Void
forall a. Encoder a -> a -> Expr Src Void
embed) (Encoder a -> Expr Src Void)
-> Map Text (Encoder a) -> Substitutions Src Void
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Encoder a)
encodeTypeRecord
newtype UnionEncoder a =
UnionEncoder
( Data.Functor.Product.Product
( Control.Applicative.Const
( Dhall.Map.Map
Text
( Expr Src Void )
)
)
( Op (Text, Expr Src Void) )
a
)
deriving (b -> UnionEncoder b -> UnionEncoder a
(a -> b) -> UnionEncoder b -> UnionEncoder a
(forall a b. (a -> b) -> UnionEncoder b -> UnionEncoder a)
-> (forall b a. b -> UnionEncoder b -> UnionEncoder a)
-> Contravariant UnionEncoder
forall b a. b -> UnionEncoder b -> UnionEncoder a
forall a b. (a -> b) -> UnionEncoder b -> UnionEncoder a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> f a)
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: b -> UnionEncoder b -> UnionEncoder a
$c>$ :: forall b a. b -> UnionEncoder b -> UnionEncoder a
contramap :: (a -> b) -> UnionEncoder b -> UnionEncoder a
$ccontramap :: forall a b. (a -> b) -> UnionEncoder b -> UnionEncoder a
Contravariant)
(>|<) :: UnionEncoder a -> UnionEncoder b -> UnionEncoder (Either a b)
UnionEncoder (Data.Functor.Product.Pair (Control.Applicative.Const mx :: Substitutions Src Void
mx) (Op fx :: a -> (Text, Expr Src Void)
fx))
>|< :: UnionEncoder a -> UnionEncoder b -> UnionEncoder (Either a b)
>|< UnionEncoder (Data.Functor.Product.Pair (Control.Applicative.Const my :: Substitutions Src Void
my) (Op fy :: b -> (Text, Expr Src Void)
fy)) =
Product
(Const (Substitutions Src Void))
(Op (Text, Expr Src Void))
(Either a b)
-> UnionEncoder (Either a b)
forall a.
Product
(Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
UnionEncoder
( Const (Substitutions Src Void) (Either a b)
-> Op (Text, Expr Src Void) (Either a b)
-> Product
(Const (Substitutions Src Void))
(Op (Text, Expr Src Void))
(Either a b)
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Data.Functor.Product.Pair
( Substitutions Src Void
-> Const (Substitutions Src Void) (Either a b)
forall k a (b :: k). a -> Const a b
Control.Applicative.Const (Substitutions Src Void
mx Substitutions Src Void
-> Substitutions Src Void -> Substitutions Src Void
forall a. Semigroup a => a -> a -> a
<> Substitutions Src Void
my) )
( (Either a b -> (Text, Expr Src Void))
-> Op (Text, Expr Src Void) (Either a b)
forall a b. (b -> a) -> Op a b
Op ((a -> (Text, Expr Src Void))
-> (b -> (Text, Expr Src Void))
-> Either a b
-> (Text, Expr Src Void)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> (Text, Expr Src Void)
fx b -> (Text, Expr Src Void)
fy) )
)
infixr 5 >|<
unionEncoder :: UnionEncoder a -> Encoder a
unionEncoder :: UnionEncoder a -> Encoder a
unionEncoder ( UnionEncoder ( Data.Functor.Product.Pair ( Control.Applicative.Const fields :: Substitutions Src Void
fields ) ( Op embedF :: a -> (Text, Expr Src Void)
embedF ) ) ) =
Encoder :: forall a. (a -> Expr Src Void) -> Expr Src Void -> Encoder a
Encoder
{ embed :: a -> Expr Src Void
embed = \x :: a
x ->
let (name :: Text
name, y :: Expr Src Void
y) = a -> (Text, Expr Src Void)
embedF a
x
in case Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecordLit Expr Src Void
y of
Nothing -> Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field (Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src Void))
fields') Text
name
Just val :: Expr Src Void
val -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr Src Void -> Text -> Expr Src Void
forall s a. Expr s a -> Text -> Expr s a
Field (Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src Void))
fields') Text
name) Expr Src Void
val
, declared :: Expr Src Void
declared =
Map Text (Maybe (Expr Src Void)) -> Expr Src Void
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union Map Text (Maybe (Expr Src Void))
fields'
}
where
fields' :: Map Text (Maybe (Expr Src Void))
fields' = (Expr Src Void -> Maybe (Expr Src Void))
-> Substitutions Src Void -> Map Text (Maybe (Expr Src Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Src Void -> Maybe (Expr Src Void)
forall s a. Expr s a -> Maybe (Expr s a)
notEmptyRecord Substitutions Src Void
fields
encodeConstructorWith
:: Text
-> Encoder a
-> UnionEncoder a
encodeConstructorWith :: Text -> Encoder a -> UnionEncoder a
encodeConstructorWith name :: Text
name encodeType :: Encoder a
encodeType = Product
(Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
forall a.
Product
(Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
UnionEncoder (Product
(Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
-> UnionEncoder a)
-> Product
(Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
-> UnionEncoder a
forall a b. (a -> b) -> a -> b
$
Const (Substitutions Src Void) a
-> Op (Text, Expr Src Void) a
-> Product
(Const (Substitutions Src Void)) (Op (Text, Expr Src Void)) a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Data.Functor.Product.Pair
( Substitutions Src Void -> Const (Substitutions Src Void) a
forall k a (b :: k). a -> Const a b
Control.Applicative.Const
( Text -> Expr Src Void -> Substitutions Src Void
forall k v. k -> v -> Map k v
Dhall.Map.singleton
Text
name
( Encoder a -> Expr Src Void
forall a. Encoder a -> Expr Src Void
declared Encoder a
encodeType )
)
)
( (a -> (Text, Expr Src Void)) -> Op (Text, Expr Src Void) a
forall a b. (b -> a) -> Op a b
Op ( (Text
name,) (Expr Src Void -> (Text, Expr Src Void))
-> (a -> Expr Src Void) -> a -> (Text, Expr Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoder a -> a -> Expr Src Void
forall a. Encoder a -> a -> Expr Src Void
embed Encoder a
encodeType )
)
encodeConstructor
:: ToDhall a
=> Text
-> UnionEncoder a
encodeConstructor :: Text -> UnionEncoder a
encodeConstructor name :: Text
name = Text -> Encoder a -> UnionEncoder a
forall a. Text -> Encoder a -> UnionEncoder a
encodeConstructorWith Text
name Encoder a
forall a. ToDhall a => Encoder a
inject