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 <- 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 a. 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 :: 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 <- (RunState p m h
 -> HashMap
      VarName
      (GVal
         (ExceptT
            (RuntimeError p)
            (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     (HashMap
        VarName
        (GVal
           (ExceptT
              (RuntimeError p)
              (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState p m h
-> HashMap
     VarName
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
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 = scope })
    a -> Run p m h a
forall a.
a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     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 :: 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 =
    (GingerContext p m h -> GingerContext p m h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall a.
(GingerContext p m h -> GingerContext p m h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     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 = 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 <- (RunState p m h
 -> HashMap
      VarName
      (GVal
         (ExceptT
            (RuntimeError p)
            (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     (HashMap
        VarName
        (GVal
           (ExceptT
              (RuntimeError p)
              (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState p m h
-> HashMap
     VarName
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
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' = VarName
-> GVal
     (ExceptT
        (RuntimeError p)
        (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> HashMap
     VarName
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
-> HashMap
     VarName
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
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
    (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 = 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 <- (RunState p m h
 -> HashMap
      VarName
      (GVal
         (ExceptT
            (RuntimeError p)
            (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     (HashMap
        VarName
        (GVal
           (ExceptT
              (RuntimeError p)
              (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState p m h
-> HashMap
     VarName
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
forall p (m :: * -> *) h.
RunState p m h -> HashMap VarName (GVal (Run p m h))
rsScope
    case VarName
-> HashMap
     VarName
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
-> Maybe
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
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 ->
            GVal
  (ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))
-> Run
     p
     m
     h
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
forall a.
a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
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 <- (GingerContext p m h
 -> VarName
 -> Run
      p
      m
      h
      (GVal
         (ExceptT
            (RuntimeError p)
            (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     (VarName
      -> Run
           p
           m
           h
           (GVal
              (ExceptT
                 (RuntimeError p)
                 (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)))))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GingerContext p m h
-> VarName
-> Run
     p
     m
     h
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))))
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 = (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 { rsCapture = 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 = (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 { rsCapture = rsCapture s <> h })

fetchCapture :: Monad m => Run p m h h
fetchCapture :: forall (m :: * -> *) p h. Monad m => Run p m h h
fetchCapture = (RunState p m h -> h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     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