{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Language.Haskell.TH.Natural.Syntax.Expr.Do.Typed (
    DoTypedExprDefinition,
    DoTypedExprBuilder,
    newDo,
    stmt,
    strictBind,
    bind,
    bind_,
    module Language.Haskell.TH.Natural.Syntax.Expr.Typed.Monad,
    module Language.Haskell.TH.Natural.Syntax.Expr.Typed.Class,
    module Language.Haskell.TH.Natural.Syntax.Expr.Do.State,
) where

import Language.Haskell.TH
import Language.Haskell.TH.Gen (GenTExpr (genTExpr))
import Language.Haskell.TH.Natural.Syntax.Builder
import Language.Haskell.TH.Natural.Syntax.Expr.Do.State
import qualified Language.Haskell.TH.Natural.Syntax.Expr.Do.Untyped as Untyped
import Language.Haskell.TH.Natural.Syntax.Expr.Typed.Builder
import Language.Haskell.TH.Natural.Syntax.Expr.Typed.Class
import qualified Language.Haskell.TH.Natural.Syntax.Expr.Typed.Class as Typed
import Language.Haskell.TH.Natural.Syntax.Expr.Typed.Monad
import qualified Language.Haskell.TH.Syntax as TH

type DoTypedExprDefinition a = TH.Q (TH.TExp a)

type DoTypedExprBuilder = TypedExprBuilder DoExprBuilderState '[] '[]

newDo :: DoTypedExprBuilder (Returns a) () -> DoTypedExprDefinition a
newDo :: forall a.
DoTypedExprBuilder (Returns a) () -> DoTypedExprDefinition a
newDo = TypedExprBuilder DoExprBuilderState '[] '[] (Returns a) ()
-> Q (TExp a)
TypedExprBuilder DoExprBuilderState '[] '[] (Returns a) ()
-> Q (TExp ('[] :~> Returns a))
forall (args :: [*]) a.
TypedExprBuilder DoExprBuilderState '[] args (Returns a) ()
-> Q (TExp (args :~> Returns a))
forall st (args :: [*]) a.
IsTypedExprBuilder st =>
TypedExprBuilder st '[] args (Returns a) ()
-> Q (TExp (args :~> Returns a))
runTypedExprBuilder

stmt :: (GenTExpr t b) => b -> DoTypedExprBuilder (Returns t) ()
stmt :: forall t b. GenTExpr t b => b -> DoTypedExprBuilder (Returns t) ()
stmt = b -> TypedExprBuilder DoExprBuilderState '[] '[] (Returns t) ()
forall t b (args :: [*]) st.
(IsExprBuilder st, GenTExpr t b) =>
b -> TypedExprBuilder st args args (Returns t) ()
Typed.returns

strictBind :: (GenTExpr t b) => b -> DoTypedExprBuilder Unknown (TH.TExp t)
strictBind :: forall {a} t b.
GenTExpr t b =>
b -> DoTypedExprBuilder 'Unknown (TExp t)
strictBind = Bool -> b -> DoTypedExprBuilder 'Unknown (TExp t)
forall {a} t b.
GenTExpr t b =>
Bool -> b -> DoTypedExprBuilder 'Unknown (TExp t)
bind_ Bool
True

bind :: (GenTExpr t b) => b -> DoTypedExprBuilder Unknown (TH.TExp t)
bind :: forall {a} t b.
GenTExpr t b =>
b -> DoTypedExprBuilder 'Unknown (TExp t)
bind = Bool -> b -> DoTypedExprBuilder 'Unknown (TExp t)
forall {a} t b.
GenTExpr t b =>
Bool -> b -> DoTypedExprBuilder 'Unknown (TExp t)
bind_ Bool
False

bind_ :: forall t b. (GenTExpr t b) => Bool -> b -> DoTypedExprBuilder Unknown (TH.TExp t)
bind_ :: forall {a} t b.
GenTExpr t b =>
Bool -> b -> DoTypedExprBuilder 'Unknown (TExp t)
bind_ Bool
s b
b = Builder DoExprBuilderState (ZonkAny 0) 'Empty (TExp t)
-> TypedExprBuilder DoExprBuilderState '[] '[] 'Unknown (TExp t)
forall {k1} {k2} s (step :: k1) (step1 :: k1) a (args0 :: [*])
       (args :: [*]) (res :: k2).
Builder s step step1 a -> TypedExprBuilder s args0 args res a
unsafeUntyped (Builder DoExprBuilderState (ZonkAny 0) 'Empty (TExp t)
 -> TypedExprBuilder DoExprBuilderState '[] '[] 'Unknown (TExp t))
-> Builder DoExprBuilderState (ZonkAny 0) 'Empty (TExp t)
-> TypedExprBuilder DoExprBuilderState '[] '[] 'Unknown (TExp t)
forall a b. (a -> b) -> a -> b
$ Untyped.do
    e <- TExp t -> Exp
forall a. TExp a -> Exp
unType (TExp t -> Exp)
-> BaseBuilder
     Q DoExprBuilderState (ZonkAny 0) (ZonkAny 0) (TExp t)
-> BaseBuilder Q DoExprBuilderState (ZonkAny 0) (ZonkAny 0) Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q (TExp t)
-> BaseBuilder
     Q DoExprBuilderState (ZonkAny 0) (ZonkAny 0) (TExp t)
forall {k} (m :: * -> *) a s (step :: k).
Monad m =>
m a -> BaseBuilder m s step step a
liftB (forall t a. GenTExpr t a => a -> Q (TExp t)
genTExpr @t b
b)
    TH.TExp <$> Untyped.bind_ s e