ginger 0.6.0.2 → 0.7.0.0

raw patch · 14 files changed

+1053/−614 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• cli/GingerCLI.hs +21/−17
• ginger.cabal +1/−1
• src/Text/Ginger/AST.hs +93/−45
• src/Text/Ginger/GVal.hs +3/−0
• src/Text/Ginger/Optimizer.hs +95/−86
• src/Text/Ginger/Parse.hs +324/−212
• src/Text/Ginger/Run.hs +176/−101
• src/Text/Ginger/Run/Builtins.hs +49/−44
• src/Text/Ginger/Run/FuncUtils.hs +12/−6
• src/Text/Ginger/Run/Type.hs +224/−73
• src/Text/Ginger/Run/VM.hs +7/−7
• test/Text/Ginger/PropertyTests.hs +9/−8
• test/Text/Ginger/SimulationTests.hs +33/−14

@@ -1,3 +1,9 @@+## 0.7.0.0++- `keepTrailingNewlines` option+- Ability to pass parser options into parseGinger+- Runtime warnings+ ## 0.6.0.2  - Documentation fixes

@@ -37,10 +37,10 @@ decodeFile :: (JSON.FromJSON v) => FilePath -> IO (Maybe v) decodeFile fn = JSON.decode <$> (openFile fn ReadMode >>= LBS.hGetContents) -printF :: GVal (Run IO Html)+printF :: GVal (Run p IO Html) printF = fromFunction $ go     where-        go :: [(Maybe Text, GVal (Run IO Html))] -> Run IO Html (GVal (Run IO Html))+        go :: [(Maybe Text, GVal (Run p IO Html))] -> Run p IO Html (GVal (Run p IO Html))         go args = forM_ args printArg >> return def         printArg (Nothing, v) = liftRun . putStrLn . Text.unpack . asText $ v         printArg (Just x, _) = return ()@@ -58,7 +58,7 @@      let scopeLookup key = toGVal (scope >>= HashMap.lookup key)         resolve = loadFileMay-    let contextLookup :: Text -> Run IO Html (GVal (Run IO Html))+    let contextLookup :: Text -> Run p IO Html (GVal (Run p IO Html))         contextLookup key =             case key of                 "print" -> return printF@@ -74,16 +74,22 @@      case tpl of         Left err -> do-            tplSource <- case src of-                            Just s -> return (Just s)-                            Nothing -> do-                                let s = peSourceName err-                                case s of-                                    Nothing -> return Nothing-                                    Just sn -> Just <$> loadFile sn+            tplSource <-+                case src of+                    Just s ->+                        return (Just s)+                    Nothing -> do+                        let s = sourceName <$> peSourcePosition err+                        case s of+                            Nothing -> return Nothing+                            Just sn -> Just <$> loadFile sn             printParserError tplSource err         Right t -> do-            let context = makeContextHtmlM contextLookup (putStr . Text.unpack . htmlSource)+            let context =+                    makeContextHtmlExM+                        contextLookup+                        (putStrLn . Text.unpack . htmlSource)+                        (hPutStrLn stderr . show)             runGingerT context t >>= either (hPutStrLn stderr . show) (putStr . show)  printParserError :: Maybe String -> ParserError -> IO ()@@ -91,14 +97,12 @@  displayParserError :: String -> ParserError -> IO () displayParserError src pe = do-    case (peSourceLine pe, peSourceColumn pe) of-        (Just l, cMay) -> do-            let ln = Prelude.take 1 . Prelude.drop (l - 1) . Prelude.lines $ src+    case peSourcePosition pe of+        Just pos -> do+            let ln = Prelude.take 1 . Prelude.drop (sourceLine pos - 1) . Prelude.lines $ src             case ln of                 [] -> return ()                 x:_ -> do                     putStrLn x-                    case cMay of-                        Just c -> putStrLn $ Prelude.replicate (c - 1) ' ' ++ "^"-                        _ -> return ()+                    putStrLn $ Prelude.replicate (sourceColumn pos - 1) ' ' ++ "^"         _ -> return ()

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                ginger-version:             0.6.0.2+version:             0.7.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.

