{-# OPTIONS_GHC -Wno-orphans #-}

module Dhall.Syntax.Instances.Monad () where

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

import qualified Lens.Family as Lens

instance Monad (Expr s) where
    return :: forall a. a -> Expr s a
return = a -> Expr s a
forall a. a -> Expr s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

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

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

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

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