module Text.Ginger.Run.Type
( GingerContext (..)
, makeContext
, makeContextM
, makeContext'
, makeContextM'
, makeContextHtml
, makeContextHtmlM
, makeContextText
, makeContextTextM
, easyContext
, ContextEncodable (..)
, liftRun
, liftRun2
, Run (..)
, RunState (..)
, Newlines (..)
)
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.Char (isSpace)
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
, contextNewlines :: Maybe (Newlines 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
newlines
class ContextEncodable h where
encode :: forall m. GVal m -> h
newlines :: Maybe (Newlines h)
newlines = Nothing
instance ContextEncodable Text where
encode = asText
newlines = Just textNewlines
instance ContextEncodable Html where
encode = toHtml
newlines = Just htmlNewlines
makeContextM' :: (Monad m, Functor m)
=> (VarName -> Run m h (GVal (Run m h)))
-> (h -> m ())
-> (GVal (Run m h) -> h)
-> Maybe (Newlines h)
-> GingerContext m h
makeContextM' lookupFn writeFn encodeFn newlines =
GingerContext
{ contextLookup = lookupFn
, contextWrite = liftRun2 writeFn
, contextEncode = encodeFn
, contextNewlines = newlines
}
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)
-> Maybe (Newlines h)
-> GingerContext (Writer h) h
makeContext' lookupFn =
makeContextM'
(return . lookupFn)
tell
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 (Just htmlNewlines)
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 (Just htmlNewlines)
makeContextText :: (VarName -> GVal (Run (Writer Text) Text))
-> GingerContext (Writer Text) Text
makeContextText l = makeContext' l asText (Just textNewlines)
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 (Just textNewlines)
data Newlines h =
Newlines
{ splitLines :: h -> [h]
, joinLines :: [h] -> h
, stripIndent :: h -> h
, endsWithNewline :: h -> Bool
}
textNewlines :: Newlines Text
textNewlines =
Newlines
{ splitLines = reNewline . Text.splitOn "\n"
, joinLines = mconcat
, stripIndent = Text.stripStart
, endsWithNewline = ("\n" `Text.isSuffixOf`)
}
htmlNewlines :: Newlines Html
htmlNewlines =
Newlines
{ splitLines = fmap unsafeRawHtml . splitLines textNewlines . htmlSource
, joinLines = unsafeRawHtml . joinLines textNewlines . fmap htmlSource
, stripIndent = unsafeRawHtml . stripIndent textNewlines . htmlSource
, endsWithNewline = endsWithNewline textNewlines . htmlSource
}
reNewline :: [Text] -> [Text]
reNewline [] = []
reNewline ("":[]) = []
reNewline (x:[]) = [x]
reNewline (x:"":[]) = [x <> "\n"]
reNewline (x:xs) = (x <> "\n") : reNewline xs
data RunState m h
= RunState
{ rsScope :: HashMap VarName (GVal (Run m h))
, rsCapture :: h
, rsCurrentTemplate :: Template
, rsCurrentBlockName :: Maybe Text
, rsIndentation :: Maybe [h]
, rsAtLineStart :: Bool
}
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