@@ -1,3 +1,4 @@+{-#LANGUAGE DeriveFunctor #-} -- | Implements Ginger's Abstract Syntax Tree. module Text.Ginger.AST where@@ -14,64 +15,111 @@ type VarName = Text  -- | Top-level data structure, representing a fully parsed template.-data Template+data Template a     = Template-        { templateBody :: Statement-        , templateBlocks :: HashMap VarName Block-        , templateParent :: Maybe Template+        { templateBody :: Statement a+        , templateBlocks :: HashMap VarName (Block a)+        , templateParent :: Maybe (Template a)         }-        deriving (Show)+        deriving (Show, Functor)  -- | A macro definition ( @{% macro %}@ )-data Macro-    = Macro { macroArgs :: [VarName], macroBody :: Statement }-    deriving (Show)+data Macro a+    = Macro { macroArgs :: [VarName], macroBody :: Statement a }+    deriving (Show, Functor)  -- | A block definition ( @{% block %}@ )-data Block-    = Block { blockBody :: Statement } -- TODO: scoped blocks-    deriving (Show)+data Block a+    = Block { blockBody :: Statement a } -- TODO: scoped blocks+    deriving (Show, Functor)  -- | Ginger statements.-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 %}-    | SetVarS VarName Expression -- ^ {% set varname = expr %}-    | DefMacroS VarName Macro -- ^ {% macro varname %}statements{% endmacro %}-    | BlockRefS VarName-    | PreprocessedIncludeS Template -- ^ {% include "template" %}-    | NullS -- ^ The do-nothing statement (NOP)-    | TryCatchS Statement [CatchBlock] Statement -- ^ Try / catch / finally-    deriving (Show)+data Statement a+    = MultiS a [Statement a] -- ^ A sequence of multiple statements+    | ScopedS a (Statement a) -- ^ Run wrapped statement in a local scope+    | IndentS a (Expression a) (Statement a) -- ^ Establish an indented context around the wrapped statement+    | LiteralS a Html -- ^ Literal output (anything outside of any tag)+    | InterpolationS a (Expression a) -- ^ {{ expression }}+    | ExpressionS a (Expression a) -- ^ Evaluate expression+    | IfS a (Expression a) (Statement a) (Statement a) -- ^ {% if expression %}statement{% else %}statement{% endif %}+    | SwitchS a (Expression a) [((Expression a), (Statement a))] (Statement a) -- ^ {% switch expression %}{% case expression %}statement{% endcase %}...{% default %}statement{% enddefault %}{% endswitch %}+    | ForS a (Maybe VarName) VarName (Expression a) (Statement a) -- ^ {% for index, varname in expression %}statement{% endfor %}+    | SetVarS a VarName (Expression a) -- ^ {% set varname = expr %}+    | DefMacroS a VarName (Macro a) -- ^ {% macro varname %}statements{% endmacro %}+    | BlockRefS a VarName+    | PreprocessedIncludeS a (Template a) -- ^ {% include "template" %}+    | NullS a -- ^ The do-nothing statement (NOP)+    | TryCatchS a (Statement a) [CatchBlock a] (Statement a) -- ^ Try / catch / finally+    deriving (Show, Functor) +stmtAnnotation (MultiS a _) = a+stmtAnnotation (ScopedS a _) = a+stmtAnnotation (IndentS a _ _) = a+stmtAnnotation (LiteralS a _) = a+stmtAnnotation (InterpolationS a _) = a+stmtAnnotation (ExpressionS a _) = a+stmtAnnotation (IfS a _ _ _) = a+stmtAnnotation (SwitchS a _ _ _) = a+stmtAnnotation (ForS a _ _ _ _) = a+stmtAnnotation (SetVarS a _ _) = a+stmtAnnotation (DefMacroS a _ _) = a+stmtAnnotation (BlockRefS a _) = a+stmtAnnotation (PreprocessedIncludeS a _) = a+stmtAnnotation (NullS a) = a+stmtAnnotation (TryCatchS a _ _ _) = a+ -- | A @catch@ block-data CatchBlock =+data CatchBlock a =     Catch         { catchWhat :: Maybe Text         , catchCaptureAs :: Maybe VarName-        , catchBody :: Statement+        , catchBody :: Statement a         }-        deriving (Show)+        deriving (Show, Functor)  -- | Expressions, building blocks for the expression minilanguage.-data Expression-    = StringLiteralE Text -- ^ String literal expression: "foobar"-    | NumberLiteralE Scientific -- ^ Numeric literal expression: 123.4-    | BoolLiteralE Bool -- ^ Boolean literal expression: true-    | NullLiteralE -- ^ Literal null-    | VarE VarName -- ^ Variable reference: foobar-    | ListE [Expression] -- ^ List construct: [ expr, expr, expr ]-    | ObjectE [(Expression, Expression)] -- ^ Object construct: { expr: expr, expr: expr, ... }-    | MemberLookupE Expression Expression -- ^ foo[bar] (also dot access)-    | 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)+data Expression a+    = StringLiteralE a Text -- ^ String literal expression: "foobar"+    | NumberLiteralE a Scientific -- ^ Numeric literal expression: 123.4+    | BoolLiteralE a Bool -- ^ Boolean literal expression: true+    | NullLiteralE a -- ^ Literal null+    | VarE a VarName -- ^ Variable reference: foobar+    | ListE a [(Expression a)] -- ^ List construct: [ expr, expr, expr ]+    | ObjectE a [((Expression a), (Expression a))] -- ^ Object construct: { expr: expr, expr: expr, ... }+    | MemberLookupE a (Expression a) (Expression a) -- ^ foo[bar] (also dot access)+    | CallE a (Expression a) [(Maybe Text, (Expression a))] -- ^ foo(bar=baz, quux)+    | LambdaE a [Text] (Expression a) -- ^ (foo, bar) -> expr+    | TernaryE a (Expression a) (Expression a) (Expression a) -- ^ expr ? expr : expr+    | DoE a (Statement a) -- ^ do { statement; }+    deriving (Show, Functor)++exprAnnotation (StringLiteralE a _) = a+exprAnnotation (NumberLiteralE a _) = a+exprAnnotation (BoolLiteralE a _) = a+exprAnnotation (NullLiteralE a) = a+exprAnnotation (VarE a _) = a+exprAnnotation (ListE a _) = a+exprAnnotation (ObjectE a _) = a+exprAnnotation (MemberLookupE a _ _) = a+exprAnnotation (CallE a _ _) = a+exprAnnotation (LambdaE a _ _) = a+exprAnnotation (TernaryE a _ _ _) = a+exprAnnotation (DoE a _) = a++class Annotated f where+    annotation :: f p -> p++instance Annotated Expression where+    annotation = exprAnnotation++instance Annotated Statement where+    annotation = stmtAnnotation++instance Annotated Block where+    annotation = annotation . blockBody++instance Annotated Macro where+    annotation = annotation . macroBody++instance Annotated Template where+    annotation = annotation . templateBody

@@ -280,6 +280,9 @@ instance ToGVal m (GVal m) where     toGVal = id +instance ToGVal m () where+    toGVal = const def+ -- | 'Nothing' becomes NULL, 'Just' unwraps. instance ToGVal m v => ToGVal m (Maybe v) where     toGVal Nothing = def { asJSON = Just JSON.Null }

@@ -2,6 +2,8 @@ {-#LANGUAGE FlexibleInstances #-} {-#LANGUAGE MultiParamTypeClasses #-} {-#LANGUAGE OverloadedStrings #-}+{-#LANGUAGE ScopedTypeVariables #-}+{-#LANGUAGE FlexibleContexts #-} -- | A syntax tree optimizer module Text.Ginger.Optimizer ( Optimizable (..) )@@ -24,19 +26,19 @@ class Optimizable a where     optimize :: a -> a -instance Optimizable Template where+instance Optimizable (Template a) where     optimize = optimizeTemplate -instance Optimizable Statement where+instance Optimizable (Statement a) where     optimize = optimizeStatement -instance Optimizable Block where+instance Optimizable (Block a) where     optimize = optimizeBlock -instance Optimizable Macro where+instance Optimizable (Macro a) where     optimize = optimizeMacro -instance Optimizable Expression where+instance Optimizable (Expression a) where     optimize = optimizeExpression  optimizeTemplate t =@@ -46,26 +48,26 @@       }  {--    = MultiS [Statement] -- ^ A sequence of multiple statements-    | ScopedS Statement -- ^ Run wrapped statement in a local scope-    | LiteralS Html -- ^ Literal output (anything outside of any tag)-    | InterpolationS Expression -- ^ {{ expression }}-    | IfS Expression Statement Statement -- ^ {% if expression %}statement{% else %}statement{% endif %}-    | ForS (Maybe VarName) VarName Expression Statement -- ^ {% for index, varname in expression %}statement{% endfor %}-    | SetVarS VarName Expression -- ^ {% set varname = expr %}-    | DefMacroS VarName Macro -- ^ {% macro varname %}statements{% endmacro %}-    | BlockRefS VarName-    | PreprocessedIncludeS Template -- ^ {% include "template" %}-    | NullS -- ^ The do-nothing statement (NOP)+    = MultiS p [Statement a] -- ^ A sequence of multiple statements+    | ScopedS p Statement a -- ^ Run wrapped statement in a local scope+    | LiteralS p Html -- ^ Literal output (anything outside of any tag)+    | InterpolationS p Expression a -- ^ {{ expression }}+    | IfS p Expression a Statement a Statement a -- ^ {% if expression %}statement{% else %}statement{% endif %}+    | ForS p (Maybe VarName) VarName Expression a Statement a -- ^ {% for index, varname in expression %}statement{% endfor %}+    | SetVarS p VarName Expression a -- ^ {% set varname = expr %}+    | DefMacroS p VarName Macro a -- ^ {% macro varname %}statements{% endmacro %}+    | BlockRefS p VarName+    | PreprocessedIncludeS p Template a -- ^ {% include "template" %}+    | NullS p -- ^ The do-nothing statement (NOP) -}-optimizeStatement (MultiS items) =+optimizeStatement (MultiS p items) =     case optimizeStatementList items of-        [] -> NullS+        [] -> NullS p         [x] -> x-        xs -> MultiS xs-optimizeStatement (InterpolationS e) =-    InterpolationS (optimize e)-optimizeStatement s@(IfS c t f) =+        xs -> MultiS p xs+optimizeStatement (InterpolationS p e) =+    InterpolationS p (optimize e)+optimizeStatement s@(IfS p c t f) =     let c' = optimize c         t' = optimize t         f' = optimize f@@ -85,32 +87,32 @@     cullNulls .     fmap optimize -cullNulls :: [Statement] -> [Statement]+cullNulls :: [Statement a] -> [Statement a] cullNulls = filter (not . isNullS)     where-        isNullS NullS = True+        isNullS (NullS _) = True         isNullS _ = False -mergeLiterals :: [Statement] -> [Statement]+mergeLiterals :: [Statement a] -> [Statement a] mergeLiterals [] = [] mergeLiterals [x] = [x]-mergeLiterals (x@(LiteralS a):y@(LiteralS b):xs) = mergeLiterals $ (LiteralS $ a <> b):xs+mergeLiterals (x@(LiteralS p1 a):y@(LiteralS p2 b):xs) = mergeLiterals $ (LiteralS p1 $ a <> b):xs mergeLiterals (x:xs) = x:mergeLiterals xs   {--data Expression-    = StringLiteralE Text -- ^ String literal expression: "foobar"-    | NumberLiteralE Scientific -- ^ Numeric literal expression: 123.4-    | BoolLiteralE Bool -- ^ Boolean literal expression: true-    | NullLiteralE -- ^ Literal null-    | VarE VarName -- ^ Variable reference: foobar-    | ListE [Expression] -- ^ List construct: [ expr, expr, expr ]-    | ObjectE [(Expression, Expression)] -- ^ Object construct: { expr: expr, expr: expr, ... }-    | MemberLookupE Expression Expression -- ^ foo[bar] (also dot access)-    | CallE Expression [(Maybe Text, Expression)] -- ^ foo(bar=baz, quux)-    | LambdaE [Text] Expression -- ^ (foo, bar) -> expr-    | TernaryE Expression Expression Expression -- ^ expr ? expr : expr+data Expression a+    = StringLiteralE p Text -- ^ String literal expression: "foobar"+    | NumberLiteralE p Scientific -- ^ Numeric literal expression: 123.4+    | BoolLiteralE p Bool -- ^ Boolean literal expression: true+    | NullLiteralE p -- ^ Literal null+    | VarE p VarName -- ^ Variable reference: foobar+    | ListE p [Expression a] -- ^ List construct: [ expr, expr, expr ]+    | ObjectE p [(Expression a, Expression a)] -- ^ Object construct: { expr: expr, expr: expr, ... }+    | MemberLookupE p Expression a Expression a -- ^ foo[bar] (also dot access)+    | CallE p Expression a [(Maybe Text, Expression a)] -- ^ foo(bar=baz, quux)+    | LambdaE p [Text] Expression a -- ^ (foo, bar) -> expr+    | TernaryE p Expression a Expression a Expression a -- ^ expr ? expr : expr     deriving (Show) -} @@ -125,21 +127,21 @@     mempty = Pure     mappend = bothPure -pureExpression :: Expression -> Purity-pureExpression (StringLiteralE _) = Pure-pureExpression (NumberLiteralE _) = Pure-pureExpression NullLiteralE = Pure-pureExpression (ListE items) = mconcat . map pureExpression $ items-pureExpression (ObjectE pairs) =+pureExpression :: Expression a -> Purity+pureExpression (StringLiteralE p _) = Pure+pureExpression (NumberLiteralE p _) = Pure+pureExpression (NullLiteralE p) = Pure+pureExpression (ListE p items) = mconcat . map pureExpression $ items+pureExpression (ObjectE p pairs) =     mconcat [ bothPure (pureExpression k) (pureExpression v)             | (k, v) <- pairs             ]-pureExpression (LambdaE args body) = pureExpression body-pureExpression (TernaryE cond yes no) =+pureExpression (LambdaE _ args body) = pureExpression body+pureExpression (TernaryE _ cond yes no) =     pureExpression cond <> pureExpression yes <> pureExpression no-pureExpression (MemberLookupE k v) =+pureExpression (MemberLookupE _ k v) =     pureExpression k <> pureExpression v-pureExpression (CallE (VarE name) args) =+pureExpression (CallE _ (VarE _ name) args) =     pureFunction name <> mconcat (map (pureExpression . snd) args) pureExpression _ = Impure @@ -191,34 +193,35 @@     , "urlencode"     ] -optimizeExpression :: Expression -> Expression+optimizeExpression :: Expression a -> Expression a optimizeExpression = preEvalExpression . expandConstExpressions . optimizeSubexpressions -preEvalExpression :: Expression -> Expression+preEvalExpression :: Expression a -> Expression a preEvalExpression e = fromMaybe e $ do-    compileTimeEval e >>= gvalToExpression+    compileTimeEval e >>= gvalToExpression (annotation e) -gvalToExpression :: GVal m -> Maybe Expression-gvalToExpression g =+gvalToExpression :: forall a m+                  . a -> GVal m -> Maybe (Expression a)+gvalToExpression p g =     (jsonLiteral =<< asJSON g) <|>-    (ObjectE <$> (recurseDict =<< asDictItems g)) <|>-    (ListE <$> (mapM gvalToExpression =<< asList g))+    (ObjectE p <$> (recurseDict =<< asDictItems g)) <|>+    (ListE p <$> (mapM (gvalToExpression p) =<< asList g))     where-        jsonLiteral :: JSON.Value -> Maybe Expression-        jsonLiteral (JSON.Bool b) = Just (BoolLiteralE b)-        jsonLiteral (JSON.String s) = Just (StringLiteralE s)-        jsonLiteral (JSON.Null) = Just NullLiteralE-        jsonLiteral (JSON.Number n) = Just (NumberLiteralE n)+        jsonLiteral :: JSON.Value -> Maybe (Expression a)+        jsonLiteral (JSON.Bool b) = Just (BoolLiteralE p b)+        jsonLiteral (JSON.String s) = Just (StringLiteralE p s)+        jsonLiteral (JSON.Null) = Just (NullLiteralE p)+        jsonLiteral (JSON.Number n) = Just (NumberLiteralE p n)         jsonLiteral _ = Nothing-        recurseDict :: [(Text, GVal m)] -> Maybe [(Expression, Expression)]+        recurseDict :: [(Text, GVal m)] -> Maybe [(Expression a, Expression a)]         recurseDict = mapM $ \(key, val) -> do-            let key' = StringLiteralE key-            val' <- gvalToExpression val+            let key' = StringLiteralE p key+            val' <- gvalToExpression p val             return (key', val')  -expandConstExpressions :: Expression -> Expression-expandConstExpressions e@(TernaryE c t f) =+expandConstExpressions :: Expression a -> Expression a+expandConstExpressions e@(TernaryE p c t f) =     case compileTimeEval c of         Just gv -> case asBoolean gv of             True -> optimizeExpression t@@ -226,31 +229,37 @@         _ -> e expandConstExpressions e = e -optimizeSubexpressions (ListE xs) = ListE (map optimize xs)-optimizeSubexpressions (ObjectE xs) = ObjectE [ (optimize k, optimize v) | (k, v) <- xs ]-optimizeSubexpressions (MemberLookupE k m) = MemberLookupE (optimize k) (optimize m)-optimizeSubexpressions (CallE f args) = CallE (optimize f) [(n, optimize v) | (n, v) <- args]-optimizeSubexpressions (LambdaE args body) = LambdaE args (optimize body)-optimizeSubexpressions (TernaryE c t f) = TernaryE (optimize c) (optimize t) (optimize f)+optimizeSubexpressions (ListE p xs) = ListE p (map optimize xs)+optimizeSubexpressions (ObjectE p xs) = ObjectE p [ (optimize k, optimize v) | (k, v) <- xs ]+optimizeSubexpressions (MemberLookupE p k m) = MemberLookupE p (optimize k) (optimize m)+optimizeSubexpressions (CallE p f args) = CallE p (optimize f) [(n, optimize v) | (n, v) <- args]+optimizeSubexpressions (LambdaE p args body) = LambdaE p args (optimize body)+optimizeSubexpressions (TernaryE p c t f) = TernaryE p (optimize c) (optimize t) (optimize f) optimizeSubexpressions e = e -isConstExpression :: Expression -> Bool-isConstExpression (StringLiteralE _) = True-isConstExpression (BoolLiteralE _) = True-isConstExpression NullLiteralE = True-isConstExpression (ListE xs) = all isConstExpression xs-isConstExpression (ObjectE xs) = all (\(k,v) -> isConstExpression k && isConstExpression v) xs-isConstExpression (MemberLookupE k m) = isConstExpression k && isConstExpression m+isConstExpression :: Expression a -> Bool+isConstExpression (StringLiteralE p _) = True+isConstExpression (BoolLiteralE p _) = True+isConstExpression (NullLiteralE p) = True+isConstExpression (ListE p xs) = all isConstExpression xs+isConstExpression (ObjectE p xs) = all (\(k,v) -> isConstExpression k && isConstExpression v) xs+isConstExpression (MemberLookupE p k m) = isConstExpression k && isConstExpression m isConstExpression e = False -compileTimeEval :: Expression -> Maybe (GVal Identity)-compileTimeEval (StringLiteralE s) = Just . toGVal $ s-compileTimeEval (NumberLiteralE n) = Just . toGVal $ n-compileTimeEval (BoolLiteralE b) = Just . toGVal $ b-compileTimeEval NullLiteralE = Just def+compileTimeEval :: Expression p -> Maybe (GVal Identity)+compileTimeEval (StringLiteralE p s) = Just . toGVal $ s+compileTimeEval (NumberLiteralE p n) = Just . toGVal $ n+compileTimeEval (BoolLiteralE p b) = Just . toGVal $ b+compileTimeEval (NullLiteralE p) = Just def compileTimeEval e = case pureExpression e of     Pure -> do-        let tpl = Template (InterpolationS e) HashMap.empty Nothing+        let tpl =+              -- We're erasing source code positions here,+              -- because we don't have any use for them anyway.+              Template+                  (InterpolationS () (fmap (const ()) e))+                  HashMap.empty+                  Nothing         Just . toGVal . runCT $ tpl     Impure -> Nothing @@ -264,10 +273,10 @@ collectedToGVal (Collected []) = def collectedToGVal (Collected (x:_)) = marshalGVal x -runCT :: Template -> Collected+runCT :: Template () -> Collected runCT = runGinger ctContext -ctContext :: GingerContext (Writer Collected) Collected+ctContext :: GingerContext () (Writer Collected) Collected ctContext = makeContext' ctLookup ctEncode Nothing  ctLookup :: VarName -> GVal m

@@ -2,18 +2,30 @@ {-#LANGUAGE OverloadedStrings #-} {-#LANGUAGE ScopedTypeVariables #-} {-#LANGUAGE DeriveGeneric #-}+{-#LANGUAGE FlexibleInstances #-}+{-#LANGUAGE MultiParamTypeClasses #-} -- | Ginger parser. module Text.Ginger.Parse ( parseGinger , parseGingerFile+, parseGinger'+, parseGingerFile' , ParserError (..)+, ParserOptions (..)+, mkParserOptions , formatParserError , IncludeResolver , Source, SourceName+, SourcePos+, sourceLine+, sourceColumn+, sourceName ) where  import Text.Parsec ( ParseError+                   , SourcePos+                   , SourceName (..)                    , sourceLine                    , sourceColumn                    , sourceName@@ -27,6 +39,7 @@                    , digit                    , getState, modifyState, putState                    , (<?>)+                   , getPosition                    ) import Text.Parsec.Error ( errorMessages                          , errorPos@@ -34,6 +47,7 @@                          ) import Text.Ginger.AST import Text.Ginger.Html ( unsafeRawHtml )+import Text.Ginger.GVal (GVal, ToGVal (..), dict, (~>))  import Control.Monad (when) import Control.Monad.Reader ( ReaderT@@ -63,23 +77,24 @@ -- | Input type for the parser (source code). type Source = String --- | A source identifier (typically a filename).-type SourceName = String- -- | Used to resolve includes. Ginger will call this function whenever it -- encounters an {% include %}, {% import %}, or {% extends %} directive. -- If the required source code is not available, the resolver should return -- @Nothing@, else @Just@ the source. type IncludeResolver m = SourceName -> m (Maybe Source) +instance ToGVal m SourcePos where+    toGVal p =+        dict [ "name" ~> sourceName p+             , "line" ~> sourceLine p+             , "column" ~> sourceColumn p+             ]  -- | Error information for Ginger parser errors. data ParserError =     ParserError         { peErrorMessage :: String -- ^ Human-readable error message-        , peSourceName :: Maybe SourceName -- ^ Source name, if any-        , peSourceLine :: Maybe Int -- ^ Line number, if available-        , peSourceColumn :: Maybe Int -- ^ Column number, if available+        , peSourcePosition :: Maybe SourcePos         }         deriving (Show, Generic) @@ -89,15 +104,17 @@ formatParserError :: Maybe String -> ParserError -> String formatParserError tplSrc e =     let sourceLocation = do-            printf "%s:%i:%i\n"-                <$> peSourceName e-                <*> peSourceLine e-                <*> peSourceColumn e+            pos <- peSourcePosition e+            return $ printf "%s:%i:%i\n"+                (sourceName pos)+                (sourceLine pos)+                (sourceColumn pos)         markerLines = do             sourceLines <- lines <$> tplSrc-            lineNum <- peSourceLine e+            pos <- peSourcePosition e+            let lineNum = sourceLine pos             offendingLine <- listToMaybe . drop (pred lineNum) $ sourceLines-            offendingColumn <- peSourceColumn e <|> Just 1+            let offendingColumn = sourceColumn pos             return . unlines $                 [ offendingLine                 , (replicate (pred offendingColumn) ' ') <> "^"@@ -112,11 +129,7 @@ -- | Helper function to create a Ginger parser error from a Parsec error. fromParsecError :: ParseError -> ParserError fromParsecError e =-    let pos = errorPos e-        sourceFilename =-            let sn = sourceName pos-            in if null sn then Nothing else Just sn-    in ParserError+    ParserError         (dropWhile (== '\n') .             showErrorMessages             "or"@@ -125,33 +138,77 @@             "unexpected"             "end of input"             $ errorMessages e)-        sourceFilename-        (Just $ sourceLine pos)-        (Just $ sourceColumn pos)+        (Just $ errorPos e)+ -- | Parse Ginger source from a file.-parseGingerFile :: Monad m => IncludeResolver m -> SourceName -> m (Either ParserError Template)-parseGingerFile resolve fn = do+parseGingerFile :: forall m. Monad m => IncludeResolver m -> SourceName -> m (Either ParserError (Template SourcePos))+parseGingerFile resolver sourceName =+    parseGingerFile' opts sourceName+    where+        opts :: ParserOptions m+        opts =+            (mkParserOptions resolver)+                { poSourceName = Just sourceName }++-- | Parse Ginger source from memory.+parseGinger :: forall m. Monad m => IncludeResolver m -> Maybe SourceName -> Source -> m (Either ParserError (Template SourcePos))+parseGinger resolver sourceName source =+    parseGinger' opts source+    where+        opts :: ParserOptions m+        opts =+            (mkParserOptions resolver)+                { poSourceName = sourceName }++-- | Parse Ginger source from a file.+parseGingerFile' :: Monad m => ParserOptions m -> SourceName -> m (Either ParserError (Template SourcePos))+parseGingerFile' opts' fn = do+    let opts = opts' { poSourceName = Just fn }+    let resolve = poIncludeResolver opts     srcMay <- resolve fn     case srcMay of         Nothing -> return . Left $             ParserError                 { peErrorMessage = "Template source not found: " ++ fn-                , peSourceName = Nothing-                , peSourceLine = Nothing-                , peSourceColumn = Nothing+                , peSourcePosition = Nothing                 }-        Just src -> parseGinger resolve (Just fn) src+        Just src -> parseGinger' opts src +-- | Parse Ginger source from memory.+parseGinger' :: Monad m => ParserOptions m -> Source -> m (Either ParserError (Template SourcePos))+parseGinger' opts src = do+    result <-+        runReaderT+            ( runParserT+                (templateP `before` eof)+                defParseState+                (fromMaybe "<<unknown>>" $ poSourceName opts)+                src+            )+            opts+    case result of+        Right t -> return . Right $ t+        Left e -> return . Left $ fromParsecError e -data ParseContext m-    = ParseContext-        { pcResolve :: IncludeResolver m-        , pcCurrentSource :: Maybe SourceName++data ParserOptions m+    = ParserOptions+        { poIncludeResolver :: IncludeResolver m+        , poSourceName :: Maybe SourceName+        , poKeepTrailingNewline :: Bool         } +mkParserOptions :: Monad m => IncludeResolver m -> ParserOptions m+mkParserOptions resolver =+    ParserOptions+        { poIncludeResolver = resolver+        , poSourceName = Nothing+        , poKeepTrailingNewline = False+        }+ data ParseState     = ParseState-        { psBlocks :: HashMap VarName Block+        { psBlocks :: HashMap VarName (Block SourcePos)         , psStripIndent :: String         } @@ -162,75 +219,83 @@         , psStripIndent = ""         } --- | Parse Ginger source from memory.-parseGinger :: Monad m => IncludeResolver m -> Maybe SourceName -> Source -> m (Either ParserError Template)-parseGinger resolve sn src = do-    result <- runReaderT (runParserT (templateP `before` eof) defParseState (fromMaybe "<<unknown>>" sn) src) (ParseContext resolve sn)-    case result of-        Right t -> return . Right $ t-        Left e -> return . Left $ fromParsecError e--type Parser m a = ParsecT String ParseState (ReaderT (ParseContext m) m) a+type Parser m a = ParsecT String ParseState (ReaderT (ParserOptions m) m) a  ignore :: Monad m => m a -> m () ignore = (>> return ())  getResolver :: Monad m => Parser m (IncludeResolver m)-getResolver = asks pcResolve+getResolver = asks poIncludeResolver -include :: Monad m => SourceName -> Parser m Statement-include sourceName = PreprocessedIncludeS <$> includeTemplate sourceName+include :: Monad m => SourceName -> Parser m (Statement SourcePos)+include sourceName =+  PreprocessedIncludeS+    <$> getPosition+    <*> includeTemplate sourceName  -- include sourceName = templateBody <$> includeTemplate sourceName -includeTemplate :: Monad m => SourceName -> Parser m Template+includeTemplate :: Monad m => SourceName -> Parser m (Template SourcePos) includeTemplate sourceName = do     resolver <- getResolver-    currentSource <- fromMaybe "" <$> asks pcCurrentSource+    currentSource <- fromMaybe "" <$> asks poSourceName     let includeSourceName = takeDirectory currentSource </> sourceName     pres <- lift . lift $ parseGingerFile resolver includeSourceName     case pres of         Right t -> return t         Left err -> fail (show err) -reduceStatements :: [Statement] -> Statement-reduceStatements [] = NullS-reduceStatements [x] = x-reduceStatements xs = MultiS xs+reduceStatements :: SourcePos -> [(Statement SourcePos)] -> (Statement SourcePos)+reduceStatements pos [] = NullS pos+reduceStatements pos [x] = x+reduceStatements pos xs = MultiS pos xs -templateP :: Monad m => Parser m Template+templateP :: Monad m => Parser m (Template SourcePos) templateP = derivedTemplateP <|> baseTemplateP -derivedTemplateP :: Monad m => Parser m Template+derivedTemplateP :: Monad m => Parser m (Template SourcePos) derivedTemplateP = do+    pos <- getPosition     parentName <- try (spaces >> fancyTagP "extends" stringLiteralP)     parentTemplate <- includeTemplate parentName     topLevelBlocks <- HashMap.fromList <$> many blockP     nestedBlocks <- psBlocks <$> getState     let blocks = topLevelBlocks <> nestedBlocks-    return Template { templateBody = NullS, templateParent = Just parentTemplate, templateBlocks = blocks }+    return+        Template+            { templateBody = NullS pos+            , templateParent = Just parentTemplate+            , templateBlocks = blocks+            } -baseTemplateP :: Monad m => Parser m Template+baseTemplateP :: Monad m => Parser m (Template SourcePos) baseTemplateP = do     body <- statementsP     blocks <- psBlocks <$> getState-    return Template { templateBody = body, templateParent = Nothing, templateBlocks = blocks }+    return+        Template+            { templateBody = body+            , templateParent = Nothing+            , templateBlocks = blocks+            } -isNullS NullS = True+isNullS (NullS _) = True isNullS _ = False -statementsP :: Monad m => Parser m Statement-statementsP =-    reduceStatements . filter (not . isNullS) <$> many (try statementP)+statementsP :: Monad m => Parser m (Statement SourcePos)+statementsP = do+    pos <- getPosition+    reduceStatements pos . filter (not . isNullS) <$> many (try statementP) -scriptStatementsP :: Monad m => Parser m Statement+scriptStatementsP :: Monad m => Parser m (Statement SourcePos) scriptStatementsP = do     spacesOrComment-    reduceStatements . filter (not . isNullS) <$>+    pos <- getPosition+    reduceStatements pos . filter (not . isNullS) <$>         many (try scriptStatementP)  -scriptStatementBlockP :: Monad m => Parser m Statement+scriptStatementBlockP :: Monad m => Parser m (Statement SourcePos) scriptStatementBlockP = do     char '{'     spacesOrComment@@ -239,7 +304,7 @@     spacesOrComment     return inner -statementP :: Monad m => Parser m Statement+statementP :: Monad m => Parser m (Statement SourcePos) statementP = interpolationStmtP            <|> commentStmtP            <|> tryCatchStmtP@@ -256,7 +321,7 @@            <|> scriptStmtP            <|> literalStmtP -scriptStatementP :: Monad m => Parser m Statement+scriptStatementP :: Monad m => Parser m (Statement SourcePos) scriptStatementP = scriptStatementBlockP                  <|> scriptEchoStmtP                  <|> scriptIfStmtP@@ -268,17 +333,19 @@                  <|> scriptScopeStmtP                  <|> scriptExprStmtP -interpolationStmtP :: Monad m => Parser m Statement+interpolationStmtP :: Monad m => Parser m (Statement SourcePos) interpolationStmtP = do+    pos <- getPosition     try openInterpolationP     spacesOrComment     expr <- expressionP     spacesOrComment     closeInterpolationP-    return $ InterpolationS expr+    return $ InterpolationS pos expr -scriptEchoStmtP :: Monad m => Parser m Statement+scriptEchoStmtP :: Monad m => Parser m (Statement SourcePos) scriptEchoStmtP = do+    pos <- getPosition     try $ keyword "echo"     spacesOrComment     char '('@@ -288,15 +355,16 @@     spacesOrComment     char ';'     spacesOrComment-    return $ InterpolationS expr+    return $ InterpolationS pos expr -literalStmtP :: Monad m => Parser m Statement+literalStmtP :: Monad m => Parser m (Statement SourcePos) literalStmtP = do+    pos <- getPosition     txt <- manyTill literalCharP endOfLiteralP      case txt of         [] -> unexpected "{{"-        _ -> return . LiteralS . unsafeRawHtml . Text.pack $ txt+        _ -> return . LiteralS pos . unsafeRawHtml . Text.pack $ txt  literalCharP :: Monad m => Parser m Char literalCharP =@@ -316,15 +384,16 @@     (ignore . lookAhead $ openCommentP) <|>     eof -commentStmtP :: Monad m => Parser m Statement+commentStmtP :: Monad m => Parser m (Statement SourcePos) commentStmtP = do+    pos <- getPosition     try openCommentP     manyTill         (   (noneOf "#" *> return ())         <|> (try $ char '#' *> notFollowedBy (char '}'))         )         (try closeCommentP)-    return NullS+    return $ NullS pos  scriptCommentP :: Monad m => Parser m () scriptCommentP = do@@ -337,46 +406,50 @@     many $ scriptCommentP <|> (oneOf " \t\r\n" *> return ())     return () -scriptExprStmtP :: Monad m => Parser m Statement+scriptExprStmtP :: Monad m => Parser m (Statement SourcePos) scriptExprStmtP = do+    pos <- getPosition     expr <- try $ expressionP     char ';'     spacesOrComment-    return $ ExpressionS expr+    return $ ExpressionS pos expr  endl :: Monad m => Parser m Char endl = char '\n' <|> (char '\r' >> char '\n') -scriptStmtP :: Monad m => Parser m Statement+scriptStmtP :: Monad m => Parser m (Statement SourcePos) scriptStmtP =     between         (try $ simpleTagP "script")         (simpleTagP "endscript")         scriptStatementsP -ifStmtP :: Monad m => Parser m Statement+ifStmtP :: Monad m => Parser m (Statement SourcePos) ifStmtP = do+    pos <- getPosition     condExpr <- fancyTagP "if" expressionP     trueStmt <- statementsP-    falseStmt <- elifBranchP <|> elseBranchP <|> return NullS+    falseStmt <- elifBranchP <|> elseBranchP <|> (NullS <$> getPosition)     simpleTagP "endif"-    return $ IfS condExpr trueStmt falseStmt+    return $ IfS pos condExpr trueStmt falseStmt -elseBranchP :: Monad m => Parser m Statement+elseBranchP :: Monad m => Parser m (Statement SourcePos) elseBranchP = do     try $ simpleTagP "else"     statementsP -elifBranchP :: Monad m => Parser m Statement+elifBranchP :: Monad m => Parser m (Statement SourcePos) elifBranchP = do+    pos <- getPosition     condExpr <- try $ fancyTagP "elif" expressionP     trueStmt <- statementsP-    falseStmt <- elifBranchP <|> elseBranchP <|> return NullS+    falseStmt <- elifBranchP <|> elseBranchP <|> (NullS <$> getPosition)     -- No endif here: the parent {% if %} owns that one.-    return $ IfS condExpr trueStmt falseStmt+    return $ IfS pos condExpr trueStmt falseStmt -scriptIfStmtP :: Monad m => Parser m Statement+scriptIfStmtP :: Monad m => Parser m (Statement SourcePos) scriptIfStmtP = do+    pos <- getPosition     try $ keyword "if"     spacesOrComment     char '('@@ -386,17 +459,18 @@     spacesOrComment     trueStmt <- scriptStatementP     spacesOrComment-    falseStmt <- scriptElifP <|> scriptElseP <|> return NullS-    return $ IfS condExpr trueStmt falseStmt+    falseStmt <- scriptElifP <|> scriptElseP <|> (NullS <$> getPosition)+    return $ IfS pos condExpr trueStmt falseStmt -scriptElseP :: Monad m => Parser m Statement+scriptElseP :: Monad m => Parser m (Statement SourcePos) scriptElseP = do     try $ keyword "else"     spacesOrComment     scriptStatementP -scriptElifP :: Monad m => Parser m Statement+scriptElifP :: Monad m => Parser m (Statement SourcePos) scriptElifP = do+    pos <- getPosition     try $ keyword "elif"     spacesOrComment     char '('@@ -407,19 +481,20 @@     spacesOrComment     trueStmt <- scriptStatementP     spacesOrComment-    falseStmt <- scriptElifP <|> scriptElseP <|> return NullS-    return $ IfS condExpr trueStmt falseStmt+    falseStmt <- scriptElifP <|> scriptElseP <|> (NullS <$> getPosition)+    return $ IfS pos condExpr trueStmt falseStmt -tryCatchStmtP :: Monad m => Parser m Statement+tryCatchStmtP :: Monad m => Parser m (Statement SourcePos) tryCatchStmtP = do+    pos <- getPosition     try $ simpleTagP "try"     tryS <- statementsP     catchesS <- many catchBranchP-    finallyS <- finallyBranchP <|> return NullS+    finallyS <- finallyBranchP <|> (NullS <$> getPosition)     simpleTagP "endtry"-    return $ TryCatchS tryS catchesS finallyS+    return $ TryCatchS pos tryS catchesS finallyS -catchBranchP :: Monad m => Parser m CatchBlock+catchBranchP :: Monad m => Parser m (CatchBlock SourcePos) catchBranchP = do     (what, captureName) <- try $         fancyTagP "catch" (try catchHeaderP <|> return (Nothing, Nothing))@@ -451,35 +526,36 @@     spaces     identifierP -finallyBranchP :: Monad m => Parser m Statement+finallyBranchP :: Monad m => Parser m (Statement SourcePos) finallyBranchP = do     try $ simpleTagP "finally"     statementsP  -- TODO: try/catch/finally in script mode --switchStmtP :: Monad m => Parser m Statement+switchStmtP :: Monad m => Parser m (Statement SourcePos) switchStmtP = do+    pos <- getPosition     pivotExpr <- try $ fancyTagP "switch" expressionP     cases <- many switchCaseP-    def <- option NullS $ switchDefaultP+    def <- switchDefaultP <|> (NullS <$> getPosition)     simpleTagP "endswitch"-    return $ SwitchS pivotExpr cases def+    return $ SwitchS pos pivotExpr cases def -switchCaseP :: Monad m => Parser m (Expression, Statement)+switchCaseP :: Monad m => Parser m ((Expression SourcePos), (Statement SourcePos)) switchCaseP = do     cmpExpr <- try $ fancyTagP "case" expressionP     body <- statementsP     simpleTagP "endcase"     return (cmpExpr, body) -switchDefaultP :: Monad m => Parser m Statement+switchDefaultP :: Monad m => Parser m (Statement SourcePos) switchDefaultP = do     try (simpleTagP "default") *> statementsP <* simpleTagP "enddefault" -scriptSwitchStmtP :: Monad m => Parser m Statement+scriptSwitchStmtP :: Monad m => Parser m (Statement SourcePos) scriptSwitchStmtP = do+    pos <- getPosition     try $ keyword "switch"     spacesOrComment     char '('@@ -491,13 +567,13 @@     char '{'     spacesOrComment     cases <- many scriptSwitchCaseP-    def <- option NullS $ scriptSwitchDefaultP+    def <- scriptSwitchDefaultP <|> (NullS <$> getPosition)     spacesOrComment     char '}'     spacesOrComment-    return $ SwitchS pivotExpr cases def+    return $ SwitchS pos pivotExpr cases def -scriptSwitchCaseP :: Monad m => Parser m (Expression, Statement)+scriptSwitchCaseP :: Monad m => Parser m ((Expression SourcePos), (Statement SourcePos)) scriptSwitchCaseP = do     try $ keyword "case"     spacesOrComment@@ -509,7 +585,7 @@     spacesOrComment     return (cmpExpr, body) -scriptSwitchDefaultP :: Monad m => Parser m Statement+scriptSwitchDefaultP :: Monad m => Parser m (Statement SourcePos) scriptSwitchDefaultP = do     try $ keyword "default"     spacesOrComment@@ -519,21 +595,24 @@     spacesOrComment     return body -setStmtP :: Monad m => Parser m Statement-setStmtP = fancyTagP "set" setStmtInnerP+setStmtP :: Monad m => Parser m (Statement SourcePos)+setStmtP = do+    pos <- getPosition+    fancyTagP "set" (setStmtInnerP pos) -setStmtInnerP :: Monad m => Parser m Statement-setStmtInnerP = do+setStmtInnerP :: Monad m => SourcePos -> Parser m (Statement SourcePos)+setStmtInnerP pos = do     name <- identifierP     spacesOrComment     char '='     spacesOrComment     val <- expressionP     spacesOrComment-    return $ SetVarS name val+    return $ SetVarS pos name val -scriptSetStmtP :: Monad m => Parser m Statement+scriptSetStmtP :: Monad m => Parser m (Statement SourcePos) scriptSetStmtP = do+    pos <- getPosition     try $ keyword "set"     spacesOrComment     name <- identifierP@@ -544,34 +623,37 @@     spacesOrComment     char ';'     spacesOrComment-    return $ SetVarS name val+    return $ SetVarS pos name val -defineBlock :: VarName -> Block -> ParseState -> ParseState+defineBlock :: VarName -> Block SourcePos -> ParseState -> ParseState defineBlock name block s =     s { psBlocks = HashMap.insert name block (psBlocks s) } -blockStmtP :: Monad m => Parser m Statement+blockStmtP :: Monad m => Parser m (Statement SourcePos) blockStmtP = do+    pos <- getPosition     (name, block) <- blockP     modifyState (defineBlock name block)-    return $ BlockRefS name+    return $ BlockRefS pos name -blockP :: Monad m => Parser m (VarName, Block)+blockP :: Monad m => Parser m (VarName, (Block SourcePos)) blockP = do     name <- fancyTagP "block" identifierP     body <- statementsP     fancyTagP "endblock" (optional $ string (Text.unpack name) >> spacesOrComment)     return (name, Block body) -macroStmtP :: Monad m => Parser m Statement+macroStmtP :: Monad m => Parser m (Statement SourcePos) macroStmtP = do+    pos <- getPosition     (name, args) <- try $ fancyTagP "macro" macroHeadP     body <- statementsP     fancyTagP "endmacro" (optional $ string (Text.unpack name) >> spacesOrComment)-    return $ DefMacroS name (Macro args body)+    return $ DefMacroS pos name (Macro args body) -scriptMacroStmtP :: Monad m => Parser m Statement+scriptMacroStmtP :: Monad m => Parser m (Statement SourcePos) scriptMacroStmtP = do+    pos <- getPosition     try $ keyword "macro"     spacesOrComment     name <- identifierP@@ -580,7 +662,7 @@     spacesOrComment     body <- scriptStatementP     spacesOrComment-    return $ DefMacroS name (Macro args body)+    return $ DefMacroS pos name (Macro args body)  macroHeadP :: Monad m => Parser m (VarName, [VarName]) macroHeadP = do@@ -599,18 +681,20 @@ -- {% set caller = __lambda %} -- {{ bar(baz) }} -- {% endscope %]-callStmtP :: Monad m => Parser m Statement+callStmtP :: Monad m => Parser m (Statement SourcePos) callStmtP = do+    pos <- getPosition     (callerArgs, call) <- try $ fancyTagP "call" callHeadP     body <- statementsP     simpleTagP "endcall"     return (-        ScopedS (-            MultiS [ DefMacroS "caller" (Macro callerArgs body)-                   , InterpolationS call-                   ]))+        ScopedS pos (+            MultiS pos+                [ DefMacroS pos "caller" (Macro callerArgs body)+                , InterpolationS pos call+                ])) -callHeadP :: Monad m => Parser m ([Text], Expression)+callHeadP :: Monad m => Parser m ([Text], (Expression SourcePos)) callHeadP = do     callerArgs <- option [] $ groupP "(" ")" identifierP     spacesOrComment@@ -618,16 +702,18 @@     spacesOrComment     return (callerArgs, call) -scopeStmtP :: Monad m => Parser m Statement+scopeStmtP :: Monad m => Parser m (Statement SourcePos) scopeStmtP =-    ScopedS <$>-        between+    ScopedS+        <$> getPosition+        <*> between             (try $ simpleTagP "scope")             (simpleTagP "endscope")             statementsP -indentStmtP :: Monad m => Parser m Statement+indentStmtP :: Monad m => Parser m (Statement SourcePos) indentStmtP = do+    pos <- getPosition     indentExpr <- try $ fancyTagP "indent" indentHeadP     preIndent <- many (oneOf " \t")     oldState <- getState@@ -636,34 +722,37 @@     body <- statementsP     putState oldState     simpleTagP "endindent"-    return $ IndentS indentExpr body+    return $ IndentS pos indentExpr body -indentHeadP :: Monad m => Parser m Expression+indentHeadP :: Monad m => Parser m (Expression SourcePos) indentHeadP =-    (expressionP <|> return (StringLiteralE "  ")) <* spacesOrComment+    (expressionP <|> (StringLiteralE <$> getPosition <*> pure "  ")) <* spacesOrComment -scriptScopeStmtP :: Monad m => Parser m Statement+scriptScopeStmtP :: Monad m => Parser m (Statement SourcePos) scriptScopeStmtP = do+    pos <- getPosition     try $ keyword "scope"     spacesOrComment-    ScopedS <$> scriptStatementP+    ScopedS pos <$> scriptStatementP -forStmtP :: Monad m => Parser m Statement+forStmtP :: Monad m => Parser m (Statement SourcePos) forStmtP = do+    pos <- getPosition     (iteree, varNameVal, varNameIndex) <- fancyTagP "for" forHeadP     body <- statementsP     elseBranchMay <- optionMaybe $ do         try $ simpleTagP "else"         statementsP     simpleTagP "endfor"-    let forLoop = ForS varNameIndex varNameVal iteree body+    let forLoop = ForS pos varNameIndex varNameVal iteree body     return $ maybe         forLoop-        (IfS iteree forLoop)+        (IfS pos iteree forLoop)         elseBranchMay -scriptForStmtP :: Monad m => Parser m Statement+scriptForStmtP :: Monad m => Parser m (Statement SourcePos) scriptForStmtP = do+    pos <- getPosition     try $ keyword "for"     spacesOrComment     char '('@@ -676,18 +765,18 @@         try $ keyword "else"         spacesOrComment         scriptStatementP-    let forLoop = ForS varNameIndex varNameVal iteree body+    let forLoop = ForS pos varNameIndex varNameVal iteree body     return $ maybe         forLoop-        (IfS iteree forLoop)+        (IfS pos iteree forLoop)         elseBranchMay -includeP :: Monad m => Parser m Statement+includeP :: Monad m => Parser m (Statement SourcePos) includeP = do     sourceName <- fancyTagP "include" stringLiteralP     include sourceName -scriptIncludeP :: Monad m => Parser m Statement+scriptIncludeP :: Monad m => Parser m (Statement SourcePos) scriptIncludeP = do     try $ keyword "include"     spacesOrComment@@ -700,7 +789,7 @@     spacesOrComment     include sourceName -forHeadP :: Monad m => Parser m (Expression, VarName, Maybe VarName)+forHeadP :: Monad m => Parser m ((Expression SourcePos), VarName, Maybe VarName) forHeadP =     (try forHeadInP <|> forHeadAsP) <* optional (keyword "recursive" >>spacesOrComment) @@ -723,7 +812,7 @@     spacesOrComment     return (varIdent, Nothing) -forHeadInP :: Monad m => Parser m (Expression, VarName, Maybe VarName)+forHeadInP :: Monad m => Parser m ((Expression SourcePos), VarName, Maybe VarName) forHeadInP = do     (varIdent, indexIdent) <- forIteratorP     spacesOrComment@@ -732,7 +821,7 @@     iteree <- expressionP     return (iteree, varIdent, indexIdent) -forHeadAsP :: Monad m => Parser m (Expression, VarName, Maybe VarName)+forHeadAsP :: Monad m => Parser m ((Expression SourcePos), VarName, Maybe VarName) forHeadAsP = do     iteree <- expressionP     spacesOrComment@@ -769,7 +858,12 @@ openTagP = openP '%'  closeTagP :: Monad m => Parser m ()-closeTagP = closeP '%'+closeTagP = do+    closeP '%'+    keepTrailingNewline <- asks poKeepTrailingNewline+    when+        (not keepTrailingNewline)+        (ignore . optional $ literalNewlineP)  openP :: Monad m => Char -> Parser m () openP c = try (openWP c) <|> try (openNWP c)@@ -798,13 +892,13 @@ closeNWP c = ignore $ do     spacesOrComment     string [ c, '}' ]-    optional . ignore $ literalNewlineP -expressionP :: Monad m => Parser m Expression+expressionP :: Monad m => Parser m (Expression SourcePos) expressionP = lambdaExprP <|> ternaryExprP -lambdaExprP :: Monad m => Parser m Expression+lambdaExprP :: Monad m => Parser m (Expression SourcePos) lambdaExprP = do+    pos <- getPosition     argNames <- try $ do         char '('         spacesOrComment@@ -815,54 +909,57 @@         spacesOrComment         return argNames     body <- expressionP-    return $ LambdaE argNames body+    return $ LambdaE pos argNames body -operativeExprP :: forall m. Monad m => Parser m Expression -> [ (String, Text) ] -> Parser m Expression+operativeExprP :: forall m. Monad m => Parser m (Expression SourcePos) -> [ (String, Text) ] -> Parser m (Expression SourcePos) operativeExprP operandP operators = do+    pos0 <- getPosition     lhs <- operandP     spacesOrComment-    tails <- many . try $ operativeTail+    tails <- many . try $ operativeTail pos0     return $ foldl (flip ($)) lhs tails     where         opChars :: [Char]         opChars = nub . sort . concatMap fst $ operators-        operativeTail :: Parser m (Expression -> Expression)-        operativeTail = do+        operativeTail :: SourcePos -> Parser m (Expression SourcePos -> Expression SourcePos)+        operativeTail pos0 = do+            pos <- getPosition             funcName <-                 foldl (<|>) (fail "operator")                     [ try (string op >> notFollowedBy (oneOf opChars)) >> return fn | (op, fn) <- operators ]             spacesOrComment             rhs <- operandP             spacesOrComment-            return (\lhs -> CallE (VarE funcName) [(Nothing, lhs), (Nothing, rhs)])+            return (\lhs -> CallE pos0 (VarE pos funcName) [(Nothing, lhs), (Nothing, rhs)]) -ternaryExprP :: Monad m => Parser m Expression+ternaryExprP :: Monad m => Parser m (Expression SourcePos) ternaryExprP = do+    pos <- getPosition     expr1 <- booleanExprP     spacesOrComment-    cTernaryTailP expr1 <|> pyTernaryTailP expr1 <|> return expr1+    cTernaryTailP pos expr1 <|> pyTernaryTailP pos expr1 <|> return expr1 -cTernaryTailP :: Monad m => Expression -> Parser m Expression-cTernaryTailP condition = do+cTernaryTailP :: Monad m => SourcePos -> (Expression SourcePos) -> Parser m (Expression SourcePos)+cTernaryTailP pos condition = do     char '?'     spacesOrComment     yesBranch <- expressionP     char ':'     spacesOrComment     noBranch <- expressionP-    return $ TernaryE condition yesBranch noBranch+    return $ TernaryE pos condition yesBranch noBranch -pyTernaryTailP :: Monad m => Expression -> Parser m Expression-pyTernaryTailP yesBranch = do+pyTernaryTailP :: Monad m => SourcePos -> (Expression SourcePos) -> Parser m (Expression SourcePos)+pyTernaryTailP pos yesBranch = do     keyword "if"     spacesOrComment     condition <- booleanExprP     keyword "else"     spacesOrComment     noBranch <- expressionP-    return $ TernaryE condition yesBranch noBranch+    return $ TernaryE pos condition yesBranch noBranch -booleanExprP :: Monad m => Parser m Expression+booleanExprP :: Monad m => Parser m (Expression SourcePos) booleanExprP =     operativeExprP         comparativeExprP@@ -870,7 +967,7 @@         , ("&&", "all")         ] -comparativeExprP :: Monad m => Parser m Expression+comparativeExprP :: Monad m => Parser m (Expression SourcePos) comparativeExprP =     operativeExprP         additiveExprP@@ -882,7 +979,7 @@         , ("<", "less")         ] -additiveExprP :: Monad m => Parser m Expression+additiveExprP :: Monad m => Parser m (Expression SourcePos) additiveExprP =     operativeExprP         multiplicativeExprP@@ -891,7 +988,7 @@         , ("~", "concat")         ] -multiplicativeExprP :: Monad m => Parser m Expression+multiplicativeExprP :: Monad m => Parser m (Expression SourcePos) multiplicativeExprP =     operativeExprP         postfixExprP@@ -901,72 +998,77 @@         , ("%", "modulo")         ] -postfixExprP :: Monad m => Parser m Expression+postfixExprP :: Monad m => Parser m (Expression SourcePos) postfixExprP = do+    pos <- getPosition     base <- atomicExprP     spacesOrComment-    postfixes <- many . try $ postfixP `before`spacesOrComment+    postfixes <- many . try $ postfixP pos `before`spacesOrComment     return $ foldl (flip ($)) base postfixes -postfixP :: Monad m => Parser m (Expression -> Expression)-postfixP = dotPostfixP-         <|> arrayAccessP-         <|> funcCallP-         <|> filterP+postfixP :: Monad m => SourcePos -> Parser m ((Expression SourcePos) -> (Expression SourcePos))+postfixP pos = dotPostfixP pos+             <|> arrayAccessP+             <|> funcCallP+             <|> filterP -dotPostfixP :: Monad m => Parser m (Expression -> Expression)-dotPostfixP = do+dotPostfixP :: Monad m => SourcePos -> Parser m ((Expression SourcePos) -> (Expression SourcePos))+dotPostfixP pos = do     char '.'     spacesOrComment-    i <- StringLiteralE <$> identifierP-    return $ \e -> MemberLookupE e i+    i <- StringLiteralE <$> getPosition <*> identifierP+    return $ \e -> MemberLookupE pos e i -arrayAccessP :: Monad m => Parser m (Expression -> Expression)+arrayAccessP :: Monad m => Parser m ((Expression SourcePos) -> (Expression SourcePos)) arrayAccessP = do-    bracedP "[" "]" inner+    pos <- getPosition+    bracedP "[" "]" (inner pos)     where-        inner = try sliceInner <|> indexInner-        sliceInner = do-            offset <- option NullLiteralE (try expressionP)+        inner pos = try (sliceInner pos) <|> indexInner pos+        sliceInner pos = do+            offset <- try expressionP <|> (NullLiteralE <$> getPosition)             char ':'-            length <- option NullLiteralE (try expressionP)+            length <- try expressionP <|> (NullLiteralE <$> getPosition)             return $ \e ->                 CallE-                    (VarE "slice")+                    pos+                    (VarE pos "slice")                     [ (Nothing, e)                     , (Nothing, offset)                     , (Nothing, length)                     ]-        indexInner = do+        indexInner pos = do             i <- expressionP-            return $ \e -> MemberLookupE e i+            return $ \e -> MemberLookupE pos e i -funcCallP :: Monad m => Parser m (Expression -> Expression)+funcCallP :: Monad m => Parser m ((Expression SourcePos) -> (Expression SourcePos)) funcCallP = do+    pos <- getPosition     args <- groupP "(" ")" funcArgP-    return $ \e -> CallE e args+    return $ \e -> CallE pos e args -funcArgP :: Monad m => Parser m (Maybe Text, Expression)+funcArgP :: Monad m => Parser m (Maybe Text, (Expression SourcePos)) funcArgP = namedFuncArgP <|> positionalFuncArgP -namedFuncArgP :: Monad m => Parser m (Maybe Text, Expression)+namedFuncArgP :: Monad m => Parser m (Maybe Text, (Expression SourcePos)) namedFuncArgP = do     name <- try $ identifierP `before` between spacesOrComment spacesOrComment (string "=")     expr <- expressionP     return (Just name, expr) -positionalFuncArgP :: Monad m => Parser m (Maybe Text, Expression)+positionalFuncArgP :: Monad m => Parser m (Maybe Text, (Expression SourcePos)) positionalFuncArgP = try $ (Nothing,) <$> expressionP -filterP :: Monad m => Parser m (Expression -> Expression)+filterP :: Monad m => Parser m ((Expression SourcePos) -> (Expression SourcePos)) filterP = do+    pos <- getPosition     char '|'     spacesOrComment     func <- atomicExprP     args <- option [] $ groupP "(" ")" funcArgP-    return $ \e -> CallE func ((Nothing, e):args)+    return $ \e -> CallE pos func ((Nothing, e):args) -atomicExprP :: Monad m => Parser m Expression+atomicExprP :: Monad m => Parser m (Expression SourcePos) atomicExprP = doExprP             <|> parenthesizedExprP             <|> objectExprP@@ -975,28 +1077,34 @@             <|> numberLiteralExprP             <|> varExprP -parenthesizedExprP :: Monad m => Parser m Expression+parenthesizedExprP :: Monad m => Parser m (Expression SourcePos) parenthesizedExprP =     between         (try . ignore $ char '(' >> spacesOrComment)         (ignore $ char ')' >> spacesOrComment)         expressionP -doExprP :: Monad m => Parser m Expression+doExprP :: Monad m => Parser m (Expression SourcePos) doExprP = do+    pos <- getPosition     try $ keyword "do"     spacesOrComment     stmt <- scriptStatementP     spacesOrComment-    return $ DoE stmt+    return $ DoE pos stmt -listExprP :: Monad m => Parser m Expression-listExprP = ListE <$> groupP "[" "]" expressionP+listExprP :: Monad m => Parser m (Expression SourcePos)+listExprP =+    ListE+        <$> getPosition+        <*> groupP "[" "]" expressionP -objectExprP :: Monad m => Parser m Expression-objectExprP = ObjectE <$> groupP "{" "}" expressionPairP+objectExprP :: Monad m => Parser m (Expression SourcePos)+objectExprP = ObjectE+    <$> getPosition+    <*> groupP "{" "}" expressionPairP -expressionPairP :: Monad m => Parser m (Expression, Expression)+expressionPairP :: Monad m => Parser m ((Expression SourcePos), (Expression SourcePos)) expressionPairP = do     a <- expressionP     spacesOrComment@@ -1017,15 +1125,16 @@         (try . ignore $ string obr >> spacesOrComment)         (ignore $ string cbr >> spacesOrComment) -varExprP :: Monad m => Parser m Expression+varExprP :: Monad m => Parser m (Expression SourcePos) varExprP = do+    pos <- getPosition     litName <- identifierP     spacesOrComment     return $ case litName of-        "true" -> BoolLiteralE True-        "false" -> BoolLiteralE False-        "null" -> NullLiteralE-        _ -> VarE litName+        "true" -> BoolLiteralE pos True+        "false" -> BoolLiteralE pos False+        "null" -> NullLiteralE pos+        _ -> VarE pos litName  identifierP :: Monad m => Parser m Text identifierP =@@ -1037,9 +1146,11 @@ identCharP :: Monad m => Parser m Char identCharP = oneOf (['a'..'z'] ++ ['A'..'Z'] ++ ['_'] ++ ['0'..'9']) -stringLiteralExprP :: Monad m => Parser m Expression+stringLiteralExprP :: Monad m => Parser m (Expression SourcePos) stringLiteralExprP =-    StringLiteralE . Text.pack <$> stringLiteralP+    StringLiteralE+      <$> getPosition+      <*> (Text.pack <$> stringLiteralP)  stringLiteralP :: Monad m => Parser m String stringLiteralP = do@@ -1062,13 +1173,14 @@                 _ -> return c2         _ -> return c1 -numberLiteralExprP :: Monad m => Parser m Expression+numberLiteralExprP :: Monad m => Parser m (Expression SourcePos) numberLiteralExprP = do+    pos <- getPosition     str <- numberLiteralP     let nMay :: Maybe Scientific         nMay = readMay str     case nMay of-        Just n -> return . NumberLiteralE $ n+        Just n -> return . NumberLiteralE pos $ n         Nothing -> fail $ "Failed to parse " ++ str ++ " as a number"  numberLiteralP :: Monad m => Parser m String

@@ -36,10 +36,13 @@ , makeContextM , makeContext' , makeContextM'+, makeContextExM' , makeContextHtml , makeContextHtmlM+, makeContextHtmlExM , makeContextText , makeContextTextM+, makeContextTextExM -- * The context type , GingerContext -- * The Run monad@@ -110,7 +113,13 @@ 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 :: forall m h p+              . ( Monoid h+                , Monad m+                , ToGVal (Run p m h) h+                , ToGVal (Run p m h) p+                )+             => [(Text, GVal (Run p m h))] defaultScope =     [ ("raw", fromFunction gfnRawHtml)     , ("abs", fromFunction . unaryNumericFunc 0 $ Prelude.abs)@@ -162,6 +171,7 @@     , ("urlencode", fromFunction gfnUrlEncode)     , ("upper", fromFunction . variadicStringFunc $ mconcat . Prelude.map Text.toUpper)     , ("lower", fromFunction . variadicStringFunc $ mconcat . Prelude.map Text.toLower)+    , ("throw", fromFunction gfnThrow)     ]  -- | Simplified interface to render a ginger template \"into\" a monad.@@ -172,13 +182,14 @@ easyRenderM :: ( Monad m                , ContextEncodable h                , Monoid h-               , ToGVal (Run m h) v-               , ToGVal (Run m h) h+               , ToGVal (Run p m h) v+               , ToGVal (Run p m h) h+               , ToGVal (Run p m h) p                )             => (h -> m ())             -> v-            -> Template-            -> m (Either RuntimeError (GVal (Run m h)))+            -> Template p+            -> m (Either (RuntimeError p) (GVal (Run p m h))) easyRenderM emit context template =     runGingerT (easyContext emit context) template @@ -189,11 +200,12 @@ -- dictionary-like object) by returning the concatenated output. easyRender :: ( ContextEncodable h               , Monoid h-              , ToGVal (Run (Writer h) h) v-              , ToGVal (Run (Writer h) h) h+              , ToGVal (Run p (Writer h) h) v+              , ToGVal (Run p (Writer h) h) h+              , ToGVal (Run p (Writer h) h) p               )            => v-           -> Template+           -> Template p            -> h easyRender context template =     execWriter $ easyRenderM tell context template@@ -201,53 +213,68 @@ -- | Purely expand a Ginger template. The underlying carrier monad is 'Writer' -- 'h', which is used to collect the output and render it into a 'h' -- value.-runGinger :: (ToGVal (Run (Writer h) h) h, Monoid h)-          => GingerContext (Writer h) h-          -> Template+runGinger :: ( ToGVal (Run p (Writer h) h) h+             , ToGVal (Run p (Writer h) h) p+             , Monoid h+             )+          => GingerContext p (Writer h) h+          -> Template p           -> h 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 (Either RuntimeError (GVal (Run m h)))+runGingerT :: ( ToGVal (Run p m h) h+              , ToGVal (Run p m h) p+              , Monoid h+              , Monad m+              , Applicative m+              , Functor m+              )+           => GingerContext p m h+           -> Template p+           -> m (Either (RuntimeError p) (GVal (Run p m h))) runGingerT context tpl =     runReaderT (evalStateT (runExceptT (runTemplate tpl)) (defRunState tpl)) context  -- | Find the effective base template of an inheritance chain-baseTemplate :: Template -> Template+baseTemplate :: Template p -> Template p baseTemplate t =     case templateParent t of         Nothing -> t         Just p -> baseTemplate p  -- | Run a template.-runTemplate :: (ToGVal (Run m h) h, Monoid h, Monad m, Functor m)-            => Template-            -> Run m h (GVal (Run m h))+runTemplate :: ( ToGVal (Run p m h) h+               , ToGVal (Run p m h) p+               , Monoid h+               , Monad m+               , Applicative m+               , Functor m+               )+            => Template p+            -> Run p m h (GVal (Run p 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, Applicative m, Functor m)+             => Template p+             -> Run p m h a+             -> Run p m h a withTemplate tpl a = do     oldTpl <- gets rsCurrentTemplate     oldBlockName <- gets rsCurrentBlockName     modify (\s -> s { rsCurrentTemplate = tpl, rsCurrentBlockName = Nothing })-    result <- a+    result <- withSourcePos (annotation tpl) a     modify (\s -> s { rsCurrentTemplate = oldTpl, rsCurrentBlockName = oldBlockName })     return result  -- | Run an action within a block context-withBlockName :: (Monad m, Functor m)+withBlockName :: (Monad m, Applicative m, Functor m)               => VarName-              -> Run m h a-              -> Run m h a+              -> Run p m h a+              -> Run p m h a withBlockName blockName a = do     oldBlockName <- gets rsCurrentBlockName     modify (\s -> s { rsCurrentBlockName = Just blockName })@@ -255,15 +282,15 @@     modify (\s -> s { rsCurrentBlockName = oldBlockName })     return result -lookupBlock :: (Monad m, Functor m) => VarName -> Run m h Block+lookupBlock :: (Monad m, Applicative m, Functor m) => VarName -> Run p m h (Block p) lookupBlock blockName = do     tpl <- gets rsCurrentTemplate     let blockMay = resolveBlock blockName tpl     case blockMay of-        Nothing -> throwError $ UndefinedBlockError blockName+        Nothing -> throwHere $ UndefinedBlockError blockName         Just block -> return block     where-        resolveBlock :: VarName -> Template -> Maybe Block+        resolveBlock :: VarName -> Template p -> Maybe (Block p)         resolveBlock name tpl =             case HashMap.lookup name (templateBlocks tpl) of                 Just block ->@@ -272,37 +299,52 @@                     templateParent tpl >>= resolveBlock name  -- | Run one statement.-runStatement :: forall m h-              . ( ToGVal (Run m h) h+runStatement :: forall m h p+              . ( ToGVal (Run p m h) h+                , ToGVal (Run p m h) p                 , Monoid h                 , Monad m                 , Functor m                 )-             => Statement-             -> Run m h (GVal (Run m h))-runStatement NullS =+             => Statement p+             -> Run p m h (GVal (Run p m h))+runStatement stmt =+    withSourcePos+        (annotation stmt)+        (runStatement' stmt)++runStatement' :: forall m h p+              . ( ToGVal (Run p m h) h+                , ToGVal (Run p m h) p+                , Monoid h+                , Monad m+                , Functor m+                )+             => Statement p+             -> Run p m h (GVal (Run p m h))+runStatement' (NullS _) =     return def-runStatement (MultiS xs) =+runStatement' (MultiS _ xs) =     forM xs runStatement >>= \case         [] -> return def         rvals -> return $ List.last rvals-runStatement (LiteralS html) =+runStatement' (LiteralS _ html) =     echo (toGVal html) >> return def-runStatement (InterpolationS expr) =+runStatement' (InterpolationS _ expr) =     runExpression expr >>= echo >> return def-runStatement (ExpressionS expr) =+runStatement' (ExpressionS _ expr) =     runExpression expr-runStatement (IfS condExpr true false) = do+runStatement' (IfS _ condExpr true false) = do     cond <- runExpression condExpr     runStatement $ if toBoolean cond then true else false -runStatement (IndentS expr body) = 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+runStatement' (SwitchS _ pivotExpr cases defBranch) = do     pivot <- runExpression pivotExpr     let branches =             [ \cont -> do@@ -316,52 +358,55 @@             [ Prelude.const $ runStatement defBranch ]     go branches     where-        go :: [ Run m h (GVal (Run m h)) -> Run m h (GVal (Run m h)) ]-           -> Run m h (GVal (Run m h))+        go :: [ Run p m h (GVal (Run p m h)) -> Run p m h (GVal (Run p m h)) ]+           -> Run p m h (GVal (Run p m h))         go [] = return def         go (x:xs) = x (go xs) -runStatement (SetVarS name valExpr) = do+runStatement' (SetVarS _ name valExpr) = do     val <- runExpression valExpr     setVar name val     return def -runStatement (DefMacroS name macro) = do+runStatement' (DefMacroS _ name macro) = do     let val = macroToGVal macro     setVar name val     return def -runStatement (BlockRefS blockName) = do+runStatement' (BlockRefS _ blockName) = do     block <- lookupBlock blockName     withBlockName blockName $         runStatement (blockBody block) -runStatement (ScopedS body) = withLocalScope runInner+runStatement' (ScopedS _ body) = withLocalScope runInner     where-        runInner :: (Functor m, Monad m) => Run m h (GVal (Run m h))+        runInner :: (Functor m, Monad m) => Run p m h (GVal (Run p m h))         runInner = runStatement body -runStatement (ForS varNameIndex varNameValue itereeExpr body) = do-    let go :: Int -> GVal (Run m h) -> Run m h (GVal (Run m h))+runStatement' (ForS _ varNameIndex varNameValue itereeExpr body) = do+    let go :: Int -> GVal (Run p m h) -> Run p m h (GVal (Run p m h))         go recursionDepth iteree = do-            let iterPairs =-                    if isJust (asDictItems iteree)-                        then [ (toGVal k, v) | (k, v) <- fromMaybe [] (asDictItems iteree) ]-                        else Prelude.zip (Prelude.map toGVal ([0..] :: [Int])) (fromMaybe [] (asList iteree))-                numItems :: Int+            iterPairs <- if isJust (asDictItems iteree)+                then return [ (toGVal k, v) | (k, v) <- fromMaybe [] (asDictItems iteree) ]+                else case asList iteree of+                  Just items -> return $ Prelude.zip (Prelude.map toGVal ([0..] :: [Int])) items+                  Nothing -> do+                    warn $ TypeError ["list", "dictionary"] (Just $ tshow iteree)+                    return []+            let numItems :: Int                 numItems = Prelude.length iterPairs-                cycle :: Int -> [(Maybe Text, GVal (Run m h))] -> Run m h (GVal (Run m h))+                cycle :: Int -> [(Maybe Text, GVal (Run p m h))] -> Run p m h (GVal (Run p m h))                 cycle index args = return                                  . fromMaybe def                                  . headMay                                  . Prelude.drop (index `Prelude.mod` Prelude.length args)                                  . fmap snd                                  $ args-                loop :: [(Maybe Text, GVal (Run m h))] -> Run m h (GVal (Run m h))-                loop [] = throwError $ ArgumentsError "loop" "at least one argument is required"+                loop :: [(Maybe Text, GVal (Run p m h))] -> Run p m h (GVal (Run p m h))+                loop [] = throwHere $ ArgumentsError (Just "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 (GVal (Run m h))+                iteration :: (Int, (GVal (Run p m h), GVal (Run p m h)))+                          -> Run p m h (GVal (Run p m h))                 iteration (index, (key, value)) = do                     setVar varNameValue value                     setVar "loop" $@@ -386,10 +431,10 @@                 rvals -> return $ List.last rvals     runExpression itereeExpr >>= go 0 -runStatement (PreprocessedIncludeS tpl) =+runStatement' (PreprocessedIncludeS _ tpl) =     withTemplate tpl $ runTemplate tpl -runStatement (TryCatchS tryS catchesS finallyS) = do+runStatement' (TryCatchS _ tryS catchesS finallyS) = do     result <- (runStatement tryS) `catchError` handle catchesS     runStatement finallyS     return result@@ -408,16 +453,17 @@                     handle catches e  -- | Deeply magical function that converts a 'Macro' into a Function.-macroToGVal :: forall m h-             . ( ToGVal (Run m h) h+macroToGVal :: forall m h p+             . ( ToGVal (Run p m h) h+               , ToGVal (Run p m h) p                , Monoid h                , Functor m                , Monad m-               ) => Macro -> GVal (Run m h)+               ) => Macro p -> GVal (Run p m h) macroToGVal (Macro argNames body) =     fromFunction f     where-        f :: Function (Run m h)+        f :: Function (Run p m h)         -- Establish a local state to not contaminate the parent scope         -- with function arguments and local variables, and;         -- Establish a local context, where we override the HTML writer,@@ -434,51 +480,59 @@                 -- the capture as the function's return value.                 toGVal <$> fetchCapture                 where-                    matchArgs' :: [(Maybe Text, GVal (Run m h))] -> (HashMap Text (GVal (Run m h)), [GVal (Run m h)], HashMap Text (GVal (Run m h)))+                    matchArgs' :: [(Maybe Text, GVal (Run p m h))] -> (HashMap Text (GVal (Run p m h)), [GVal (Run p m h)], HashMap Text (GVal (Run p m h)))                     matchArgs' = matchFuncArgs argNames                     (matchedArgs, positionalArgs, namedArgs) = matchArgs' args +-- | Run p (evaluate) an expression and return its value into the Run p monad+runExpression expr =+    withSourcePos+        (annotation expr)+        (runExpression' expr) --- | Run (evaluate) an expression and return its value into the Run monad-runExpression (StringLiteralE str) = return . toGVal $ str-runExpression (NumberLiteralE n) = return . toGVal $ n-runExpression (BoolLiteralE b) = return . toGVal $ b-runExpression NullLiteralE = return def-runExpression (VarE key) = getVar key-runExpression (ListE xs) = toGVal <$> forM xs runExpression-runExpression (ObjectE xs) = do+runExpression' (StringLiteralE _ str) = return . toGVal $ str+runExpression' (NumberLiteralE _ n) = return . toGVal $ n+runExpression' (BoolLiteralE _ b) = return . toGVal $ b+runExpression' (NullLiteralE _) = return def+runExpression' (VarE _ key) = getVar key+runExpression' (ListE _ xs) = toGVal <$> forM xs runExpression+runExpression' (ObjectE _ xs) = do     items <- forM xs $ \(a, b) -> do         l <- asText <$> runExpression a         r <- runExpression b         return (l, r)     return . toGVal . HashMap.fromList $ items-runExpression (MemberLookupE baseExpr indexExpr) = do+runExpression' (MemberLookupE _ baseExpr indexExpr) = do     base <- runExpression baseExpr     index <- runExpression indexExpr-    return . fromMaybe def . lookupLoose index $ base-runExpression (CallE funcE argsEs) = do+    warnFromMaybe (IndexError $ tshow (asText index)) def $+        lookupLoose index base+runExpression' (CallE _ funcE argsEs) = do     args <- forM argsEs $         \(argName, argE) -> (argName,) <$> runExpression argE-    func <- toFunction <$> runExpression funcE+    e <- runExpression funcE+    let func = toFunction e     case func of-        Nothing -> return def+        Nothing -> do+            warn NotAFunctionError+            return def         Just f -> f args-runExpression (LambdaE argNames body) = do+runExpression' (LambdaE _ argNames body) = do     let fn args = withLocalScope $ do             forM_ (Prelude.zip argNames (fmap snd args)) $ uncurry setVar             runExpression body     return $ fromFunction fn-runExpression (TernaryE condition yes no) = do+runExpression' (TernaryE _ condition yes no) = do     condVal <- runExpression condition     let expr = if asBoolean condVal then yes else no     runExpression expr-runExpression (DoE stmt) =+runExpression' (DoE _ stmt) =     runStatement stmt  -- | Helper function to output a HTML value using whatever print function the -- context provides.-echo :: (Monad m, Functor m, Monoid h)-     => GVal (Run m h) -> Run m h ()+echo :: (Monad m, Applicative m, Functor m, Monoid h)+     => GVal (Run p m h) -> Run p m h () echo src = do     e <- asks contextEncode     p <- asks contextWrite@@ -498,21 +552,21 @@                     rsAtLineStart = endsWithNewline newlines l                 } -indented :: (Monad m, Functor m, Monoid h)+indented :: (Monad m, Applicative m, Functor m, Monoid h)          => h-         -> Run m h a-         -> Run m h a+         -> Run p m h a+         -> Run p m h a indented i action = do     pushIndent i *> action <* popIndent -pushIndent :: (Monad m, Functor m, Monoid h)+pushIndent :: (Monad m, Applicative m, Functor m, Monoid h)            => h-           -> Run m h ()+           -> Run p m h () pushIndent i =     modify $ \state ->         state { rsIndentation = increaseIndent i (rsIndentation state) }-popIndent :: (Monad m, Functor m, Monoid h)-           => Run m h ()+popIndent :: (Monad m, Applicative m, Functor m, Monoid h)+           => Run p m h () popIndent =     modify $ \state ->         state { rsIndentation = decreaseIndent (rsIndentation state) }@@ -526,9 +580,14 @@ 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+defRunState :: forall m h p+             . ( ToGVal (Run p m h) h+               , ToGVal (Run p m h) p+               , Monoid h+               , Monad m+               )+            => Template p+            -> RunState p m h defRunState tpl =     RunState         { rsScope = HashMap.fromList defaultScope@@ -537,10 +596,24 @@         , rsCurrentBlockName = Nothing         , rsIndentation = Nothing         , rsAtLineStart = True+        , rsCurrentSourcePos = annotation tpl         } -gfnEval :: (Monad m, Monoid h, ToGVal (Run m h) h)-        => Function (Run m h)+gfnThrow :: ( Monad m+            , Monoid h+            , ToGVal (Run p m h) h+            , ToGVal (Run p m h) p+            )+         => Function (Run p m h)+gfnThrow args =+    throwHere (RuntimeError . mconcat . fmap (asText . snd) $ args)++gfnEval :: ( Monad m+           , Monoid h+           , ToGVal (Run p m h) h+           , ToGVal (Run p m h) p+           )+        => Function (Run p m h) gfnEval args =     let extracted =             extractArgsDefL@@ -549,14 +622,16 @@                 ]                 args     in case extracted of-        Left _ -> throwError $ ArgumentsError "eval" "expected: (src, context)"+        Left _ -> throwHere $ ArgumentsError (Just "eval") "expected: (src, context)"         Right [gSrc, gContext] -> do-            result <- parseGinger+            result' <- parseGinger                 (Prelude.const . return $ Nothing) -- include resolver                 Nothing -- source name                 (Text.unpack . asText $ gSrc) -- source code+            pos <- gets rsCurrentSourcePos+            let result = fmap (Prelude.const pos) <$> result'             tpl <- case result of-                Left err -> throwError $ EvalParseError err+                Left err -> throwHere $ EvalParseError err                 Right t -> return t             let localLookup varName = return $                     lookupLooseDef def (toGVal varName) gContext

@@ -78,10 +78,13 @@                  ) import Data.Foldable (asum) -gfnRawHtml :: Monad m => Function (Run m h)+tshow :: Show a => a -> Text+tshow = Text.pack . show++gfnRawHtml :: Monad m => Function (Run p m h) gfnRawHtml = unaryFunc (toGVal . unsafeRawHtml . asText) -gfnUrlEncode :: Monad m => Function (Run m h)+gfnUrlEncode :: Monad m => Function (Run p m h) gfnUrlEncode =     unaryFunc         ( toGVal@@ -93,43 +96,43 @@         . asText         ) -gfnDefault :: Monad m => Function (Run m h)+gfnDefault :: Monad m => Function (Run p m h) gfnDefault [] = return def gfnDefault ((_, x):xs)     | asBoolean x = return x     | otherwise = gfnDefault xs -gfnEscape :: Monad m => Function (Run m h)+gfnEscape :: Monad m => Function (Run p m h) gfnEscape = return . toGVal . html . mconcat . fmap (asText . snd) -gfnAny :: Monad m => Function (Run m h)+gfnAny :: Monad m => Function (Run p m h) gfnAny xs = return . toGVal $ Prelude.any (asBoolean . snd) xs -gfnAll :: Monad m => Function (Run m h)+gfnAll :: Monad m => Function (Run p m h) gfnAll xs = return . toGVal $ Prelude.all (asBoolean . snd) xs -gfnEquals :: Monad m => Function (Run m h)+gfnEquals :: Monad m => Function (Run p m h) gfnEquals [] = return $ toGVal True gfnEquals [x] = return $ toGVal True gfnEquals (x:xs) =     return . toGVal $ Prelude.all ((snd x `looseEquals`) . snd) xs -gfnNEquals :: Monad m => Function (Run m h)+gfnNEquals :: Monad m => Function (Run p m h) gfnNEquals [] = return $ toGVal True gfnNEquals [x] = return $ toGVal True gfnNEquals (x:xs) =     return . toGVal $ Prelude.any (not . (snd x `looseEquals`) . snd) xs -gfnContains :: Monad m => Function (Run m h)+gfnContains :: Monad m => Function (Run p m h) gfnContains [] = return $ toGVal False-gfnContains (list:elems) =-    let rawList = fromMaybe [] . asList . snd $ list-        rawElems = fmap snd elems+gfnContains (list:elems) = do+    rawList <- warnFromMaybe (TypeError ["list"] (Just $ tshow list)) [] . asList . snd $ list+    let rawElems = fmap snd elems         e `isInList` xs = Prelude.any (looseEquals e) xs         es `areInList` xs = Prelude.all (`isInList` xs) es-    in return . toGVal $ rawElems `areInList` rawList+    return . toGVal $ rawElems `areInList` rawList -looseEquals :: GVal (Run m h) -> GVal (Run m h) -> Bool+looseEquals :: GVal (Run p m h) -> GVal (Run p m h) -> Bool looseEquals a b     | isJust (asFunction a) || isJust (asFunction b) = False     | isJust (asList a) /= isJust (asList b) = False@@ -140,44 +143,44 @@     | isNull a || isNull b = asBoolean a == asBoolean b     | otherwise = asText a == asText b -gfnLess :: Monad m => Function (Run m h)+gfnLess :: Monad m => Function (Run p m h) gfnLess [] = return . toGVal $ False gfnLess xs' =     let xs = fmap snd xs'     in return . toGVal $         Prelude.all (== Just True) (Prelude.zipWith less xs (Prelude.tail xs)) -gfnGreater :: Monad m => Function (Run m h)+gfnGreater :: Monad m => Function (Run p m h) gfnGreater [] = return . toGVal $ False gfnGreater xs' =     let xs = fmap snd xs'     in return . toGVal $         Prelude.all (== Just True) (Prelude.zipWith greater xs (Prelude.tail xs)) -gfnLessEquals :: Monad m => Function (Run m h)+gfnLessEquals :: Monad m => Function (Run p m h) gfnLessEquals [] = return . toGVal $ False gfnLessEquals xs' =     let xs = fmap snd xs'     in return . toGVal $         Prelude.all (== Just True) (Prelude.zipWith lessEq xs (Prelude.tail xs)) -gfnGreaterEquals :: Monad m => Function (Run m h)+gfnGreaterEquals :: Monad m => Function (Run p m h) gfnGreaterEquals [] = return . toGVal $ False gfnGreaterEquals xs' =     let xs = fmap snd xs'     in return . toGVal $         Prelude.all (== Just True) (Prelude.zipWith greaterEq xs (Prelude.tail xs)) -less :: Monad m => GVal (Run m h) -> GVal (Run m h) -> Maybe Bool+less :: Monad m => GVal (Run p m h) -> GVal (Run p m h) -> Maybe Bool less a b = (<) <$> asNumber a <*> asNumber b -greater :: Monad m => GVal (Run m h) -> GVal (Run m h) -> Maybe Bool+greater :: Monad m => GVal (Run p m h) -> GVal (Run p m h) -> Maybe Bool greater a b = (>) <$> asNumber a <*> asNumber b -lessEq :: Monad m => GVal (Run m h) -> GVal (Run m h) -> Maybe Bool+lessEq :: Monad m => GVal (Run p m h) -> GVal (Run p m h) -> Maybe Bool lessEq a b = (<=) <$> asNumber a <*> asNumber b -greaterEq :: Monad m => GVal (Run m h) -> GVal (Run m h) -> Maybe Bool+greaterEq :: Monad m => GVal (Run p m h) -> GVal (Run p m h) -> Maybe Bool greaterEq a b = (>=) <$> asNumber a <*> asNumber b  difference :: Prelude.Num a => [a] -> a@@ -199,14 +202,14 @@ capitalize :: Text -> Text capitalize txt = Text.toUpper (Text.take 1 txt) <> Text.drop 1 txt -gfnCenter :: Monad m => Function (Run m h)+gfnCenter :: Monad m => Function (Run p m h) gfnCenter [] = gfnCenter [(Nothing, toGVal ("" :: Text))] gfnCenter [x] = gfnCenter [x, (Nothing, toGVal (80 :: Int))] gfnCenter [x,y] = gfnCenter [x, y, (Nothing, toGVal (" " :: Text))] gfnCenter ((_, s):(_, w):(_, pad):_) =     return . toGVal $ center (asText s) (fromMaybe 80 $ Prelude.truncate <$> asNumber w) (asText pad) -gfnSlice :: Monad m => Function (Run m h)+gfnSlice :: Monad m => Function (Run p m h) gfnSlice args =     let argValues =             extractArgsDefL@@ -242,9 +245,9 @@                     Nothing ->                         return . toGVal . Text.pack $                             slice (Text.unpack $ asText slicee) startInt lengthInt-        _ -> throwError $ ArgumentsError "slice" "expected: (slicee, start=0, length=null)"+        _ -> throwHere $ ArgumentsError (Just "slice") "expected: (slicee, start=0, length=null)" -gfnReplace :: Monad m => Function (Run m h)+gfnReplace :: Monad m => Function (Run p m h) gfnReplace args =     let argValues =             extractArgsDefL@@ -259,9 +262,9 @@                 search = asText searchG                 replace = asText replaceG             return . toGVal $ Text.replace search replace str-        _ -> throwError $ ArgumentsError "replace" "expected: (str, search, replace)"+        _ -> throwHere $ ArgumentsError (Just "replace") "expected: (str, search, replace)" -gfnMap :: Monad m => Function (Run m h)+gfnMap :: Monad m => Function (Run p m h) gfnMap args = do     let parsedArgs = extractArgsDefL             [ ("collection", def)@@ -294,7 +297,7 @@             toGVal <$> mapM (mapFunction . (:[]) . (Nothing,)) items              -gfnSort :: Monad m => Function (Run m h)+gfnSort :: Monad m => Function (Run p m h) gfnSort args = do     let parsedArgs = extractArgsDefL             [ ("sortee", def)@@ -308,20 +311,20 @@                    , sortKey                    , asBoolean reverseG                    )-        _ -> throwError $ ArgumentsError "sort" "expected: (sortee, by, reverse)"-    let -- extractByFunc :: Maybe ((Text, GVal (Run m h)) -> Run m h (GVal (Run m h)))+        _ -> throwHere $ ArgumentsError (Just "sort") "expected: (sortee, by, reverse)"+    let -- extractByFunc :: Maybe ((Text, GVal (Run p m h)) -> Run p m h (GVal (Run p m h)))         extractByFunc = do             f <- asFunction sortKey             return $ \g ->                 f [(Nothing, snd g)] -    let -- extractByPath :: Maybe ((Text, GVal (Run m h)) -> Run m h (GVal (Run m h)))+    let -- extractByPath :: Maybe ((Text, GVal (Run p m h)) -> Run p m h (GVal (Run p m h)))         extractByPath = do             keys <- asList sortKey             return $ \g ->                 return $ List.foldl' (flip (lookupLooseDef def)) (snd g) keys -        extractByKey :: Monad m => Maybe ((Text, a) -> Run m h (GVal (Run m h)))+        extractByKey :: Monad m => Maybe ((Text, a) -> Run p m h (GVal (Run p m h)))         extractByKey =             if asText sortKey == "__key"                 then Just $ return . toGVal . fst@@ -364,7 +367,7 @@  listToIndexedDict :: [a] -> [(Text, a)] listToIndexedDict values =-    let indexes = fmap (Text.pack . show) [0..]+    let indexes = fmap (tshow) [0..]     in List.zip indexes values  center :: Text -> Prelude.Int -> Text -> Text@@ -381,7 +384,7 @@         repsR = Prelude.succ charsR `div` Text.length pad         paddingR = Text.take charsR . Text.replicate repsR $ pad -gfnFileSizeFormat :: Monad m => Function (Run m h)+gfnFileSizeFormat :: Monad m => Function (Run p m h) gfnFileSizeFormat [(_, sizeG)] =     gfnFileSizeFormat [(Nothing, sizeG), (Nothing, def)] gfnFileSizeFormat [(_, sizeG), (_, binaryG)] = do@@ -423,8 +426,10 @@                 else formatScientific Fixed (Just 1) dividedSize     in formattedSize ++ " " ++ unitName -gfnPrintf :: Monad m => Function (Run m h)-gfnPrintf [] = return def+gfnPrintf :: Monad m => Function (Run p m h)+gfnPrintf [] = do+    warn $ ArgumentsError (Just "printf") "No format string provided"+    return def gfnPrintf [(_, fmtStrG)] = return fmtStrG gfnPrintf ((_, fmtStrG):args) = do     return . toGVal $ printfG fmtStr (fmap snd args)@@ -506,7 +511,7 @@ parseTZ :: String -> Maybe TimeZone parseTZ = parseTimeM True defaultTimeLocale "%z" -gfnDateFormat :: Monad m => Function (Run m h)+gfnDateFormat :: Monad m => Function (Run p m h) gfnDateFormat args =     let extracted =             extractArgsDefL@@ -554,13 +559,13 @@                     return . toGVal $ formatTime locale fmt . convertTZ tzMay <$> dateMay                 Nothing -> do                     return . toGVal $ convertTZ tzMay <$> dateMay-        _ -> throwError $ ArgumentsError "date" "expected: (date, format, tz=null, locale=null)"+        _ -> throwHere $ ArgumentsError (Just "date") "expected: (date, format, tz=null, locale=null)"     where         convertTZ :: Maybe TimeZone -> ZonedTime -> ZonedTime         convertTZ Nothing = id         convertTZ (Just tz) = utcToZonedTime tz . zonedTimeToUTC -getTimeLocale :: Monad m => GVal (Run m h) -> Run m h TimeLocale+getTimeLocale :: Monad m => GVal (Run p m h) -> Run p m h TimeLocale getTimeLocale localeName = do     toFunction <$> getVar "getlocale" >>= \case         Nothing ->@@ -572,7 +577,7 @@             fromMaybe defaultTimeLocale . fromGVal <$> getlocale args  -gfnFilter :: Monad m => Function (Run m h)+gfnFilter :: Monad m => Function (Run p m h) gfnFilter [] = return def gfnFilter [(_, xs)] = return xs gfnFilter ((_, xs):(_, p):args) = do@@ -586,7 +591,7 @@ printfG fmt args = printfa fmt (fmap P args)  -gfnDictsort :: Monad m => Function (Run m h)+gfnDictsort :: Monad m => Function (Run p m h) gfnDictsort args =     let extracted =             extractArgsDefL@@ -602,7 +607,7 @@                 "key" -> return True                 "value" -> return False                 "val" -> return False-                x -> throwError $ ArgumentsError "dictsort"+                x -> throwError $ ArgumentsError (Just "dictsort")                         ( "argument 'by' must be one of 'key', 'value', 'val', " <>                           "but found '" <>                           x <> "'"@@ -612,4 +617,4 @@                     (if caseSensitive then id else Text.toUpper) .                     (if sortByKey then fst else (asText . snd))             return . orderedDict . List.sortOn projection $ items-        _ -> throwError $ ArgumentsError "dictsort" "expected: (dict, case_sensitive=false, by=null)"+        _ -> throwHere $ ArgumentsError (Just "dictsort") "expected: (dict, case_sensitive=false, by=null)"

@@ -60,21 +60,27 @@ import Data.Maybe (isNothing) import Data.List (lookup, zipWith, unzip) -unaryFunc :: forall m h. (Monad m) => (GVal (Run m h) -> GVal (Run m h)) -> Function (Run m h)-unaryFunc f [] = return def-unaryFunc f ((_, x):[]) = return (f x)+unaryFunc :: forall m h p. (Monad m) => (GVal (Run p m h) -> GVal (Run p m h)) -> Function (Run p m h)+unaryFunc f [] = do+    warn $ ArgumentsError Nothing "expected at least one argument"+    return def+unaryFunc f ((_, x):[]) =+    return (f x)+unaryFunc f ((_, x):xs) = do+    warn $ ArgumentsError Nothing "expected exactly one argument"+    return (f x)  ignoreArgNames :: ([a] -> b) -> ([(c, a)] -> b) ignoreArgNames f args = f (Prelude.map snd args) -variadicNumericFunc :: Monad m => Scientific -> ([Scientific] -> Scientific) -> [(Maybe Text, GVal (Run m h))] -> Run m h (GVal (Run m h))+variadicNumericFunc :: Monad m => Scientific -> ([Scientific] -> Scientific) -> [(Maybe Text, GVal (Run p m h))] -> Run p m h (GVal (Run p m h)) variadicNumericFunc zero f args =     return . toGVal . f $ args'     where         args' :: [Scientific]         args' = Prelude.map (fromMaybe zero . asNumber . snd) args -unaryNumericFunc :: Monad m => Scientific -> (Scientific -> Scientific) -> [(Maybe Text, GVal (Run m h))] -> Run m h (GVal (Run m h))+unaryNumericFunc :: Monad m => Scientific -> (Scientific -> Scientific) -> [(Maybe Text, GVal (Run p m h))] -> Run p m h (GVal (Run p m h)) unaryNumericFunc zero f args =     return . toGVal . f $ args'     where@@ -83,7 +89,7 @@                     [] -> 0                     (arg:_) -> fromMaybe zero . asNumber . snd $ arg -variadicStringFunc :: Monad m => ([Text] -> Text) -> [(Maybe Text, GVal (Run m h))] -> Run m h (GVal (Run m h))+variadicStringFunc :: Monad m => ([Text] -> Text) -> [(Maybe Text, GVal (Run p m h))] -> Run p m h (GVal (Run p m h)) variadicStringFunc f args =     return . toGVal . f $ args'     where

@@ -11,10 +11,13 @@ , makeContextM , makeContext' , makeContextM'+, makeContextExM' , makeContextHtml , makeContextHtmlM+, makeContextHtmlExM , makeContextText , makeContextTextM+, makeContextTextExM , easyContext , ContextEncodable (..) , liftRun@@ -31,6 +34,11 @@ , hoistRun , hoistNewlines , hoistRunState+, warn+, warnFromMaybe+, throwHere+, withSourcePos+, getSourcePos ) where @@ -60,7 +68,7 @@ import Text.Ginger.AST import Text.Ginger.Html import Text.Ginger.GVal-import Text.Ginger.Parse (ParserError (..))+import Text.Ginger.Parse (ParserError (..), sourceLine, sourceColumn, sourceName) import Text.Printf import Text.PrintfA import Data.Scientific (formatScientific)@@ -92,11 +100,12 @@  -- | Execution context. Determines how to look up variables from the -- environment, and how to write out template output.-data GingerContext m h+data GingerContext p m h     = GingerContext-        { contextLookup :: VarName -> Run m h (GVal (Run m h))-        , contextWrite :: h -> Run m h ()-        , contextEncode :: GVal (Run m h) -> h+        { contextLookup :: VarName -> Run p m h (GVal (Run p m h))+        , contextWrite :: h -> Run p m h ()+        , contextWarn :: RuntimeError p -> Run p m h ()+        , contextEncode :: GVal (Run p m h) -> h         , contextNewlines :: Maybe (Newlines h)         } @@ -104,7 +113,7 @@ -- @hoistContext fwd rev context@ returns a context over a different -- output type, applying the @fwd@ and @rev@ projections to convert -- between the original and desired output types.-hoistContext :: Monad m => (h -> t) -> (t -> h) -> GingerContext m h -> GingerContext m t+hoistContext :: Monad m => (h -> t) -> (t -> h) -> GingerContext p m h -> GingerContext p m t hoistContext fwd rev c =     GingerContext         { contextLookup = \varName ->@@ -114,6 +123,8 @@                 hoistRun fwd rev (contextLookup c varName)         , contextWrite = \val ->             hoistRun fwd rev (contextWrite c $ rev val)+        , contextWarn = \str ->+            hoistRun fwd rev (contextWarn c str)         , contextEncode = \gval ->             fwd .                 contextEncode c .@@ -123,22 +134,31 @@             hoistNewlines fwd rev <$> contextNewlines c         } -contextWriteEncoded :: GingerContext m h -> GVal (Run m h) -> Run m h ()+contextWriteEncoded :: GingerContext p m h -> GVal (Run p m h) -> Run p m h () contextWriteEncoded context =     contextWrite context . contextEncode context -easyContext :: (Monad m, ContextEncodable h, ToGVal (Run m h) v)+easyContext :: (Monad m, ContextEncodable h, ToGVal (Run p m h) v)             => (h -> m ())             -> v-            -> GingerContext m h+            -> GingerContext p m h easyContext emit context =-    makeContextM'+    easyContextEx emit (Prelude.const $ return ()) context++easyContextEx :: (Monad m, ContextEncodable h, ToGVal (Run p m h) v)+              => (h -> m ())+              -> (RuntimeError p -> m ())+              -> v+              -> GingerContext p m h+easyContextEx emit warn context =+    makeContextExM'         (\varName ->             return                 (lookupLooseDef def                     (toGVal varName)                     (toGVal context)))         emit+        warn         encode         newlines @@ -166,20 +186,31 @@ -- means the carrier monad provides, e.g. @putStr@ for @IO@, or @tell@ for -- @Writer@s). makeContextM' :: (Monad m, Functor m)-             => (VarName -> Run m h (GVal (Run m h)))+             => (VarName -> Run p m h (GVal (Run p m h)))              -> (h -> m ())-             -> (GVal (Run m h) -> h)+             -> (GVal (Run p m h) -> h)              -> Maybe (Newlines h)-             -> GingerContext m h+             -> GingerContext p m h makeContextM' lookupFn writeFn encodeFn newlines =+  makeContextExM' lookupFn writeFn (Prelude.const $ return ()) encodeFn newlines++makeContextExM' :: (Monad m, Functor m)+             => (VarName -> Run p m h (GVal (Run p m h)))+             -> (h -> m ())+             -> (RuntimeError p -> m ())+             -> (GVal (Run p m h) -> h)+             -> Maybe (Newlines h)+             -> GingerContext p m h+makeContextExM' lookupFn writeFn warnFn encodeFn newlines =     GingerContext         { contextLookup = lookupFn         , contextWrite = liftRun2 writeFn+        , contextWarn = liftRun2 warnFn         , contextEncode = encodeFn         , contextNewlines = newlines         } -liftLookup :: (Monad m, ToGVal (Run m h) v) => (VarName -> m v) -> VarName -> Run m h (GVal (Run m h))+liftLookup :: (Monad m, ToGVal (Run p m h) v) => (VarName -> m v) -> VarName -> Run p m h (GVal (Run p m h)) liftLookup f k = do     v <- liftRun $ f k     return . toGVal $ v@@ -195,47 +226,61 @@ -- on them, so the 'GVal (Run (Writer Html))' part can usually be ignored. -- See the 'Text.Ginger.GVal' module for details. makeContext' :: Monoid h-            => (VarName -> GVal (Run (Writer h) h))-            -> (GVal (Run (Writer h) h) -> h)+            => (VarName -> GVal (Run p (Writer h) h))+            -> (GVal (Run p (Writer h) h) -> h)             -> Maybe (Newlines h)-            -> GingerContext (Writer h) h+            -> GingerContext p (Writer h) h makeContext' lookupFn =     makeContextM'         (return . lookupFn)         tell  {-#DEPRECATED makeContext "Compatibility alias for makeContextHtml" #-}-makeContext :: (VarName -> GVal (Run (Writer Html) Html))-            -> GingerContext (Writer Html) Html+makeContext :: (VarName -> GVal (Run p (Writer Html) Html))+            -> GingerContext p (Writer Html) Html makeContext = makeContextHtml  {-#DEPRECATED makeContextM "Compatibility alias for makeContextHtmlM" #-} makeContextM :: (Monad m, Functor m)-             => (VarName -> Run m Html (GVal (Run m Html)))+             => (VarName -> Run p m Html (GVal (Run p m Html)))              -> (Html -> m ())-             -> GingerContext m Html+             -> GingerContext p m Html makeContextM = makeContextHtmlM -makeContextHtml :: (VarName -> GVal (Run (Writer Html) Html))-                -> GingerContext (Writer Html) Html+makeContextHtml :: (VarName -> GVal (Run p (Writer Html) Html))+                -> GingerContext p (Writer Html) Html makeContextHtml l = makeContext' l toHtml (Just htmlNewlines)  makeContextHtmlM :: (Monad m, Functor m)-                 => (VarName -> Run m Html (GVal (Run m Html)))+                 => (VarName -> Run p m Html (GVal (Run p m Html)))                  -> (Html -> m ())-                 -> GingerContext m Html+                 -> GingerContext p m Html makeContextHtmlM l w = makeContextM' l w toHtml (Just htmlNewlines) -makeContextText :: (VarName -> GVal (Run (Writer Text) Text))-                -> GingerContext (Writer Text) Text+makeContextHtmlExM :: (Monad m, Functor m)+                 => (VarName -> Run p m Html (GVal (Run p m Html)))+                 -> (Html -> m ())+                 -> (RuntimeError p -> m ())+                 -> GingerContext p m Html+makeContextHtmlExM l w warn = makeContextExM' l w warn toHtml (Just htmlNewlines)++makeContextText :: (VarName -> GVal (Run p (Writer Text) Text))+                -> GingerContext p (Writer Text) Text makeContextText l = makeContext' l asText (Just textNewlines)  makeContextTextM :: (Monad m, Functor m)-                 => (VarName -> Run m Text (GVal (Run m Text)))+                 => (VarName -> Run p m Text (GVal (Run p m Text)))                  -> (Text -> m ())-                 -> GingerContext m Text+                 -> GingerContext p m Text makeContextTextM l w = makeContextM' l w asText (Just textNewlines) +makeContextTextExM :: (Monad m, Functor m)+                 => (VarName -> Run p m Text (GVal (Run p m Text)))+                 -> (Text -> m ())+                 -> (RuntimeError p -> m ())+                 -> GingerContext p m Text+makeContextTextExM l w warn = makeContextExM' l w warn 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.@@ -285,20 +330,21 @@ reNewline (x:"":[]) = [x <> "\n"] reNewline (x:xs) = (x <> "\n") : reNewline xs -data RunState m h+data RunState p m h     = RunState-        { rsScope :: HashMap VarName (GVal (Run m h))+        { rsScope :: HashMap VarName (GVal (Run p m h))         , rsCapture :: h-        , rsCurrentTemplate :: Template -- the template we are currently running+        , rsCurrentTemplate :: Template p -- 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         , rsAtLineStart :: Bool -- is the next output position the first column+        , rsCurrentSourcePos :: p         }  -- | Hoist a 'RunState' onto a different output type. -- You don't normally need to use this directly; see 'hoistRun' and/or -- 'hoistContext'.-hoistRunState :: Monad m => (h -> t) -> (t -> h) -> RunState m h -> RunState m t+hoistRunState :: Monad m => (h -> t) -> (t -> h) -> RunState p m h -> RunState p m t hoistRunState fwd rev rs =     RunState         { rsScope = marshalGValEx (hoistRun fwd rev) (hoistRun rev fwd) <$> rsScope rs@@ -307,80 +353,146 @@         , rsCurrentBlockName = rsCurrentBlockName rs         , rsIndentation = fmap fwd <$> rsIndentation rs         , rsAtLineStart = rsAtLineStart rs+        , rsCurrentSourcePos = rsCurrentSourcePos rs         } -data RuntimeError = RuntimeError Text -- ^ Generic runtime error-                  | UndefinedBlockError Text -- ^ Tried to use a block that isn't defined-                  -- r Invalid arguments to function (function name, explanation)-                  | ArgumentsError Text Text-                  | EvalParseError ParserError-                  | NotAFunctionError+data RuntimeError p = RuntimeError Text -- ^ Generic runtime error+                    | UndefinedBlockError Text -- ^ Tried to use a block that isn't defined+                    -- | Invalid arguments to function (function name, explanation)+                    | ArgumentsError (Maybe Text) Text+                    -- | Wrong type, expected one of...+                    | TypeError [Text] (Maybe Text)+                    -- | Invalid index+                    | IndexError Text+                    | EvalParseError ParserError+                    | NotAFunctionError+                    | RuntimeErrorAt p (RuntimeError p)         deriving (Show) -instance Default RuntimeError where+instance Default (RuntimeError p) where     def = RuntimeError "" -instance ToGVal m RuntimeError where+instance ToGVal m p => ToGVal m (RuntimeError p) where     toGVal = runtimeErrorToGVal -runtimeErrorWhat :: RuntimeError -> Text+runtimeErrorWhat :: RuntimeError p -> Text runtimeErrorWhat (ArgumentsError funcName explanation) = "ArgumentsError" runtimeErrorWhat (EvalParseError e) = "EvalParseError" runtimeErrorWhat (RuntimeError msg) = "RuntimeError" runtimeErrorWhat (UndefinedBlockError blockName) = "UndefinedBlockError" runtimeErrorWhat NotAFunctionError = "NotAFunctionError"+runtimeErrorWhat (IndexError _) = "IndexError"+runtimeErrorWhat (TypeError _ _) = "TypeError"+runtimeErrorWhat (RuntimeErrorAt _ e) = runtimeErrorWhat e -runtimeErrorToGVal :: RuntimeError -> GVal m-runtimeErrorToGVal (RuntimeError msg) =-    rteGVal "RuntimeError"-        msg []-runtimeErrorToGVal (UndefinedBlockError blockName) =-    rteGVal "UndefinedBlockError"-        ("undefined block: '" <> blockName <> "'")+runtimeErrorMessage :: RuntimeError p -> Text+runtimeErrorMessage (ArgumentsError Nothing explanation) =+    "invalid arguments: " <> explanation+runtimeErrorMessage (ArgumentsError (Just funcName) explanation) =+    "invalid arguments to function '" <> funcName <> "': " <> explanation+runtimeErrorMessage (TypeError expected actual) =+    "wrong type"+    <> case expected of+        [] -> ""+        [x] -> ", expected " <> x+        xs -> ", expected " <> (mconcat . List.intersperse " or " $ xs)+    <> case actual of+        Nothing -> ""+        Just x -> ", found " <> x+runtimeErrorMessage (IndexError i) =+    "invalid index " <> i+runtimeErrorMessage (EvalParseError e) =+    "parser error in eval()-ed code: " <> Text.pack (peErrorMessage e)+runtimeErrorMessage (RuntimeError msg) =+    msg+runtimeErrorMessage (UndefinedBlockError blockName) =+    "undefined block: '" <> blockName <> "'"+runtimeErrorMessage NotAFunctionError =+    "attempted to call something that is not a function"+runtimeErrorMessage (RuntimeErrorAt _ e) =+    runtimeErrorMessage e++runtimeErrorWhere :: RuntimeError p -> [p]+runtimeErrorWhere (RuntimeErrorAt p e) = p:runtimeErrorWhere e+runtimeErrorWhere _ = []++runtimeErrorToGVal :: forall m p. ToGVal m p => RuntimeError p -> GVal m+runtimeErrorToGVal e =+    let (callStack, props) = runtimeErrorToGValRaw e+        props' = (("callStack" :: Text) ~> callStack):props+    in (dict props') { asText = runtimeErrorMessage e }++runtimeErrorToGValRaw :: RuntimeError p -> ([p], [(Text, GVal m)])+runtimeErrorToGValRaw (RuntimeError msg) =+    ( []+    , rteGVal "RuntimeError" []+    )+runtimeErrorToGValRaw (UndefinedBlockError blockName) =+    ( []+    , rteGVal "UndefinedBlockError"         [ "block" ~> blockName         ]-runtimeErrorToGVal (ArgumentsError funcName explanation) =-    rteGVal "ArgumentsError"-        ("invalid arguments to function '" <> funcName <> "': " <> explanation)+    )+runtimeErrorToGValRaw (ArgumentsError funcName explanation) =+    ( []+    , rteGVal "ArgumentsError"         [ "explanation" ~> explanation         , "function" ~> funcName         ]-runtimeErrorToGVal (EvalParseError e) =-    rteGVal "EvalParseError"-        ("error parsing eval()-ed code: " <> Text.pack (peErrorMessage e))+    )+runtimeErrorToGValRaw (TypeError expected Nothing) =+    ( []+    , rteGVal "ArgumentsError"+        [ "expected" ~> expected+        ]+    )+runtimeErrorToGValRaw (TypeError expected (Just actual)) =+    ( []+    , rteGVal "ArgumentsError"+        [ "expected" ~> expected+        , "actual" ~> actual+        ]+    )+runtimeErrorToGValRaw (EvalParseError e) =+    ( []+    , rteGVal "EvalParseError"         [ "errorMessage" ~> peErrorMessage e-        , "sourceFile" ~> peSourceName e-        , "line" ~> peSourceLine e-        , "col" ~> peSourceColumn e+        -- , "sourcePosition" ~> peSourcePosition e         ]-runtimeErrorToGVal NotAFunctionError =-    rteGVal "NotAFunctionError"-        ("attempted to call something that is not a function")+    )+runtimeErrorToGValRaw NotAFunctionError =+    ( []+    , rteGVal "NotAFunctionError"         []+    ) -rteGVal :: Text -> Text -> [(Text, GVal m)] -> GVal m-rteGVal what msg extra =-    (dict $-        [ "what" ~> what-        , "message" ~> msg-        ] ++ extra) { asText = msg }+runtimeErrorToGValRaw (RuntimeErrorAt p e) =+    let (callStack, inner) = runtimeErrorToGValRaw e+    in (p:callStack, inner) +rteGVal :: Text -> [(Text, GVal m)] -> [(Text, GVal m)]+rteGVal what extra =+    ( [ "what" ~> what+      ]+      ++ extra+    )+ -- | Internal type alias for our template-runner monad stack.-type Run m h = ExceptT RuntimeError (StateT (RunState m h) (ReaderT (GingerContext m h) m))+type Run p m h = ExceptT (RuntimeError p) (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))  -- | Lift a value from the host monad @m@ into the 'Run' monad.-liftRun :: Monad m => m a -> Run m h a+liftRun :: Monad m => m a -> Run p m h a liftRun = lift . lift . lift  -- | Lift a function from the host monad @m@ into the 'Run' monad.-liftRun2 :: Monad m => (a -> m b) -> a -> Run m h b+liftRun2 :: Monad m => (a -> m b) -> a -> Run p m h b liftRun2 f x = liftRun $ f x  -- | Hoist a 'Run' action onto a different output type.--- @hoistRun fwd rev action@ hoists the @action@ from @Run m h a@ to--- @Run m t a@, applying @fwd@ and @rev@ to convert between the output+-- @hoistRun fwd rev action@ hoists the @action@ from @Run p m h a@ to+-- @Run p m t a@, applying @fwd@ and @rev@ to convert between the output -- types.-hoistRun :: Monad m => (h -> t) -> (t -> h) -> Run m h a -> Run m t a+hoistRun :: Monad m => (h -> t) -> (t -> h) -> Run p m h a -> Run p m t a hoistRun fwd rev action = do     contextT <- ask     let contextH = hoistContext rev fwd contextT@@ -390,3 +502,42 @@     let stateT' = hoistRunState fwd rev stateH'     put stateT'     Prelude.either throwError return x++warn :: (Monad m) => RuntimeError p -> Run p m h ()+warn err = do+    pos <- getSourcePos+    warnFn <- asks contextWarn+    warnFn $ RuntimeErrorAt pos err++warnFromMaybe :: Monad m => RuntimeError p -> a -> Maybe a -> Run p m h a+warnFromMaybe err d Nothing = warn err >> return d+warnFromMaybe _ d (Just x) = return x++setSourcePos :: (Monad m, Applicative m, Functor m)+             => p+             -> Run p m h ()+setSourcePos pos =+  modify (\s -> s { rsCurrentSourcePos = pos })++getSourcePos :: (Monad m, Applicative m, Functor m)+             => Run p m h p+getSourcePos = gets rsCurrentSourcePos++throwHere :: Monad m => RuntimeError p -> Run p m h a+throwHere err = do+    pos <- getSourcePos+    throwError $ RuntimeErrorAt pos err++-- | @withSourcePos pos action@ runs @action@ in a context where the+-- current source location is set to @pos@. The original source position is+-- restored when @action@ finishes.+withSourcePos :: (Monad m, Applicative m, Functor m)+              => p+              -> Run p m h a+              -> Run p m h a+withSourcePos pos a = do+  oldPos <- getSourcePos+  catchError+    (setSourcePos pos *> a <* setSourcePos oldPos)+    (\err -> throwError $ RuntimeErrorAt oldPos err)+

@@ -22,7 +22,7 @@  -- | 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 m h a -> Run m h a+withLocalScope :: (Monad m) => Run p m h a -> Run p m h a withLocalScope a = do     scope <- gets rsScope     r <- a@@ -31,17 +31,17 @@  -- | 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 m h) -> h) -> Run m h a -> Run m h a+withEncoder :: (ContextEncodable h, Monad m) => (GVal (Run p m h) -> h) -> Run p m h a -> Run p m h a withEncoder encoder =     local (\context -> context { contextEncode = encode }) -setVar :: Monad m => VarName -> GVal (Run m h) -> Run m h ()+setVar :: Monad m => VarName -> GVal (Run p m h) -> Run p m h () setVar name val = do     vars <- gets rsScope     let vars' = HashMap.insert name val vars     modify (\s -> s { rsScope = vars' }) -getVar :: Monad m => VarName -> Run m h (GVal (Run m h))+getVar :: Monad m => VarName -> Run p m h (GVal (Run p m h)) getVar key = do     vars <- gets rsScope     case HashMap.lookup key vars of@@ -51,12 +51,12 @@             l <- asks contextLookup             l key -clearCapture :: (Monoid h, Monad m) => Run m h ()+clearCapture :: (Monoid h, Monad m) => Run p m h () clearCapture = modify (\s -> s { rsCapture = mempty }) -appendCapture :: (Monoid h, Monad m) => h -> Run m h ()+appendCapture :: (Monoid h, Monad m) => h -> Run p m h () appendCapture h = modify (\s -> s { rsCapture = rsCapture s <> h }) -fetchCapture :: Monad m => Run m h h+fetchCapture :: Monad m => Run p m h h fetchCapture = gets rsCapture 

