{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE PatternSynonyms      #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns         #-}

{-| Eval-apply environment machine with conversion checking and quoting to
    normal forms. Fairly similar to GHCI's STG machine algorithmically, but much
    simpler, with no known call optimization or environment trimming.

    Potential optimizations without changing Expr:

    * In conversion checking, get non-shadowing variables not by linear
      Env-walking, but by keeping track of Env size, and generating names which
      are known to be illegal as source-level names (to rule out shadowing).

    * Use HashMap Text chunks for large let-definitions blocks. "Large" vs
      "Small" is fairly cheap to determine at evaluation time.

    Potential optimizations with changing Expr:

    * Use actual full de Bruijn indices in Var instead of Text counting indices.
      Then, we'd switch to full de Bruijn levels in Val as well, and use proper
      constant time non-shadowing name generation.
-}

module Dhall.Eval (
    judgmentallyEqual
  , normalize
  , alphaNormalize
  , eval
  , quote
  , envNames
  , countNames
  , conv
  , toVHPi
  , Closure(..)
  , Names(..)
  , Environment(..)
  , Val(..)
  , (~>)
  , textShow
  , dateShow
  , timeShow
  , timezoneShow
  ) where

import Data.Bifunctor     (first)
import Data.ByteString    (ByteString)
import Data.Foldable      (foldr', toList)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Sequence      (Seq, ViewL (..), ViewR (..))
import Data.Text          (Text)
import Data.Time          (Day, TimeOfDay(..), TimeZone)
import Data.Void          (Void)
import Dhall.Map          (Map)
import Dhall.Set          (Set)
import GHC.Natural        (Natural)
import Prelude            hiding (succ)

import Dhall.Syntax
    ( Binding (..)
    , Chunks (..)
    , Const (..)
    , DhallDouble (..)
    , Expr (..)
    , FunctionBinding (..)
    , PreferAnnotation (..)
    , RecordField (..)
    , Var (..)
    , WithComponent (..)
    )

import qualified Data.Char
import qualified Data.Sequence as Sequence
import qualified Data.Set
import qualified Data.Text     as Text
import qualified Data.Time     as Time
import qualified Dhall.Map     as Map
import qualified Dhall.Set
import qualified Dhall.Syntax  as Syntax
import qualified Text.Printf   as Printf

data Environment a
    = Empty
    | Skip   !(Environment a) {-# UNPACK #-} !Text
    | Extend !(Environment a) {-# UNPACK #-} !Text (Val a)

deriving instance (Show a, Show (Val a -> Val a)) => Show (Environment a)

errorMsg :: String
errorMsg :: String
errorMsg = [String] -> String
unlines
  [ String
_ERROR forall a. Semigroup a => a -> a -> a
<> String
": Compiler bug                                                        "
  , String
"                                                                                "
  , String
"An ill-typed expression was encountered during normalization.                   "
  , String
"Explanation: This error message means that there is a bug in the Dhall compiler."
  , String
"You didn't do anything wrong, but if you would like to see this problem fixed   "
  , String
"then you should report the bug at:                                              "
  , String
"                                                                                "
  , String
"https://github.com/dhall-lang/dhall-haskell/issues                              "
  ]
  where
    _ERROR :: String
    _ERROR :: String
_ERROR = String
"\ESC[1;31mError\ESC[0m"


data Closure a = Closure !Text !(Environment a) !(Expr Void a)

deriving instance (Show a, Show (Val a -> Val a)) => Show (Closure a)

data VChunks a = VChunks ![(Text, Val a)] !Text

deriving instance (Show a, Show (Val a -> Val a)) => Show (VChunks a)

instance Semigroup (VChunks a) where
  VChunks [(Text, Val a)]
xys Text
z <> :: VChunks a -> VChunks a -> VChunks a
<> VChunks [] Text
z' = forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [(Text, Val a)]
xys (Text
z forall a. Semigroup a => a -> a -> a
<> Text
z')
  VChunks [(Text, Val a)]
xys Text
z <> VChunks ((Text
x', Val a
y'):[(Text, Val a)]
xys') Text
z' = forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks ([(Text, Val a)]
xys forall a. [a] -> [a] -> [a]
++ (Text
z forall a. Semigroup a => a -> a -> a
<> Text
x', Val a
y')forall a. a -> [a] -> [a]
:[(Text, Val a)]
xys') Text
z'

instance Monoid (VChunks a) where
  mempty :: VChunks a
mempty = forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] forall a. Monoid a => a
mempty

{-| Some information is lost when `eval` converts a `Lam` or a built-in function
    from the `Expr` type to a `VHLam` of the `Val` type and `quote` needs that
    information in order to reconstruct an equivalent `Expr`.  This `HLamInfo`
    type holds that extra information necessary to perform that reconstruction
-}
data HLamInfo a
  = Prim
  -- ^ Don't store any information
  | Typed !Text (Val a)
  -- ^ Store the original name and type of the variable bound by the `Lam`
  | NaturalSubtractZero
  -- ^ The original function was a @Natural/subtract 0@.  We need to preserve
  --   this information in case the @Natural/subtract@ ends up not being fully
  --   saturated, in which case we need to recover the unsaturated built-in
  | TextReplaceEmpty
  -- ^ The original function was a @Text/replace ""@
  | TextReplaceEmptyArgument (Val a)
  -- ^ The original function was a @Text/replace "" replacement@

deriving instance (Show a, Show (Val a -> Val a)) => Show (HLamInfo a)

pattern VPrim :: (Val a -> Val a) -> Val a
pattern $bVPrim :: forall a. (Val a -> Val a) -> Val a
$mVPrim :: forall {r} {a}.
Val a -> ((Val a -> Val a) -> r) -> ((# #) -> r) -> r
VPrim f = VHLam Prim f

toVHPi :: Eq a => Val a -> Maybe (Text, Val a, Val a -> Val a)
toVHPi :: forall a. Eq a => Val a -> Maybe (Text, Val a, Val a -> Val a)
toVHPi (VPi Val a
a b :: Closure a
b@(Closure Text
x Environment a
_ Expr Void a
_)) = forall a. a -> Maybe a
Just (Text
x, Val a
a, forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
b)
toVHPi (VHPi Text
x Val a
a Val a -> Val a
b             ) = forall a. a -> Maybe a
Just (Text
x, Val a
a, Val a -> Val a
b)
toVHPi  Val a
_                        = forall a. Maybe a
Nothing
{-# INLINABLE toVHPi #-}

data Val a
    = VConst !Const
    | VVar !Text !Int
    | VPrimVar
    | VApp !(Val a) !(Val a)

    | VLam (Val a) {-# UNPACK #-} !(Closure a)
    | VHLam !(HLamInfo a) !(Val a -> Val a)

    | VPi (Val a) {-# UNPACK #-} !(Closure a)
    | VHPi !Text (Val a) !(Val a -> Val a)

    | VBool
    | VBoolLit !Bool
    | VBoolAnd !(Val a) !(Val a)
    | VBoolOr !(Val a) !(Val a)
    | VBoolEQ !(Val a) !(Val a)
    | VBoolNE !(Val a) !(Val a)
    | VBoolIf !(Val a) !(Val a) !(Val a)

    | VBytes
    | VBytesLit ByteString

    | VNatural
    | VNaturalLit !Natural
    | VNaturalFold !(Val a) !(Val a) !(Val a) !(Val a)
    | VNaturalBuild !(Val a)
    | VNaturalIsZero !(Val a)
    | VNaturalEven !(Val a)
    | VNaturalOdd !(Val a)
    | VNaturalToInteger !(Val a)
    | VNaturalShow !(Val a)
    | VNaturalSubtract !(Val a) !(Val a)
    | VNaturalPlus !(Val a) !(Val a)
    | VNaturalTimes !(Val a) !(Val a)

    | VInteger
    | VIntegerLit !Integer
    | VIntegerClamp !(Val a)
    | VIntegerNegate !(Val a)
    | VIntegerShow !(Val a)
    | VIntegerToDouble !(Val a)

    | VDouble
    | VDoubleLit !DhallDouble
    | VDoubleShow !(Val a)

    | VText
    | VTextLit !(VChunks a)
    | VTextAppend !(Val a) !(Val a)
    | VTextShow !(Val a)
    | VTextReplace !(Val a) !(Val a) !(Val a)

    | VDate
    | VDateLiteral Time.Day
    | VDateShow !(Val a)
    | VTime
    | VTimeLiteral Time.TimeOfDay Word
    | VTimeShow !(Val a)
    | VTimeZone
    | VTimeZoneLiteral Time.TimeZone
    | VTimeZoneShow !(Val a)

    | VList !(Val a)
    | VListLit !(Maybe (Val a)) !(Seq (Val a))
    | VListAppend !(Val a) !(Val a)
    | VListBuild   (Val a) !(Val a)
    | VListFold    (Val a) !(Val a) !(Val a) !(Val a) !(Val a)
    | VListLength  (Val a) !(Val a)
    | VListHead    (Val a) !(Val a)
    | VListLast    (Val a) !(Val a)
    | VListIndexed (Val a) !(Val a)
    | VListReverse (Val a) !(Val a)

    | VOptional (Val a)
    | VSome (Val a)
    | VNone (Val a)
    | VRecord !(Map Text (Val a))
    | VRecordLit !(Map Text (Val a))
    | VUnion !(Map Text (Maybe (Val a)))
    | VCombine !(Maybe Text) !(Val a) !(Val a)
    | VCombineTypes !(Val a) !(Val a)
    | VPrefer !(Val a) !(Val a)
    | VMerge !(Val a) !(Val a) !(Maybe (Val a))
    | VToMap !(Val a) !(Maybe (Val a))
    | VShowConstructor !(Val a)
    | VField !(Val a) !Text
    | VInject !(Map Text (Maybe (Val a))) !Text !(Maybe (Val a))
    | VProject !(Val a) !(Either (Set Text) (Val a))
    | VAssert !(Val a)
    | VEquivalent !(Val a) !(Val a)
    | VWith !(Val a) (NonEmpty WithComponent) !(Val a)
    | VEmbed a

-- | For use with "Text.Show.Functions".
deriving instance (Show a, Show (Val a -> Val a)) => Show (Val a)

(~>) :: Val a -> Val a -> Val a
~> :: forall a. Val a -> Val a -> Val a
(~>) Val a
a Val a
b = forall a. Text -> Val a -> (Val a -> Val a) -> Val a
VHPi Text
"_" Val a
a (\Val a
_ -> Val a
b)
{-# INLINE (~>) #-}

infixr 5 ~>

countEnvironment :: Text -> Environment a -> Int
countEnvironment :: forall a. Text -> Environment a -> Int
countEnvironment Text
x = forall {t} {a}. Num t => t -> Environment a -> t
go (Int
0 :: Int)
  where
    go :: t -> Environment a -> t
go !t
acc Environment a
Empty             = t
acc
    go  t
acc (Skip Environment a
env Text
x'    ) = t -> Environment a -> t
go (if Text
x forall a. Eq a => a -> a -> Bool
== Text
x' then t
acc forall a. Num a => a -> a -> a
+ t
1 else t
acc) Environment a
env
    go  t
acc (Extend Environment a
env Text
x' Val a
_) = t -> Environment a -> t
go (if Text
x forall a. Eq a => a -> a -> Bool
== Text
x' then t
acc forall a. Num a => a -> a -> a
+ t
1 else t
acc) Environment a
env

instantiate :: Eq a => Closure a -> Val a -> Val a
instantiate :: forall a. Eq a => Closure a -> Val a -> Val a
instantiate (Closure Text
x Environment a
env Expr Void a
t) !Val a
u = forall a. Eq a => Environment a -> Expr Void a -> Val a
eval (forall a. Environment a -> Text -> Val a -> Environment a
Extend Environment a
env Text
x Val a
u) Expr Void a
t
{-# INLINE instantiate #-}

-- Out-of-env variables have negative de Bruijn levels.
vVar :: Environment a -> Var -> Val a
vVar :: forall a. Environment a -> Var -> Val a
vVar Environment a
env0 (V Text
x Int
i0) = forall {a}. Environment a -> Int -> Val a
go Environment a
env0 Int
i0
  where
    go :: Environment a -> Int -> Val a
go (Extend Environment a
env Text
x' Val a
v) Int
i
        | Text
x forall a. Eq a => a -> a -> Bool
== Text
x' =
            if Int
i forall a. Eq a => a -> a -> Bool
== Int
0 then Val a
v else Environment a -> Int -> Val a
go Environment a
env (Int
i forall a. Num a => a -> a -> a
- Int
1)
        | Bool
otherwise =
            Environment a -> Int -> Val a
go Environment a
env Int
i
    go (Skip Environment a
env Text
x') Int
i
        | Text
x forall a. Eq a => a -> a -> Bool
== Text
x' =
            if Int
i forall a. Eq a => a -> a -> Bool
== Int
0 then forall a. Text -> Int -> Val a
VVar Text
x (forall a. Text -> Environment a -> Int
countEnvironment Text
x Environment a
env) else Environment a -> Int -> Val a
go Environment a
env (Int
i forall a. Num a => a -> a -> a
- Int
1)
        | Bool
otherwise =
            Environment a -> Int -> Val a
go Environment a
env Int
i
    go Environment a
Empty Int
i =
        forall a. Text -> Int -> Val a
VVar Text
x (forall a. Num a => a -> a
negate Int
i forall a. Num a => a -> a -> a
- Int
1)

vApp :: Eq a => Val a -> Val a -> Val a
vApp :: forall a. Eq a => Val a -> Val a -> Val a
vApp !Val a
t !Val a
u =
    case Val a
t of
        VLam Val a
_ Closure a
t'  -> forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
t' Val a
u
        VHLam HLamInfo a
_ Val a -> Val a
t' -> Val a -> Val a
t' Val a
u
        Val a
t'        -> forall a. Val a -> Val a -> Val a
VApp Val a
t' Val a
u
{-# INLINE vApp #-}

vPrefer :: Eq a => Environment a -> Val a -> Val a -> Val a
vPrefer :: forall a. Eq a => Environment a -> Val a -> Val a -> Val a
vPrefer Environment a
env Val a
t Val a
u =
    case (Val a
t, Val a
u) of
        (VRecordLit Map Text (Val a)
m, Val a
u') | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Val a)
m ->
            Val a
u'
        (Val a
t', VRecordLit Map Text (Val a)
m) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Val a)
m ->
            Val a
t'
        (VRecordLit Map Text (Val a)
m, VRecordLit Map Text (Val a)
m') ->
            forall a. Map Text (Val a) -> Val a
VRecordLit (forall k v. Ord k => Map k v -> Map k v -> Map k v
Map.union Map Text (Val a)
m' Map Text (Val a)
m)
        (Val a
t', Val a
u') | forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t' Val a
u' ->
            Val a
t'
        (Val a
t', Val a
u') ->
            forall a. Val a -> Val a -> Val a
VPrefer Val a
t' Val a
u'
{-# INLINE vPrefer #-}

vCombine :: Maybe Text -> Val a -> Val a -> Val a
vCombine :: forall a. Maybe Text -> Val a -> Val a -> Val a
vCombine Maybe Text
mk Val a
t Val a
u =
    case (Val a
t, Val a
u) of
        (VRecordLit Map Text (Val a)
m, Val a
u') | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Val a)
m ->
            Val a
u'
        (Val a
t', VRecordLit Map Text (Val a)
m) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Val a)
m ->
            Val a
t'
        (VRecordLit Map Text (Val a)
m, VRecordLit Map Text (Val a)
m') ->
            forall a. Map Text (Val a) -> Val a
VRecordLit (forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v
Map.unionWith (forall a. Maybe Text -> Val a -> Val a -> Val a
vCombine forall a. Maybe a
Nothing) Map Text (Val a)
m Map Text (Val a)
m')
        (Val a
t', Val a
u') ->
            forall a. Maybe Text -> Val a -> Val a -> Val a
VCombine Maybe Text
mk Val a
t' Val a
u'

vCombineTypes :: Val a -> Val a -> Val a
vCombineTypes :: forall a. Val a -> Val a -> Val a
vCombineTypes Val a
t Val a
u =
    case (Val a
t, Val a
u) of
        (VRecord Map Text (Val a)
m, Val a
u') | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Val a)
m ->
            Val a
u'
        (Val a
t', VRecord Map Text (Val a)
m) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Val a)
m ->
            Val a
t'
        (VRecord Map Text (Val a)
m, VRecord Map Text (Val a)
m') ->
            forall a. Map Text (Val a) -> Val a
VRecord (forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v
Map.unionWith forall a. Val a -> Val a -> Val a
vCombineTypes Map Text (Val a)
m Map Text (Val a)
m')
        (Val a
t', Val a
u') ->
            forall a. Val a -> Val a -> Val a
VCombineTypes Val a
t' Val a
u'

vListAppend :: Val a -> Val a -> Val a
vListAppend :: forall a. Val a -> Val a -> Val a
vListAppend Val a
t Val a
u =
    case (Val a
t, Val a
u) of
        (VListLit Maybe (Val a)
_ Seq (Val a)
xs, Val a
u') | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Val a)
xs ->
            Val a
u'
        (Val a
t', VListLit Maybe (Val a)
_ Seq (Val a)
ys) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Val a)
ys ->
            Val a
t'
        (VListLit Maybe (Val a)
t' Seq (Val a)
xs, VListLit Maybe (Val a)
_ Seq (Val a)
ys) ->
            forall a. Maybe (Val a) -> Seq (Val a) -> Val a
VListLit Maybe (Val a)
t' (Seq (Val a)
xs forall a. Semigroup a => a -> a -> a
<> Seq (Val a)
ys)
        (Val a
t', Val a
u') ->
            forall a. Val a -> Val a -> Val a
VListAppend Val a
t' Val a
u'
{-# INLINE vListAppend #-}

vNaturalPlus :: Val a -> Val a -> Val a
vNaturalPlus :: forall a. Val a -> Val a -> Val a
vNaturalPlus Val a
t Val a
u =
    case (Val a
t, Val a
u) of
        (VNaturalLit Natural
0, Val a
u') ->
            Val a
u'
        (Val a
t', VNaturalLit Natural
0) ->
            Val a
t'
        (VNaturalLit Natural
m, VNaturalLit Natural
n) ->
            forall a. Natural -> Val a
VNaturalLit (Natural
m forall a. Num a => a -> a -> a
+ Natural
n)
        (Val a
t', Val a
u') ->
            forall a. Val a -> Val a -> Val a
VNaturalPlus Val a
t' Val a
u'
{-# INLINE vNaturalPlus #-}

vField :: Val a -> Text -> Val a
vField :: forall a. Val a -> Text -> Val a
vField Val a
t0 Text
k = forall {a}. Val a -> Val a
go Val a
t0
  where
    go :: Val a -> Val a
go = \case
        VUnion Map Text (Maybe (Val a))
m -> case forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
k Map Text (Maybe (Val a))
m of
            Just (Just Val a
_) -> forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \ ~Val a
u -> forall a.
Map Text (Maybe (Val a)) -> Text -> Maybe (Val a) -> Val a
VInject Map Text (Maybe (Val a))
m Text
k (forall a. a -> Maybe a
Just Val a
u)
            Just Maybe (Val a)
Nothing  -> forall a.
Map Text (Maybe (Val a)) -> Text -> Maybe (Val a) -> Val a
VInject Map Text (Maybe (Val a))
m Text
k forall a. Maybe a
Nothing
            Maybe (Maybe (Val a))
_             -> forall a. HasCallStack => String -> a
error String
errorMsg
        VRecordLit Map Text (Val a)
m
            | Just Val a
v <- forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
k Map Text (Val a)
m -> Val a
v
            | Bool
otherwise -> forall a. HasCallStack => String -> a
error String
errorMsg
        VProject Val a
t Either (Set Text) (Val a)
_ -> Val a -> Val a
go Val a
t
        VPrefer (VRecordLit Map Text (Val a)
m) Val a
r -> case forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
k Map Text (Val a)
m of
            Just Val a
v -> forall a. Val a -> Text -> Val a
VField (forall a. Val a -> Val a -> Val a
VPrefer (forall {a}. Val a -> Val a
singletonVRecordLit Val a
v) Val a
r) Text
k
            Maybe (Val a)
Nothing -> Val a -> Val a
go Val a
r
        VPrefer Val a
l (VRecordLit Map Text (Val a)
m) -> case forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
k Map Text (Val a)
m of
            Just Val a
v -> Val a
v
            Maybe (Val a)
Nothing -> Val a -> Val a
go Val a
l
        VCombine Maybe Text
mk (VRecordLit Map Text (Val a)
m) Val a
r -> case forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
k Map Text (Val a)
m of
            Just Val a
v -> forall a. Val a -> Text -> Val a
VField (forall a. Maybe Text -> Val a -> Val a -> Val a
VCombine Maybe Text
mk (forall {a}. Val a -> Val a
singletonVRecordLit Val a
v) Val a
r) Text
k
            Maybe (Val a)
Nothing -> Val a -> Val a
go Val a
r
        VCombine Maybe Text
mk Val a
l (VRecordLit Map Text (Val a)
m) -> case forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
k Map Text (Val a)
m of
            Just Val a
v -> forall a. Val a -> Text -> Val a
VField (forall a. Maybe Text -> Val a -> Val a -> Val a
VCombine Maybe Text
mk Val a
l (forall {a}. Val a -> Val a
singletonVRecordLit Val a
v)) Text
k
            Maybe (Val a)
Nothing -> Val a -> Val a
go Val a
l
        Val a
t -> forall a. Val a -> Text -> Val a
VField Val a
t Text
k

    singletonVRecordLit :: Val a -> Val a
singletonVRecordLit Val a
v = forall a. Map Text (Val a) -> Val a
VRecordLit (forall k v. k -> v -> Map k v
Map.singleton Text
k Val a
v)
{-# INLINE vField #-}

vTextReplace :: Text -> Val a -> Text -> VChunks a
vTextReplace :: forall a. Text -> Val a -> Text -> VChunks a
vTextReplace Text
needle Val a
replacement Text
haystack = Text -> VChunks a
go Text
haystack
  where
    go :: Text -> VChunks a
go Text
t
        | Text -> Bool
Text.null Text
suffix = forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] Text
t
        | Bool
otherwise =
            let remainder :: Text
remainder = Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
needle) Text
suffix

                rest :: VChunks a
rest = Text -> VChunks a
go Text
remainder

            in  case Val a
replacement of
                    VTextLit VChunks a
replacementChunks ->
                        forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] Text
prefix forall a. Semigroup a => a -> a -> a
<> VChunks a
replacementChunks forall a. Semigroup a => a -> a -> a
<> VChunks a
rest
                    Val a
_ ->
                        forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [(Text
prefix, Val a
replacement)] Text
"" forall a. Semigroup a => a -> a -> a
<> VChunks a
rest
      where
        (Text
prefix, Text
suffix) = Text -> Text -> (Text, Text)
Text.breakOn Text
needle Text
t

vProjectByFields :: Eq a => Environment a -> Val a -> Set Text -> Val a
vProjectByFields :: forall a. Eq a => Environment a -> Val a -> Set Text -> Val a
vProjectByFields Environment a
env Val a
t Set Text
ks =
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Text
ks
        then forall a. Map Text (Val a) -> Val a
VRecordLit forall a. Monoid a => a
mempty
        else case Val a
t of
            VRecordLit Map Text (Val a)
kvs ->
                let kvs' :: Map Text (Val a)
kvs' = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Text (Val a)
kvs (forall a. Set a -> Set a
Dhall.Set.toSet Set Text
ks)
                in  forall a. Map Text (Val a) -> Val a
VRecordLit Map Text (Val a)
kvs'
            VProject Val a
t' Either (Set Text) (Val a)
_ ->
                forall a. Eq a => Environment a -> Val a -> Set Text -> Val a
vProjectByFields Environment a
env Val a
t' Set Text
ks
            VPrefer Val a
l (VRecordLit Map Text (Val a)
kvs) ->
                let ksSet :: Set Text
ksSet = forall a. Set a -> Set a
Dhall.Set.toSet Set Text
ks

                    kvs' :: Map Text (Val a)
kvs' = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Text (Val a)
kvs Set Text
ksSet

                    ks' :: Set Text
ks' =
                        forall a. Set a -> Set a
Dhall.Set.fromSet
                            (forall a. Ord a => Set a -> Set a -> Set a
Data.Set.difference Set Text
ksSet (forall k v. Map k v -> Set k
Map.keysSet Map Text (Val a)
kvs'))

                in  forall a. Eq a => Environment a -> Val a -> Val a -> Val a
vPrefer Environment a
env (forall a. Eq a => Environment a -> Val a -> Set Text -> Val a
vProjectByFields Environment a
env Val a
l Set Text
ks') (forall a. Map Text (Val a) -> Val a
VRecordLit Map Text (Val a)
kvs')
            Val a
t' ->
                forall a. Val a -> Either (Set Text) (Val a) -> Val a
VProject Val a
t' (forall a b. a -> Either a b
Left Set Text
ks)

vWith :: Val a -> NonEmpty WithComponent -> Val a -> Val a
vWith :: forall a. Val a -> NonEmpty WithComponent -> Val a -> Val a
vWith (VRecordLit Map Text (Val a)
kvs) (WithLabel Text
k  :| []     ) Val a
v = forall a. Map Text (Val a) -> Val a
VRecordLit (forall k v. Ord k => k -> v -> Map k v -> Map k v
Map.insert Text
k  Val a
v  Map Text (Val a)
kvs)
vWith (VRecordLit Map Text (Val a)
kvs) (WithLabel Text
k₀ :| WithComponent
k₁ : [WithComponent]
ks) Val a
v = forall a. Map Text (Val a) -> Val a
VRecordLit (forall k v. Ord k => k -> v -> Map k v -> Map k v
Map.insert Text
k₀ Val a
e₂ Map Text (Val a)
kvs)
  where
    e₁ :: Val a
e₁ =
        case forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
k₀ Map Text (Val a)
kvs of
            Maybe (Val a)
Nothing  -> forall a. Map Text (Val a) -> Val a
VRecordLit forall a. Monoid a => a
mempty
            Just Val a
e₁' -> Val a
e₁'

    e₂ :: Val a
e₂ = forall a. Val a -> NonEmpty WithComponent -> Val a -> Val a
vWith Val a
e₁ (WithComponent
k₁ forall a. a -> [a] -> NonEmpty a
:| [WithComponent]
ks) Val a
v
vWith (VNone Val a
_T) (WithComponent
WithQuestion :| [WithComponent]
_      ) Val a
_ = forall {a}. Val a -> Val a
VNone Val a
_T
vWith (VSome  Val a
_) (WithComponent
WithQuestion :| []     ) Val a
v = forall {a}. Val a -> Val a
VSome Val a
v
vWith (VSome  Val a
t) (WithComponent
WithQuestion :| WithComponent
k₁ : [WithComponent]
ks) Val a
v = forall {a}. Val a -> Val a
VSome (forall a. Val a -> NonEmpty WithComponent -> Val a -> Val a
vWith Val a
t (WithComponent
k₁ forall a. a -> [a] -> NonEmpty a
:| [WithComponent]
ks) Val a
v)
vWith Val a
e₀ NonEmpty WithComponent
ks Val a
v₀ = forall a. Val a -> NonEmpty WithComponent -> Val a -> Val a
VWith Val a
e₀ NonEmpty WithComponent
ks Val a
v₀

eval :: forall a. Eq a => Environment a -> Expr Void a -> Val a
eval :: forall a. Eq a => Environment a -> Expr Void a -> Val a
eval !Environment a
env Expr Void a
t0 =
    case Expr Void a
t0 of
        Const Const
k ->
            forall a. Const -> Val a
VConst Const
k
        Var Var
v ->
            forall a. Environment a -> Var -> Val a
vVar Environment a
env Var
v
        Lam Maybe CharacterSet
_ (FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
x, functionBindingAnnotation :: forall s a. FunctionBinding s a -> Expr s a
functionBindingAnnotation = Expr Void a
a }) Expr Void a
t ->
            forall a. Val a -> Closure a -> Val a
VLam (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
a) (forall a. Text -> Environment a -> Expr Void a -> Closure a
Closure Text
x Environment a
env Expr Void a
t)
        Pi Maybe CharacterSet
_ Text
x Expr Void a
a Expr Void a
b ->
            forall a. Val a -> Closure a -> Val a
VPi (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
a) (forall a. Text -> Environment a -> Expr Void a -> Closure a
Closure Text
x Environment a
env Expr Void a
b)
        App Expr Void a
t Expr Void a
u ->
            forall a. Eq a => Val a -> Val a -> Val a
vApp (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u)
        Let (Binding Maybe Void
_ Text
x Maybe Void
_ Maybe (Maybe Void, Expr Void a)
_mA Maybe Void
_ Expr Void a
a) Expr Void a
b ->
            let !env' :: Environment a
env' = forall a. Environment a -> Text -> Val a -> Environment a
Extend Environment a
env Text
x (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
a)
            in  forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env' Expr Void a
b
        Annot Expr Void a
t Expr Void a
_ ->
            forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t
        Expr Void a
Bool ->
            forall a. Val a
VBool
        BoolLit Bool
b ->
            forall a. Bool -> Val a
VBoolLit Bool
b
        BoolAnd Expr Void a
t Expr Void a
u ->
            case (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t, forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u) of
                (VBoolLit Bool
True, Val a
u')       -> Val a
u'
                (VBoolLit Bool
False, Val a
_)       -> forall a. Bool -> Val a
VBoolLit Bool
False
                (Val a
t', VBoolLit Bool
True)       -> Val a
t'
                (Val a
_ , VBoolLit Bool
False)      -> forall a. Bool -> Val a
VBoolLit Bool
False
                (Val a
t', Val a
u') | forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t' Val a
u' -> Val a
t'
                (Val a
t', Val a
u')                  -> forall a. Val a -> Val a -> Val a
VBoolAnd Val a
t' Val a
u'
        BoolOr Expr Void a
t Expr Void a
u ->
            case (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t, forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u) of
                (VBoolLit Bool
False, Val a
u')      -> Val a
u'
                (VBoolLit Bool
True, Val a
_)        -> forall a. Bool -> Val a
VBoolLit Bool
True
                (Val a
t', VBoolLit Bool
False)      -> Val a
t'
                (Val a
_ , VBoolLit Bool
True)       -> forall a. Bool -> Val a
VBoolLit Bool
True
                (Val a
t', Val a
u') | forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t' Val a
u' -> Val a
t'
                (Val a
t', Val a
u')                  -> forall a. Val a -> Val a -> Val a
VBoolOr Val a
t' Val a
u'
        BoolEQ Expr Void a
t Expr Void a
u ->
            case (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t, forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u) of
                (VBoolLit Bool
True, Val a
u')       -> Val a
u'
                (Val a
t', VBoolLit Bool
True)       -> Val a
t'
                (Val a
t', Val a
u') | forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t' Val a
u' -> forall a. Bool -> Val a
VBoolLit Bool
True
                (Val a
t', Val a
u')                  -> forall a. Val a -> Val a -> Val a
VBoolEQ Val a
t' Val a
u'
        BoolNE Expr Void a
t Expr Void a
u ->
            case (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t, forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u) of
                (VBoolLit Bool
False, Val a
u')      -> Val a
u'
                (Val a
t', VBoolLit Bool
False)      -> Val a
t'
                (Val a
t', Val a
u') | forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t' Val a
u' -> forall a. Bool -> Val a
VBoolLit Bool
False
                (Val a
t', Val a
u')                  -> forall a. Val a -> Val a -> Val a
VBoolNE Val a
t' Val a
u'
        BoolIf Expr Void a
b Expr Void a
t Expr Void a
f ->
            case (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
b, forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t, forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
f) of
                (VBoolLit Bool
True,  Val a
t', Val a
_ )            -> Val a
t'
                (VBoolLit Bool
False, Val a
_ , Val a
f')            -> Val a
f'
                (Val a
b', VBoolLit Bool
True, VBoolLit Bool
False) -> Val a
b'
                (Val a
_, Val a
t', Val a
f') | forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t' Val a
f'        -> Val a
t'
                (Val a
b', Val a
t', Val a
f')                        -> forall a. Val a -> Val a -> Val a -> Val a
VBoolIf Val a
b' Val a
t' Val a
f'
        Expr Void a
Bytes ->
            forall a. Val a
VBytes
        BytesLit ByteString
b ->
            forall a. ByteString -> Val a
VBytesLit ByteString
b
        Expr Void a
Natural ->
            forall a. Val a
VNatural
        NaturalLit Natural
n ->
            forall a. Natural -> Val a
VNaturalLit Natural
n
        Expr Void a
NaturalFold ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
n ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
natural ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
succ ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
zero ->
            let inert :: Val a
inert = forall a. Val a -> Val a -> Val a -> Val a -> Val a
VNaturalFold Val a
n Val a
natural Val a
succ Val a
zero
            in  case Val a
zero of
                Val a
VPrimVar -> Val a
inert
                Val a
_ -> case Val a
succ of
                    Val a
VPrimVar -> Val a
inert
                    Val a
_ -> case Val a
natural of
                        Val a
VPrimVar -> Val a
inert
                        Val a
_ -> case Val a
n of
                            VNaturalLit Natural
n' ->
                                -- Use an `Integer` for the loop, due to the
                                -- following issue:
                                --
                                -- https://github.com/ghcjs/ghcjs/issues/782
                                let go :: Val a -> t -> Val a
go !Val a
acc t
0 = Val a
acc
                                    go  Val a
acc t
m = Val a -> t -> Val a
go (forall a. Eq a => Val a -> Val a -> Val a
vApp Val a
succ Val a
acc) (t
m forall a. Num a => a -> a -> a
- t
1)
                                in  forall {t}. (Num t, Eq t) => Val a -> t -> Val a
go Val a
zero (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n' :: Integer)
                            Val a
_ -> Val a
inert
        Expr Void a
NaturalBuild ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                Val a
VPrimVar ->
                    forall {a}. Val a -> Val a
VNaturalBuild forall a. Val a
VPrimVar
                Val a
t ->       Val a
t
                    forall a. Eq a => Val a -> Val a -> Val a
`vApp` forall a. Val a
VNatural
                    forall a. Eq a => Val a -> Val a -> Val a
`vApp` forall a. HLamInfo a -> (Val a -> Val a) -> Val a
VHLam (forall a. Text -> Val a -> HLamInfo a
Typed Text
"n" forall a. Val a
VNatural) (\Val a
n -> forall a. Val a -> Val a -> Val a
vNaturalPlus Val a
n (forall a. Natural -> Val a
VNaturalLit Natural
1))
                    forall a. Eq a => Val a -> Val a -> Val a
`vApp` forall a. Natural -> Val a
VNaturalLit Natural
0

        Expr Void a
NaturalIsZero -> forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
            VNaturalLit Natural
n -> forall a. Bool -> Val a
VBoolLit (Natural
n forall a. Eq a => a -> a -> Bool
== Natural
0)
            Val a
n             -> forall {a}. Val a -> Val a
VNaturalIsZero Val a
n
        Expr Void a
NaturalEven -> forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
            VNaturalLit Natural
n -> forall a. Bool -> Val a
VBoolLit (forall a. Integral a => a -> Bool
even Natural
n)
            Val a
n             -> forall {a}. Val a -> Val a
VNaturalEven Val a
n
        Expr Void a
NaturalOdd -> forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
            VNaturalLit Natural
n -> forall a. Bool -> Val a
VBoolLit (forall a. Integral a => a -> Bool
odd Natural
n)
            Val a
n             -> forall {a}. Val a -> Val a
VNaturalOdd Val a
n
        Expr Void a
NaturalToInteger -> forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
            VNaturalLit Natural
n -> forall a. Integer -> Val a
VIntegerLit (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
            Val a
n             -> forall {a}. Val a -> Val a
VNaturalToInteger Val a
n
        Expr Void a
NaturalShow -> forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
            VNaturalLit Natural
n -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] (String -> Text
Text.pack (forall a. Show a => a -> String
show Natural
n)))
            Val a
n             -> forall {a}. Val a -> Val a
VNaturalShow Val a
n
        Expr Void a
NaturalSubtract -> forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
            VNaturalLit Natural
0 ->
                forall a. HLamInfo a -> (Val a -> Val a) -> Val a
VHLam forall a. HLamInfo a
NaturalSubtractZero forall a. a -> a
id
            x :: Val a
x@(VNaturalLit Natural
m) ->
                forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                    VNaturalLit Natural
n
                        | Natural
n forall a. Ord a => a -> a -> Bool
>= Natural
m ->
                            -- Use an `Integer` for the subtraction, due to the
                            -- following issue:
                            --
                            -- https://github.com/ghcjs/ghcjs/issues/782
                            forall a. Natural -> Val a
VNaturalLit (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a -> a
subtract (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
m :: Integer) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n :: Integer)))
                        | Bool
otherwise -> forall a. Natural -> Val a
VNaturalLit Natural
0
                    Val a
y -> forall a. Val a -> Val a -> Val a
VNaturalSubtract Val a
x Val a
y
            Val a
x ->
                forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                    VNaturalLit Natural
0    -> forall a. Natural -> Val a
VNaturalLit Natural
0
                    Val a
y | forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
x Val a
y -> forall a. Natural -> Val a
VNaturalLit Natural
0
                    Val a
y                -> forall a. Val a -> Val a -> Val a
VNaturalSubtract Val a
x Val a
y
        NaturalPlus Expr Void a
t Expr Void a
u ->
            forall a. Val a -> Val a -> Val a
vNaturalPlus (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u)
        NaturalTimes Expr Void a
t Expr Void a
u ->
            case (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t, forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u) of
                (VNaturalLit Natural
1, Val a
u'           ) -> Val a
u'
                (Val a
t'           , VNaturalLit Natural
1) -> Val a
t'
                (VNaturalLit Natural
0, Val a
_            ) -> forall a. Natural -> Val a
VNaturalLit Natural
0
                (Val a
_            , VNaturalLit Natural
0) -> forall a. Natural -> Val a
VNaturalLit Natural
0
                (VNaturalLit Natural
m, VNaturalLit Natural
n) -> forall a. Natural -> Val a
VNaturalLit (Natural
m forall a. Num a => a -> a -> a
* Natural
n)
                (Val a
t'           , Val a
u'           ) -> forall a. Val a -> Val a -> Val a
VNaturalTimes Val a
t' Val a
u'
        Expr Void a
Integer ->
            forall a. Val a
VInteger
        IntegerLit Integer
n ->
            forall a. Integer -> Val a
VIntegerLit Integer
n
        Expr Void a
IntegerClamp ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VIntegerLit Integer
n
                    | Integer
0 forall a. Ord a => a -> a -> Bool
<= Integer
n    -> forall a. Natural -> Val a
VNaturalLit (forall a. Num a => Integer -> a
fromInteger Integer
n)
                    | Bool
otherwise -> forall a. Natural -> Val a
VNaturalLit Natural
0
                Val a
n -> forall {a}. Val a -> Val a
VIntegerClamp Val a
n
        Expr Void a
IntegerNegate ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VIntegerLit Integer
n -> forall a. Integer -> Val a
VIntegerLit (forall a. Num a => a -> a
negate Integer
n)
                Val a
n             -> forall {a}. Val a -> Val a
VIntegerNegate Val a
n
        Expr Void a
IntegerShow ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VIntegerLit Integer
n
                    | Integer
0 forall a. Ord a => a -> a -> Bool
<= Integer
n    -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] (String -> Text
Text.pack (Char
'+'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Integer
n)))
                    | Bool
otherwise -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] (String -> Text
Text.pack (forall a. Show a => a -> String
show Integer
n)))
                Val a
n -> forall {a}. Val a -> Val a
VIntegerShow Val a
n
        Expr Void a
IntegerToDouble ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VIntegerLit Integer
n -> forall a. DhallDouble -> Val a
VDoubleLit (Double -> DhallDouble
DhallDouble (forall a. Read a => String -> a
read (forall a. Show a => a -> String
show Integer
n)))
                -- `(read . show)` is used instead of `fromInteger`
                -- because `read` uses the correct rounding rule.
                -- See https://gitlab.haskell.org/ghc/ghc/issues/17231.
                Val a
n             -> forall {a}. Val a -> Val a
VIntegerToDouble Val a
n
        Expr Void a
Double ->
            forall a. Val a
VDouble
        DoubleLit DhallDouble
n ->
            forall a. DhallDouble -> Val a
VDoubleLit DhallDouble
n
        Expr Void a
DoubleShow ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VDoubleLit (DhallDouble Double
n) -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] (String -> Text
Text.pack (forall a. Show a => a -> String
show Double
n)))
                Val a
n                          -> forall {a}. Val a -> Val a
VDoubleShow Val a
n
        Expr Void a
Text ->
            forall a. Val a
VText
        TextLit Chunks Void a
cs ->
            case Chunks Void a -> VChunks a
evalChunks Chunks Void a
cs of
                VChunks [(Text
"", Val a
t)] Text
"" -> Val a
t
                VChunks a
vcs                  -> forall a. VChunks a -> Val a
VTextLit VChunks a
vcs
        TextAppend Expr Void a
t Expr Void a
u ->
            forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env (forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(Text
"", Expr Void a
t), (Text
"", Expr Void a
u)] Text
""))
        Expr Void a
TextShow ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VTextLit (VChunks [] Text
x) -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] (Text -> Text
textShow Text
x))
                Val a
t                       -> forall {a}. Val a -> Val a
VTextShow Val a
t
        Expr Void a
TextReplace ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
needle ->
            let hLamInfo0 :: HLamInfo a
hLamInfo0 = case Val a
needle of
                    VTextLit (VChunks [] Text
"") -> forall a. HLamInfo a
TextReplaceEmpty
                    Val a
_                        -> forall a. HLamInfo a
Prim

            in  forall a. HLamInfo a -> (Val a -> Val a) -> Val a
VHLam forall a. HLamInfo a
hLamInfo0 forall a b. (a -> b) -> a -> b
$ \Val a
replacement ->
            let hLamInfo1 :: HLamInfo a
hLamInfo1 = case Val a
needle of
                    VTextLit (VChunks [] Text
"") ->
                        forall a. Val a -> HLamInfo a
TextReplaceEmptyArgument Val a
replacement
                    Val a
_ ->
                        forall a. HLamInfo a
Prim
            in  forall a. HLamInfo a -> (Val a -> Val a) -> Val a
VHLam HLamInfo a
hLamInfo1 forall a b. (a -> b) -> a -> b
$ \Val a
haystack ->
                    case Val a
needle of
                        VTextLit (VChunks [] Text
"") ->
                            Val a
haystack

                        VTextLit (VChunks [] Text
needleText) ->
                            case Val a
haystack of
                                VTextLit (VChunks [] Text
haystackText) ->
                                    case Val a
replacement of
                                        VTextLit (VChunks [] Text
replacementText) ->
                                            forall a. VChunks a -> Val a
VTextLit forall a b. (a -> b) -> a -> b
$ forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks []
                                                (Text -> Text -> Text -> Text
Text.replace
                                                    Text
needleText
                                                    Text
replacementText
                                                    Text
haystackText
                                                )
                                        Val a
_ ->
                                            forall a. VChunks a -> Val a
VTextLit
                                                (forall a. Text -> Val a -> Text -> VChunks a
vTextReplace
                                                    Text
needleText
                                                    Val a
replacement
                                                    Text
haystackText
                                                )
                                Val a
_ ->
                                    forall a. Val a -> Val a -> Val a -> Val a
VTextReplace Val a
needle Val a
replacement Val a
haystack
                        Val a
_ ->
                            forall a. Val a -> Val a -> Val a -> Val a
VTextReplace Val a
needle Val a
replacement Val a
haystack
        Expr Void a
Date ->
            forall a. Val a
VDate
        DateLiteral Day
d ->
            forall a. Day -> Val a
VDateLiteral Day
d
        Expr Void a
DateShow ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VDateLiteral Day
d -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] (Day -> Text
dateShow Day
d))
                Val a
t              -> forall {a}. Val a -> Val a
VDateShow Val a
t
        Expr Void a
Time ->
            forall a. Val a
VTime
        TimeLiteral TimeOfDay
t Word
p ->
            forall a. TimeOfDay -> Word -> Val a
VTimeLiteral TimeOfDay
t Word
p
        Expr Void a
TimeShow ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VTimeLiteral TimeOfDay
d Word
p -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] (TimeOfDay -> Word -> Text
timeShow TimeOfDay
d Word
p))
                Val a
t                -> forall {a}. Val a -> Val a
VTimeShow Val a
t
        Expr Void a
TimeZone ->
            forall a. Val a
VTimeZone
        TimeZoneLiteral TimeZone
z ->
            forall a. TimeZone -> Val a
VTimeZoneLiteral TimeZone
z
        Expr Void a
TimeZoneShow ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VTimeZoneLiteral TimeZone
d -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] (TimeZone -> Text
timezoneShow TimeZone
d))
                Val a
t                  -> forall {a}. Val a -> Val a
VTimeZoneShow Val a
t
        Expr Void a
List ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall {a}. Val a -> Val a
VList
        ListLit Maybe (Expr Void a)
ma Seq (Expr Void a)
ts ->
            forall a. Maybe (Val a) -> Seq (Val a) -> Val a
VListLit (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env) Maybe (Expr Void a)
ma) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env) Seq (Expr Void a)
ts)
        ListAppend Expr Void a
t Expr Void a
u ->
            forall a. Val a -> Val a -> Val a
vListAppend (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u)
        Expr Void a
ListBuild ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
a ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                Val a
VPrimVar ->
                    forall a. Val a -> Val a -> Val a
VListBuild Val a
a forall a. Val a
VPrimVar
                Val a
t ->       Val a
t
                    forall a. Eq a => Val a -> Val a -> Val a
`vApp` forall {a}. Val a -> Val a
VList Val a
a
                    forall a. Eq a => Val a -> Val a -> Val a
`vApp` forall a. HLamInfo a -> (Val a -> Val a) -> Val a
VHLam (forall a. Text -> Val a -> HLamInfo a
Typed Text
"a" Val a
a) (\Val a
x ->
                           forall a. HLamInfo a -> (Val a -> Val a) -> Val a
VHLam (forall a. Text -> Val a -> HLamInfo a
Typed Text
"as" (forall {a}. Val a -> Val a
VList Val a
a)) (\Val a
as ->
                           forall a. Val a -> Val a -> Val a
vListAppend (forall a. Maybe (Val a) -> Seq (Val a) -> Val a
VListLit forall a. Maybe a
Nothing (forall (f :: * -> *) a. Applicative f => a -> f a
pure Val a
x)) Val a
as))
                    forall a. Eq a => Val a -> Val a -> Val a
`vApp` forall a. Maybe (Val a) -> Seq (Val a) -> Val a
VListLit (forall a. a -> Maybe a
Just (forall {a}. Val a -> Val a
VList Val a
a)) forall a. Monoid a => a
mempty

        Expr Void a
ListFold ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
a ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
as ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
list ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
cons ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \Val a
nil ->
            let inert :: Val a
inert = forall a. Val a -> Val a -> Val a -> Val a -> Val a -> Val a
VListFold Val a
a Val a
as Val a
list Val a
cons Val a
nil
            in  case Val a
nil of
                Val a
VPrimVar -> Val a
inert
                Val a
_ -> case Val a
cons of
                    Val a
VPrimVar -> Val a
inert
                    Val a
_ -> case Val a
list of
                        Val a
VPrimVar -> Val a
inert
                        Val a
_ -> case Val a
a of
                            Val a
VPrimVar -> Val a
inert
                            Val a
_ -> case Val a
as of
                                VListLit Maybe (Val a)
_ Seq (Val a)
as' ->
                                    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\Val a
x Val a
b -> Val a
cons forall a. Eq a => Val a -> Val a -> Val a
`vApp` Val a
x forall a. Eq a => Val a -> Val a -> Val a
`vApp` Val a
b) Val a
nil Seq (Val a)
as'
                                Val a
_ -> Val a
inert
        Expr Void a
ListLength ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \ Val a
a ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VListLit Maybe (Val a)
_ Seq (Val a)
as -> forall a. Natural -> Val a
VNaturalLit (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Seq a -> Int
Sequence.length Seq (Val a)
as))
                Val a
as            -> forall a. Val a -> Val a -> Val a
VListLength Val a
a Val a
as
        Expr Void a
ListHead ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \ Val a
a ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VListLit Maybe (Val a)
_ Seq (Val a)
as ->
                    case forall a. Seq a -> ViewL a
Sequence.viewl Seq (Val a)
as of
                        Val a
y :< Seq (Val a)
_ -> forall {a}. Val a -> Val a
VSome Val a
y
                        ViewL (Val a)
_      -> forall {a}. Val a -> Val a
VNone Val a
a
                Val a
as ->
                    forall a. Val a -> Val a -> Val a
VListHead Val a
a Val a
as
        Expr Void a
ListLast ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \ Val a
a ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VListLit Maybe (Val a)
_ Seq (Val a)
as ->
                    case forall a. Seq a -> ViewR a
Sequence.viewr Seq (Val a)
as of
                        Seq (Val a)
_ :> Val a
t -> forall {a}. Val a -> Val a
VSome Val a
t
                        ViewR (Val a)
_      -> forall {a}. Val a -> Val a
VNone Val a
a
                Val a
as -> forall a. Val a -> Val a -> Val a
VListLast Val a
a Val a
as
        Expr Void a
ListIndexed ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \ Val a
a ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VListLit Maybe (Val a)
_ Seq (Val a)
as ->
                    let a' :: Maybe (Val a)
a' =
                            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Val a)
as
                            then forall a. a -> Maybe a
Just (forall {a}. Val a -> Val a
VList (forall a. Map Text (Val a) -> Val a
VRecord (forall k v. Ord k => [(k, v)] -> Map k v
Map.unorderedFromList [(Text
"index", forall a. Val a
VNatural), (Text
"value", Val a
a)])))
                            else forall a. Maybe a
Nothing

                        as' :: Seq (Val a)
as' =
                            forall a b. (Int -> a -> b) -> Seq a -> Seq b
Sequence.mapWithIndex
                                (\Int
i Val a
t ->
                                    forall a. Map Text (Val a) -> Val a
VRecordLit
                                        (forall k v. Ord k => [(k, v)] -> Map k v
Map.unorderedFromList
                                            [ (Text
"index", forall a. Natural -> Val a
VNaturalLit (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i))
                                            , (Text
"value", Val a
t)
                                            ]
                                        )
                                )
                                Seq (Val a)
as

                        in  forall a. Maybe (Val a) -> Seq (Val a) -> Val a
VListLit Maybe (Val a)
a' Seq (Val a)
as'
                Val a
t ->
                    forall a. Val a -> Val a -> Val a
VListIndexed Val a
a Val a
t
        Expr Void a
ListReverse ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \ ~Val a
a ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \case
                VListLit Maybe (Val a)
t Seq (Val a)
as | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Val a)
as ->
                    forall a. Maybe (Val a) -> Seq (Val a) -> Val a
VListLit Maybe (Val a)
t Seq (Val a)
as
                VListLit Maybe (Val a)
_ Seq (Val a)
as ->
                    forall a. Maybe (Val a) -> Seq (Val a) -> Val a
VListLit forall a. Maybe a
Nothing (forall a. Seq a -> Seq a
Sequence.reverse Seq (Val a)
as)
                Val a
t ->
                    forall a. Val a -> Val a -> Val a
VListReverse Val a
a Val a
t
        Expr Void a
Optional ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall {a}. Val a -> Val a
VOptional
        Some Expr Void a
t ->
            forall {a}. Val a -> Val a
VSome (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t)
        Expr Void a
None ->
            forall a. (Val a -> Val a) -> Val a
VPrim forall a b. (a -> b) -> a -> b
$ \ ~Val a
a -> forall {a}. Val a -> Val a
VNone Val a
a
        Record Map Text (RecordField Void a)
kts ->
            forall a. Map Text (Val a) -> Val a
VRecord (forall k v. Map k v -> Map k v
Map.sort (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. RecordField s a -> Expr s a
recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField Void a)
kts))
        RecordLit Map Text (RecordField Void a)
kts ->
            forall a. Map Text (Val a) -> Val a
VRecordLit (forall k v. Map k v -> Map k v
Map.sort (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. RecordField s a -> Expr s a
recordFieldValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField Void a)
kts))
        Union Map Text (Maybe (Expr Void a))
kts ->
            forall a. Map Text (Maybe (Val a)) -> Val a
VUnion (forall k v. Map k v -> Map k v
Map.sort (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env)) Map Text (Maybe (Expr Void a))
kts))
        Combine Maybe CharacterSet
_ Maybe Text
mk Expr Void a
t Expr Void a
u ->
            forall a. Maybe Text -> Val a -> Val a -> Val a
vCombine Maybe Text
mk (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u)
        CombineTypes Maybe CharacterSet
_ Expr Void a
t Expr Void a
u ->
            forall a. Val a -> Val a -> Val a
vCombineTypes (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u)
        Prefer Maybe CharacterSet
_ PreferAnnotation
_ Expr Void a
t Expr Void a
u ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Val a
vPrefer Environment a
env (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u)
        RecordCompletion Expr Void a
t Expr Void a
u ->
            forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env (forall s a. Expr s a -> Expr s a -> Expr s a
Annot (forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Prefer forall a. Monoid a => a
mempty PreferAnnotation
PreferFromCompletion (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Void a
t forall {s}. FieldSelection s
def) Expr Void a
u) (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr Void a
t forall {s}. FieldSelection s
typ))
          where
            def :: FieldSelection s
def = forall s. Text -> FieldSelection s
Syntax.makeFieldSelection Text
"default"
            typ :: FieldSelection s
typ = forall s. Text -> FieldSelection s
Syntax.makeFieldSelection Text
"Type"
        Merge Expr Void a
x Expr Void a
y Maybe (Expr Void a)
ma ->
            case (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
x, forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
y, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env) Maybe (Expr Void a)
ma) of
                (VRecordLit Map Text (Val a)
m, VInject Map Text (Maybe (Val a))
_ Text
k Maybe (Val a)
mt, Maybe (Val a)
_)
                    | Just Val a
f <- forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
k Map Text (Val a)
m -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Val a
f (forall a. Eq a => Val a -> Val a -> Val a
vApp Val a
f) Maybe (Val a)
mt
                    | Bool
otherwise                -> forall a. HasCallStack => String -> a
error String
errorMsg
                (VRecordLit Map Text (Val a)
m, VSome Val a
t, Maybe (Val a)
_)
                    | Just Val a
f <- forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
"Some" Map Text (Val a)
m -> forall a. Eq a => Val a -> Val a -> Val a
vApp Val a
f Val a
t
                    | Bool
otherwise                     -> forall a. HasCallStack => String -> a
error String
errorMsg
                (VRecordLit Map Text (Val a)
m, VNone Val a
_, Maybe (Val a)
_)
                    | Just Val a
t <- forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
"None" Map Text (Val a)
m -> Val a
t
                    | Bool
otherwise                     -> forall a. HasCallStack => String -> a
error String
errorMsg
                (Val a
x', Val a
y', Maybe (Val a)
ma') -> forall a. Val a -> Val a -> Maybe (Val a) -> Val a
VMerge Val a
x' Val a
y' Maybe (Val a)
ma'
        ToMap Expr Void a
x Maybe (Expr Void a)
ma ->
            case (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
x, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env) Maybe (Expr Void a)
ma) of
                (VRecordLit Map Text (Val a)
m, ma' :: Maybe (Val a)
ma'@(Just Val a
_)) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (Val a)
m ->
                    forall a. Maybe (Val a) -> Seq (Val a) -> Val a
VListLit Maybe (Val a)
ma' forall a. Seq a
Sequence.empty
                (VRecordLit Map Text (Val a)
m, Maybe (Val a)
_) ->
                    let entry :: (Text, Val a) -> Val a
entry (Text
k, Val a
v) =
                            forall a. Map Text (Val a) -> Val a
VRecordLit
                                (forall k v. Ord k => [(k, v)] -> Map k v
Map.unorderedFromList
                                    [ (Text
"mapKey", forall a. VChunks a -> Val a
VTextLit forall a b. (a -> b) -> a -> b
$ forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] Text
k)
                                    , (Text
"mapValue", Val a
v)
                                    ]
                                )

                        s :: Seq (Val a)
s = (forall a. [a] -> Seq a
Sequence.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Text, Val a) -> Val a
entry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Map k v -> [(k, v)]
Map.toAscList) Map Text (Val a)
m

                    in  forall a. Maybe (Val a) -> Seq (Val a) -> Val a
VListLit forall a. Maybe a
Nothing Seq (Val a)
s
                (Val a
x', Maybe (Val a)
ma') ->
                    forall a. Val a -> Maybe (Val a) -> Val a
VToMap Val a
x' Maybe (Val a)
ma'
        ShowConstructor Expr Void a
x ->
            case forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
x of
                VInject Map Text (Maybe (Val a))
m Text
k Maybe (Val a)
_
                    | Just Maybe (Val a)
_ <- forall k v. Ord k => k -> Map k v -> Maybe v
Map.lookup Text
k Map Text (Maybe (Val a))
m -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] Text
k)
                    | Bool
otherwise                -> forall a. HasCallStack => String -> a
error String
errorMsg
                VSome Val a
_ -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] Text
"Some")
                VNone Val a
_ -> forall a. VChunks a -> Val a
VTextLit (forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] Text
"None")
                Val a
x' -> forall {a}. Val a -> Val a
VShowConstructor Val a
x'
        Field Expr Void a
t (forall s. FieldSelection s -> Text
Syntax.fieldSelectionLabel -> Text
k) ->
            forall a. Val a -> Text -> Val a
vField (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) Text
k
        Project Expr Void a
t (Left [Text]
ks) ->
            forall a. Eq a => Environment a -> Val a -> Set Text -> Val a
vProjectByFields Environment a
env (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a. Ord a => Set a -> Set a
Dhall.Set.sort (forall a. Ord a => [a] -> Set a
Dhall.Set.fromList [Text]
ks))
        Project Expr Void a
t (Right Expr Void a
e) ->
            case forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
e of
                VRecord Map Text (Val a)
kts ->
                    forall a. Eq a => Environment a -> Val a -> Set Text -> Val a
vProjectByFields Environment a
env (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a. Set a -> Set a
Dhall.Set.fromSet (forall k v. Map k v -> Set k
Map.keysSet Map Text (Val a)
kts))
                Val a
e' ->
                    forall a. Val a -> Either (Set Text) (Val a) -> Val a
VProject (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a b. b -> Either a b
Right Val a
e')
        Assert Expr Void a
t ->
            forall {a}. Val a -> Val a
VAssert (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t)
        Equivalent Maybe CharacterSet
_ Expr Void a
t Expr Void a
u ->
            forall a. Val a -> Val a -> Val a
VEquivalent (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t) (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
u)
        With Expr Void a
e₀ NonEmpty WithComponent
ks Expr Void a
v ->
            forall a. Val a -> NonEmpty WithComponent -> Val a -> Val a
vWith (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
e₀) NonEmpty WithComponent
ks (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
v)
        Note Void
_ Expr Void a
e ->
            forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
e
        ImportAlt Expr Void a
t Expr Void a
_ ->
            forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t
        Embed a
a ->
            forall a. a -> Val a
VEmbed a
a
  where
    evalChunks :: Chunks Void a -> VChunks a
    evalChunks :: Chunks Void a -> VChunks a
evalChunks (Chunks [(Text, Expr Void a)]
xys Text
z) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (Text, Expr Void a) -> VChunks a -> VChunks a
cons forall a. VChunks a
nil [(Text, Expr Void a)]
xys
      where
        cons :: (Text, Expr Void a) -> VChunks a -> VChunks a
cons (Text
x, Expr Void a
t) VChunks a
vcs =
            case forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env Expr Void a
t of
                VTextLit VChunks a
vcs' -> forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] Text
x forall a. Semigroup a => a -> a -> a
<> VChunks a
vcs' forall a. Semigroup a => a -> a -> a
<> VChunks a
vcs
                Val a
t'            -> forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [(Text
x, Val a
t')] forall a. Monoid a => a
mempty forall a. Semigroup a => a -> a -> a
<> VChunks a
vcs

        nil :: VChunks a
nil = forall a. [(Text, Val a)] -> Text -> VChunks a
VChunks [] Text
z
    {-# INLINE evalChunks #-}

eqListBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool
eqListBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
eqListBy a -> a -> Bool
f = [a] -> [a] -> Bool
go
  where
    go :: [a] -> [a] -> Bool
go (a
x:[a]
xs) (a
y:[a]
ys) | a -> a -> Bool
f a
x a
y = [a] -> [a] -> Bool
go [a]
xs [a]
ys
    go [] [] = Bool
True
    go [a]
_  [a]
_  = Bool
False
{-# INLINE eqListBy #-}

eqMapsBy :: Ord k => (v -> v -> Bool) -> Map k v -> Map k v -> Bool
eqMapsBy :: forall k v. Ord k => (v -> v -> Bool) -> Map k v -> Map k v -> Bool
eqMapsBy v -> v -> Bool
f Map k v
mL Map k v
mR =
    forall k v. Map k v -> Int
Map.size Map k v
mL forall a. Eq a => a -> a -> Bool
== forall k v. Map k v -> Int
Map.size Map k v
mR
    Bool -> Bool -> Bool
&& forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
eqListBy forall {a}. Eq a => (a, v) -> (a, v) -> Bool
eq (forall k v. Map k v -> [(k, v)]
Map.toAscList Map k v
mL) (forall k v. Map k v -> [(k, v)]
Map.toAscList Map k v
mR)
  where
    eq :: (a, v) -> (a, v) -> Bool
eq (a
kL, v
vL) (a
kR, v
vR) = a
kL forall a. Eq a => a -> a -> Bool
== a
kR Bool -> Bool -> Bool
&& v -> v -> Bool
f v
vL v
vR
{-# INLINE eqMapsBy #-}

eqMaybeBy :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
eqMaybeBy :: forall a. (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
eqMaybeBy a -> a -> Bool
f = Maybe a -> Maybe a -> Bool
go
  where
    go :: Maybe a -> Maybe a -> Bool
go (Just a
x) (Just a
y) = a -> a -> Bool
f a
x a
y
    go Maybe a
Nothing  Maybe a
Nothing  = Bool
True
    go Maybe a
_        Maybe a
_        = Bool
False
{-# INLINE eqMaybeBy #-}

-- | Utility that powers the @Text/show@ built-in
textShow :: Text -> Text
textShow :: Text -> Text
textShow Text
text = Text
"\"" forall a. Semigroup a => a -> a -> a
<> (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
f Text
text forall a. Semigroup a => a -> a -> a
<> Text
"\""
  where
    f :: Char -> Text
f Char
'"'  = Text
"\\\""
    f Char
'$'  = Text
"\\u0024"
    f Char
'\\' = Text
"\\\\"
    f Char
'\b' = Text
"\\b"
    f Char
'\n' = Text
"\\n"
    f Char
'\r' = Text
"\\r"
    f Char
'\t' = Text
"\\t"
    f Char
'\f' = Text
"\\f"
    f Char
c | Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x1F' = String -> Text
Text.pack (forall r. PrintfType r => String -> r
Printf.printf String
"\\u%04x" (Char -> Int
Data.Char.ord Char
c))
        | Bool
otherwise   = Char -> Text
Text.singleton Char
c

-- | Utility that powers the @Date/show@ built-in
dateShow :: Day -> Text
dateShow :: Day -> Text
dateShow = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
Time.defaultTimeLocale String
"%0Y-%m-%d"

-- | Utility that powers the @Time/show@ built-in
timeShow :: TimeOfDay -> Word -> Text
timeShow :: TimeOfDay -> Word -> Text
timeShow (TimeOfDay Int
hh Int
mm Pico
seconds) Word
precision =
    String -> Text
Text.pack (forall r. PrintfType r => String -> r
Printf.printf String
"%02d:%02d:%02d" Int
hh Int
mm Integer
ss forall a. Semigroup a => a -> a -> a
<> String
suffix)
  where
    magnitude :: Integer
    magnitude :: Integer
magnitude = Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Word
precision

    (Integer
ss, Integer
fraction) =
        forall a b. (RealFrac a, Integral b) => a -> b
truncate (Pico
seconds forall a. Num a => a -> a -> a
* forall a. Num a => Integer -> a
fromInteger Integer
magnitude) forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
magnitude

    suffix :: String
suffix
        | Word
precision forall a. Eq a => a -> a -> Bool
== Word
0 = String
""
        | Bool
otherwise      = forall r. PrintfType r => String -> r
Printf.printf String
".%0*d" Word
precision Integer
fraction

-- | Utility that powers the @TimeZone/show@ built-in
timezoneShow :: TimeZone -> Text
timezoneShow :: TimeZone -> Text
timezoneShow = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
Time.formatTime TimeLocale
Time.defaultTimeLocale String
"%Ez"

conv :: forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv :: forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv !Environment a
env Val a
t0 Val a
t0' =
    case (Val a
t0, Val a
t0') of
        (VConst Const
k, VConst Const
k') ->
            Const
k forall a. Eq a => a -> a -> Bool
== Const
k'
        (VVar Text
x Int
i, VVar Text
x' Int
i') ->
            Text
x forall a. Eq a => a -> a -> Bool
== Text
x' Bool -> Bool -> Bool
&& Int
i forall a. Eq a => a -> a -> Bool
== Int
i'
        (VLam Val a
_ (Closure a -> (Text, Val a, Closure a)
freshClosure -> (Text
x, Val a
v, Closure a
t)), VLam Val a
_ Closure a
t' ) ->
            Text -> Val a -> Val a -> Bool
convSkip Text
x (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
t Val a
v) (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
t' Val a
v)
        (VLam Val a
_ (Closure a -> (Text, Val a, Closure a)
freshClosure -> (Text
x, Val a
v, Closure a
t)), VHLam HLamInfo a
_ Val a -> Val a
t') ->
            Text -> Val a -> Val a -> Bool
convSkip Text
x (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
t Val a
v) (Val a -> Val a
t' Val a
v)
        (VLam Val a
_ (Closure a -> (Text, Val a, Closure a)
freshClosure -> (Text
x, Val a
v, Closure a
t)), Val a
t'        ) ->
            Text -> Val a -> Val a -> Bool
convSkip Text
x (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
t Val a
v) (forall a. Eq a => Val a -> Val a -> Val a
vApp Val a
t' Val a
v)
        (VHLam HLamInfo a
_ Val a -> Val a
t, VLam Val a
_ (Closure a -> (Text, Val a, Closure a)
freshClosure -> (Text
x, Val a
v, Closure a
t'))) ->
            Text -> Val a -> Val a -> Bool
convSkip Text
x (Val a -> Val a
t Val a
v) (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
t' Val a
v)
        (VHLam HLamInfo a
_ Val a -> Val a
t, VHLam HLamInfo a
_ Val a -> Val a
t'                    ) ->
            let (Text
x, Val a
v) = Text -> (Text, Val a)
fresh Text
"x" in Text -> Val a -> Val a -> Bool
convSkip Text
x (Val a -> Val a
t Val a
v) (Val a -> Val a
t' Val a
v)
        (VHLam HLamInfo a
_ Val a -> Val a
t, Val a
t'                            ) ->
            let (Text
x, Val a
v) = Text -> (Text, Val a)
fresh Text
"x" in Text -> Val a -> Val a -> Bool
convSkip Text
x (Val a -> Val a
t Val a
v) (forall a. Eq a => Val a -> Val a -> Val a
vApp Val a
t' Val a
v)
        (Val a
t, VLam Val a
_ (Closure a -> (Text, Val a, Closure a)
freshClosure -> (Text
x, Val a
v, Closure a
t'))) ->
            Text -> Val a -> Val a -> Bool
convSkip Text
x (forall a. Eq a => Val a -> Val a -> Val a
vApp Val a
t Val a
v) (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
t' Val a
v)
        (Val a
t, VHLam HLamInfo a
_ Val a -> Val a
t'  ) ->
            let (Text
x, Val a
v) = Text -> (Text, Val a)
fresh Text
"x" in Text -> Val a -> Val a -> Bool
convSkip Text
x (forall a. Eq a => Val a -> Val a -> Val a
vApp Val a
t Val a
v) (Val a -> Val a
t' Val a
v)
        (VApp Val a
t Val a
u, VApp Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VPi Val a
a Closure a
b, VPi Val a
a' (Closure a -> (Text, Val a, Closure a)
freshClosure -> (Text
x, Val a
v, Closure a
b'))) ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
a Val a
a' Bool -> Bool -> Bool
&& Text -> Val a -> Val a -> Bool
convSkip Text
x (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
b Val a
v) (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
b' Val a
v)
        (VPi Val a
a Closure a
b, VHPi (Text -> (Text, Val a)
fresh -> (Text
x, Val a
v)) Val a
a' Val a -> Val a
b') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
a Val a
a' Bool -> Bool -> Bool
&& Text -> Val a -> Val a -> Bool
convSkip Text
x (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
b Val a
v) (Val a -> Val a
b' Val a
v)
        (VHPi Text
_ Val a
a Val a -> Val a
b, VPi Val a
a' (Closure a -> (Text, Val a, Closure a)
freshClosure -> (Text
x, Val a
v, Closure a
b'))) ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
a Val a
a' Bool -> Bool -> Bool
&& Text -> Val a -> Val a -> Bool
convSkip Text
x (Val a -> Val a
b Val a
v) (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
b' Val a
v)
        (VHPi Text
_ Val a
a Val a -> Val a
b, VHPi (Text -> (Text, Val a)
fresh -> (Text
x, Val a
v)) Val a
a' Val a -> Val a
b') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
a Val a
a' Bool -> Bool -> Bool
&& Text -> Val a -> Val a -> Bool
convSkip Text
x (Val a -> Val a
b Val a
v) (Val a -> Val a
b' Val a
v)
        (Val a
VBool, Val a
VBool) ->
            Bool
True
        (VBoolLit Bool
b, VBoolLit Bool
b') ->
            Bool
b forall a. Eq a => a -> a -> Bool
== Bool
b'
        (VBoolAnd Val a
t Val a
u, VBoolAnd Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VBoolOr Val a
t Val a
u, VBoolOr Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VBoolEQ Val a
t Val a
u, VBoolEQ Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VBoolNE Val a
t Val a
u, VBoolNE Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VBoolIf Val a
t Val a
u Val a
v, VBoolIf Val a
t' Val a
u' Val a
v') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
v Val a
v'
        (Val a
VBytes, Val a
VBytes) ->
            Bool
True
        (VBytesLit ByteString
l, VBytesLit ByteString
r) ->
            ByteString
l forall a. Eq a => a -> a -> Bool
== ByteString
r
        (Val a
VNatural, Val a
VNatural) ->
            Bool
True
        (VNaturalLit Natural
n, VNaturalLit Natural
n') ->
            Natural
n forall a. Eq a => a -> a -> Bool
== Natural
n'
        (VNaturalFold Val a
t Val a
_ Val a
u Val a
v, VNaturalFold Val a
t' Val a
_ Val a
u' Val a
v') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
v Val a
v'
        (VNaturalBuild Val a
t, VNaturalBuild Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VNaturalIsZero Val a
t, VNaturalIsZero Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VNaturalEven Val a
t, VNaturalEven Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VNaturalOdd Val a
t, VNaturalOdd Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VNaturalToInteger Val a
t, VNaturalToInteger Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VNaturalShow Val a
t, VNaturalShow Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VNaturalSubtract Val a
x Val a
y, VNaturalSubtract Val a
x' Val a
y') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
x Val a
x' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
y Val a
y'
        (VNaturalPlus Val a
t Val a
u, VNaturalPlus Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VNaturalTimes Val a
t Val a
u, VNaturalTimes Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (Val a
VInteger, Val a
VInteger) ->
            Bool
True
        (VIntegerLit Integer
t, VIntegerLit Integer
t') ->
            Integer
t forall a. Eq a => a -> a -> Bool
== Integer
t'
        (VIntegerClamp Val a
t, VIntegerClamp Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VIntegerNegate Val a
t, VIntegerNegate Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VIntegerShow Val a
t, VIntegerShow Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VIntegerToDouble Val a
t, VIntegerToDouble Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (Val a
VDouble, Val a
VDouble) ->
            Bool
True
        (VDoubleLit DhallDouble
n, VDoubleLit DhallDouble
n') ->
            DhallDouble
n forall a. Eq a => a -> a -> Bool
== DhallDouble
n'
        (VDoubleShow Val a
t, VDoubleShow Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (Val a
VText, Val a
VText) ->
            Bool
True
        (VTextLit VChunks a
cs, VTextLit VChunks a
cs') ->
            VChunks a -> VChunks a -> Bool
convChunks VChunks a
cs VChunks a
cs'
        (VTextAppend Val a
t Val a
u, VTextAppend Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VTextShow Val a
t, VTextShow Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VTextReplace Val a
a Val a
b Val a
c, VTextReplace Val a
a' Val a
b' Val a
c') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
a Val a
a' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
b Val a
b' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
c Val a
c'
        (Val a
VDate, Val a
VDate) ->
            Bool
True
        (VDateLiteral Day
l, VDateLiteral Day
r) ->
            Day
l forall a. Eq a => a -> a -> Bool
== Day
r
        (VDateShow Val a
t, VDateShow Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (Val a
VTime, Val a
VTime) ->
            Bool
True
        (VTimeLiteral TimeOfDay
tl Word
pl, VTimeLiteral TimeOfDay
tr Word
pr) ->
            TimeOfDay
tl forall a. Eq a => a -> a -> Bool
== TimeOfDay
tr Bool -> Bool -> Bool
&& Word
pl forall a. Eq a => a -> a -> Bool
== Word
pr
        (VTimeShow Val a
t, VTimeShow Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (Val a
VTimeZone, Val a
VTimeZone) ->
            Bool
True
        (VTimeZoneLiteral TimeZone
l, VTimeZoneLiteral TimeZone
r) ->
            TimeZone
l forall a. Eq a => a -> a -> Bool
== TimeZone
r
        (VTimeZoneShow Val a
t, VTimeZoneShow Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VList Val a
a, VList Val a
a') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
a Val a
a'
        (VListLit Maybe (Val a)
_ Seq (Val a)
xs, VListLit Maybe (Val a)
_ Seq (Val a)
xs') ->
            forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
eqListBy (forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Val a)
xs) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Val a)
xs')
        (VListAppend Val a
t Val a
u, VListAppend Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VListBuild Val a
_ Val a
t, VListBuild Val a
_ Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VListLength Val a
a Val a
t, VListLength Val a
a' Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
a Val a
a' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VListHead Val a
_ Val a
t, VListHead Val a
_ Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VListLast Val a
_ Val a
t, VListLast Val a
_ Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VListIndexed Val a
_ Val a
t, VListIndexed Val a
_ Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VListReverse Val a
_ Val a
t, VListReverse Val a
_ Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VListFold Val a
a Val a
l Val a
_ Val a
t Val a
u, VListFold Val a
a' Val a
l' Val a
_ Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
a Val a
a' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
l Val a
l' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VOptional Val a
a, VOptional Val a
a') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
a Val a
a'
        (VSome Val a
t, VSome Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VNone Val a
_, VNone Val a
_) ->
            Bool
True
        (VRecord Map Text (Val a)
m, VRecord Map Text (Val a)
m') ->
            forall k v. Ord k => (v -> v -> Bool) -> Map k v -> Map k v -> Bool
eqMapsBy (forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env) Map Text (Val a)
m Map Text (Val a)
m'
        (VRecordLit Map Text (Val a)
m, VRecordLit Map Text (Val a)
m') ->
            forall k v. Ord k => (v -> v -> Bool) -> Map k v -> Map k v -> Bool
eqMapsBy (forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env) Map Text (Val a)
m Map Text (Val a)
m'
        (VUnion Map Text (Maybe (Val a))
m, VUnion Map Text (Maybe (Val a))
m') ->
            forall k v. Ord k => (v -> v -> Bool) -> Map k v -> Map k v -> Bool
eqMapsBy (forall a. (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
eqMaybeBy (forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env)) Map Text (Maybe (Val a))
m Map Text (Maybe (Val a))
m'
        (VCombine Maybe Text
_ Val a
t Val a
u, VCombine Maybe Text
_ Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VCombineTypes Val a
t Val a
u, VCombineTypes Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VPrefer Val a
t Val a
u, VPrefer Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VMerge Val a
t Val a
u Maybe (Val a)
_, VMerge Val a
t' Val a
u' Maybe (Val a)
_) ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VToMap Val a
t Maybe (Val a)
_, VToMap Val a
t' Maybe (Val a)
_) ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VShowConstructor Val a
t, VShowConstructor Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VField Val a
t Text
k, VField Val a
t' Text
k') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& Text
k forall a. Eq a => a -> a -> Bool
== Text
k'
        (VProject Val a
t (Left Set Text
ks), VProject Val a
t' (Left Set Text
ks')) ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& Set Text
ks forall a. Eq a => a -> a -> Bool
== Set Text
ks'
        (VProject Val a
t (Right Val a
e), VProject Val a
t' (Right Val a
e')) ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
e Val a
e'
        (VAssert Val a
t, VAssert Val a
t') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t'
        (VEquivalent Val a
t Val a
u, VEquivalent Val a
t' Val a
u') ->
            forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
t Val a
t' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
u Val a
u'
        (VInject Map Text (Maybe (Val a))
m Text
k Maybe (Val a)
mt, VInject Map Text (Maybe (Val a))
m' Text
k' Maybe (Val a)
mt') ->
            forall k v. Ord k => (v -> v -> Bool) -> Map k v -> Map k v -> Bool
eqMapsBy (forall a. (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
eqMaybeBy (forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env)) Map Text (Maybe (Val a))
m Map Text (Maybe (Val a))
m' Bool -> Bool -> Bool
&& Text
k forall a. Eq a => a -> a -> Bool
== Text
k' Bool -> Bool -> Bool
&& forall a. (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
eqMaybeBy (forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env) Maybe (Val a)
mt Maybe (Val a)
mt'
        (VEmbed a
a, VEmbed a
a') ->
            a
a forall a. Eq a => a -> a -> Bool
== a
a'
        (Val a
_, Val a
_) ->
            Bool
False
  where
    fresh :: Text -> (Text, Val a)
    fresh :: Text -> (Text, Val a)
fresh Text
x = (Text
x, forall a. Text -> Int -> Val a
VVar Text
x (forall a. Text -> Environment a -> Int
countEnvironment Text
x Environment a
env))
    {-# INLINE fresh #-}

    freshClosure :: Closure a -> (Text, Val a, Closure a)
    freshClosure :: Closure a -> (Text, Val a, Closure a)
freshClosure closure :: Closure a
closure@(Closure Text
x Environment a
_ Expr Void a
_) = (Text
x, forall a b. (a, b) -> b
snd (Text -> (Text, Val a)
fresh Text
x), Closure a
closure)
    {-# INLINE freshClosure #-}

    convChunks :: VChunks a -> VChunks a -> Bool
    convChunks :: VChunks a -> VChunks a -> Bool
convChunks (VChunks [(Text, Val a)]
xys Text
z) (VChunks [(Text, Val a)]
xys' Text
z') =
      forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
eqListBy (\(Text
x, Val a
y) (Text
x', Val a
y') -> Text
x forall a. Eq a => a -> a -> Bool
== Text
x' Bool -> Bool -> Bool
&& forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv Environment a
env Val a
y Val a
y') [(Text, Val a)]
xys [(Text, Val a)]
xys' Bool -> Bool -> Bool
&& Text
z forall a. Eq a => a -> a -> Bool
== Text
z'
    {-# INLINE convChunks #-}

    convSkip :: Text -> Val a -> Val a -> Bool
    convSkip :: Text -> Val a -> Val a -> Bool
convSkip Text
x = forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv (forall a. Environment a -> Text -> Environment a
Skip Environment a
env Text
x)
    {-# INLINE convSkip #-}

judgmentallyEqual :: Eq a => Expr s a -> Expr t a -> Bool
judgmentallyEqual :: forall a s t. Eq a => Expr s a -> Expr t a -> Bool
judgmentallyEqual (forall s a t. Expr s a -> Expr t a
Syntax.denote -> Expr Void a
t) (forall s a t. Expr s a -> Expr t a
Syntax.denote -> Expr Void a
u) =
    forall a. Eq a => Environment a -> Val a -> Val a -> Bool
conv forall a. Environment a
Empty (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval forall a. Environment a
Empty Expr Void a
t) (forall a. Eq a => Environment a -> Expr Void a -> Val a
eval forall a. Environment a
Empty Expr Void a
u)
{-# INLINABLE judgmentallyEqual #-}

data Names
  = EmptyNames
  | Bind !Names {-# UNPACK #-} !Text
  deriving Int -> Names -> ShowS
[Names] -> ShowS
Names -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Names] -> ShowS
$cshowList :: [Names] -> ShowS
show :: Names -> String
$cshow :: Names -> String
showsPrec :: Int -> Names -> ShowS
$cshowsPrec :: Int -> Names -> ShowS
Show

envNames :: Environment a -> Names
envNames :: forall a. Environment a -> Names
envNames Environment a
Empty = Names
EmptyNames
envNames (Skip   Environment a
env Text
x  ) = Names -> Text -> Names
Bind (forall a. Environment a -> Names
envNames Environment a
env) Text
x
envNames (Extend Environment a
env Text
x Val a
_) = Names -> Text -> Names
Bind (forall a. Environment a -> Names
envNames Environment a
env) Text
x

countNames :: Text -> Names -> Int
countNames :: Text -> Names -> Int
countNames Text
x = forall {t}. Num t => t -> Names -> t
go Int
0
  where
    go :: t -> Names -> t
go !t
acc Names
EmptyNames         = t
acc
    go  t
acc (Bind Names
env Text
x') = t -> Names -> t
go (if Text
x forall a. Eq a => a -> a -> Bool
== Text
x' then t
acc forall a. Num a => a -> a -> a
+ t
1 else t
acc) Names
env

-- | Quote a value into beta-normal form.
quote :: forall a. Eq a => Names -> Val a -> Expr Void a
quote :: forall a. Eq a => Names -> Val a -> Expr Void a
quote !Names
env !Val a
t0 =
    case Val a
t0 of
        VConst Const
k ->
            forall s a. Const -> Expr s a
Const Const
k
        VVar !Text
x !Int
i ->
            forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x (Text -> Names -> Int
countNames Text
x Names
env forall a. Num a => a -> a -> a
- Int
i forall a. Num a => a -> a -> a
- Int
1))
        VApp Val a
t Val a
u ->
            forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t Expr Void a -> Val a -> Expr Void a
`qApp` Val a
u
        VLam Val a
a (Closure a -> (Text, Val a, Closure a)
freshClosure -> (Text
x, Val a
v, Closure a
t)) ->
            forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam
                forall a. Monoid a => a
mempty
                (forall s a. Text -> Expr s a -> FunctionBinding s a
Syntax.makeFunctionBinding Text
x (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
a))
                (Text -> Val a -> Expr Void a
quoteBind Text
x (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
t Val a
v))
        VHLam HLamInfo a
i Val a -> Val a
t ->
            case HLamInfo a
i of
                Typed (Text -> (Text, Val a)
fresh -> (Text
x, Val a
v)) Val a
a ->
                    forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam forall a. Monoid a => a
mempty
                        (forall s a. Text -> Expr s a -> FunctionBinding s a
Syntax.makeFunctionBinding Text
x (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
a))
                        (Text -> Val a -> Expr Void a
quoteBind Text
x (Val a -> Val a
t Val a
v))
                HLamInfo a
Prim ->
                    forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env (Val a -> Val a
t forall a. Val a
VPrimVar)
                HLamInfo a
NaturalSubtractZero ->
                    forall s a. Expr s a -> Expr s a -> Expr s a
App forall s a. Expr s a
NaturalSubtract (forall s a. Natural -> Expr s a
NaturalLit Natural
0)
                HLamInfo a
TextReplaceEmpty ->
                    forall s a. Expr s a -> Expr s a -> Expr s a
App forall s a. Expr s a
TextReplace (forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
""))
                TextReplaceEmptyArgument Val a
replacement ->
                    forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> Expr s a -> Expr s a
App forall s a. Expr s a
TextReplace (forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [] Text
"")))
                        (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
replacement)

        VPi Val a
a (Closure a -> (Text, Val a, Closure a)
freshClosure -> (Text
x, Val a
v, Closure a
b)) ->
            forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Monoid a => a
mempty Text
x (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
a) (Text -> Val a -> Expr Void a
quoteBind Text
x (forall a. Eq a => Closure a -> Val a -> Val a
instantiate Closure a
b Val a
v))
        VHPi (Text -> (Text, Val a)
fresh -> (Text
x, Val a
v)) Val a
a Val a -> Val a
b ->
            forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Monoid a => a
mempty Text
x (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
a) (Text -> Val a -> Expr Void a
quoteBind Text
x (Val a -> Val a
b Val a
v))
        Val a
VBool ->
            forall s a. Expr s a
Bool
        VBoolLit Bool
b ->
            forall s a. Bool -> Expr s a
BoolLit Bool
b
        VBoolAnd Val a
t Val a
u ->
            forall s a. Expr s a -> Expr s a -> Expr s a
BoolAnd (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VBoolOr Val a
t Val a
u ->
            forall s a. Expr s a -> Expr s a -> Expr s a
BoolOr (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VBoolEQ Val a
t Val a
u ->
            forall s a. Expr s a -> Expr s a -> Expr s a
BoolEQ (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VBoolNE Val a
t Val a
u ->
            forall s a. Expr s a -> Expr s a -> Expr s a
BoolNE (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VBoolIf Val a
t Val a
u Val a
v ->
            forall s a. Expr s a -> Expr s a -> Expr s a -> Expr s a
BoolIf (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
v)
        Val a
VBytes ->
            forall s a. Expr s a
Bytes
        VBytesLit ByteString
b ->
            forall s a. ByteString -> Expr s a
BytesLit ByteString
b
        Val a
VNatural ->
            forall s a. Expr s a
Natural
        VNaturalLit Natural
n ->
            forall s a. Natural -> Expr s a
NaturalLit Natural
n
        VNaturalFold Val a
a Val a
t Val a
u Val a
v ->
            forall s a. Expr s a
NaturalFold Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t Expr Void a -> Val a -> Expr Void a
`qApp` Val a
u Expr Void a -> Val a -> Expr Void a
`qApp` Val a
v
        VNaturalBuild Val a
t ->
            forall s a. Expr s a
NaturalBuild Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VNaturalIsZero Val a
t ->
            forall s a. Expr s a
NaturalIsZero Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VNaturalEven Val a
t ->
            forall s a. Expr s a
NaturalEven Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VNaturalOdd Val a
t ->
            forall s a. Expr s a
NaturalOdd Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VNaturalToInteger Val a
t ->
            forall s a. Expr s a
NaturalToInteger Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VNaturalShow Val a
t ->
            forall s a. Expr s a
NaturalShow Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VNaturalPlus Val a
t Val a
u ->
            forall s a. Expr s a -> Expr s a -> Expr s a
NaturalPlus (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VNaturalTimes Val a
t Val a
u ->
            forall s a. Expr s a -> Expr s a -> Expr s a
NaturalTimes (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VNaturalSubtract Val a
x Val a
y ->
            forall s a. Expr s a
NaturalSubtract Expr Void a -> Val a -> Expr Void a
`qApp` Val a
x Expr Void a -> Val a -> Expr Void a
`qApp` Val a
y
        Val a
VInteger ->
            forall s a. Expr s a
Integer
        VIntegerLit Integer
n ->
            forall s a. Integer -> Expr s a
IntegerLit Integer
n
        VIntegerClamp Val a
t ->
            forall s a. Expr s a
IntegerClamp Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VIntegerNegate Val a
t ->
            forall s a. Expr s a
IntegerNegate Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VIntegerShow Val a
t ->
            forall s a. Expr s a
IntegerShow Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VIntegerToDouble Val a
t ->
            forall s a. Expr s a
IntegerToDouble Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        Val a
VDouble ->
            forall s a. Expr s a
Double
        VDoubleLit DhallDouble
n ->
            forall s a. DhallDouble -> Expr s a
DoubleLit DhallDouble
n
        VDoubleShow Val a
t ->
            forall s a. Expr s a
DoubleShow Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        Val a
VText ->
            forall s a. Expr s a
Text
        VTextLit (VChunks [(Text, Val a)]
xys Text
z) ->
            forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env)) [(Text, Val a)]
xys) Text
z)
        VTextAppend Val a
t Val a
u ->
            forall s a. Expr s a -> Expr s a -> Expr s a
TextAppend (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VTextShow Val a
t ->
            forall s a. Expr s a
TextShow Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VTextReplace Val a
a Val a
b Val a
c ->
            forall s a. Expr s a
TextReplace Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a Expr Void a -> Val a -> Expr Void a
`qApp` Val a
b Expr Void a -> Val a -> Expr Void a
`qApp` Val a
c
        Val a
VDate ->
            forall s a. Expr s a
Date
        VDateLiteral Day
d ->
            forall s a. Day -> Expr s a
DateLiteral Day
d
        VDateShow Val a
t ->
            forall s a. Expr s a
DateShow Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        Val a
VTime ->
            forall s a. Expr s a
Time
        VTimeLiteral TimeOfDay
t Word
p ->
            forall s a. TimeOfDay -> Word -> Expr s a
TimeLiteral TimeOfDay
t Word
p
        VTimeShow Val a
t ->
            forall s a. Expr s a
TimeShow Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        Val a
VTimeZone ->
            forall s a. Expr s a
TimeZone
        VTimeZoneLiteral TimeZone
z ->
            forall s a. TimeZone -> Expr s a
TimeZoneLiteral TimeZone
z
        VTimeZoneShow Val a
t ->
            forall s a. Expr s a
TimeZoneShow Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VList Val a
t ->
            forall s a. Expr s a
List Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VListLit Maybe (Val a)
ma Seq (Val a)
ts ->
            forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env) Maybe (Val a)
ma) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env) Seq (Val a)
ts)
        VListAppend Val a
t Val a
u ->
            forall s a. Expr s a -> Expr s a -> Expr s a
ListAppend (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VListBuild Val a
a Val a
t ->
            forall s a. Expr s a
ListBuild Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VListFold Val a
a Val a
l Val a
t Val a
u Val a
v ->
            forall s a. Expr s a
ListFold Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a Expr Void a -> Val a -> Expr Void a
`qApp` Val a
l Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t Expr Void a -> Val a -> Expr Void a
`qApp` Val a
u Expr Void a -> Val a -> Expr Void a
`qApp` Val a
v
        VListLength Val a
a Val a
t ->
            forall s a. Expr s a
ListLength Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VListHead Val a
a Val a
t ->
            forall s a. Expr s a
ListHead Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VListLast Val a
a Val a
t ->
            forall s a. Expr s a
ListLast Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VListIndexed Val a
a Val a
t ->
            forall s a. Expr s a
ListIndexed Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VListReverse Val a
a Val a
t ->
            forall s a. Expr s a
ListReverse Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VOptional Val a
a ->
            forall s a. Expr s a
Optional Expr Void a -> Val a -> Expr Void a
`qApp` Val a
a
        VSome Val a
t ->
            forall s a. Expr s a -> Expr s a
Some (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t)
        VNone Val a
t ->
            forall s a. Expr s a
None Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VRecord Map Text (Val a)
m ->
            forall s a. Map Text (RecordField s a) -> Expr s a
Record (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Val a -> RecordField Void a
quoteRecordField Map Text (Val a)
m)
        VRecordLit Map Text (Val a)
m ->
            forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Val a -> RecordField Void a
quoteRecordField Map Text (Val a)
m)
        VUnion Map Text (Maybe (Val a))
m ->
            forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env)) Map Text (Maybe (Val a))
m)
        VCombine Maybe Text
mk Val a
t Val a
u ->
            forall s a.
Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine forall a. Monoid a => a
mempty Maybe Text
mk (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VCombineTypes Val a
t Val a
u ->
            forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
CombineTypes forall a. Monoid a => a
mempty (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VPrefer Val a
t Val a
u ->
            forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Prefer forall a. Monoid a => a
mempty PreferAnnotation
PreferFromSource (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VMerge Val a
t Val a
u Maybe (Val a)
ma ->
            forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env) Maybe (Val a)
ma)
        VToMap Val a
t Maybe (Val a)
ma ->
            forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
ToMap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env) Maybe (Val a)
ma)
        VShowConstructor Val a
t ->
            forall s a. Expr s a -> Expr s a
ShowConstructor (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t)
        VField Val a
t Text
k ->
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Syntax.makeFieldSelection Text
k
        VProject Val a
t Either (Set Text) (Val a)
p ->
            forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Project (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Set a -> [a]
Dhall.Set.toList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env) Either (Set Text) (Val a)
p))
        VAssert Val a
t ->
            forall s a. Expr s a -> Expr s a
Assert (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t)
        VEquivalent Val a
t Val a
u ->
            forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
Equivalent forall a. Monoid a => a
mempty (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
t) (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
        VWith Val a
e NonEmpty WithComponent
ks Val a
v ->
            forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
e) NonEmpty WithComponent
ks (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
v)
        VInject Map Text (Maybe (Val a))
m Text
k Maybe (Val a)
Nothing ->
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env)) Map Text (Maybe (Val a))
m)) forall a b. (a -> b) -> a -> b
$ forall s. Text -> FieldSelection s
Syntax.makeFieldSelection Text
k
        VInject Map Text (Maybe (Val a))
m Text
k (Just Val a
t) ->
            forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env)) Map Text (Maybe (Val a))
m)) (forall s. Text -> FieldSelection s
Syntax.makeFieldSelection Text
k) Expr Void a -> Val a -> Expr Void a
`qApp` Val a
t
        VEmbed a
a ->
            forall s a. a -> Expr s a
Embed a
a
        Val a
VPrimVar ->
            forall a. HasCallStack => String -> a
error String
errorMsg
  where
    fresh :: Text -> (Text, Val a)
    fresh :: Text -> (Text, Val a)
fresh Text
x = (Text
x, forall a. Text -> Int -> Val a
VVar Text
x (Text -> Names -> Int
countNames Text
x Names
env))
    {-# INLINE fresh #-}

    freshClosure :: Closure a -> (Text, Val a, Closure a)
    freshClosure :: Closure a -> (Text, Val a, Closure a)
freshClosure closure :: Closure a
closure@(Closure Text
x Environment a
_ Expr Void a
_) = (Text
x, forall a b. (a, b) -> b
snd (Text -> (Text, Val a)
fresh Text
x), Closure a
closure)
    {-# INLINE freshClosure #-}

    quoteBind :: Text -> Val a -> Expr Void a
    quoteBind :: Text -> Val a -> Expr Void a
quoteBind Text
x = forall a. Eq a => Names -> Val a -> Expr Void a
quote (Names -> Text -> Names
Bind Names
env Text
x)
    {-# INLINE quoteBind #-}

    qApp :: Expr Void a -> Val a -> Expr Void a
    qApp :: Expr Void a -> Val a -> Expr Void a
qApp Expr Void a
t Val a
VPrimVar = Expr Void a
t
    qApp Expr Void a
t Val a
u        = forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Void a
t (forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env Val a
u)
    {-# INLINE qApp #-}

    quoteRecordField :: Val a -> RecordField Void a
    quoteRecordField :: Val a -> RecordField Void a
quoteRecordField = forall s a. Expr s a -> RecordField s a
Syntax.makeRecordField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => Names -> Val a -> Expr Void a
quote Names
env
    {-# INLINE quoteRecordField #-}

-- | Normalize an expression in an environment of values. Any variable pointing out of
--   the environment is treated as opaque free variable.
nf :: Eq a => Environment a -> Expr s a -> Expr t a
nf :: forall a s t. Eq a => Environment a -> Expr s a -> Expr t a
nf !Environment a
env = forall a s. Expr Void a -> Expr s a
Syntax.renote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => Names -> Val a -> Expr Void a
quote (forall a. Environment a -> Names
envNames Environment a
env) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => Environment a -> Expr Void a -> Val a
eval Environment a
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a t. Expr s a -> Expr t a
Syntax.denote

normalize :: Eq a => Expr s a -> Expr t a
normalize :: forall a s t. Eq a => Expr s a -> Expr t a
normalize = forall a s t. Eq a => Environment a -> Expr s a -> Expr t a
nf forall a. Environment a
Empty
{-# INLINABLE normalize #-}

alphaNormalize :: Expr s a -> Expr s a
alphaNormalize :: forall s a. Expr s a -> Expr s a
alphaNormalize = forall s a. Names -> Expr s a -> Expr s a
goEnv Names
EmptyNames
  where
    goVar :: Names -> Text -> Int -> Expr s a
    goVar :: forall s a. Names -> Text -> Int -> Expr s a
goVar Names
e Text
topX Int
topI = forall {s} {a}. Int -> Names -> Int -> Expr s a
go Int
0 Names
e Int
topI
      where
        go :: Int -> Names -> Int -> Expr s a
go !Int
acc (Bind Names
env Text
x) !Int
i
          | Text
x forall a. Eq a => a -> a -> Bool
== Text
topX = if Int
i forall a. Eq a => a -> a -> Bool
== Int
0 then forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
"_" Int
acc) else Int -> Names -> Int -> Expr s a
go (Int
acc forall a. Num a => a -> a -> a
+ Int
1) Names
env (Int
i forall a. Num a => a -> a -> a
- Int
1)
          | Bool
otherwise = Int -> Names -> Int -> Expr s a
go (Int
acc forall a. Num a => a -> a -> a
+ Int
1) Names
env Int
i
        go Int
_ Names
EmptyNames Int
i = forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
topX Int
i)

    goEnv :: Names -> Expr s a -> Expr s a
    goEnv :: forall s a. Names -> Expr s a -> Expr s a
goEnv !Names
e0 Expr s a
t0 =
        case Expr s a
t0 of
            Const Const
k ->
                forall s a. Const -> Expr s a
Const Const
k
            Var (V Text
x Int
i) ->
                forall s a. Names -> Text -> Int -> Expr s a
goVar Names
e0 Text
x Int
i
            Lam Maybe CharacterSet
cs (FunctionBinding Maybe s
src0 Text
x Maybe s
src1 Maybe s
src2 Expr s a
t) Expr s a
u ->
                forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
cs (forall s a.
Maybe s
-> Text -> Maybe s -> Maybe s -> Expr s a -> FunctionBinding s a
FunctionBinding Maybe s
src0 Text
"_" Maybe s
src1 Maybe s
src2 (forall s a. Expr s a -> Expr s a
go Expr s a
t)) (forall {s} {a}. Text -> Expr s a -> Expr s a
goBind Text
x Expr s a
u)
            Pi Maybe CharacterSet
cs Text
x Expr s a
a Expr s a
b ->
                forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
cs Text
"_" (forall s a. Expr s a -> Expr s a
go Expr s a
a) (forall {s} {a}. Text -> Expr s a -> Expr s a
goBind Text
x Expr s a
b)
            App Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
App (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            Let (Binding Maybe s
src0 Text
x Maybe s
src1 Maybe (Maybe s, Expr s a)
mA Maybe s
src2 Expr s a
a) Expr s a
b ->
                forall s a. Binding s a -> Expr s a -> Expr s a
Let (forall s a.
Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
Binding Maybe s
src0 Text
"_" Maybe s
src1 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Expr s a
go) Maybe (Maybe s, Expr s a)
mA) Maybe s
src2 (forall s a. Expr s a -> Expr s a
go Expr s a
a)) (forall {s} {a}. Text -> Expr s a -> Expr s a
goBind Text
x Expr s a
b)
            Annot Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
Annot (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            Expr s a
Bool ->
                forall s a. Expr s a
Bool
            BoolLit Bool
b ->
                forall s a. Bool -> Expr s a
BoolLit Bool
b
            BoolAnd Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
BoolAnd (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            BoolOr Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
BoolOr  (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            BoolEQ Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
BoolEQ  (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            BoolNE Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
BoolNE  (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            BoolIf Expr s a
b Expr s a
t Expr s a
f ->
                forall s a. Expr s a -> Expr s a -> Expr s a -> Expr s a
BoolIf  (forall s a. Expr s a -> Expr s a
go Expr s a
b) (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
f)
            Expr s a
Bytes ->
                forall s a. Expr s a
Bytes
            BytesLit ByteString
b ->
                forall s a. ByteString -> Expr s a
BytesLit ByteString
b
            Expr s a
Natural ->
                forall s a. Expr s a
Natural
            NaturalLit Natural
n ->
                forall s a. Natural -> Expr s a
NaturalLit Natural
n
            Expr s a
NaturalFold ->
                forall s a. Expr s a
NaturalFold
            Expr s a
NaturalBuild ->
                forall s a. Expr s a
NaturalBuild
            Expr s a
NaturalIsZero ->
                forall s a. Expr s a
NaturalIsZero
            Expr s a
NaturalEven ->
                forall s a. Expr s a
NaturalEven
            Expr s a
NaturalOdd ->
                forall s a. Expr s a
NaturalOdd
            Expr s a
NaturalToInteger ->
                forall s a. Expr s a
NaturalToInteger
            Expr s a
NaturalShow ->
                forall s a. Expr s a
NaturalShow
            Expr s a
NaturalSubtract ->
                forall s a. Expr s a
NaturalSubtract
            NaturalPlus Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
NaturalPlus (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            NaturalTimes Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
NaturalTimes (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            Expr s a
Integer ->
                forall s a. Expr s a
Integer
            IntegerLit Integer
n ->
                forall s a. Integer -> Expr s a
IntegerLit Integer
n
            Expr s a
IntegerClamp ->
                forall s a. Expr s a
IntegerClamp
            Expr s a
IntegerNegate ->
                forall s a. Expr s a
IntegerNegate
            Expr s a
IntegerShow ->
                forall s a. Expr s a
IntegerShow
            Expr s a
IntegerToDouble ->
                forall s a. Expr s a
IntegerToDouble
            Expr s a
Double ->
                forall s a. Expr s a
Double
            DoubleLit DhallDouble
n ->
                forall s a. DhallDouble -> Expr s a
DoubleLit DhallDouble
n
            Expr s a
DoubleShow ->
                forall s a. Expr s a
DoubleShow
            Expr s a
Text ->
                forall s a. Expr s a
Text
            TextLit Chunks s a
cs ->
                forall s a. Chunks s a -> Expr s a
TextLit (forall {s} {a}. Chunks s a -> Chunks s a
goChunks Chunks s a
cs)
            TextAppend Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
TextAppend (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            Expr s a
TextShow ->
                forall s a. Expr s a
TextShow
            Expr s a
TextReplace ->
                forall s a. Expr s a
TextReplace
            Expr s a
Date ->
                forall s a. Expr s a
Date
            DateLiteral Day
d ->
                forall s a. Day -> Expr s a
DateLiteral Day
d
            Expr s a
DateShow ->
                forall s a. Expr s a
DateShow
            Expr s a
Time ->
                forall s a. Expr s a
Time
            TimeLiteral TimeOfDay
t Word
p ->
                forall s a. TimeOfDay -> Word -> Expr s a
TimeLiteral TimeOfDay
t Word
p
            Expr s a
TimeShow ->
                forall s a. Expr s a
TimeShow
            Expr s a
TimeZone ->
                forall s a. Expr s a
TimeZone
            TimeZoneLiteral TimeZone
z ->
                forall s a. TimeZone -> Expr s a
TimeZoneLiteral TimeZone
z
            Expr s a
TimeZoneShow ->
                forall s a. Expr s a
TimeZoneShow
            Expr s a
List ->
                forall s a. Expr s a
List
            ListLit Maybe (Expr s a)
ma Seq (Expr s a)
ts ->
                forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Expr s a
go Maybe (Expr s a)
ma) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Expr s a
go Seq (Expr s a)
ts)
            ListAppend Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
ListAppend (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            Expr s a
ListBuild ->
                forall s a. Expr s a
ListBuild
            Expr s a
ListFold ->
                forall s a. Expr s a
ListFold
            Expr s a
ListLength ->
                forall s a. Expr s a
ListLength
            Expr s a
ListHead ->
                forall s a. Expr s a
ListHead
            Expr s a
ListLast ->
                forall s a. Expr s a
ListLast
            Expr s a
ListIndexed ->
                forall s a. Expr s a
ListIndexed
            Expr s a
ListReverse ->
                forall s a. Expr s a
ListReverse
            Expr s a
Optional ->
                forall s a. Expr s a
Optional
            Some Expr s a
t ->
                forall s a. Expr s a -> Expr s a
Some (forall s a. Expr s a -> Expr s a
go Expr s a
t)
            Expr s a
None ->
                forall s a. Expr s a
None
            Record Map Text (RecordField s a)
kts ->
                forall s a. Map Text (RecordField s a) -> Expr s a
Record (forall {s} {a}. RecordField s a -> RecordField s a
goRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField s a)
kts)
            RecordLit Map Text (RecordField s a)
kts ->
                forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (forall {s} {a}. RecordField s a -> RecordField s a
goRecordField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField s a)
kts)
            Union Map Text (Maybe (Expr s a))
kts ->
                forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Expr s a
go) Map Text (Maybe (Expr s a))
kts)
            Combine Maybe CharacterSet
cs Maybe Text
m Expr s a
t Expr s a
u ->
                forall s a.
Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine Maybe CharacterSet
cs Maybe Text
m (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            CombineTypes Maybe CharacterSet
cs Expr s a
t Expr s a
u ->
                forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
CombineTypes Maybe CharacterSet
cs (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            Prefer Maybe CharacterSet
cs PreferAnnotation
b Expr s a
t Expr s a
u ->
                forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Prefer Maybe CharacterSet
cs PreferAnnotation
b (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            RecordCompletion Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
RecordCompletion (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            Merge Expr s a
x Expr s a
y Maybe (Expr s a)
ma ->
                forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge (forall s a. Expr s a -> Expr s a
go Expr s a
x) (forall s a. Expr s a -> Expr s a
go Expr s a
y) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Expr s a
go Maybe (Expr s a)
ma)
            ToMap Expr s a
x Maybe (Expr s a)
ma ->
                forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
ToMap (forall s a. Expr s a -> Expr s a
go Expr s a
x) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Expr s a
go Maybe (Expr s a)
ma)
            ShowConstructor Expr s a
x ->
                forall s a. Expr s a -> Expr s a
ShowConstructor (forall s a. Expr s a -> Expr s a
go Expr s a
x)
            Field Expr s a
t FieldSelection s
k ->
                forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (forall s a. Expr s a -> Expr s a
go Expr s a
t) FieldSelection s
k
            Project Expr s a
t Either [Text] (Expr s a)
ks ->
                forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Project (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Expr s a
go Either [Text] (Expr s a)
ks)
            Assert Expr s a
t ->
                forall s a. Expr s a -> Expr s a
Assert (forall s a. Expr s a -> Expr s a
go Expr s a
t)
            Equivalent Maybe CharacterSet
cs Expr s a
t Expr s a
u ->
                forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
Equivalent Maybe CharacterSet
cs (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            With Expr s a
e NonEmpty WithComponent
k Expr s a
v ->
                forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With (forall s a. Expr s a -> Expr s a
go Expr s a
e) NonEmpty WithComponent
k (forall s a. Expr s a -> Expr s a
go Expr s a
v)
            Note s
s Expr s a
e ->
                forall s a. s -> Expr s a -> Expr s a
Note s
s (forall s a. Expr s a -> Expr s a
go Expr s a
e)
            ImportAlt Expr s a
t Expr s a
u ->
                forall s a. Expr s a -> Expr s a -> Expr s a
ImportAlt (forall s a. Expr s a -> Expr s a
go Expr s a
t) (forall s a. Expr s a -> Expr s a
go Expr s a
u)
            Embed a
a ->
                forall s a. a -> Expr s a
Embed a
a
      where
        go :: Expr s a -> Expr s a
go                     = forall s a. Names -> Expr s a -> Expr s a
goEnv Names
e0
        goBind :: Text -> Expr s a -> Expr s a
goBind Text
x               = forall s a. Names -> Expr s a -> Expr s a
goEnv (Names -> Text -> Names
Bind Names
e0 Text
x)
        goChunks :: Chunks s a -> Chunks s a
goChunks (Chunks [(Text, Expr s a)]
ts Text
x) = forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. Expr s a -> Expr s a
go) [(Text, Expr s a)]
ts) Text
x
        goRecordField :: RecordField s a -> RecordField s a
goRecordField (RecordField Maybe s
s0 Expr s a
e Maybe s
s1 Maybe s
s2) = forall s a.
Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
RecordField Maybe s
s0 (forall s a. Expr s a -> Expr s a
go Expr s a
e) Maybe s
s1 Maybe s
s2