ginger 0.3.9.1 → 0.5.0.0

raw patch · 8 files changed

+820/−107 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• cli/GingerCLI.hs +1/−1
• ginger.cabal +1/−1
• src/Text/Ginger/AST.hs +3/−0
• src/Text/Ginger/Optimizer.hs +1/−1
• src/Text/Ginger/Parse.hs +328/−70
• src/Text/Ginger/Run.hs +119/−24
• src/Text/Ginger/Run/Type.hs +54/−9
• test/Text/Ginger/SimulationTests.hs +313/−1

@@ -85,7 +85,7 @@             displayParserError tplSource err         Right t -> do             let context = makeContextHtmlM contextLookup (putStr . Text.unpack . htmlSource)-            runGingerT context t+            runGingerT context t >>= hPutStrLn stderr . show  printParserError :: ParserError -> IO () printParserError = putStrLn . formatParserError

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                ginger-version:             0.3.9.1+version:             0.5.0.0 synopsis:            An implementation of the Jinja2 template language in Haskell description:         Ginger is Jinja, minus the most blatant pythonisms. Wants                      to be feature complete, but isn't quite there yet.

@@ -36,8 +36,10 @@ data Statement     = MultiS [Statement] -- ^ A sequence of multiple statements     | ScopedS Statement -- ^ Run wrapped statement in a local scope+    | IndentS Expression Statement -- ^ Establish an indented context around the wrapped statement     | LiteralS Html -- ^ Literal output (anything outside of any tag)     | InterpolationS Expression -- ^ {{ expression }}+    | ExpressionS Expression -- ^ Evaluate expression     | IfS Expression Statement Statement -- ^ {% if expression %}statement{% else %}statement{% endif %}     | SwitchS Expression [(Expression, Statement)] Statement -- ^ {% switch expression %}{% case expression %}statement{% endcase %}...{% default %}statement{% enddefault %}{% endswitch %}     | ForS (Maybe VarName) VarName Expression Statement -- ^ {% for index, varname in expression %}statement{% endfor %}@@ -61,4 +63,5 @@     | CallE Expression [(Maybe Text, Expression)] -- ^ foo(bar=baz, quux)     | LambdaE [Text] Expression -- ^ (foo, bar) -> expr     | TernaryE Expression Expression Expression -- ^ expr ? expr : expr+    | DoE Statement -- ^ do { statement; }     deriving (Show)

@@ -268,7 +268,7 @@ runCT = runGinger ctContext  ctContext :: GingerContext (Writer Collected) Collected-ctContext = makeContext' ctLookup ctEncode+ctContext = makeContext' ctLookup ctEncode Nothing  ctLookup :: VarName -> GVal m ctLookup = const def

