{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-missing-export-lists #-}

module Language.Haskell.TH.Natural.Syntax.Builder.Internal where

import Control.Monad.Reader (MonadReader (..))
import Control.Monad.State (MonadState (..), StateT (..), execStateT, modify)
import qualified Control.Monad.State
import qualified Language.Haskell.TH as TH

-- | A computation that builds an object, the state
--
-- A graded state monad
newtype BaseBuilder m s (prev :: k) (next :: k) a
    = MkB {forall k (m :: * -> *) s (prev :: k) (next :: k) a.
BaseBuilder m s prev next a -> StateT s m a
unB :: StateT s m a}
    deriving ((forall a b.
 (a -> b)
 -> BaseBuilder m s prev next a -> BaseBuilder m s prev next b)
-> (forall a b.
    a -> BaseBuilder m s prev next b -> BaseBuilder m s prev next a)
-> Functor (BaseBuilder m s prev next)
forall a b.
a -> BaseBuilder m s prev next b -> BaseBuilder m s prev next a
forall a b.
(a -> b)
-> BaseBuilder m s prev next a -> BaseBuilder m s prev next b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) s k (prev :: k) (next :: k) a b.
Functor m =>
a -> BaseBuilder m s prev next b -> BaseBuilder m s prev next a
forall (m :: * -> *) s k (prev :: k) (next :: k) a b.
Functor m =>
(a -> b)
-> BaseBuilder m s prev next a -> BaseBuilder m s prev next b
$cfmap :: forall (m :: * -> *) s k (prev :: k) (next :: k) a b.
Functor m =>
(a -> b)
-> BaseBuilder m s prev next a -> BaseBuilder m s prev next b
fmap :: forall a b.
(a -> b)
-> BaseBuilder m s prev next a -> BaseBuilder m s prev next b
$c<$ :: forall (m :: * -> *) s k (prev :: k) (next :: k) a b.
Functor m =>
a -> BaseBuilder m s prev next b -> BaseBuilder m s prev next a
<$ :: forall a b.
a -> BaseBuilder m s prev next b -> BaseBuilder m s prev next a
Functor)

-- | Typically used a kinds to represent the progress of a 'Builder' computation
data BuilderStep
    = -- | When the builder is not _ready_ to produce a valid AST (i.e. one of the fields is "empty")
      Empty
    | -- | The builder is ready to produce the AST
      Ready
    deriving (BuilderStep -> BuilderStep -> Bool
(BuilderStep -> BuilderStep -> Bool)
-> (BuilderStep -> BuilderStep -> Bool) -> Eq BuilderStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuilderStep -> BuilderStep -> Bool
== :: BuilderStep -> BuilderStep -> Bool
$c/= :: BuilderStep -> BuilderStep -> Bool
/= :: BuilderStep -> BuilderStep -> Bool
Eq, Int -> BuilderStep -> ShowS
[BuilderStep] -> ShowS
BuilderStep -> String
(Int -> BuilderStep -> ShowS)
-> (BuilderStep -> String)
-> ([BuilderStep] -> ShowS)
-> Show BuilderStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuilderStep -> ShowS
showsPrec :: Int -> BuilderStep -> ShowS
$cshow :: BuilderStep -> String
show :: BuilderStep -> String
$cshowList :: [BuilderStep] -> ShowS
showList :: [BuilderStep] -> ShowS
Show)

-- | Common type for anything that builds a TH AST.
type Builder = BaseBuilder TH.Q

-- | Similar to 'Builder', but the state is always 'Ready'
type ConstBuilder s = BaseBuilder TH.Q s Ready Ready