@@ -1,5 +1,6 @@ {-#LANGUAGE OverloadedStrings #-} {-#LANGUAGE FlexibleContexts #-}+{-#LANGUAGE FlexibleInstances #-} module Text.Ginger.PropertyTests where @@ -61,13 +62,13 @@     arbitrary =         ZonedTime <$> arbitrary <*> arbitrary -instance Arbitrary Statement where+instance Arbitrary (Statement ()) where     arbitrary = arbitraryStatement 2  arbitrarySimpleStatement = oneof-        [ return NullS-        , ScopedS <$> arbitrary-        , LiteralS <$> arbitrary+        [ return (NullS ())+        , ScopedS () <$> arbitrary+        , LiteralS () <$> arbitrary         -- , InterpolationS <$> arbitrary         -- , IfS <$> arbitrary <*> arbitrary <*> arbitrary         -- , ForS <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary@@ -77,14 +78,14 @@         -- , PreprocessedIncludeS <$> arbitrary         ] -arbitraryStatement :: Int -> Gen Statement+arbitraryStatement :: Int -> Gen (Statement ()) arbitraryStatement 0 = arbitrarySimpleStatement arbitraryStatement n = oneof     [ arbitrarySimpleStatement-    , MultiS <$> resize 5 (listOf $ arbitraryStatement (pred n))+    , MultiS () <$> resize 5 (listOf $ arbitraryStatement (pred n))     ] -instance Arbitrary Template where+instance Arbitrary (Template ()) where     arbitrary =         Template <$> arbitrary <*> return HashMap.empty <*> return Nothing @@ -135,7 +136,7 @@                => a -> Bool roundTripGValP = roundTripGValExP (==) -expand :: Template -> IO (Either String Text)+expand :: Template () -> IO (Either String Text) expand tpl =     mapLeft (const "ERROR" :: SomeException -> String) <$>         try (return $ runGinger (makeContextText (const def)) tpl)

@@ -37,6 +37,15 @@         , testCase "flow" $ mkTestHtml             [] [] "- {%- set x=1 -%} -" "--"         ]+    , testGroup "Trailing newlines"+        [ testCase "eaten after blocks" $ mkTestHtml+            [] [] "{% if true %}\nHello!\n{% endif %}\n" "Hello!\n"+        , testCase "not eaten after interpolations" $ mkTestHtml+            [] [] "{{'---'}}\nHello!\n{{'---'}}\n" "---\nHello!\n---\n"+        , testCase "not eaten after blocks when keepTrailingNewline is on" $+            mkTestHtmlOpts (\o -> o { poKeepTrailingNewline = True })+            [] [] "{% if true %}\nHello!\n{% endif %}\n" "\nHello!\n\n"+        ]     , testGroup "Literals"         [ testGroup "Strings"             [ testCase "String: \"foobar\"" $ mkTestHtml@@ -86,7 +95,7 @@         -- assert that the IORef contains what we expect.         [ testCase "print(\"Hello\")" $ do             buf <- newIORef ""-            let printF :: Function (Run IO Html)+            let printF :: Function (Run SourcePos IO Html)                 printF = \xs -> do                     liftIO . writeIORef buf . mconcat . map (asText . snd) $ xs                     return def@@ -96,7 +105,7 @@             assertEqual "" actual expected         , testCase "\"Hello\"|print" $ do             buf <- newIORef ""-            let printF :: Function (Run IO Html)+            let printF :: Function (Run SourcePos IO Html)                 printF = \xs -> do                     liftIO . writeIORef buf . mconcat . map (asText . snd) $ xs                     return def@@ -894,7 +903,7 @@                     , ""                     , "{% indent '' %}"                     , "<body>"-                    , "{{ foobar() }}"+                    , "{{ foobar() -}}"                     , "</body>"                     , "{% endindent %}"                     ])@@ -1173,26 +1182,34 @@         ]     ] -mkTestHtml :: [(VarName, GVal (Run IO Html))]+mkTestHtml :: [(VarName, GVal (Run SourcePos IO Html))]            -> [(FilePath, String)]            -> String            -> Text            -> Assertion-mkTestHtml = mkTest makeContextHtmlM htmlSource+mkTestHtml = mkTest id makeContextHtmlM htmlSource -mkTestText :: [(VarName, GVal (Run IO Text))]+mkTestHtmlOpts :: (ParserOptions IO -> ParserOptions IO)+               -> [(VarName, GVal (Run SourcePos IO Html))]+               -> [(FilePath, String)]+               -> String+               -> Text+               -> Assertion+mkTestHtmlOpts setOptions = mkTest setOptions makeContextHtmlM htmlSource++mkTestText :: [(VarName, GVal (Run SourcePos IO Text))]            -> [(FilePath, String)]            -> String            -> Text            -> Assertion-mkTestText = mkTest makeContextTextM id+mkTestText = mkTest id makeContextTextM id -mkTestJSON :: [(VarName, GVal (Run IO [JSON.Value]))]+mkTestJSON :: [(VarName, GVal (Run SourcePos IO [JSON.Value]))]            -> [(FilePath, String)]            -> String            -> Text            -> Assertion-mkTestJSON = mkTest+mkTestJSON = mkTest id     (\l w -> makeContextM' l w toJSONSingleton Nothing) encodeText     where         toJSONSingleton = (:[]) . JSON.toJSON@@ -1200,17 +1217,19 @@ encodeText :: JSON.ToJSON a => a -> Text encodeText = Text.pack . LUTF8.toString . JSON.encode -mkTest :: (Monoid a, ToGVal (Run IO a) a)-       => ((VarName -> Run IO a (GVal (Run IO a))) -> (a -> IO ()) -> GingerContext IO a) -- ^ mkContextM flavor+mkTest :: (Monoid a, ToGVal (Run SourcePos IO a) a)+       => (ParserOptions IO -> ParserOptions IO)+       -> ((VarName -> Run SourcePos IO a (GVal (Run SourcePos IO a))) -> (a -> IO ()) -> GingerContext SourcePos IO a) -- ^ mkContextM flavor        -> (a -> Text) -- ^ Convert a to Text for output-       -> [(VarName, GVal (Run IO a))] -- ^ Context dictionary+       -> [(VarName, GVal (Run SourcePos IO a))] -- ^ Context dictionary        -> [(FilePath, String)] -- ^ Lookup table for includes        -> String -- ^ Template source        -> Text -- ^ Expected output        -> Assertion-mkTest mContext valToText contextDict includeLookup src expected = do+mkTest setOptions mContext valToText contextDict includeLookup src expected = do     let resolver srcName = return $ lookup srcName includeLookup-    template <- either (fail . show) return =<< parseGinger resolver Nothing src+    let options = setOptions (mkParserOptions resolver)+    template <- either (fail . show) return =<< parseGinger' options src     output <- newIORef mempty     let write h = modifyIORef output (<> h)     let context = mContext