module Text.Ginger.Run.Type
( GingerContext (..)
, makeContext
, makeContextM
, makeContext'
, makeContextM'
, makeContextHtml
, makeContextHtmlM
, makeContextText
, makeContextTextM
, easyContext
, ContextEncodable (..)
, liftRun
, liftRun2
, Run (..)
, RunState (..)
)
where
import Prelude ( (.), ($), (==), (/=)
, (>), (<), (>=), (<=)
, (+), (), (*), (/), div, (**), (^)
, (||), (&&)
, (++)
, Show, show
, undefined, otherwise
, Maybe (..)
, Bool (..)
, Int, Integer, String
, fromIntegral, floor, round
, not
, show
, uncurry
, seq
, fst, snd
, maybe
, Either (..)
, id
)
import qualified Prelude
import Data.Maybe (fromMaybe, isJust)
import qualified Data.List as List
import Text.Ginger.AST
import Text.Ginger.Html
import Text.Ginger.GVal
import Text.Printf
import Text.PrintfA
import Data.Scientific (formatScientific)
import Data.Text (Text)
import Data.String (fromString)
import qualified Data.Text as Text
import qualified Data.ByteString.UTF8 as UTF8
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.State
import Control.Applicative
import qualified Data.HashMap.Strict as HashMap
import Data.HashMap.Strict (HashMap)
import Data.Scientific (Scientific)
import Data.Scientific as Scientific
import Data.Default (def)
import Safe (readMay, lastDef, headMay)
import Network.HTTP.Types (urlEncode)
import Debug.Trace (trace)
import Data.Maybe (isNothing)
import Data.List (lookup, zipWith, unzip)
data GingerContext m h
= GingerContext
{ contextLookup :: VarName -> Run m h (GVal (Run m h))
, contextWrite :: h -> Run m h ()
, contextEncode :: GVal (Run m h) -> h
}
contextWriteEncoded :: GingerContext m h -> GVal (Run m h) -> Run m h ()
contextWriteEncoded context =
contextWrite context . contextEncode context
easyContext :: (Monad m, ContextEncodable h, ToGVal (Run m h) v)
=> (h -> m ())
-> v
-> GingerContext m h
easyContext emit context =
makeContextM'
(\varName ->
return
(lookupLooseDef def
(toGVal varName)
(toGVal context)))
emit
encode
class ContextEncodable h where
encode :: forall m. GVal m -> h
instance ContextEncodable Text where
encode = asText
instance ContextEncodable Html where
encode = toHtml
makeContextM' :: (Monad m, Functor m)
=> (VarName -> Run m h (GVal (Run m h)))
-> (h -> m ())
-> (GVal (Run m h) -> h)
-> GingerContext m h
makeContextM' lookupFn writeFn encodeFn =
GingerContext
{ contextLookup = lookupFn
, contextWrite = liftRun2 writeFn
, contextEncode = encodeFn
}
liftLookup :: (Monad m, ToGVal (Run m h) v) => (VarName -> m v) -> VarName -> Run m h (GVal (Run m h))
liftLookup f k = do
v <- liftRun $ f k
return . toGVal $ v
makeContext' :: Monoid h
=> (VarName -> GVal (Run (Writer h) h))
-> (GVal (Run (Writer h) h) -> h)
-> GingerContext (Writer h) h
makeContext' lookupFn encodeFn =
makeContextM'
(return . lookupFn)
tell
encodeFn
makeContext :: (VarName -> GVal (Run (Writer Html) Html))
-> GingerContext (Writer Html) Html
makeContext = makeContextHtml
makeContextM :: (Monad m, Functor m)
=> (VarName -> Run m Html (GVal (Run m Html)))
-> (Html -> m ())
-> GingerContext m Html
makeContextM = makeContextHtmlM
makeContextHtml :: (VarName -> GVal (Run (Writer Html) Html))
-> GingerContext (Writer Html) Html
makeContextHtml l = makeContext' l toHtml
makeContextHtmlM :: (Monad m, Functor m)
=> (VarName -> Run m Html (GVal (Run m Html)))
-> (Html -> m ())
-> GingerContext m Html
makeContextHtmlM l w = makeContextM' l w toHtml
makeContextText :: (VarName -> GVal (Run (Writer Text) Text))
-> GingerContext (Writer Text) Text
makeContextText l = makeContext' l asText
makeContextTextM :: (Monad m, Functor m)
=> (VarName -> Run m Text (GVal (Run m Text)))
-> (Text -> m ())
-> GingerContext m Text
makeContextTextM l w = makeContextM' l w asText
data RunState m h
= RunState
{ rsScope :: HashMap VarName (GVal (Run m h))
, rsCapture :: h
, rsCurrentTemplate :: Template
, rsCurrentBlockName :: Maybe Text
}
type Run m h = StateT (RunState m h) (ReaderT (GingerContext m h) m)
liftRun :: Monad m => m a -> Run m h a
liftRun = lift . lift
liftRun2 :: Monad m => (a -> m b) -> a -> Run m h b
liftRun2 f x = liftRun $ f x