{-# OPTIONS_GHC -Wno-orphans #-}

module Dhall.Syntax.Instances.Applicative () where

import Dhall.Syntax.Binding
import Dhall.Syntax.Expr
import Dhall.Syntax.FunctionBinding
import Dhall.Syntax.Instances.Functor ()
import Dhall.Syntax.Operations
import Dhall.Syntax.RecordField

import qualified Lens.Family as Lens

instance Applicative (Expr s) where
    pure :: a -> Expr s a
pure = a -> Expr s a
forall s a. a -> Expr s a
Embed

    Expr s (a -> b)
expression <*> :: Expr s (a -> b) -> Expr s a -> Expr s b
<*> Expr s a
k = case Expr s (a -> b)
expression of
        Embed a -> b
a     -> a -> b
a (a -> b) -> Expr s a -> Expr s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr s a
k
        Let Binding s (a -> b)
a Expr s (a -> b)
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 (a -> b) -> Binding s b
forall b. Binding s (a -> b) -> Binding s b
adaptBinding Binding s (a -> b)
a) (Expr s (a -> b)
b Expr s (a -> b) -> Expr s a -> Expr s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a
k)
        Note s
a Expr s (a -> b)
b    -> s -> Expr s b -> Expr s b
forall s a. s -> Expr s a -> Expr s a
Note s
a (Expr s (a -> b)
b Expr s (a -> b) -> Expr s a -> Expr s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a
k)
        Record Map Text (RecordField s (a -> b))
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)
-> Map Text (RecordField s b) -> Expr s b
forall a b. (a -> b) -> a -> b
$ RecordField s (a -> b) -> RecordField s b
forall a. RecordField s (a -> a) -> RecordField s a
adaptRecordField (RecordField s (a -> b) -> RecordField s b)
-> Map Text (RecordField s (a -> b)) -> Map Text (RecordField s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField s (a -> b))
a
        RecordLit Map Text (RecordField s (a -> b))
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)
-> Map Text (RecordField s b) -> Expr s b
forall a b. (a -> b) -> a -> b
$ RecordField s (a -> b) -> RecordField s b
forall a. RecordField s (a -> a) -> RecordField s a
adaptRecordField (RecordField s (a -> b) -> RecordField s b)
-> Map Text (RecordField s (a -> b)) -> Map Text (RecordField s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField s (a -> b))
a
        Lam Maybe CharacterSet
cs FunctionBinding s (a -> b)
a Expr s (a -> b)
b  -> 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 (a -> b) -> FunctionBinding s b
forall a. FunctionBinding s (a -> a) -> FunctionBinding s a
adaptFunctionBinding FunctionBinding s (a -> b)
a) (Expr s (a -> b)
b Expr s (a -> b) -> Expr s a -> Expr s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a
k)
        Field Expr s (a -> b)
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 (a -> b)
a Expr s (a -> b) -> Expr s a -> Expr s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a
k) FieldSelection s
b
        Expr s (a -> b)
_ -> ASetter (Expr s (a -> b)) (Expr s b) (Expr s (a -> b)) (Expr s b)
-> (Expr s (a -> b) -> Expr s b) -> Expr s (a -> b) -> Expr s b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter (Expr s (a -> b)) (Expr s b) (Expr s (a -> b)) (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 -> b) -> Expr s a -> Expr s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a
k) Expr s (a -> b)
expression
      where
        adaptRecordField :: RecordField s (a -> a) -> RecordField s a
adaptRecordField (RecordField Maybe s
s0 Expr s (a -> a)
e Maybe s
s1 Maybe s
s2) =
            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
s0 (Expr s (a -> a)
e Expr s (a -> a) -> Expr s a -> Expr s a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a
k) Maybe s
s1 Maybe s
s2

        adaptBinding :: Binding s (a -> b) -> Binding s b
adaptBinding (Binding Maybe s
src0 Text
c Maybe s
src1 Maybe (Maybe s, Expr s (a -> b))
d Maybe s
src2 Expr s (a -> b)
e) =
            Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s b)
-> Maybe s
-> Expr s b
-> Binding s b
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
c Maybe s
src1 (((Maybe s, Expr s (a -> b)) -> (Maybe s, Expr s b))
-> Maybe (Maybe s, Expr s (a -> b)) -> Maybe (Maybe s, Expr s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe s, Expr s (a -> b)) -> (Maybe s, Expr s b)
forall a b. (a, Expr s (a -> b)) -> (a, Expr s b)
adaptBindingAnnotation Maybe (Maybe s, Expr s (a -> b))
d) Maybe s
src2 (Expr s (a -> b)
e Expr s (a -> b) -> Expr s a -> Expr s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a
k)

        adaptFunctionBinding :: FunctionBinding s (a -> a) -> FunctionBinding s a
adaptFunctionBinding (FunctionBinding Maybe s
src0 Text
label Maybe s
src1 Maybe s
src2 Expr s (a -> a)
type_) =
            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
label Maybe s
src1 Maybe s
src2 (Expr s (a -> a)
type_ Expr s (a -> a) -> Expr s a -> Expr s a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a
k)

        adaptBindingAnnotation :: (a, Expr s (a -> b)) -> (a, Expr s b)
adaptBindingAnnotation (a
src3, Expr s (a -> b)
f) = (a
src3, Expr s (a -> b)
f Expr s (a -> b) -> Expr s a -> Expr s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr s a
k)