module Text.Ginger.Run.VM
where

import Text.Ginger.Run.Type
import Text.Ginger.Run.FuncUtils
import Text.Ginger.AST
import Text.Ginger.GVal
import Data.Monoid ( (<>) )
import Control.Monad.State (MonadState (..), get, gets, modify)
import Control.Monad.Reader (asks, local)
import qualified Data.HashMap.Strict as HashMap
import Data.HashMap.Strict (HashMap)

-- | Helper function to run a State action with a temporary state, reverting
-- to the old state after the action has finished.
withLocalState :: (Monad m, MonadState s m) => m a -> m a
withLocalState :: m a -> m a
withLocalState m a
a = do
    s
s <- m s
forall s (m :: * -> *). MonadState s m => m s
get
    a
r <- m a
a
    s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Helper function to run a Scope action with a temporary scope, reverting
-- to the old scope after the action has finished.
withLocalScope :: (Monad m) => Run p m h a -> Run p m h a
withLocalScope :: Run p m h a -> Run p m h a
withLocalScope Run p m h a
a = do
    HashMap VarName (GVal (Run p m h))
scope <- (RunState p m h -> HashMap VarName (GVal (Run p m h)))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     (HashMap VarName (GVal (Run p m h)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState p m h -> HashMap VarName (GVal (Run p m h))
forall p (m :: * -> *) h.
RunState p m h -> HashMap VarName (GVal (Run p m h))
rsScope
    a
r <- Run p m h a
a
    (RunState p m h -> RunState p m h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState p m h
s -> RunState p m h
s { rsScope :: HashMap VarName (GVal (Run p m h))
rsScope = HashMap VarName (GVal (Run p m h))
scope })
    a -> Run p m h a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Override the encoder used for converting 'GVal's to the output type.
-- This can be used for things like temporarily disabling HTML encoding.
withEncoder :: (ContextEncodable h, Monad m) => (GVal (Run p m h) -> h) -> Run p m h a -> Run p m h a
withEncoder :: (GVal (Run p m h) -> h) -> Run p m h a -> Run p m h a
withEncoder GVal (Run p m h) -> h
encoder =
    (GingerContext p m h -> GingerContext p m h)
-> Run p m h a -> Run p m h a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\GingerContext p m h
context -> GingerContext p m h
context { contextEncode :: GVal (Run p m h) -> h
contextEncode = GVal (Run p m h) -> h
forall h (m :: * -> *). ContextEncodable h => GVal m -> h
encode })

setVar :: Monad m => VarName -> GVal (Run p m h) -> Run p m h ()
setVar :: VarName -> GVal (Run p m h) -> Run p m h ()
setVar VarName
name GVal (Run p m h)
val = do
    HashMap VarName (GVal (Run p m h))
vars <- (RunState p m h -> HashMap VarName (GVal (Run p m h)))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     (HashMap VarName (GVal (Run p m h)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState p m h -> HashMap VarName (GVal (Run p m h))
forall p (m :: * -> *) h.
RunState p m h -> HashMap VarName (GVal (Run p m h))
rsScope
    let vars' :: HashMap VarName (GVal (Run p m h))
vars' = VarName
-> GVal (Run p m h)
-> HashMap VarName (GVal (Run p m h))
-> HashMap VarName (GVal (Run p m h))
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert VarName
name GVal (Run p m h)
val HashMap VarName (GVal (Run p m h))
vars
    (RunState p m h -> RunState p m h) -> Run p m h ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState p m h
s -> RunState p m h
s { rsScope :: HashMap VarName (GVal (Run p m h))
rsScope = HashMap VarName (GVal (Run p m h))
vars' })

getVar :: Monad m => VarName -> Run p m h (GVal (Run p m h))
getVar :: VarName -> Run p m h (GVal (Run p m h))
getVar VarName
key = do
    HashMap VarName (GVal (Run p m h))
vars <- (RunState p m h -> HashMap VarName (GVal (Run p m h)))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     (HashMap VarName (GVal (Run p m h)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState p m h -> HashMap VarName (GVal (Run p m h))
forall p (m :: * -> *) h.
RunState p m h -> HashMap VarName (GVal (Run p m h))
rsScope
    case VarName
-> HashMap VarName (GVal (Run p m h)) -> Maybe (GVal (Run p m h))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup VarName
key HashMap VarName (GVal (Run p m h))
vars of
        Just GVal (Run p m h)
val ->
            GVal (Run p m h) -> Run p m h (GVal (Run p m h))
forall (m :: * -> *) a. Monad m => a -> m a
return GVal (Run p m h)
val
        Maybe (GVal (Run p m h))
Nothing -> do
            VarName -> Run p m h (GVal (Run p m h))
l <- (GingerContext p m h -> VarName -> Run p m h (GVal (Run p m h)))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     (VarName -> Run p m h (GVal (Run p m h)))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GingerContext p m h -> VarName -> Run p m h (GVal (Run p m h))
forall p (m :: * -> *) h.
GingerContext p m h -> VarName -> Run p m h (GVal (Run p m h))
contextLookup
            VarName -> Run p m h (GVal (Run p m h))
l VarName
key

clearCapture :: (Monoid h, Monad m) => Run p m h ()
clearCapture :: Run p m h ()
clearCapture = (RunState p m h -> RunState p m h) -> Run p m h ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState p m h
s -> RunState p m h
s { rsCapture :: h
rsCapture = h
forall a. Monoid a => a
mempty })

appendCapture :: (Monoid h, Monad m) => h -> Run p m h ()
appendCapture :: h -> Run p m h ()
appendCapture h
h = (RunState p m h -> RunState p m h) -> Run p m h ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState p m h
s -> RunState p m h
s { rsCapture :: h
rsCapture = RunState p m h -> h
forall p (m :: * -> *) h. RunState p m h -> h
rsCapture RunState p m h
s h -> h -> h
forall a. Semigroup a => a -> a -> a
<> h
h })

fetchCapture :: Monad m => Run p m h h
fetchCapture :: Run p m h h
fetchCapture = (RunState p m h -> h) -> Run p m h h
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState p m h -> h
forall p (m :: * -> *) h. RunState p m h -> h
rsCapture