-- | Runs the 'BaseBuilder' and returns the state
{-# INLINE runBaseBuilder #-}
runBaseBuilder :: (Monad m) => BaseBuilder m s step end () -> s -> m s
runBaseBuilder :: forall {k} (m :: * -> *) s (step :: k) (end :: k).
Monad m =>
BaseBuilder m s step end () -> s -> m s
runBaseBuilder (MkB StateT s m ()
f) = StateT s m () -> s -> m s
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT s m ()
f

-- | Similar to 'runBaseBuilder', but also returns the value output by the computation
{-# INLINE runBaseBuilder' #-}
runBaseBuilder' :: BaseBuilder m s step end a -> s -> m (a, s)
runBaseBuilder' :: forall {k} (m :: * -> *) s (step :: k) (end :: k) a.
BaseBuilder m s step end a -> s -> m (a, s)
runBaseBuilder' (MkB StateT s m a
f) = StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m a
f

instance (Monad m) => Applicative (BaseBuilder m s step step) where
    pure :: forall a. a -> BaseBuilder m s step step a
pure a
a = StateT s m a -> BaseBuilder m s step step a
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB (StateT s m a -> BaseBuilder m s step step a)
-> StateT s m a -> BaseBuilder m s step step a
forall a b. (a -> b) -> a -> b
$ a -> StateT s m a
forall a. a -> StateT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    liftA2 :: forall a b c.
(a -> b -> c)
-> BaseBuilder m s step step a
-> BaseBuilder m s step step b
-> BaseBuilder m s step step c
liftA2 a -> b -> c
pair (MkB StateT s m a
f1) (MkB StateT s m b
f2) = StateT s m c -> BaseBuilder m s step step c
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB (StateT s m c -> BaseBuilder m s step step c)
-> StateT s m c -> BaseBuilder m s step step c
forall a b. (a -> b) -> a -> b
$ do
        a <- StateT s m a
f1
        pair a <$> f2

instance (Monad m) => Monad (BaseBuilder m s step step) where
    >>= :: forall a b.
BaseBuilder m s step step a
-> (a -> BaseBuilder m s step step b)
-> BaseBuilder m s step step b
(>>=) (MkB StateT s m a
f1) a -> BaseBuilder m s step step b
f2 = StateT s m b -> BaseBuilder m s step step b
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB (StateT s m b -> BaseBuilder m s step step b)
-> StateT s m b -> BaseBuilder m s step step b
forall a b. (a -> b) -> a -> b
$ Prelude.do
        a <- StateT s m a
f1
        unB (f2 a)

instance (Monad m) => MonadReader s (BaseBuilder m s step step) where
    ask :: BaseBuilder m s step step s
ask = StateT s m s -> BaseBuilder m s step step s
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB StateT s m s
forall s (m :: * -> *). MonadState s m => m s
get
    local :: forall a.
(s -> s)
-> BaseBuilder m s step step a -> BaseBuilder m s step step a
local s -> s
f BaseBuilder m s step step a
m = StateT s m () -> BaseBuilder m s step step ()
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB ((s -> s) -> StateT s m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify s -> s
f) BaseBuilder m s step step ()
-> BaseBuilder m s step step a -> BaseBuilder m s step step a
forall a b.
BaseBuilder m s step step a
-> BaseBuilder m s step step b -> BaseBuilder m s step step b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
Prelude.>> BaseBuilder m s step step a
m

instance (MonadFail m) => MonadFail (BaseBuilder m s step step) where
    fail :: forall a. String -> BaseBuilder m s step step a
fail String
s = StateT s m a -> BaseBuilder m s step step a
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB (StateT s m a -> BaseBuilder m s step step a)
-> StateT s m a -> BaseBuilder m s step step a
forall a b. (a -> b) -> a -> b
$ String -> StateT s m a
forall a. String -> StateT s m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
s

instance (Monad m) => MonadState s (BaseBuilder m s step step) where
    state :: forall a. (s -> (a, s)) -> BaseBuilder m s step step a
state s -> (a, s)
f = StateT s m a -> BaseBuilder m s step step a
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB (StateT s m a -> BaseBuilder m s step step a)
-> StateT s m a -> BaseBuilder m s step step a
forall a b. (a -> b) -> a -> b
$ (s -> (a, s)) -> StateT s m a
forall a. (s -> (a, s)) -> StateT s m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f

-- | Lift a monadic computation in a builder
liftB :: (Monad m) => m a -> BaseBuilder m s step step a
liftB :: forall {k} (m :: * -> *) a s (step :: k).
Monad m =>
m a -> BaseBuilder m s step step a
liftB = StateT s m a -> BaseBuilder m s step step a
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB (StateT s m a -> BaseBuilder m s step step a)
-> (m a -> StateT s m a) -> m a -> BaseBuilder m s step step a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT s m a
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Control.Monad.State.lift

-- | A 'safe' way to cast the current step of the 'BaseBuilder' when a computation is 'pure' and does not explicitly changes the state of the 'BaseBuilder'
impure :: BaseBuilder m s step step a -> BaseBuilder m s step next a
impure :: forall {k} (m :: * -> *) s (step :: k) a (next :: k).
BaseBuilder m s step step a -> BaseBuilder m s step next a
impure = BaseBuilder m s step step a -> BaseBuilder m s step next a
forall {k} {k} (prev' :: k) (curr' :: k) (prev :: k) (curr :: k)
       (m :: * -> *) s a.
BaseBuilder m s prev curr a -> BaseBuilder m s prev' curr' a
unsafeCastStep

-- | Allows accessing and modifying the state.
--
-- Using this to modify the state breaks the security provided by the type-level tracking of state.
unsafeWithState :: StateT s m a -> BaseBuilder m s prev curr a
unsafeWithState :: forall {k} s (m :: * -> *) a (prev :: k) (curr :: k).
StateT s m a -> BaseBuilder m s prev curr a
unsafeWithState = StateT s m a -> BaseBuilder m s prev curr a
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB

-- | Unsafely changes the state of the computation. Breaks the security provided by the type-level tracking of state.
unsafeCastStep :: forall prev' curr' prev curr m s a. BaseBuilder m s prev curr a -> BaseBuilder m s prev' curr' a
unsafeCastStep :: forall {k} {k} (prev' :: k) (curr' :: k) (prev :: k) (curr :: k)
       (m :: * -> *) s a.
BaseBuilder m s prev curr a -> BaseBuilder m s prev' curr' a
unsafeCastStep (MkB StateT s m a
m) = StateT s m a -> BaseBuilder m s prev' curr' a
forall k (m :: * -> *) s (prev :: k) (next :: k) a.
StateT s m a -> BaseBuilder m s prev next a
MkB StateT s m a
m