@@ -20,11 +20,11 @@                    , runParserT                    , try, lookAhead                    , manyTill, oneOf, string, notFollowedBy, between, sepBy-                   , eof, spaces, anyChar, char+                   , eof, spaces, anyChar, noneOf, char                    , option, optionMaybe                    , unexpected                    , digit-                   , getState, modifyState+                   , getState, modifyState, putState                    , (<?>)                    ) import Text.Parsec.Error ( errorMessages@@ -34,6 +34,7 @@ import Text.Ginger.AST import Text.Ginger.Html ( unsafeRawHtml ) +import Control.Monad (when) import Control.Monad.Reader ( ReaderT                             , runReaderT                             , ask, asks@@ -53,6 +54,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.Default ( Default (..) ) import Data.Monoid ( (<>) )+import Data.Char (isSpace)  import System.FilePath ( takeDirectory, (</>) ) @@ -124,12 +126,14 @@ data ParseState     = ParseState         { psBlocks :: HashMap VarName Block+        , psStripIndent :: String         }  defParseState :: ParseState defParseState =     ParseState         { psBlocks = HashMap.empty+        , psStripIndent = ""         }  -- | Parse Ginger source from memory.@@ -186,13 +190,29 @@     blocks <- psBlocks <$> getState     return Template { templateBody = body, templateParent = Nothing, templateBlocks = blocks } +isNullS NullS = True+isNullS _ = False+ statementsP :: Monad m => Parser m Statement statementsP =     reduceStatements . filter (not . isNullS) <$> many (try statementP)-    where-        isNullS NullS = True-        isNullS _ = False +scriptStatementsP :: Monad m => Parser m Statement+scriptStatementsP = do+    spacesOrComment+    reduceStatements . filter (not . isNullS) <$>+        many (try scriptStatementP)+++scriptStatementBlockP :: Monad m => Parser m Statement+scriptStatementBlockP = do+    char '{'+    spacesOrComment+    inner <- scriptStatementsP+    char '}'+    spacesOrComment+    return inner+ statementP :: Monad m => Parser m Statement statementP = interpolationStmtP            <|> commentStmtP@@ -205,25 +225,63 @@            <|> blockStmtP            <|> callStmtP            <|> scopeStmtP+           <|> indentStmtP+           <|> scriptStmtP            <|> literalStmtP +scriptStatementP :: Monad m => Parser m Statement+scriptStatementP = scriptStatementBlockP+                 <|> scriptEchoStmtP+                 <|> scriptIfStmtP+                 <|> scriptSwitchStmtP+                 <|> scriptSetStmtP+                 <|> scriptForStmtP+                 <|> scriptIncludeP+                 <|> scriptMacroStmtP+                 <|> scriptScopeStmtP+                 <|> scriptExprStmtP+ interpolationStmtP :: Monad m => Parser m Statement interpolationStmtP = do     try openInterpolationP-    spaces+    spacesOrComment     expr <- expressionP-    spaces+    spacesOrComment     closeInterpolationP     return $ InterpolationS expr +scriptEchoStmtP :: Monad m => Parser m Statement+scriptEchoStmtP = do+    try $ keyword "echo"+    spacesOrComment+    char '('+    expr <- expressionP+    spacesOrComment+    char ')'+    spacesOrComment+    char ';'+    spacesOrComment+    return $ InterpolationS expr+ literalStmtP :: Monad m => Parser m Statement literalStmtP = do-    txt <- manyTill anyChar endOfLiteralP+    txt <- manyTill literalCharP endOfLiteralP      case txt of         [] -> unexpected "{{"         _ -> return . LiteralS . unsafeRawHtml . Text.pack $ txt +literalCharP :: Monad m => Parser m Char+literalCharP =+    literalNewlineP <|> anyChar++literalNewlineP :: Monad m => Parser m Char+literalNewlineP = do+    stripStr <- psStripIndent <$> getState+    char '\n'+    when (not $ null stripStr) (ignore . optional . try $ string stripStr)+    return '\n'+ endOfLiteralP :: Monad m => Parser m () endOfLiteralP =     (ignore . lookAhead . try $ openInterpolationP) <|>@@ -234,9 +292,41 @@ commentStmtP :: Monad m => Parser m Statement commentStmtP = do     try openCommentP-    manyTill anyChar (try closeCommentP)+    manyTill+        (   (noneOf "#" *> return ())+        <|> (try $ char '#' *> notFollowedBy (char '}'))+        )+        (try closeCommentP)     return NullS +scriptCommentP :: Monad m => Parser m ()+scriptCommentP = do+    try $ char '#' *> notFollowedBy (char '}')+    manyTill anyChar endl+    spacesOrComment++spacesOrComment :: Monad m => Parser m ()+spacesOrComment = do+    many $ scriptCommentP <|> (oneOf " \t\r\n" *> return ())+    return ()++scriptExprStmtP :: Monad m => Parser m Statement+scriptExprStmtP = do+    expr <- try $ expressionP+    char ';'+    spacesOrComment+    return $ ExpressionS expr++endl :: Monad m => Parser m Char+endl = char '\n' <|> (char '\r' >> char '\n')++scriptStmtP :: Monad m => Parser m Statement+scriptStmtP =+    between+        (try $ simpleTagP "script")+        (simpleTagP "endscript")+        scriptStatementsP+ ifStmtP :: Monad m => Parser m Statement ifStmtP = do     condExpr <- fancyTagP "if" expressionP@@ -258,6 +348,41 @@     -- No endif here: the parent {% if %} owns that one.     return $ IfS condExpr trueStmt falseStmt +scriptIfStmtP :: Monad m => Parser m Statement+scriptIfStmtP = do+    try $ keyword "if"+    spacesOrComment+    char '('+    condExpr <- expressionP+    spacesOrComment+    char ')'+    spacesOrComment+    trueStmt <- scriptStatementP+    spacesOrComment+    falseStmt <- scriptElifP <|> scriptElseP <|> return NullS+    return $ IfS condExpr trueStmt falseStmt++scriptElseP :: Monad m => Parser m Statement+scriptElseP = do+    try $ keyword "else"+    spacesOrComment+    scriptStatementP++scriptElifP :: Monad m => Parser m Statement+scriptElifP = do+    try $ keyword "elif"+    spacesOrComment+    char '('+    spacesOrComment+    condExpr <- expressionP+    spacesOrComment+    char ')'+    spacesOrComment+    trueStmt <- scriptStatementP+    spacesOrComment+    falseStmt <- scriptElifP <|> scriptElseP <|> return NullS+    return $ IfS condExpr trueStmt falseStmt+ switchStmtP :: Monad m => Parser m Statement switchStmtP = do     pivotExpr <- try $ fancyTagP "switch" expressionP@@ -277,19 +402,74 @@ switchDefaultP = do     try (simpleTagP "default") *> statementsP <* simpleTagP "enddefault" +scriptSwitchStmtP :: Monad m => Parser m Statement+scriptSwitchStmtP = do+    try $ keyword "switch"+    spacesOrComment+    char '('+    spacesOrComment+    pivotExpr <- expressionP+    spacesOrComment+    char ')'+    spacesOrComment+    char '{'+    spacesOrComment+    cases <- many scriptSwitchCaseP+    def <- option NullS $ scriptSwitchDefaultP+    spacesOrComment+    char '}'+    spacesOrComment+    return $ SwitchS pivotExpr cases def++scriptSwitchCaseP :: Monad m => Parser m (Expression, Statement)+scriptSwitchCaseP = do+    try $ keyword "case"+    spacesOrComment+    cmpExpr <- expressionP+    spacesOrComment+    char ':'+    spacesOrComment+    body <- scriptStatementP+    spacesOrComment+    return (cmpExpr, body)++scriptSwitchDefaultP :: Monad m => Parser m Statement+scriptSwitchDefaultP = do+    try $ keyword "default"+    spacesOrComment+    char ':'+    spacesOrComment+    body <- scriptStatementP+    spacesOrComment+    return body+ setStmtP :: Monad m => Parser m Statement setStmtP = fancyTagP "set" setStmtInnerP  setStmtInnerP :: Monad m => Parser m Statement setStmtInnerP = do     name <- identifierP-    spaces+    spacesOrComment     char '='-    spaces+    spacesOrComment     val <- expressionP-    spaces+    spacesOrComment     return $ SetVarS name val +scriptSetStmtP :: Monad m => Parser m Statement+scriptSetStmtP = do+    try $ keyword "set"+    spacesOrComment+    name <- identifierP+    spacesOrComment+    char '='+    spacesOrComment+    val <- expressionP+    spacesOrComment+    char ';'+    spacesOrComment+    return $ SetVarS name val+ defineBlock :: VarName -> Block -> ParseState -> ParseState defineBlock name block s =     s { psBlocks = HashMap.insert name block (psBlocks s) }@@ -304,22 +484,34 @@ blockP = do     name <- fancyTagP "block" identifierP     body <- statementsP-    fancyTagP "endblock" (optional $ string (Text.unpack name) >> spaces)+    fancyTagP "endblock" (optional $ string (Text.unpack name) >> spacesOrComment)     return (name, Block body)  macroStmtP :: Monad m => Parser m Statement macroStmtP = do     (name, args) <- try $ fancyTagP "macro" macroHeadP     body <- statementsP-    fancyTagP "endmacro" (optional $ string (Text.unpack name) >> spaces)+    fancyTagP "endmacro" (optional $ string (Text.unpack name) >> spacesOrComment)     return $ DefMacroS name (Macro args body) +scriptMacroStmtP :: Monad m => Parser m Statement+scriptMacroStmtP = do+    try $ keyword "macro"+    spacesOrComment+    name <- identifierP+    spacesOrComment+    args <- option [] $ groupP "(" ")" identifierP+    spacesOrComment+    body <- scriptStatementP+    spacesOrComment+    return $ DefMacroS name (Macro args body)+ macroHeadP :: Monad m => Parser m (VarName, [VarName]) macroHeadP = do     name <- identifierP-    spaces+    spacesOrComment     args <- option [] $ groupP "(" ")" identifierP-    spaces+    spacesOrComment     return (name, args)  -- {% call (foo) bar(baz) %}quux{% endcall %}@@ -345,19 +537,41 @@ callHeadP :: Monad m => Parser m ([Text], Expression) callHeadP = do     callerArgs <- option [] $ groupP "(" ")" identifierP-    spaces+    spacesOrComment     call <- expressionP-    spaces+    spacesOrComment     return (callerArgs, call)  scopeStmtP :: Monad m => Parser m Statement scopeStmtP =     ScopedS <$>         between-            (simpleTagP "scope")+            (try $ simpleTagP "scope")             (simpleTagP "endscope")             statementsP +indentStmtP :: Monad m => Parser m Statement+indentStmtP = do+    indentExpr <- try $ fancyTagP "indent" indentHeadP+    preIndent <- many (oneOf " \t")+    oldState <- getState+    modifyState $ \state ->+        state { psStripIndent = preIndent }+    body <- statementsP+    putState oldState+    simpleTagP "endindent"+    return $ IndentS indentExpr body++indentHeadP :: Monad m => Parser m Expression+indentHeadP =+    (expressionP <|> return (StringLiteralE "  ")) <* spacesOrComment++scriptScopeStmtP :: Monad m => Parser m Statement+scriptScopeStmtP = do+    try $ keyword "scope"+    spacesOrComment+    ScopedS <$> scriptStatementP+ forStmtP :: Monad m => Parser m Statement forStmtP = do     (iteree, varNameVal, varNameIndex) <- fancyTagP "for" forHeadP@@ -372,14 +586,47 @@         (IfS iteree forLoop)         elseBranchMay +scriptForStmtP :: Monad m => Parser m Statement+scriptForStmtP = do+    try $ keyword "for"+    spacesOrComment+    char '('+    (iteree, varNameVal, varNameIndex) <- forHeadP+    spacesOrComment+    char ')'+    spacesOrComment+    body <- scriptStatementP+    elseBranchMay <- optionMaybe $ do+        try $ keyword "else"+        spacesOrComment+        scriptStatementP+    let forLoop = ForS varNameIndex varNameVal iteree body+    return $ maybe+        forLoop+        (IfS iteree forLoop)+        elseBranchMay+ includeP :: Monad m => Parser m Statement includeP = do     sourceName <- fancyTagP "include" stringLiteralP     include sourceName +scriptIncludeP :: Monad m => Parser m Statement+scriptIncludeP = do+    try $ keyword "include"+    spacesOrComment+    char '('+    sourceName <- stringLiteralP+    spacesOrComment+    char ')'+    spacesOrComment+    char ';'+    spacesOrComment+    include sourceName+ forHeadP :: Monad m => Parser m (Expression, VarName, Maybe VarName) forHeadP =-    (try forHeadInP <|> forHeadAsP) <* optional (string "recursive" >> spaces)+    (try forHeadInP <|> forHeadAsP) <* optional (keyword "recursive" >>spacesOrComment)  forIteratorP :: Monad m => Parser m (VarName, Maybe VarName) forIteratorP = try forIndexedIteratorP <|> try forSimpleIteratorP <?> "iteration variables"@@ -387,36 +634,34 @@ forIndexedIteratorP :: Monad m => Parser m (VarName, Maybe VarName) forIndexedIteratorP = do     indexIdent <- identifierP-    spaces+    spacesOrComment     char ','-    spaces+    spacesOrComment     varIdent <- identifierP-    spaces+    spacesOrComment     return (varIdent, Just indexIdent)  forSimpleIteratorP :: Monad m => Parser m (VarName, Maybe VarName) forSimpleIteratorP = do     varIdent <- identifierP-    spaces+    spacesOrComment     return (varIdent, Nothing)  forHeadInP :: Monad m => Parser m (Expression, VarName, Maybe VarName) forHeadInP = do     (varIdent, indexIdent) <- forIteratorP-    spaces-    string "in"-    notFollowedBy identCharP-    spaces+    spacesOrComment+    keyword "in"+    spacesOrComment     iteree <- expressionP     return (iteree, varIdent, indexIdent)  forHeadAsP :: Monad m => Parser m (Expression, VarName, Maybe VarName) forHeadAsP = do     iteree <- expressionP-    spaces-    string "as"-    notFollowedBy identCharP-    spaces+    spacesOrComment+    keyword "as"+    spacesOrComment     (varIdent, indexIdent) <- forIteratorP     return (iteree, varIdent, indexIdent) @@ -425,8 +670,8 @@     between         (try $ do             openTagP-            string tagName-            spaces)+            keyword tagName+            spacesOrComment)         closeTagP  simpleTagP :: Monad m => String -> Parser m ()@@ -457,27 +702,27 @@ openWP c = ignore $ do     spaces     string [ '{', c, '-' ]-    spaces+    spacesOrComment  openNWP :: Monad m => Char -> Parser m () openNWP c = ignore $ do     string [ '{', c ]-    spaces+    spacesOrComment  closeP :: Monad m => Char -> Parser m () closeP c = try (closeWP c) <|> try (closeNWP c)  closeWP :: Monad m => Char -> Parser m () closeWP c = ignore $ do-    spaces+    spacesOrComment     string [ '-', c, '}' ]     spaces  closeNWP :: Monad m => Char -> Parser m () closeNWP c = ignore $ do-    spaces+    spacesOrComment     string [ c, '}' ]-    optional . ignore . char $ '\n'+    optional . ignore $ literalNewlineP  expressionP :: Monad m => Parser m Expression expressionP = lambdaExprP <|> ternaryExprP@@ -486,12 +731,12 @@ lambdaExprP = do     argNames <- try $ do         char '('-        spaces-        argNames <- sepBy (spaces >> identifierP) (try $ spaces >> char ',')+        spacesOrComment+        argNames <- sepBy (spacesOrComment>> identifierP) (try $ spacesOrComment>> char ',')         char ')'-        spaces+        spacesOrComment         string "->"-        spaces+        spacesOrComment         return argNames     body <- expressionP     return $ LambdaE argNames body@@ -499,7 +744,7 @@ operativeExprP :: forall m. Monad m => Parser m Expression -> [ (String, Text) ] -> Parser m Expression operativeExprP operandP operators = do     lhs <- operandP-    spaces+    spacesOrComment     tails <- many . try $ operativeTail     return $ foldl (flip ($)) lhs tails     where@@ -510,36 +755,34 @@             funcName <-                 foldl (<|>) (fail "operator")                     [ try (string op >> notFollowedBy (oneOf opChars)) >> return fn | (op, fn) <- operators ]-            spaces+            spacesOrComment             rhs <- operandP-            spaces+            spacesOrComment             return (\lhs -> CallE (VarE funcName) [(Nothing, lhs), (Nothing, rhs)])  ternaryExprP :: Monad m => Parser m Expression ternaryExprP = do     expr1 <- booleanExprP-    spaces+    spacesOrComment     cTernaryTailP expr1 <|> pyTernaryTailP expr1 <|> return expr1  cTernaryTailP :: Monad m => Expression -> Parser m Expression cTernaryTailP condition = do     char '?'-    spaces+    spacesOrComment     yesBranch <- expressionP     char ':'-    spaces+    spacesOrComment     noBranch <- expressionP     return $ TernaryE condition yesBranch noBranch  pyTernaryTailP :: Monad m => Expression -> Parser m Expression pyTernaryTailP yesBranch = do-    string "if"-    notFollowedBy identCharP-    spaces+    keyword "if"+    spacesOrComment     condition <- booleanExprP-    string "else"-    notFollowedBy identCharP-    spaces+    keyword "else"+    spacesOrComment     noBranch <- expressionP     return $ TernaryE condition yesBranch noBranch @@ -585,8 +828,8 @@ postfixExprP :: Monad m => Parser m Expression postfixExprP = do     base <- atomicExprP-    spaces-    postfixes <- many . try $ postfixP `before` spaces+    spacesOrComment+    postfixes <- many . try $ postfixP `before`spacesOrComment     return $ foldl (flip ($)) base postfixes  postfixP :: Monad m => Parser m (Expression -> Expression)@@ -598,7 +841,7 @@ dotPostfixP :: Monad m => Parser m (Expression -> Expression) dotPostfixP = do     char '.'-    spaces+    spacesOrComment     i <- StringLiteralE <$> identifierP     return $ \e -> MemberLookupE e i @@ -632,7 +875,7 @@  namedFuncArgP :: Monad m => Parser m (Maybe Text, Expression) namedFuncArgP = do-    name <- try $ identifierP `before` between spaces spaces (string "=")+    name <- try $ identifierP `before` between spacesOrComment spacesOrComment (string "=")     expr <- expressionP     return (Just name, expr) @@ -642,13 +885,14 @@ filterP :: Monad m => Parser m (Expression -> Expression) filterP = do     char '|'-    spaces+    spacesOrComment     func <- atomicExprP     args <- option [] $ groupP "(" ")" funcArgP     return $ \e -> CallE func ((Nothing, e):args)  atomicExprP :: Monad m => Parser m Expression-atomicExprP = parenthesizedExprP+atomicExprP = doExprP+            <|> parenthesizedExprP             <|> objectExprP             <|> listExprP             <|> stringLiteralExprP@@ -658,10 +902,18 @@ parenthesizedExprP :: Monad m => Parser m Expression parenthesizedExprP =     between-        (try . ignore $ char '(' >> spaces)-        (ignore $ char ')' >> spaces)+        (try . ignore $ char '(' >> spacesOrComment)+        (ignore $ char ')' >> spacesOrComment)         expressionP +doExprP :: Monad m => Parser m Expression+doExprP = do+    try $ keyword "do"+    spacesOrComment+    stmt <- scriptStatementP+    spacesOrComment+    return $ DoE stmt+ listExprP :: Monad m => Parser m Expression listExprP = ListE <$> groupP "[" "]" expressionP @@ -671,28 +923,28 @@ expressionPairP :: Monad m => Parser m (Expression, Expression) expressionPairP = do     a <- expressionP-    spaces+    spacesOrComment     char ':'-    spaces+    spacesOrComment     b <- expressionP-    spaces+    spacesOrComment     return (a, b)  groupP :: Monad m => String -> String -> Parser m a -> Parser m [a] groupP obr cbr inner =     bracedP obr cbr-        (sepBy (inner `before` spaces) (try $ string "," `before` spaces))+        (sepBy (inner `before` spacesOrComment) (try $ string "," `before` spacesOrComment))  bracedP :: Monad m => String -> String -> Parser m a -> Parser m a bracedP obr cbr =     between-        (try . ignore $ string obr >> spaces)-        (ignore $ string cbr >> spaces)+        (try . ignore $ string obr >> spacesOrComment)+        (ignore $ string cbr >> spacesOrComment)  varExprP :: Monad m => Parser m Expression varExprP = do     litName <- identifierP-    spaces+    spacesOrComment     return $ case litName of         "true" -> BoolLiteralE True         "false" -> BoolLiteralE False@@ -755,3 +1007,9 @@  before :: Monad m => m a -> m b -> m a before = flip followedBy++keyword :: Monad m => String -> Parser m String+keyword kw = do+    string kw+    notFollowedBy identCharP+    return kw

@@ -5,6 +5,7 @@ {-#LANGUAGE TypeSynonymInstances #-} {-#LANGUAGE MultiParamTypeClasses #-} {-#LANGUAGE ScopedTypeVariables #-}+{-#LANGUAGE LambdaCase #-} -- | Execute Ginger templates in an arbitrary monad. -- -- Usage example:@@ -101,6 +102,7 @@ import Network.HTTP.Types (urlEncode) import Debug.Trace (trace) import Data.List (lookup, zipWith, unzip)+import Data.Aeson as JSON  defaultScope :: forall m h. (Monoid h, Monad m, ToGVal (Run m h) h) => [(Text, GVal (Run m h))] defaultScope =@@ -164,7 +166,7 @@                , ToGVal (Run m h) v                , ToGVal (Run m h) h                )-            => (h -> m ()) -> v -> Template -> m ()+            => (h -> m ()) -> v -> Template -> m (GVal (Run m h)) easyRenderM emit context template =     runGingerT (easyContext emit context) template @@ -191,7 +193,10 @@ runGinger context template = execWriter $ runGingerT context template  -- | Monadically run a Ginger template. The @m@ parameter is the carrier monad.-runGingerT :: (ToGVal (Run m h) h, Monoid h, Monad m, Functor m) => GingerContext m h -> Template -> m ()+runGingerT :: (ToGVal (Run m h) h, Monoid h, Monad m, Functor m)+           => GingerContext m h+           -> Template+           -> m (GVal (Run m h)) runGingerT context tpl = runReaderT (evalStateT (runTemplate tpl) (defRunState tpl)) context  -- | Find the effective base template of an inheritance chain@@ -202,11 +207,16 @@         Just p -> baseTemplate p  -- | Run a template.-runTemplate :: (ToGVal (Run m h) h, Monoid h, Monad m, Functor m) => Template -> Run m h ()+runTemplate :: (ToGVal (Run m h) h, Monoid h, Monad m, Functor m)+            => Template+            -> Run m h (GVal (Run m h)) runTemplate = runStatement . templateBody . baseTemplate  -- | Run an action within a different template context.-withTemplate :: (Monad m, Functor m) => Template -> Run m h a -> Run m h a+withTemplate :: (Monad m, Functor m)+             => Template+             -> Run m h a+             -> Run m h a withTemplate tpl a = do     oldTpl <- gets rsCurrentTemplate     oldBlockName <- gets rsCurrentBlockName@@ -216,7 +226,10 @@     return result  -- | Run an action within a block context-withBlockName :: (Monad m, Functor m) => VarName -> Run m h a -> Run m h a+withBlockName :: (Monad m, Functor m)+              => VarName+              -> Run m h a+              -> Run m h a withBlockName blockName a = do     oldBlockName <- gets rsCurrentBlockName     modify (\s -> s { rsCurrentBlockName = Just blockName })@@ -241,16 +254,37 @@                     templateParent tpl >>= resolveBlock name  -- | Run one statement.-runStatement :: forall m h. (ToGVal (Run m h) h, Monoid h, Monad m, Functor m) => Statement -> Run m h ()-runStatement NullS = return ()-runStatement (MultiS xs) = forM_ xs runStatement-runStatement (LiteralS html) = echo (toGVal html)-runStatement (InterpolationS expr) = runExpression expr >>= echo+runStatement :: forall m h+              . ( ToGVal (Run m h) h+                , Monoid h+                , Monad m+                , Functor m+                )+             => Statement+             -> Run m h (GVal (Run m h))+runStatement NullS =+    return def+runStatement (MultiS xs) =+    forM xs runStatement >>= \case+        [] -> return def+        rvals -> return $ List.last rvals+runStatement (LiteralS html) =+    echo (toGVal html) >> return def+runStatement (InterpolationS expr) =+    runExpression expr >>= echo >> return def+runStatement (ExpressionS expr) =+    runExpression expr runStatement (IfS condExpr true false) = do     cond <- runExpression condExpr     runStatement $ if toBoolean cond then true else false -runStatement (SwitchS pivotExpr cases def) = do+runStatement (IndentS expr body) = do+    i <- runExpression expr+    encode <- asks contextEncode+    let istr = encode i+    indented istr $ runStatement body++runStatement (SwitchS pivotExpr cases defBranch) = do     pivot <- runExpression pivotExpr     let branches =             [ \cont -> do@@ -261,20 +295,23 @@             | (condExpr, body)             <- cases             ] ++-            [ Prelude.const (runStatement def)-            ]+            [ Prelude.const $ runStatement defBranch ]     go branches     where-        go [] = return ()+        go :: [ Run m h (GVal (Run m h)) -> Run m h (GVal (Run m h)) ]+           -> Run m h (GVal (Run m h))+        go [] = return def         go (x:xs) = x (go xs)  runStatement (SetVarS name valExpr) = do     val <- runExpression valExpr     setVar name val+    return def  runStatement (DefMacroS name macro) = do     let val = macroToGVal macro     setVar name val+    return def  runStatement (BlockRefS blockName) = do     block <- lookupBlock blockName@@ -283,7 +320,7 @@  runStatement (ScopedS body) = withLocalScope runInner     where-        runInner :: (Functor m, Monad m) => Run m h ()+        runInner :: (Functor m, Monad m) => Run m h (GVal (Run m h))         runInner = runStatement body  runStatement (ForS varNameIndex varNameValue itereeExpr body) = do@@ -305,7 +342,8 @@                 loop :: [(Maybe Text, GVal (Run m h))] -> Run m h (GVal (Run m h))                 loop [] = fail "Invalid call to `loop`; at least one argument is required"                 loop ((_, loopee):_) = go (Prelude.succ recursionDepth) loopee-                iteration :: (Int, (GVal (Run m h), GVal (Run m h))) -> Run m h ()+                iteration :: (Int, (GVal (Run m h), GVal (Run m h)))+                          -> Run m h (GVal (Run m h))                 iteration (index, (key, value)) = do                     setVar varNameValue value                     setVar "loop" $@@ -322,18 +360,24 @@                              ])                              { asFunction = Just loop }                     case varNameIndex of-                        Nothing -> return ()+                        Nothing -> return def                         Just n -> setVar n key                     runStatement body-            withLocalScope $ forM_ (Prelude.zip [0..] iterPairs) iteration-            return def-    runExpression itereeExpr >>= go 0 >> return ()+            (withLocalScope $ forM (Prelude.zip [0..] iterPairs) iteration) >>= \case+                [] -> return def+                rvals -> return $ List.last rvals+    runExpression itereeExpr >>= go 0  runStatement (PreprocessedIncludeS tpl) =     withTemplate tpl $ runTemplate tpl  -- | Deeply magical function that converts a 'Macro' into a Function.-macroToGVal :: forall m h. (ToGVal (Run m h) h, Monoid h, Functor m, Monad m) => Macro -> GVal (Run m h)+macroToGVal :: forall m h+             . ( ToGVal (Run m h) h+               , Monoid h+               , Functor m+               , Monad m+               ) => Macro -> GVal (Run m h) macroToGVal (Macro argNames body) =     fromFunction f     where@@ -392,15 +436,64 @@     condVal <- runExpression condition     let expr = if asBoolean condVal then yes else no     runExpression expr+runExpression (DoE stmt) =+    runStatement stmt  -- | Helper function to output a HTML value using whatever print function the -- context provides.-echo :: (Monad m, Functor m) => GVal (Run m h) -> Run m h ()+echo :: (Monad m, Functor m, Monoid h)+     => GVal (Run m h) -> Run m h () echo src = do     e <- asks contextEncode+    newlinesMay <- asks contextNewlines+    indentationMay <- gets rsIndentation     p <- asks contextWrite-    p . e $ src+    let indent = fromMaybe id $ do+            newlines <- newlinesMay+            indentation <- indentationMay+            return $ applyIndentation newlines indentation +    p . indent . e $ src++applyIndentation :: (Monoid h)+                 => Newlines h+                 -> [h]+                 -> h+                 -> h+applyIndentation n levels =+    let indent = mconcat . List.reverse $ levels+    in joinLines n .+       fmap (indent <>) .+       splitLines n++indented :: (Monad m, Functor m, Monoid h)+         => h+         -> Run m h a+         -> Run m h a+indented i action = do+    pushIndent i *> action <* popIndent++pushIndent :: (Monad m, Functor m, Monoid h)+           => h+           -> Run m h ()+pushIndent i =+    modify $ \state ->+        state { rsIndentation = increaseIndent i (rsIndentation state) }+popIndent :: (Monad m, Functor m, Monoid h)+           => Run m h ()+popIndent =+    modify $ \state ->+        state { rsIndentation = decreaseIndent (rsIndentation state) }++increaseIndent :: a -> Maybe [a] -> Maybe [a]+increaseIndent _ Nothing = Just []+increaseIndent x (Just xs) = Just (x:xs)++decreaseIndent :: Maybe [a] -> Maybe [a]+decreaseIndent Nothing = Nothing+decreaseIndent (Just []) = Nothing+decreaseIndent (Just (x:xs)) = Just xs+ defRunState :: forall m h. (ToGVal (Run m h) h, Monoid h, Monad m)             => Template             -> RunState m h@@ -410,9 +503,11 @@         , rsCapture = mempty         , rsCurrentTemplate = tpl         , rsCurrentBlockName = Nothing+        , rsIndentation = Nothing         } -gfnEval :: (Monad m, Monoid h, ToGVal (Run m h) h) => Function (Run m h)+gfnEval :: (Monad m, Monoid h, ToGVal (Run m h) h)+        => Function (Run m h) gfnEval args =     let extracted =             extractArgsDefL

@@ -21,6 +21,9 @@ , liftRun2 , Run (..) , RunState (..)+-- * The Newlines type+-- | Required for handling indentation+, Newlines (..) ) where @@ -54,6 +57,7 @@ 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@@ -82,6 +86,7 @@         { 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 ()@@ -101,20 +106,25 @@                     (toGVal context)))         emit         encode+        newlines   -- | Typeclass that defines how to encode 'GVal's into a given type. class ContextEncodable h where     encode :: forall m. GVal m -> h+    newlines :: Maybe (Newlines h)+    newlines = Nothing  -- | Encoding to text just takes the text representation without further -- processing. instance ContextEncodable Text where     encode = asText+    newlines = Just textNewlines  -- | Encoding to Html is implemented as returning the 'asHtml' representation. instance ContextEncodable Html where     encode = toHtml+    newlines = Just htmlNewlines  -- | Create an execution context for runGingerT. -- Takes a lookup function, which returns ginger values into the carrier monad@@ -125,12 +135,14 @@              => (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 =+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))@@ -151,12 +163,12 @@ makeContext' :: Monoid h             => (VarName -> GVal (Run (Writer h) h))             -> (GVal (Run (Writer h) h) -> h)+            -> Maybe (Newlines h)             -> GingerContext (Writer h) h-makeContext' lookupFn encodeFn =+makeContext' lookupFn =     makeContextM'         (return . lookupFn)         tell-        encodeFn  {-#DEPRECATED makeContext "Compatibility alias for makeContextHtml" #-} makeContext :: (VarName -> GVal (Run (Writer Html) Html))@@ -172,31 +184,66 @@  makeContextHtml :: (VarName -> GVal (Run (Writer Html) Html))                 -> GingerContext (Writer Html) Html-makeContextHtml l = makeContext' l toHtml+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+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+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+makeContextTextM l w = makeContextM' l w asText (Just textNewlines) +-- | A 'Newlines' determines the rules by which a 'h' value can be+-- split into lines, how a list of lines can be joined into a single+-- value, and how to remove leading whitespace.+data Newlines h =+    Newlines+        { splitLines :: h -> [h]+        , joinLines :: [h] -> h+        , stripIndent :: h -> h+        } +stringNewlines :: Newlines String+stringNewlines =+    Newlines+        { splitLines = List.lines+        , joinLines = List.unlines+        , stripIndent = List.dropWhile isSpace+        }++textNewlines :: Newlines Text+textNewlines =+    Newlines+        { splitLines = Text.lines+        , joinLines = Text.unlines+        , stripIndent = Text.stripStart+        }++htmlNewlines :: Newlines Html+htmlNewlines =+    Newlines+        { splitLines = fmap unsafeRawHtml . splitLines textNewlines . htmlSource+        , joinLines = unsafeRawHtml . joinLines textNewlines . fmap htmlSource+        , stripIndent = unsafeRawHtml . stripIndent textNewlines . htmlSource+        }++ data RunState m h     = RunState         { rsScope :: HashMap VarName (GVal (Run m h))         , rsCapture :: h         , rsCurrentTemplate :: Template -- the template we are currently running         , rsCurrentBlockName :: Maybe Text -- the name of the innermost block we're currently in+        , rsIndentation :: Maybe [h] -- current indentation level, if any         }  -- | Internal type alias for our template-runner monad stack.@@ -209,5 +256,3 @@ -- | Lift a function from the host monad @m@ into the 'Run' monad. liftRun2 :: Monad m => (a -> m b) -> a -> Run m h b liftRun2 f x = liftRun $ f x--

@@ -727,6 +727,126 @@         , testCase "after exiting local scope" $ do             mkTestHtml [] [] "{% set bedazzle = \"no\" %}{% scope %}{% set bedazzle = \"ya\" %}{% endscope %}{{ bedazzle }}" "no"         ]+    , testGroup "Indentation"+        [ testCase "stripping leading spaces" $ do+            mkTestHtml [] []+                (unlines+                    [ "{% indent %}"+                    , "  aaaaa"+                    , "  aaaaa"+                    , "{% endindent %}"+                    ])+                (Text.unlines+                    [ "aaaaa"+                    , "aaaaa"+                    ])+        , testCase "explicit indent string" $ do+            mkTestHtml [] []+                (unlines+                    [ "{% indent %}"+                    , "    aaaaa"+                    , "{% indent '    ' %}"+                    , "    aaaaa"+                    , "{% endindent %}"+                    , "    aaaaa"+                    , "{% endindent %}"+                    ])+                (Text.unlines+                    [ "aaaaa"+                    , "    aaaaa"+                    , "aaaaa"+                    ])+        , testCase "implicit indent string" $ do+            mkTestHtml [] []+                (unlines+                    [ "{% indent %}"+                    , "    aaaaa"+                    , "{% indent %}"+                    , "  aaaaa"+                    , "{% endindent %}"+                    , "    aaaaa"+                    , "{% endindent %}"+                    ])+                (Text.unlines+                    [ "aaaaa"+                    , "  aaaaa"+                    , "aaaaa"+                    ])+        , testCase "explicit non-whitespace indent string" $ do+            mkTestHtml [] []+                (unlines+                    [ "{% indent %}"+                    , "    aaaaa"+                    , "{% indent '--- ' %}"+                    , "    aaaaa"+                    , "{% endindent %}"+                    , "    aaaaa"+                    , "{% endindent %}"+                    ])+                (Text.unlines+                    [ "aaaaa"+                    , "--- aaaaa"+                    , "aaaaa"+                    ])+        , testCase "explicit indent string from more complex expression" $ do+            mkTestHtml [] []+                (unlines+                    [ "{% indent %}"+                    , "  aaaaa"+                    , "{% indent (17 + 4) ~ ' '%}"+                    , "  aaaaa"+                    , "{% endindent %}"+                    , "  aaaaa"+                    , "{% endindent %}"+                    ])+                (Text.unlines+                    [ "aaaaa"+                    , "21 aaaaa"+                    , "aaaaa"+                    ])+        , testCase "discarding level-0 indents" $ do+            mkTestHtml [] []+                (unlines+                    [ "{% indent 'nope' %}"+                    , "  aaaaa"+                    , "{% indent %}"+                    , "  aaaaa"+                    , "{% endindent %}"+                    , "  aaaaa"+                    , "{% endindent %}"+                    ])+                (Text.unlines+                    [ "aaaaa"+                    , "  aaaaa"+                    , "aaaaa"+                    ])+        , testCase "indentation levels inherited at runtime (dynamic)" $ do+            mkTestHtml [] []+                (unlines+                    [ "{%- macro foobar() %}"+                    , "{% indent '  ' %}"+                    , "<div>"+                    , "{% indent '  ' %}"+                    , "<h1>Hello!</h1>"+                    , "{% endindent %}"+                    , "</div>"+                    , "{% endindent %}"+                    , "{% endmacro -%}"+                    , ""+                    , "{% indent '' %}"+                    , "<body>"+                    , "{{ foobar() }}"+                    , "</body>"+                    , "{% endindent %}"+                    ])+                (Text.unlines+                    [ "<body>"+                    , "  <div>"+                    , "    <h1>Hello!</h1>"+                    , "  </div>"+                    , "</body>"+                    ])+        ]     , testGroup "Macros"         [ testCase "simple" $ do             mkTestHtml [] []@@ -800,6 +920,198 @@                 "{{ '<>' }}{{ 1 }}{{ {'foo': true} }}"                 "[\"<>\",1,{\"foo\":true}]"         ]+    , testGroup "Script mode"+        [ testCase "empty script block" $+            mkTestHtml+                []+                []+                "{% script %}{% endscript %}"+                ""+        , testGroup "comments"+            [ testCase "simple" $+                mkTestHtml+                    []+                    []+                    "{% script %}  # this is a comment\n{% endscript %}"+                    ""+            , testCase "multiple" $ do+                mkTestHtml [] []+                    (unlines+                        [ "{% script %}"+                        , "23; # this is a comment"+                        , " ## this is a comment, too"+                        , "{% endscript %}"+                        ])+                    ""+            , testCase "inside expressions" $ do+                mkTestHtml [] []+                    (unlines+                        [ "{% script %}"+                        , "23 # this is a comment"+                        , " ## this is a comment, too"+                        , " ;"+                        , "{% endscript %}"+                        ])+                    ""+            ]+        , testCase "echo" $+            mkTestHtml+                []+                []+                "{% script %}echo('Hi!');{% endscript %}"+                "Hi!"+        , testCase "expression statement" $+            mkTestHtml+                []+                []+                "{% script %}12 + 15;{% endscript %}"+                ""+        , testCase "grouped statements" $+            mkTestHtml+                []+                []+                "{% script %}{ \n 1; 2; 3; 4; }{% endscript %}"+                ""+        , testCase "if" $+            mkTestHtml+                []+                []+                "{% script %}if (true) { echo('Hi!'); }{% endscript %}"+                "Hi!"+        , testCase "if/else" $+            mkTestHtml+                []+                []+                "{% script %}if (false) echo ('nope'); else { echo('Hi!'); }{% endscript %}"+                "Hi!"+        , testCase "switch" $+            mkTestHtml+                []+                []+                "{% script %}switch ('hi') { case 'hi': echo('Hello'); case 'no': echo('Nope'); default: echo('Default'); }{% endscript %}"+                "Hello"+        , testCase "for" $+            mkTestHtml+                []+                []+                "{% script %}for (i in [1,2,3]) echo(i);{% endscript %}"+                "123"+        , testCase "for/else (loop)" $+            mkTestHtml+                []+                []+                "{% script %}for (i in [1,2,3]) echo(i); else echo('none');{% endscript %}"+                "123"+        , testCase "for/else (recover)" $+            mkTestHtml+                []+                []+                "{% script %}for (i in null) echo(i); else echo('none');{% endscript %}"+                "none"+        , testCase "set" $+            mkTestHtml+                []+                []+                "{% script %}set a = 'Hi' ~ '!'; echo(a);{% endscript %}"+                "Hi!"+        , testCase "include" $ do+            mkTestHtml [] [("./features-included.html", "This is an included template")]+                "{% script %}include('features-included.html');{% endscript %}"+                "This is an included template"+        , testCase "macro" $ do+            mkTestHtml [] []+                (unlines+                    [ "{% script %}"+                    , "macro greet(name) {"+                    , "echo('Hello, ');"+                    , "echo(name);"+                    , "}"+                    , ""+                    , "echo(greet('tobias'));"+                    , "{% endscript %}"+                    ])+                "Hello, tobias"+        , testGroup "Script statment blocks"+            [ testCase "baseline" $ do+                mkTestHtml [] []+                    (unlines+                        [ "{% script %}"+                        , "set bedazzle = 'no';"+                        , "echo(bedazzle);"+                        , "{% endscript %}"+                        ])+                    "no"+            , testCase "inside local scope" $ do+                mkTestHtml [] []+                    (unlines+                        [ "{% script %}"+                        , "set bedazzle = 'no';"+                        , "{"+                        , "    set bedazzle = 'ya';"+                        , "    echo(bedazzle);"+                        , "}"+                        , "{% endscript %}"+                        ])+                    "ya"+            , testCase "after exiting block" $ do+                mkTestHtml [] []+                    (unlines+                        [ "{% script %}"+                        , "set bedazzle = 'no';"+                        , "{"+                        , "    set bedazzle = 'ya';"+                        , "}"+                        , "echo(bedazzle);"+                        , "{% endscript %}"+                        ])+                    "ya"+            ]+        , testGroup "Explicit Local Scopes"+            [ testCase "baseline" $ do+                mkTestHtml [] []+                    (unlines+                        [ "{% script %}"+                        , "set bedazzle = 'no';"+                        , "echo(bedazzle);"+                        , "{% endscript %}"+                        ])+                    "no"+            , testCase "inside local scope" $ do+                mkTestHtml [] []+                    (unlines+                        [ "{% script %}"+                        , "set bedazzle = 'no';"+                        , "scope {"+                        , "    set bedazzle = 'ya';"+                        , "    echo(bedazzle);"+                        , "}"+                        , "{% endscript %}"+                        ])+                    "ya"+            , testCase "after exiting local scope" $ do+                mkTestHtml [] []+                    (unlines+                        [ "{% script %}"+                        , "set bedazzle = 'no';"+                        , "scope {"+                        , "    set bedazzle = 'ya';"+                        , "}"+                        , "echo(bedazzle);"+                        , "{% endscript %}"+                        ])+                    "no"+            ]+        ]+    , testGroup "do expressions"+        [ testCase "single statement" $ do+            mkTestHtml [] []+                "{{ do 'hello'; }}"+                "hello"+        , testCase "statement block" $ do+            mkTestHtml [] []+                "{{ do { 'hello'; 'world'; } }}"+                "world"+        ]     ]  mkTestHtml :: [(VarName, GVal (Run IO Html))]@@ -822,7 +1134,7 @@            -> Text            -> Assertion mkTestJSON = mkTest-    (\l w -> makeContextM' l w toJSONSingleton) encodeText+    (\l w -> makeContextM' l w toJSONSingleton Nothing) encodeText     where         toJSONSingleton = (:[]) . JSON.toJSON