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 :: forall (m :: * -> *) s a. (Monad m, MonadState s m) => m a -> m a
withLocalState m a
a = do
    s
s <- forall s (m :: * -> *). MonadState s m => m s
get
    a
r <- m a
a
    forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s
    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 :: forall (m :: * -> *) p h a. Monad m => Run p m h a -> Run p m h a
withLocalScope Run p m h a
a = do
    HashMap
  VarName
  (GVal
     (ExceptT
        (RuntimeError p)
        (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
scope <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall p (m :: * -> *) h.
RunState p m h -> HashMap VarName (GVal (Run p m h))
rsScope
    a
r <- Run p m h a
a
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState p m h
s -> RunState p m h
s { rsScope :: HashMap
  VarName
  (GVal
     (ExceptT
        (RuntimeError p)
        (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
rsScope = HashMap
  VarName
  (GVal
     (ExceptT
        (RuntimeError p)
        (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
scope })
    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 :: forall h (m :: * -> *) p a.
(ContextEncodable h, Monad m) =>
(GVal (Run p m h) -> h) -> Run p m h a -> Run p m h a
withEncoder GVal
  (ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> h
encoder =
    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
  (ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> h
contextEncode = forall h (m :: * -> *). ContextEncodable h => GVal m -> h
encode })

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

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

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

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

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