diff --git a/heist.cabal b/heist.cabal --- a/heist.cabal +++ b/heist.cabal @@ -1,5 +1,5 @@ name: heist -version: 1.0.0.0 +version: 1.0.1.0 synopsis: An Haskell template system supporting both HTML5 and XML. description: Heist is a powerful template system that supports both HTML5 and XML. @@ -67,6 +67,7 @@ test/templates/attrs.tpl, test/templates/attrsubtest1.tpl, test/templates/attrsubtest2.tpl, + test/templates/backslash.tpl test/templates/bar/a.tpl, test/templates/bar/index.tpl, test/templates/bind-apply-interaction/_outer.tpl, @@ -86,13 +87,18 @@ test/templates/index.tpl, test/templates/ioc.tpl, test/templates/json.tpl, + test/templates/json_array.tpl test/templates/json_object.tpl, test/templates/json_snippet.tpl, test/templates/markdown.tpl, + test/templates/namespaces.tpl test/templates/page.tpl, + test/templates/pandoc.tpl + test/templates/pandocdiv.tpl test/templates/people.tpl, test/templates/post.tpl, test/templates/readme.txt, + test/templates/rss.xtpl test/templates/test.md, test/templates/textarea_expansion.tpl, test/templates/title_expansion.tpl, @@ -104,6 +110,16 @@ test/templates-bad/apply-template-not-found.tpl, test/templates-bad/bind-infinite-loop.tpl, test/templates-bad/bind-missing-attr.tpl, + test/templates-defer/test.tpl, + test/templates-loaderror/_error.tpl, + test/templates-loaderror/_ok.tpl, + test/templates-loaderror/test.tpl, + test/templates-nsbind/nsbind.tpl, + test/templates-nsbind/nsbinderror.tpl, + test/templates-ns-nested/test.tpl, + test/templates-nscall/_call.tpl, + test/templates-nscall/_invalid.tpl, + test/templates-nscall/nscall.tpl, TODO @@ -135,7 +151,7 @@ Heist.Interpreted.Internal build-depends: - aeson >= 0.6 && < 0.12, + aeson >= 0.6 && < 1.1, attoparsec >= 0.10 && < 0.14, base >= 4 && < 5, blaze-builder >= 0.2 && < 0.5, @@ -191,7 +207,7 @@ build-depends: HUnit >= 1.2 && < 2, - QuickCheck >= 2 && < 2.9, + QuickCheck >= 2 && < 2.10, lens >= 4.3 && < 4.15, test-framework >= 0.4 && < 0.9, test-framework-hunit >= 0.2.7 && < 0.4, @@ -199,7 +215,7 @@ aeson, attoparsec, base, - bifunctors >= 5.3 && < 5.4, + bifunctors >= 5.3 && < 5.5, blaze-builder, blaze-html, bytestring, @@ -207,7 +223,6 @@ directory, directory-tree, dlist, - errors, filepath, hashable, lifted-base, @@ -226,8 +241,9 @@ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded Extensions: OverloadedStrings -Executable benchmark +Benchmark benchmark hs-source-dirs: src test/suite + type: exitcode-stdio-1.0 main-is: Benchmark.hs build-depends: @@ -248,7 +264,6 @@ directory, directory-tree, dlist, - errors, filepath, hashable, lifted-base, diff --git a/src/Heist.hs b/src/Heist.hs --- a/src/Heist.hs +++ b/src/Heist.hs @@ -41,6 +41,7 @@ , Chunk , HeistState , SpliceError(..) + , CompileException(..) , HeistT -- * Lenses (can be used with lens or lens-family) diff --git a/src/Heist/Common.hs b/src/Heist/Common.hs --- a/src/Heist/Common.hs +++ b/src/Heist/Common.hs @@ -91,28 +91,15 @@ tellSpliceError :: Monad m => Text -> HeistT n m () tellSpliceError msg = do hs <- getHS + node <- getParamNode let spliceError = SpliceError { spliceHistory = _splicePath hs , spliceTemplateFile = _curTemplateFile hs , visibleSplices = Map.keys $ _compiledSpliceMap hs + , contextNode = node , spliceMsg = msg } modifyHS (\hs' -> hs { _spliceErrors = spliceError : _spliceErrors hs' }) - - ------------------------------------------------------------------------------- --- | Transform a SpliceError record to a Text message. -spliceErrorText :: SpliceError -> Text -spliceErrorText (SpliceError hist tf splices msg) = - (maybe "" ((`mappend` ": ") . T.pack) tf) `T.append` msg `T.append` - foldr (\(_, tf', tag) -> (("\n ... via " `T.append` - (maybe "" ((`mappend` ": ") . T.pack) tf') - `T.append` tag) `T.append`)) T.empty hist - `T.append` - if null splices - then T.empty - else "\nBound splices:" `T.append` - foldl (\x y -> x `T.append` " " `T.append` y) T.empty splices ------------------------------------------------------------------------------ diff --git a/src/Heist/Compiled.hs b/src/Heist/Compiled.hs --- a/src/Heist/Compiled.hs +++ b/src/Heist/Compiled.hs @@ -28,11 +28,13 @@ , pureSplice , deferMany + , defer , deferMap , mayDeferMap , bindLater , withSplices , manyWithSplices + , manyWith , withLocalSplices -- * Constructing Chunks diff --git a/src/Heist/Compiled/Internal.hs b/src/Heist/Compiled/Internal.hs --- a/src/Heist/Compiled/Internal.hs +++ b/src/Heist/Compiled/Internal.hs @@ -14,6 +14,7 @@ import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Char.Utf8 import Control.Arrow +import Control.Exception import Control.Monad import Control.Monad.RWS.Strict import Control.Monad.State.Strict @@ -290,14 +291,33 @@ let pre = _splicePrefix hs let hasPrefix = (T.isPrefixOf pre `fmap` X.tagName node) == Just True when (not (T.null pre) && hasPrefix) incNamespacedTags - isStatic <- subtreeIsStatic node - markup <- getsHS _curMarkup - if isStatic - then return $! yieldPure $! renderFragment markup [parseAttrs node] - else localHS (\hs' -> hs' {_splicePath = - (_curContext hs', _curTemplateFile hs', - X.elementTag node):(_splicePath hs')}) $ - compileNode node + hs' <- getHS + -- Plain rethrows for CompileException to avoid multiple annotations. + (res, hs'') <- liftIO $ catches (compileIO hs') + [ Handler (\(ex :: CompileException) -> throwIO ex) + , Handler (\(ex :: SomeException) -> handleError ex hs')] + putHS hs'' + return res + where + localSplicePath = + localHS (\hs -> hs {_splicePath = (_curContext hs, + _curTemplateFile hs, + X.elementTag node): + (_splicePath hs)}) + compileIO hs = runHeistT compile node hs + compile = do + isStatic <- subtreeIsStatic node + dl <- compile' isStatic + liftIO $ evaluate $ DL.fromList $! consolidate dl + compile' True = do + markup <- getsHS _curMarkup + return $! yieldPure $! renderFragment markup [parseAttrs node] + compile' False = localSplicePath $ compileNode node + handleError ex hs = do + errs <- evalHeistT (do localSplicePath $ tellSpliceError $ T.pack $ + "Exception in splice compile: " ++ show ex + getsHS _spliceErrors) node hs + throwIO $ CompileException ex errs parseAttrs :: X.Node -> X.Node @@ -606,13 +626,14 @@ -- | Looks up a compiled template and returns a compiled splice. callTemplate :: Monad n => ByteString - -> HeistT n IO (DList (Chunk n)) + -> Splice n callTemplate nm = do hs <- getHS - runNodeList $ maybe (error err) (X.docContent . dfDoc . fst) $ - lookupTemplate nm hs _templateMap + maybe (error err) call $ lookupTemplate nm hs _templateMap where err = "callTemplate: "++(T.unpack $ T.decodeUtf8 nm)++(" does not exist") + call (df,_) = localHS (\hs' -> hs' {_curTemplateFile = dfFile df}) $ + runNodeList $ X.docContent $ dfDoc df interpret :: Monad n => DList (Chunk n) -> n Builder @@ -735,42 +756,37 @@ ------------------------------------------------------------------------------ -- | Saves the results of a runtme computation in a 'Promise' so they don't -- get recalculated if used more than once. +-- +-- Note that this is just a specialized version of function application ($) +-- done for the side effect in runtime splice. +defer :: Monad n + => (RuntimeSplice n a -> Splice n) + -> RuntimeSplice n a -> Splice n +defer pf n = do + p2 <- newEmptyPromise + let action = yieldRuntimeEffect $ putPromise p2 =<< n + res <- pf $ getPromise p2 + return $ action `mappend` res + + +------------------------------------------------------------------------------ +-- | A version of defer which applies a function on the runtime value. deferMap :: Monad n => (a -> RuntimeSplice n b) -> (RuntimeSplice n b -> Splice n) -> RuntimeSplice n a -> Splice n -deferMap f pf n = do - p2 <- newEmptyPromise - let action = yieldRuntimeEffect $ putPromise p2 =<< f =<< n - res <- pf $ getPromise p2 - return $ action `mappend` res +deferMap f pf n = defer pf $ f =<< n ------------------------------------------------------------------------------ -- | Like deferMap, but only runs the result if a Maybe function of the -- runtime value returns Just. If it returns Nothing, then no output is -- generated. --- --- This is a good example of how to do more complex flow control with --- promises. The generalization of this abstraction is too complex to be --- distilled to elegant high-level combinators. If you need to implement your --- own special flow control, then you should use functions from the --- `Heist.Compiled.LowLevel` module similarly to how it is done in the --- implementation of this function. mayDeferMap :: Monad n => (a -> RuntimeSplice n (Maybe b)) -> (RuntimeSplice n b -> Splice n) -> RuntimeSplice n a -> Splice n -mayDeferMap f pf n = do - p2 <- newEmptyPromise - action <- pf $ getPromise p2 - return $ yieldRuntime $ do - mb <- f =<< n - case mb of - Nothing -> return mempty - Just b -> do - putPromise p2 b - codeGen action +mayDeferMap f pf n = deferMany pf $ f =<< n ------------------------------------------------------------------------------ diff --git a/src/Heist/Internal/Types/HeistState.hs b/src/Heist/Internal/Types/HeistState.hs --- a/src/Heist/Internal/Types/HeistState.hs +++ b/src/Heist/Internal/Types/HeistState.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -23,6 +24,7 @@ import Blaze.ByteString.Builder (Builder) import Control.Applicative (Alternative (..)) import Control.Arrow (first) +import Control.Exception (Exception) import Control.Monad (MonadPlus (..), ap) import Control.Monad.Base import Control.Monad.Cont (MonadCont (..)) @@ -171,11 +173,50 @@ { spliceHistory :: [(TPath, Maybe FilePath, Text)] , spliceTemplateFile :: Maybe FilePath , visibleSplices :: [Text] + , contextNode :: X.Node , spliceMsg :: Text } deriving ( Show, Eq ) ------------------------------------------------------------------------------ +-- | Transform a SpliceError record to a Text message. +spliceErrorText :: SpliceError -> Text +spliceErrorText (SpliceError hist tf splices node msg) = + (maybe "" ((`mappend` ": ") . T.pack) tf) `T.append` msg `T.append` + foldr (\(_, tf', tag) -> (("\n ... via " `T.append` + (maybe "" ((`mappend` ": ") . T.pack) tf') + `T.append` tag) `T.append`)) T.empty hist + `T.append` + if null splices + then T.empty + else "\nBound splices:" `T.append` + foldl (\x y -> x `T.append` " " `T.append` y) T.empty splices + `T.append` + (T.pack $ "\nNode: " ++ (show node)) + + +------------------------------------------------------------------------------ +-- | Exception type for splice compile errors. Wraps the original +-- exception and provides context. +--data (Exception e) => CompileException e = CompileException +data CompileException = forall e . Exception e => CompileException + { originalException :: e + -- The list of splice errors. The head of it has the context + -- related to the exception. + , exceptionContext :: [SpliceError] + } deriving ( Typeable ) + + +instance Show CompileException where + show (CompileException e []) = + "Heist load exception (unknown context): " ++ (show e) + show (CompileException _ (c:_)) = (T.unpack $ spliceErrorText c) + + +instance Exception CompileException + + +------------------------------------------------------------------------------ -- | Holds all the state information needed for template processing. You will -- build a @HeistState@ using 'initHeist' and any of Heist's @HeistState -> -- HeistState@ \"filter\" functions. Then you use the resulting @HeistState@ @@ -564,6 +605,8 @@ -- spliceMap. restoreHS :: Monad m => HeistState n -> HeistT n m () restoreHS old = modifyHS (\cur -> old { _doctypes = _doctypes cur + , _numNamespacedTags = + _numNamespacedTags cur , _spliceErrors = _spliceErrors cur }) {-# INLINE restoreHS #-} diff --git a/test/suite/Benchmark.hs b/test/suite/Benchmark.hs --- a/test/suite/Benchmark.hs +++ b/test/suite/Benchmark.hs @@ -6,9 +6,9 @@ ------------------------------------------------------------------------------ import Blaze.ByteString.Builder import Control.Concurrent -import Control.Error import Control.Exception (evaluate) import Control.Monad +import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT) import Criterion import Criterion.Main import Criterion.Measurement hiding (getTime) diff --git a/test/suite/Heist/Compiled/Tests.hs b/test/suite/Heist/Compiled/Tests.hs --- a/test/suite/Heist/Compiled/Tests.hs +++ b/test/suite/Heist/Compiled/Tests.hs @@ -1,22 +1,29 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Heist.Compiled.Tests where import Blaze.ByteString.Builder -import Control.Error +import Control.Applicative +import Control.Exception +import Control.Monad.Trans.Except import Control.Lens import Control.Monad.Trans import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Char +import Data.IORef +import Data.Maybe import Data.Map.Syntax import Data.Monoid import qualified Data.Set as Set +import qualified Data.Text as T import Data.Text.Encoding import Test.Framework (Test) import Test.Framework.Providers.HUnit import qualified Test.HUnit as H +import qualified Text.XmlHtml as X ------------------------------------------------------------------------------ @@ -41,12 +48,15 @@ , testCase "compiled/namespace4" namespaceTest4 , testCase "compiled/namespace5" namespaceTest5 , testCase "compiled/no-ns-splices" noNsSplices + , testCase "compiled/ns-nested" nsNestedUnused , testCase "compiled/nsbind" nsBindTest , testCase "compiled/nsbinderr" nsBindErrorTest , testCase "compiled/nscall" nsCallTest , testCase "compiled/nscallerr" nsCallErrTest , testCase "compiled/nsbindstack" nsBindStackTest , testCase "compiled/doctype" doctypeTest + , testCase "compiled/exceptions" exceptionsTest + , testCase "compiled/defer" deferTest ] simpleCompiledTest :: IO () @@ -179,6 +189,25 @@ & scTemplateLocations .~ [loadTemplates "templates-no-ns"] +------------------------------------------------------------------------------ +-- | Test that no namespace splice message works correctly when there are no +-- top level splices used +nsNestedUnused :: IO () +nsNestedUnused = do + res <- runExceptT $ do + hs <- ExceptT $ initHeist hc + runner <- noteT ["Error rendering"] $ hoistMaybe $ + renderTemplate hs "test" + b <- lift $ fst runner + return $ toByteString b + + H.assertEqual "ns nested unused warn test" (Right "
aeou
\n") res + where + hc = HeistConfig sc "h" False + sc = mempty & scCompiledSplices .~ ("foo" ## return $ yieldPureText "aeou") + & scTemplateLocations .~ [loadTemplates "templates-ns-nested"] + + nsBindTemplateHC :: String -> HeistConfig IO nsBindTemplateHC dir = HeistConfig sc "h" False where @@ -237,9 +266,9 @@ H.assertEqual "namespace bind error test" (Left [ err1, err2, err3 ]) res where - err1 = "templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid3\n ... via templates-nsbind/nsbinderror.tpl: h:main2\nBound splices: h:sub h:recurse h:call h:main2 h:main" - err2 = "templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid2\n ... via templates-nsbind/nsbinderror.tpl: h:recurse\n ... via templates-nsbind/nsbinderror.tpl: h:main\nBound splices: h:sub h:recurse h:call h:main2 h:main" - err3 = "templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid1\nBound splices: h:call h:main2 h:main" + err1 = "templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid3\n ... via templates-nsbind/nsbinderror.tpl: h:main2\nBound splices: h:sub h:recurse h:call h:main2 h:main\nNode: Element {elementTag = \"h:invalid3\", elementAttrs = [], elementChildren = []}" + err2 = "templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid2\n ... via templates-nsbind/nsbinderror.tpl: h:recurse\n ... via templates-nsbind/nsbinderror.tpl: h:main\nBound splices: h:sub h:recurse h:call h:main2 h:main\nNode: Element {elementTag = \"h:invalid2\", elementAttrs = [], elementChildren = []}" + err3 = "templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid1\nBound splices: h:call h:main2 h:main\nNode: Element {elementTag = \"h:invalid1\", elementAttrs = [], elementChildren = []}" ------------------------------------------------------------------------------ @@ -256,6 +285,7 @@ , "h:main2") ] (Just "templates-nsbind/nsbinderror.tpl") ["h:sub","h:recurse","h:call","h:main2","h:main"] + (X.Element "h:invalid3" [] []) "No splice bound for h:invalid3" err2 = SpliceError [ ( ["nsbinderror"] , Just "templates-nsbind/nsbinderror.tpl" @@ -265,10 +295,12 @@ ,"h:main") ] (Just "templates-nsbind/nsbinderror.tpl") ["h:sub","h:recurse","h:call","h:main2","h:main"] + (X.Element "h:invalid2" [] []) "No splice bound for h:invalid2" err3 = SpliceError [] (Just "templates-nsbind/nsbinderror.tpl") ["h:call","h:main2","h:main"] + (X.Element "h:invalid1" [] []) "No splice bound for h:invalid1" @@ -302,5 +334,86 @@ (Left $ Set.fromList [ err1, err2 ]) (first Set.fromList res) where - err1 = "templates-nscall/_call.tpl: No splice bound for h:sub\nBound splices: h:call h:main2 h:main" - err2 = "templates-nscall/_invalid.tpl: No splice bound for h:invalid\nBound splices: h:call h:main2 h:main" + err1 = "templates-nscall/_call.tpl: No splice bound for h:sub\nBound splices: h:call h:main2 h:main\nNode: Element {elementTag = \"h:sub\", elementAttrs = [], elementChildren = []}" + err2 = "templates-nscall/_invalid.tpl: No splice bound for h:invalid\nBound splices: h:call h:main2 h:main\nNode: Element {elementTag = \"h:invalid\", elementAttrs = [], elementChildren = []}" + + +------------------------------------------------------------------------------ +-- | Test exception handling in template load. +exceptionsTest :: IO () +exceptionsTest = do + res <- Control.Exception.catch + (runExceptT $ do + hs <- ExceptT $ initHeist hc + -- The rest needed only for type inference. + runner <- noteT ["Error rendering"] $ hoistMaybe $ + renderTemplate hs "" + _ <- lift $ fst runner + throwE ["Unexpected success"]) + (\(e :: CompileException) -> return $ Right + (show e, head $ + exceptionContext e)) + + H.assertEqual "exceptions" (Right (msg, err)) $ res + + where + msg = "templates-loaderror/_error.tpl: Exception in splice compile: Prelude.read: no parse\n ... via templates-loaderror/_error.tpl: h:adder\n ... via templates-loaderror/test.tpl: h:call2\nBound splices: h:adder h:call2 h:call1\nNode: Element {elementTag = \"h:adder\", elementAttrs = [(\"value\",\"noparse\")], elementChildren = []}" + err = SpliceError [ ( ["test"] + , Just "templates-loaderror/_error.tpl" + , "h:adder"), + ( ["test"] + , Just "templates-loaderror/test.tpl" + ,"h:call2") ] + (Just "templates-loaderror/_error.tpl") + ["h:adder", "h:call2", "h:call1"] + (X.Element "h:adder" [("value", "noparse")] []) + "Exception in splice compile: Prelude.read: no parse" + hc = HeistConfig sc "h" True + sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices + & scCompiledSplices .~ splices + & scTemplateLocations .~ [loadTemplates "templates-loaderror"] + splices = do + "call1" ## callTemplate "_ok" + "call2" ## callTemplate "_error" + "adder" ## do + value :: Int <- read . T.unpack . fromJust . + X.getAttribute "value" <$> getParamNode + return $ yieldPureText $ T.pack $ show $ 1 + value + + +------------------------------------------------------------------------------ +-- | Test for defer functions to see that they correctly save the result of +-- a runtime computation. +deferTest :: IO () +deferTest = do + rs <- mapM newIORef $ replicate 5 (0 :: Int) + res <- runExceptT $ do + hs <- ExceptT $ initHeist $ hc rs + runner <- noteT ["Error rendering"] $ hoistMaybe $ + renderTemplate hs "test" + b <- lift $ fst runner + return $ toByteString b + + vs <- mapM readIORef rs + H.assertEqual "defer test" ([2, 1, 1, 1, 1], Right msg) (vs, res) + where + msg = "1 2\n1 1\n1 1\n\n1 1\n" + hc rs = HeistConfig (sc rs) "h" True + sc rs = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices + & scCompiledSplices .~ (splices rs) + & scTemplateLocations .~ [loadTemplates "templates-defer"] + splices [r1, r2, r3, r4, r5] = do + "plain" ## subSplice $ addAndReturn r1 + "defer" ## deferMap return subSplice $ addAndReturn r2 + "maydefer" ## mayDeferMap (return . Just) subSplice $ addAndReturn r3 + "maydefer2" ## mayDeferMap (const $ return Nothing) subSplice $ + addAndReturn r4 + "defermany" ## deferMany subSplice $ addAndReturn' r5 + subSplice = + withSplices runChildren + ("use" ## \n -> return $ yieldRuntimeText $ return . T.pack . show =<< n) + addAndReturn r = liftIO $ modifyIORef r (+1) >> readIORef r + addAndReturn' r = liftIO $ do + modifyIORef r (+1) + val <- readIORef r + return [val] diff --git a/test/suite/Heist/Interpreted/Tests.hs b/test/suite/Heist/Interpreted/Tests.hs --- a/test/suite/Heist/Interpreted/Tests.hs +++ b/test/suite/Heist/Interpreted/Tests.hs @@ -11,7 +11,6 @@ ------------------------------------------------------------------------------ import Blaze.ByteString.Builder -import Control.Error import Control.Monad.State import Data.Aeson import Data.ByteString.Char8 (ByteString) @@ -629,7 +628,6 @@ Nothing)) hs evalHeistT (runNodeList $ buildApplyCaller apply) (X.TextNode "") hs' - diff --git a/test/suite/Heist/TestCommon.hs b/test/suite/Heist/TestCommon.hs --- a/test/suite/Heist/TestCommon.hs +++ b/test/suite/Heist/TestCommon.hs @@ -2,11 +2,11 @@ ------------------------------------------------------------------------------ import Blaze.ByteString.Builder -import Control.Error import Control.Monad.Trans +import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) +import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B -import Data.Map.Syntax import Data.Maybe import Data.Monoid @@ -113,3 +113,22 @@ builder <- I.renderTemplate hs name return $ toByteString $ fst $ fromJust builder + +------------------------------------------------------------------------------ +isLeft :: Either e a -> Bool +isLeft (Left _) = True +isLeft _ = False + + +------------------------------------------------------------------------------ +noteT :: Monad m => e -> MaybeT m a -> ExceptT e m a +noteT e ma = do + x <- lift $ runMaybeT ma + case x of + Nothing -> ExceptT $ return (Left e) + Just a -> ExceptT $ return (Right a) + + +------------------------------------------------------------------------------ +hoistMaybe :: Monad m => Maybe a -> MaybeT m a +hoistMaybe = MaybeT . return diff --git a/test/suite/Heist/Tutorial/Imports.hs b/test/suite/Heist/Tutorial/Imports.hs --- a/test/suite/Heist/Tutorial/Imports.hs +++ b/test/suite/Heist/Tutorial/Imports.hs @@ -15,9 +15,9 @@ ) where import Blaze.ByteString.Builder -import Control.Error (runExceptT, ExceptT(..)) import Control.Monad import Control.Monad.Trans +import Control.Monad.Trans.Except (ExceptT(..), runExceptT) import qualified Control.Monad.Trans.State as ST import Data.ByteString.Char8 (ByteString) import Data.Maybe diff --git a/test/templates-defer/test.tpl b/test/templates-defer/test.tpl new file mode 100644 --- /dev/null +++ b/test/templates-defer/test.tpl @@ -0,0 +1,5 @@ + + + + + diff --git a/test/templates-loaderror/_error.tpl b/test/templates-loaderror/_error.tpl new file mode 100644 --- /dev/null +++ b/test/templates-loaderror/_error.tpl @@ -0,0 +1,1 @@ + diff --git a/test/templates-loaderror/_ok.tpl b/test/templates-loaderror/_ok.tpl new file mode 100644 --- /dev/null +++ b/test/templates-loaderror/_ok.tpl @@ -0,0 +1,1 @@ + diff --git a/test/templates-loaderror/test.tpl b/test/templates-loaderror/test.tpl new file mode 100644 --- /dev/null +++ b/test/templates-loaderror/test.tpl @@ -0,0 +1,3 @@ + + + diff --git a/test/templates-ns-nested/test.tpl b/test/templates-ns-nested/test.tpl new file mode 100644 --- /dev/null +++ b/test/templates-ns-nested/test.tpl @@ -0,0 +1,1 @@ +
diff --git a/test/templates-nsbind/nsbind.tpl b/test/templates-nsbind/nsbind.tpl new file mode 100644 --- /dev/null +++ b/test/templates-nsbind/nsbind.tpl @@ -0,0 +1,7 @@ +Alpha + +Beta + +Gamma + + diff --git a/test/templates-nsbind/nsbinderror.tpl b/test/templates-nsbind/nsbinderror.tpl new file mode 100644 --- /dev/null +++ b/test/templates-nsbind/nsbinderror.tpl @@ -0,0 +1,10 @@ +Alpha + + + + + + + + + diff --git a/test/templates-nscall/_call.tpl b/test/templates-nscall/_call.tpl new file mode 100644 --- /dev/null +++ b/test/templates-nscall/_call.tpl @@ -0,0 +1,2 @@ +Called + diff --git a/test/templates-nscall/_invalid.tpl b/test/templates-nscall/_invalid.tpl new file mode 100644 --- /dev/null +++ b/test/templates-nscall/_invalid.tpl @@ -0,0 +1,1 @@ + diff --git a/test/templates-nscall/nscall.tpl b/test/templates-nscall/nscall.tpl new file mode 100644 --- /dev/null +++ b/test/templates-nscall/nscall.tpl @@ -0,0 +1,6 @@ +Top + +Inside 1 + +Inside 2 + diff --git a/test/templates/backslash.tpl b/test/templates/backslash.tpl new file mode 100644 --- /dev/null +++ b/test/templates/backslash.tpl @@ -0,0 +1,1 @@ + diff --git a/test/templates/json_array.tpl b/test/templates/json_array.tpl new file mode 100644 --- /dev/null +++ b/test/templates/json_array.tpl @@ -0,0 +1,1 @@ +, and diff --git a/test/templates/namespaces.tpl b/test/templates/namespaces.tpl new file mode 100644 --- /dev/null +++ b/test/templates/namespaces.tpl @@ -0,0 +1,5 @@ +Alpha +Inside foo +Beta +Inside h:foo +End diff --git a/test/templates/pandoc.tpl b/test/templates/pandoc.tpl new file mode 100644 --- /dev/null +++ b/test/templates/pandoc.tpl @@ -0,0 +1,1 @@ + diff --git a/test/templates/pandocdiv.tpl b/test/templates/pandocdiv.tpl new file mode 100644 --- /dev/null +++ b/test/templates/pandocdiv.tpl @@ -0,0 +1,1 @@ + diff --git a/test/templates/rss.xtpl b/test/templates/rss.xtpl new file mode 100644 --- /dev/null +++ b/test/templates/rss.xtpl @@ -0,0 +1,1 @@ +http://www.devalot.com/