{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}

module Dhall.Syntax.Operations
    ( -- * Optics
      subExpressions
    , subExpressionsWith
    , unsafeSubExpressions

      -- * Handling 'Note's
    , denote
    , renote
    , shallowDenote

      -- * Reserved identifiers
    , reservedIdentifiers
    , reservedKeywords

      -- * Utilities
    , internalError
      -- `shift` should really be in `Dhall.Normalize`, but it's here to avoid a
      -- module cycle
    , shift
    ) where

import Data.HashSet                 (HashSet)
import Data.Text                    (Text)
import Data.Void                    (Void)
import Dhall.Syntax.Binding         (Binding (..), bindingExprs)
import Dhall.Syntax.Chunks          (chunkExprs)
import Dhall.Syntax.Expr
import Dhall.Syntax.FunctionBinding
import Dhall.Syntax.RecordField     (RecordField (..), recordFieldExprs)
import Dhall.Syntax.Types
import Dhall.Syntax.Var
import Unsafe.Coerce                (unsafeCoerce)

import qualified Data.HashSet
import qualified Data.Text
import qualified Lens.Family  as Lens


-- | A traversal over the immediate sub-expressions of an expression.
subExpressions
    :: Applicative f => (Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions :: (Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions = (a -> f (Expr s a))
-> (Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
forall (f :: * -> *) a s b.
Applicative f =>
(a -> f (Expr s b))
-> (Expr s a -> f (Expr s b)) -> Expr s a -> f (Expr s b)
subExpressionsWith (Expr s a -> f (Expr s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr s a -> f (Expr s a)) -> (a -> Expr s a) -> a -> f (Expr s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Expr s a
forall s a. a -> Expr s a
Embed)
{-# INLINABLE subExpressions #-}

{-| A traversal over the immediate sub-expressions of an expression which
    allows mapping embedded values
-}
subExpressionsWith
    :: Applicative f => (a -> f (Expr s b)) -> (Expr s a -> f (Expr s b)) -> Expr s a -> f (Expr s b)
subExpressionsWith :: (a -> f (Expr s b))
-> (Expr s a -> f (Expr s b)) -> Expr s a -> f (Expr s b)
subExpressionsWith a -> f (Expr s b)
h Expr s a -> f (Expr s b)
_ (Embed a
a) = a -> f (Expr s b)
h a
a
subExpressionsWith a -> f (Expr s b)
_ Expr s a -> f (Expr s b)
f (Note s
a Expr s a
b) = s -> Expr s b -> Expr s b
forall s a. s -> Expr s a -> Expr s a
Note s
a (Expr s b -> Expr s b) -> f (Expr s b) -> f (Expr s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr s b)
f Expr s a
b
subExpressionsWith a -> f (Expr s b)
_ Expr s a -> f (Expr s b)
f (Let Binding s a
a Expr s a
b) = Binding s b -> Expr s b -> Expr s b
forall s a. Binding s a -> Expr s a -> Expr s a
Let (Binding s b -> Expr s b -> Expr s b)
-> f (Binding s b) -> f (Expr s b -> Expr s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr s a -> f (Expr s b)) -> Binding s a -> f (Binding s b)
forall (f :: * -> *) s a b.
Applicative f =>
(Expr s a -> f (Expr s b)) -> Binding s a -> f (Binding s b)
bindingExprs Expr s a -> f (Expr s b)
f Binding s a
a f (Expr s b -> Expr s b) -> f (Expr s b) -> f (Expr s b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr s b)
f Expr s a
b
subExpressionsWith a -> f (Expr s b)
_ Expr s a -> f (Expr s b)
f (Record Map Text (RecordField s a)
a) = Map Text (RecordField s b) -> Expr s b
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField s b) -> Expr s b)
-> f (Map Text (RecordField s b)) -> f (Expr s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RecordField s a -> f (RecordField s b))
-> Map Text (RecordField s a) -> f (Map Text (RecordField s b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr s a -> f (Expr s b))
-> RecordField s a -> f (RecordField s b)
forall (f :: * -> *) s a b.
Applicative f =>
(Expr s a -> f (Expr s b))
-> RecordField s a -> f (RecordField s b)
recordFieldExprs Expr s a -> f (Expr s b)
f) Map Text (RecordField s a)
a
subExpressionsWith a -> f (Expr s b)
_ Expr s a -> f (Expr s b)
f (RecordLit Map Text (RecordField s a)
a) = Map Text (RecordField s b) -> Expr s b
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField s b) -> Expr s b)
-> f (Map Text (RecordField s b)) -> f (Expr s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RecordField s a -> f (RecordField s b))
-> Map Text (RecordField s a) -> f (Map Text (RecordField s b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr s a -> f (Expr s b))
-> RecordField s a -> f (RecordField s b)
forall (f :: * -> *) s a b.
Applicative f =>
(Expr s a -> f (Expr s b))
-> RecordField s a -> f (RecordField s b)
recordFieldExprs Expr s a -> f (Expr s b)
f) Map Text (RecordField s a)
a
subExpressionsWith a -> f (Expr s b)
_ Expr s a -> f (Expr s b)
f (Lam Maybe CharacterSet
cs FunctionBinding s a
fb Expr s a
e) = Maybe CharacterSet -> FunctionBinding s b -> Expr s b -> Expr s b
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
cs (FunctionBinding s b -> Expr s b -> Expr s b)
-> f (FunctionBinding s b) -> f (Expr s b -> Expr s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr s a -> f (Expr s b))
-> FunctionBinding s a -> f (FunctionBinding s b)
forall (f :: * -> *) s a b.
Applicative f =>
(Expr s a -> f (Expr s b))
-> FunctionBinding s a -> f (FunctionBinding s b)
functionBindingExprs Expr s a -> f (Expr s b)
f FunctionBinding s a
fb f (Expr s b -> Expr s b) -> f (Expr s b) -> f (Expr s b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr s b)
f Expr s a
e
subExpressionsWith a -> f (Expr s b)
_ Expr s a -> f (Expr s b)
f (Field Expr s a
a FieldSelection s
b) = Expr s b -> FieldSelection s -> Expr s b
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (Expr s b -> FieldSelection s -> Expr s b)
-> f (Expr s b) -> f (FieldSelection s -> Expr s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr s b)
f Expr s a
a f (FieldSelection s -> Expr s b)
-> f (FieldSelection s) -> f (Expr s b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldSelection s -> f (FieldSelection s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldSelection s
b
subExpressionsWith a -> f (Expr s b)
_ Expr s a -> f (Expr s b)
f Expr s a
expression = (Expr s a -> f (Expr s b)) -> Expr s a -> f (Expr s b)
forall (f :: * -> *) s a t b.
Applicative f =>
(Expr s a -> f (Expr t b)) -> Expr s a -> f (Expr t b)
unsafeSubExpressions Expr s a -> f (Expr s b)
f Expr s a
expression
{-# INLINABLE subExpressionsWith #-}

{-| An internal utility used to implement transformations that require changing
    one of the type variables of the `Expr` type

    This utility only works because the implementation is partial, not
    handling the `Let`, `Note`, or `Embed` cases, which need to be handled by
    the caller.
-}
unsafeSubExpressions
    :: Applicative f => (Expr s a -> f (Expr t b)) -> Expr s a -> f (Expr t b)
unsafeSubExpressions :: (Expr s a -> f (Expr t b)) -> Expr s a -> f (Expr t b)
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (Const Const
c) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Const -> Expr t b
forall s a. Const -> Expr s a
Const Const
c)
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (Var Var
v) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> Expr t b
forall s a. Var -> Expr s a
Var Var
v)
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Pi Maybe CharacterSet
cs Text
a Expr s a
b Expr s a
c) = Maybe CharacterSet -> Text -> Expr t b -> Expr t b -> Expr t b
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
cs Text
a (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
unsafeSubExpressions Expr s a -> f (Expr t b)
f (App Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Annot Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
Annot (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
Bool = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
Bool
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (BoolLit Bool
b) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Expr t b
forall s a. Bool -> Expr s a
BoolLit Bool
b)
unsafeSubExpressions Expr s a -> f (Expr t b)
f (BoolAnd Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
BoolAnd (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (BoolOr Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
BoolOr (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (BoolEQ Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
BoolEQ (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (BoolNE Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
BoolNE (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (BoolIf Expr s a
a Expr s a
b Expr s a
c) = Expr t b -> Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a -> Expr s a
BoolIf (Expr t b -> Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
Bytes = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
Bytes
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (BytesLit ByteString
a) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Expr t b
forall s a. ByteString -> Expr s a
BytesLit ByteString
a)
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
Natural = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
Natural
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (NaturalLit Natural
n) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> Expr t b
forall s a. Natural -> Expr s a
NaturalLit Natural
n)
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
NaturalFold = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
NaturalFold
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
NaturalBuild = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
NaturalBuild
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
NaturalIsZero = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
NaturalIsZero
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
NaturalEven = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
NaturalEven
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
NaturalOdd = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
NaturalOdd
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
NaturalToInteger = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
NaturalToInteger
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
NaturalShow = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
NaturalShow
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
NaturalSubtract = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
NaturalSubtract
unsafeSubExpressions Expr s a -> f (Expr t b)
f (NaturalPlus Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
NaturalPlus (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (NaturalTimes Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
NaturalTimes (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
Integer = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
Integer
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (IntegerLit Integer
n) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Expr t b
forall s a. Integer -> Expr s a
IntegerLit Integer
n)
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
IntegerClamp = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
IntegerClamp
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
IntegerNegate = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
IntegerNegate
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
IntegerShow = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
IntegerShow
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
IntegerToDouble = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
IntegerToDouble
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
Double = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
Double
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (DoubleLit DhallDouble
n) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DhallDouble -> Expr t b
forall s a. DhallDouble -> Expr s a
DoubleLit DhallDouble
n)
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
DoubleShow = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
DoubleShow
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
Text = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
Text
unsafeSubExpressions Expr s a -> f (Expr t b)
f (TextLit Chunks s a
chunks) = Chunks t b -> Expr t b
forall s a. Chunks s a -> Expr s a
TextLit (Chunks t b -> Expr t b) -> f (Chunks t b) -> f (Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr s a -> f (Expr t b)) -> Chunks s a -> f (Chunks t b)
forall (f :: * -> *) s a t b.
Applicative f =>
(Expr s a -> f (Expr t b)) -> Chunks s a -> f (Chunks t b)
chunkExprs Expr s a -> f (Expr t b)
f Chunks s a
chunks
unsafeSubExpressions Expr s a -> f (Expr t b)
f (TextAppend Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
TextAppend (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
TextReplace = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
TextReplace
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
TextShow = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
TextShow
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
Date = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
Date
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (DateLiteral Day
a) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> Expr t b
forall s a. Day -> Expr s a
DateLiteral Day
a)
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
DateShow = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
DateShow
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
Time = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
Time
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (TimeLiteral TimeOfDay
a Word
b) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeOfDay -> Word -> Expr t b
forall s a. TimeOfDay -> Word -> Expr s a
TimeLiteral TimeOfDay
a Word
b)
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
TimeShow = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
TimeShow
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
TimeZone = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
TimeZone
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (TimeZoneLiteral TimeZone
a) = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeZone -> Expr t b
forall s a. TimeZone -> Expr s a
TimeZoneLiteral TimeZone
a)
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
TimeZoneShow = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
TimeZoneShow
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
List = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
List
unsafeSubExpressions Expr s a -> f (Expr t b)
f (ListLit Maybe (Expr s a)
a Seq (Expr s a)
b) = Maybe (Expr t b) -> Seq (Expr t b) -> Expr t b
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (Maybe (Expr t b) -> Seq (Expr t b) -> Expr t b)
-> f (Maybe (Expr t b)) -> f (Seq (Expr t b) -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr s a -> f (Expr t b))
-> Maybe (Expr s a) -> f (Maybe (Expr t b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> f (Expr t b)
f Maybe (Expr s a)
a f (Seq (Expr t b) -> Expr t b)
-> f (Seq (Expr t b)) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr s a -> f (Expr t b)) -> Seq (Expr s a) -> f (Seq (Expr t b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> f (Expr t b)
f Seq (Expr s a)
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (ListAppend Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
ListAppend (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
ListBuild = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
ListBuild
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
ListFold = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
ListFold
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
ListLength = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
ListLength
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
ListHead = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
ListHead
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
ListLast = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
ListLast
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
ListIndexed = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
ListIndexed
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
ListReverse = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
ListReverse
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
Optional = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
Optional
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Some Expr s a
a) = Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a
Some (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
unsafeSubExpressions Expr s a -> f (Expr t b)
_ Expr s a
None = Expr t b -> f (Expr t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr t b
forall s a. Expr s a
None
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Union Map Text (Maybe (Expr s a))
a) = Map Text (Maybe (Expr t b)) -> Expr t b
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (Map Text (Maybe (Expr t b)) -> Expr t b)
-> f (Map Text (Maybe (Expr t b))) -> f (Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Expr s a) -> f (Maybe (Expr t b)))
-> Map Text (Maybe (Expr s a)) -> f (Map Text (Maybe (Expr t b)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr s a -> f (Expr t b))
-> Maybe (Expr s a) -> f (Maybe (Expr t b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> f (Expr t b)
f) Map Text (Maybe (Expr s a))
a
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Combine Maybe CharacterSet
cs Maybe Text
a Expr s a
b Expr s a
c) = Maybe CharacterSet
-> Maybe Text -> Expr t b -> Expr t b -> Expr t b
forall s a.
Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine Maybe CharacterSet
cs Maybe Text
a (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
unsafeSubExpressions Expr s a -> f (Expr t b)
f (CombineTypes Maybe CharacterSet
cs Expr s a
a Expr s a
b) = Maybe CharacterSet -> Expr t b -> Expr t b -> Expr t b
forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
CombineTypes Maybe CharacterSet
cs (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Prefer Maybe CharacterSet
cs PreferAnnotation
a Expr s a
b Expr s a
c) = Maybe CharacterSet
-> PreferAnnotation -> Expr t b -> Expr t b -> Expr t b
forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Prefer Maybe CharacterSet
cs (PreferAnnotation -> Expr t b -> Expr t b -> Expr t b)
-> f PreferAnnotation -> f (Expr t b -> Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PreferAnnotation -> f PreferAnnotation
forall (f :: * -> *) a. Applicative f => a -> f a
pure PreferAnnotation
a f (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
unsafeSubExpressions Expr s a -> f (Expr t b)
f (RecordCompletion Expr s a
a Expr s a
b) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
RecordCompletion (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Merge Expr s a
a Expr s a
b Maybe (Expr s a)
t) = Expr t b -> Expr t b -> Maybe (Expr t b) -> Expr t b
forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge (Expr t b -> Expr t b -> Maybe (Expr t b) -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Maybe (Expr t b) -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Maybe (Expr t b) -> Expr t b)
-> f (Expr t b) -> f (Maybe (Expr t b) -> Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b f (Maybe (Expr t b) -> Expr t b)
-> f (Maybe (Expr t b)) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr s a -> f (Expr t b))
-> Maybe (Expr s a) -> f (Maybe (Expr t b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> f (Expr t b)
f Maybe (Expr s a)
t
unsafeSubExpressions Expr s a -> f (Expr t b)
f (ToMap Expr s a
a Maybe (Expr s a)
t) = Expr t b -> Maybe (Expr t b) -> Expr t b
forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
ToMap (Expr t b -> Maybe (Expr t b) -> Expr t b)
-> f (Expr t b) -> f (Maybe (Expr t b) -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Maybe (Expr t b) -> Expr t b)
-> f (Maybe (Expr t b)) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr s a -> f (Expr t b))
-> Maybe (Expr s a) -> f (Maybe (Expr t b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> f (Expr t b)
f Maybe (Expr s a)
t
unsafeSubExpressions Expr s a -> f (Expr t b)
f (ShowConstructor Expr s a
a) = Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a
ShowConstructor (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Project Expr s a
a Either [Text] (Expr s a)
b) = Expr t b -> Either [Text] (Expr t b) -> Expr t b
forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Project (Expr t b -> Either [Text] (Expr t b) -> Expr t b)
-> f (Expr t b) -> f (Either [Text] (Expr t b) -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Either [Text] (Expr t b) -> Expr t b)
-> f (Either [Text] (Expr t b)) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr s a -> f (Expr t b))
-> Either [Text] (Expr s a) -> f (Either [Text] (Expr t b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr s a -> f (Expr t b)
f Either [Text] (Expr s a)
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Assert Expr s a
a) = Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a
Assert (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a
unsafeSubExpressions Expr s a -> f (Expr t b)
f (Equivalent Maybe CharacterSet
cs Expr s a
a Expr s a
b) = Maybe CharacterSet -> Expr t b -> Expr t b -> Expr t b
forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
Equivalent Maybe CharacterSet
cs (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
b
unsafeSubExpressions Expr s a -> f (Expr t b)
f (With Expr s a
a NonEmpty WithComponent
b Expr s a
c) = Expr t b -> NonEmpty WithComponent -> Expr t b -> Expr t b
forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With (Expr t b -> NonEmpty WithComponent -> Expr t b -> Expr t b)
-> f (Expr t b)
-> f (NonEmpty WithComponent -> Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
a f (NonEmpty WithComponent -> Expr t b -> Expr t b)
-> f (NonEmpty WithComponent) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NonEmpty WithComponent -> f (NonEmpty WithComponent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty WithComponent
b f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
c
unsafeSubExpressions Expr s a -> f (Expr t b)
f (ImportAlt Expr s a
l Expr s a
r) = Expr t b -> Expr t b -> Expr t b
forall s a. Expr s a -> Expr s a -> Expr s a
ImportAlt (Expr t b -> Expr t b -> Expr t b)
-> f (Expr t b) -> f (Expr t b -> Expr t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a -> f (Expr t b)
f Expr s a
l f (Expr t b -> Expr t b) -> f (Expr t b) -> f (Expr t b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a -> f (Expr t b)
f Expr s a
r
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (Let {}) = Text -> f (Expr t b)
forall a. Text -> a
unhandledConstructor Text
"Let"
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (Note {}) = Text -> f (Expr t b)
forall a. Text -> a
unhandledConstructor Text
"Note"
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (Embed {}) = Text -> f (Expr t b)
forall a. Text -> a
unhandledConstructor Text
"Embed"
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (Record {}) = Text -> f (Expr t b)
forall a. Text -> a
unhandledConstructor Text
"Record"
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (RecordLit {}) = Text -> f (Expr t b)
forall a. Text -> a
unhandledConstructor Text
"RecordLit"
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (Lam {}) = Text -> f (Expr t b)
forall a. Text -> a
unhandledConstructor Text
"Lam"
unsafeSubExpressions Expr s a -> f (Expr t b)
_ (Field {}) = Text -> f (Expr t b)
forall a. Text -> a
unhandledConstructor Text
"Field"
{-# INLINABLE unsafeSubExpressions #-}

unhandledConstructor :: Text -> a
unhandledConstructor :: Text -> a
unhandledConstructor Text
constructor =
    Text -> forall b. b
internalError
        (   Text
"Dhall.Syntax.unsafeSubExpressions: Unhandled "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
constructor
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
" construtor"
        )

-- | Remove all `Note` constructors from an `Expr` (i.e. de-`Note`)
--
-- This also remove CharacterSet annotations.
denote :: Expr s a -> Expr t a
denote :: Expr s a -> Expr t a
denote = \case
    Note s
_ Expr s a
b -> Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
b
    Let Binding s a
a Expr s a
b -> Binding t a -> Expr t a -> Expr t a
forall s a. Binding s a -> Expr s a -> Expr s a
Let (Binding s a -> Binding t a
forall s a s. Binding s a -> Binding s a
denoteBinding Binding s a
a) (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
b)
    Embed a
a -> a -> Expr t a
forall s a. a -> Expr s a
Embed a
a
    Combine Maybe CharacterSet
_ Maybe Text
_ Expr s a
b Expr s a
c -> Maybe CharacterSet
-> Maybe Text -> Expr t a -> Expr t a -> Expr t a
forall s a.
Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine Maybe CharacterSet
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
b) (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
c)
    CombineTypes Maybe CharacterSet
_ Expr s a
b Expr s a
c -> Maybe CharacterSet -> Expr t a -> Expr t a -> Expr t a
forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
CombineTypes Maybe CharacterSet
forall a. Maybe a
Nothing (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
b) (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
c)
    Prefer Maybe CharacterSet
_ PreferAnnotation
a Expr s a
b Expr s a
c -> ASetter (Expr s a) (Expr t a) (Expr s a) (Expr t a)
-> (Expr s a -> Expr t a) -> Expr s a -> Expr t a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter (Expr s a) (Expr t a) (Expr s a) (Expr t a)
forall (f :: * -> *) s a t b.
Applicative f =>
(Expr s a -> f (Expr t b)) -> Expr s a -> f (Expr t b)
unsafeSubExpressions Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote (Expr s a -> Expr t a) -> Expr s a -> Expr t a
forall a b. (a -> b) -> a -> b
$ Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Prefer Maybe CharacterSet
forall a. Maybe a
Nothing PreferAnnotation
a Expr s a
b Expr s a
c
    Record Map Text (RecordField s a)
a -> Map Text (RecordField t a) -> Expr t a
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField t a) -> Expr t a)
-> Map Text (RecordField t a) -> Expr t a
forall a b. (a -> b) -> a -> b
$ RecordField s a -> RecordField t a
forall s a s. RecordField s a -> RecordField s a
denoteRecordField (RecordField s a -> RecordField t a)
-> Map Text (RecordField s a) -> Map Text (RecordField t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField s a)
a
    RecordLit Map Text (RecordField s a)
a -> Map Text (RecordField t a) -> Expr t a
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField t a) -> Expr t a)
-> Map Text (RecordField t a) -> Expr t a
forall a b. (a -> b) -> a -> b
$ RecordField s a -> RecordField t a
forall s a s. RecordField s a -> RecordField s a
denoteRecordField (RecordField s a -> RecordField t a)
-> Map Text (RecordField s a) -> Map Text (RecordField t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField s a)
a
    Lam Maybe CharacterSet
_ FunctionBinding s a
a Expr s a
b -> Maybe CharacterSet -> FunctionBinding t a -> Expr t a -> Expr t a
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
forall a. Maybe a
Nothing (FunctionBinding s a -> FunctionBinding t a
forall s a s. FunctionBinding s a -> FunctionBinding s a
denoteFunctionBinding FunctionBinding s a
a) (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
b)
    Pi Maybe CharacterSet
_ Text
t Expr s a
a Expr s a
b -> Maybe CharacterSet -> Text -> Expr t a -> Expr t a -> Expr t a
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
forall a. Maybe a
Nothing Text
t (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
a) (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
b)
    Field Expr s a
a (FieldSelection Maybe s
_ Text
b Maybe s
_) -> Expr t a -> FieldSelection t -> Expr t a
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
a) (Maybe t -> Text -> Maybe t -> FieldSelection t
forall s. Maybe s -> Text -> Maybe s -> FieldSelection s
FieldSelection Maybe t
forall a. Maybe a
Nothing Text
b Maybe t
forall a. Maybe a
Nothing)
    Equivalent Maybe CharacterSet
_ Expr s a
a Expr s a
b -> Maybe CharacterSet -> Expr t a -> Expr t a -> Expr t a
forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
Equivalent Maybe CharacterSet
forall a. Maybe a
Nothing (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
a) (Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
b)
    Expr s a
expression -> ASetter (Expr s a) (Expr t a) (Expr s a) (Expr t a)
-> (Expr s a -> Expr t a) -> Expr s a -> Expr t a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter (Expr s a) (Expr t a) (Expr s a) (Expr t a)
forall (f :: * -> *) s a t b.
Applicative f =>
(Expr s a -> f (Expr t b)) -> Expr s a -> f (Expr t b)
unsafeSubExpressions Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
expression
  where
    denoteRecordField :: RecordField s a -> RecordField s a
denoteRecordField (RecordField Maybe s
_ Expr s a
e Maybe s
_ Maybe s
_) = Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
forall s a.
Maybe s -> Expr s a -> Maybe s -> Maybe s -> RecordField s a
RecordField Maybe s
forall a. Maybe a
Nothing (Expr s a -> Expr s a
forall s a t. Expr s a -> Expr t a
denote Expr s a
e) Maybe s
forall a. Maybe a
Nothing Maybe s
forall a. Maybe a
Nothing

    denoteBinding :: Binding s a -> Binding s a
denoteBinding (Binding Maybe s
_ Text
c Maybe s
_ Maybe (Maybe s, Expr s a)
d Maybe s
_ Expr s a
e) =
        Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
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
forall a. Maybe a
Nothing Text
c Maybe s
forall a. Maybe a
Nothing (((Maybe s, Expr s a) -> (Maybe s, Expr s a))
-> Maybe (Maybe s, Expr s a) -> Maybe (Maybe s, Expr s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe s, Expr s a) -> (Maybe s, Expr s a)
forall a s a a t. (a, Expr s a) -> (Maybe a, Expr t a)
denoteBindingAnnotation Maybe (Maybe s, Expr s a)
d) Maybe s
forall a. Maybe a
Nothing (Expr s a -> Expr s a
forall s a t. Expr s a -> Expr t a
denote Expr s a
e)

    denoteBindingAnnotation :: (a, Expr s a) -> (Maybe a, Expr t a)
denoteBindingAnnotation (a
_, Expr s a
f) = (Maybe a
forall a. Maybe a
Nothing, Expr s a -> Expr t a
forall s a t. Expr s a -> Expr t a
denote Expr s a
f)

    denoteFunctionBinding :: FunctionBinding s a -> FunctionBinding s a
denoteFunctionBinding (FunctionBinding Maybe s
_ Text
l Maybe s
_ Maybe s
_ Expr s a
t) =
        Maybe s
-> Text -> Maybe s -> Maybe s -> Expr s a -> FunctionBinding s a
forall s a.
Maybe s
-> Text -> Maybe s -> Maybe s -> Expr s a -> FunctionBinding s a
FunctionBinding Maybe s
forall a. Maybe a
Nothing Text
l Maybe s
forall a. Maybe a
Nothing Maybe s
forall a. Maybe a
Nothing (Expr s a -> Expr s a
forall s a t. Expr s a -> Expr t a
denote Expr s a
t)

-- | The \"opposite\" of `denote`, like @first absurd@ but faster
renote :: Expr Void a -> Expr s a
renote :: Expr Void a -> Expr s a
renote = Expr Void a -> Expr s a
forall a b. a -> b
unsafeCoerce
{-# INLINE renote #-}

{-| Remove any outermost `Note` constructors

    This is typically used when you want to get the outermost non-`Note`
    constructor without removing internal `Note` constructors
-}
shallowDenote :: Expr s a -> Expr s a
shallowDenote :: Expr s a -> Expr s a
shallowDenote (Note s
_ Expr s a
e) = Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
shallowDenote Expr s a
e
shallowDenote         Expr s a
e  = Expr s a
e

-- | The set of reserved keywords according to the @keyword@ rule in the grammar
reservedKeywords :: HashSet Text
reservedKeywords :: HashSet Text
reservedKeywords =
    [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Data.HashSet.fromList
        [ Text
"if"
        , Text
"then"
        , Text
"else"
        , Text
"let"
        , Text
"in"
        , Text
"using"
        , Text
"missing"
        , Text
"as"
        , Text
"Infinity"
        , Text
"NaN"
        , Text
"merge"
        , Text
"Some"
        , Text
"toMap"
        , Text
"assert"
        , Text
"forall"
        , Text
"with"
        ]

-- | The set of reserved identifiers for the Dhall language
-- | Contains also all keywords from "reservedKeywords"
reservedIdentifiers :: HashSet Text
reservedIdentifiers :: HashSet Text
reservedIdentifiers = HashSet Text
reservedKeywords HashSet Text -> HashSet Text -> HashSet Text
forall a. Semigroup a => a -> a -> a
<>
    [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Data.HashSet.fromList
        [ -- Builtins according to the `builtin` rule in the grammar
          Text
"Natural/fold"
        , Text
"Natural/build"
        , Text
"Natural/isZero"
        , Text
"Natural/even"
        , Text
"Natural/odd"
        , Text
"Natural/toInteger"
        , Text
"Natural/show"
        , Text
"Natural/subtract"
        , Text
"Integer"
        , Text
"Integer/clamp"
        , Text
"Integer/negate"
        , Text
"Integer/show"
        , Text
"Integer/toDouble"
        , Text
"Integer/show"
        , Text
"Natural/subtract"
        , Text
"Double/show"
        , Text
"List/build"
        , Text
"List/fold"
        , Text
"List/length"
        , Text
"List/head"
        , Text
"List/last"
        , Text
"List/indexed"
        , Text
"List/reverse"
        , Text
"Text/replace"
        , Text
"Text/show"
        , Text
"Date/show"
        , Text
"Time/show"
        , Text
"TimeZone/show"
        , Text
"Bool"
        , Text
"Bytes"
        , Text
"True"
        , Text
"False"
        , Text
"Optional"
        , Text
"None"
        , Text
"Natural"
        , Text
"Integer"
        , Text
"Double"
        , Text
"Text"
        , Text
"Date"
        , Text
"Time"
        , Text
"TimeZone"
        , Text
"List"
        , Text
"Type"
        , Text
"Kind"
        , Text
"Sort"
        ]

{-| `shift` is used by both normalization and type-checking to avoid variable
    capture by shifting variable indices

    For example, suppose that you were to normalize the following expression:

> λ(a : Type) → λ(x : a) → (λ(y : a) → λ(x : a) → y) x

    If you were to substitute @y@ with @x@ without shifting any variable
    indices, then you would get the following incorrect result:

> λ(a : Type) → λ(x : a) → λ(x : a) → x  -- Incorrect normalized form

    In order to substitute @x@ in place of @y@ we need to `shift` @x@ by @1@ in
    order to avoid being misinterpreted as the @x@ bound by the innermost
    lambda.  If we perform that `shift` then we get the correct result:

> λ(a : Type) → λ(x : a) → λ(x : a) → x@1

    As a more worked example, suppose that you were to normalize the following
    expression:

>     λ(a : Type)
> →   λ(f : a → a → a)
> →   λ(x : a)
> →   λ(x : a)
> →   (λ(x : a) → f x x@1) x@1

    The correct normalized result would be:

>     λ(a : Type)
> →   λ(f : a → a → a)
> →   λ(x : a)
> →   λ(x : a)
> →   f x@1 x

    The above example illustrates how we need to both increase and decrease
    variable indices as part of substitution:

    * We need to increase the index of the outer @x\@1@ to @x\@2@ before we
      substitute it into the body of the innermost lambda expression in order
      to avoid variable capture.  This substitution changes the body of the
      lambda expression to @(f x\@2 x\@1)@

    * We then remove the innermost lambda and therefore decrease the indices of
      both @x@s in @(f x\@2 x\@1)@ to @(f x\@1 x)@ in order to reflect that one
      less @x@ variable is now bound within that scope

    Formally, @(shift d (V x n) e)@ modifies the expression @e@ by adding @d@ to
    the indices of all variables named @x@ whose indices are greater than
    @(n + m)@, where @m@ is the number of bound variables of the same name
    within that scope

    In practice, @d@ is always @1@ or @-1@ because we either:

    * increment variables by @1@ to avoid variable capture during substitution
    * decrement variables by @1@ when deleting lambdas after substitution

    @n@ starts off at @0@ when substitution begins and increments every time we
    descend into a lambda or let expression that binds a variable of the same
    name in order to avoid shifting the bound variables by mistake.
-}
shift :: Int -> Var -> Expr s a -> Expr s a
shift :: Int -> Var -> Expr s a -> Expr s a
shift Int
d (V Text
x Int
n) (Var (V Text
x' Int
n')) = Var -> Expr s a
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x' Int
n'')
  where
    n'' :: Int
n'' = if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n' then Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d else Int
n'
shift Int
d (V Text
x Int
n) (Lam Maybe CharacterSet
cs (FunctionBinding Maybe s
src0 Text
x' Maybe s
src1 Maybe s
src2 Expr s a
_A) Expr s a
b) =
    Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
cs (Maybe s
-> Text -> Maybe s -> Maybe s -> Expr s a -> FunctionBinding s a
forall s a.
Maybe s
-> Text -> Maybe s -> Maybe s -> Expr s a -> FunctionBinding s a
FunctionBinding Maybe s
src0 Text
x' Maybe s
src1 Maybe s
src2 Expr s a
_A') Expr s a
b'
  where
    _A' :: Expr s a
_A' = Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
shift Int
d (Text -> Int -> Var
V Text
x Int
n ) Expr s a
_A
    b' :: Expr s a
b'  = Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
shift Int
d (Text -> Int -> Var
V Text
x Int
n') Expr s a
b
      where
        n' :: Int
n' = if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n
shift Int
d (V Text
x Int
n) (Pi Maybe CharacterSet
cs Text
x' Expr s a
_A Expr s a
_B) = Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
cs Text
x' Expr s a
_A' Expr s a
_B'
  where
    _A' :: Expr s a
_A' = Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
shift Int
d (Text -> Int -> Var
V Text
x Int
n ) Expr s a
_A
    _B' :: Expr s a
_B' = Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
shift Int
d (Text -> Int -> Var
V Text
x Int
n') Expr s a
_B
      where
        n' :: Int
n' = if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n
shift Int
d (V Text
x Int
n) (Let (Binding Maybe s
src0 Text
f Maybe s
src1 Maybe (Maybe s, Expr s a)
mt Maybe s
src2 Expr s a
r) Expr s a
e) =
    Binding s a -> Expr s a -> Expr s a
forall s a. Binding s a -> Expr s a -> Expr s a
Let (Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
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
f Maybe s
src1 Maybe (Maybe s, Expr s a)
mt' Maybe s
src2 Expr s a
r') Expr s a
e'
  where
    e' :: Expr s a
e' = Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
shift Int
d (Text -> Int -> Var
V Text
x Int
n') Expr s a
e
      where
        n' :: Int
n' = if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
f then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n

    mt' :: Maybe (Maybe s, Expr s a)
mt' = ((Maybe s, Expr s a) -> (Maybe s, Expr s a))
-> Maybe (Maybe s, Expr s a) -> Maybe (Maybe s, Expr s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr s a -> Expr s a)
-> (Maybe s, Expr s a) -> (Maybe s, Expr s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
shift Int
d (Text -> Int -> Var
V Text
x Int
n))) Maybe (Maybe s, Expr s a)
mt
    r' :: Expr s a
r'  =             Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
shift Int
d (Text -> Int -> Var
V Text
x Int
n)  Expr s a
r
shift Int
d Var
v Expr s a
expression = ASetter (Expr s a) (Expr s a) (Expr s a) (Expr s a)
-> (Expr s a -> Expr s a) -> Expr s a -> Expr s a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter (Expr s a) (Expr s a) (Expr s a) (Expr s a)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions (Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
shift Int
d Var
v) Expr s a
expression

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

{-| Utility function used to throw internal errors that should never happen
    (in theory) but that are not enforced by the type system
-}
internalError :: Data.Text.Text -> forall b . b
internalError :: Text -> forall b. b
internalError Text
text = String -> b
forall a. HasCallStack => String -> a
error ([String] -> String
unlines
    [ String
_ERROR String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Compiler bug                                                        "
    , String
"                                                                                "
    , 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                              "
    , String
"                                                                                "
    , String
"Please include the following text in your bug report:                           "
    , String
"                                                                                "
    , String
"```                                                                             "
    , Text -> String
Data.Text.unpack Text
text String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"                                                       "
    , String
"```                                                                             "
    ] )