heist 0.14.1.4 → 1.0.0.0
raw patch · 28 files changed
+877/−567 lines, 28 filesdep +HUnitdep +QuickCheckdep +bifunctorsdep −MonadCatchIO-transformersdep −eitherdep ~aesondep ~attoparsecdep ~basenew-component:exe:benchmarkPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, QuickCheck, bifunctors, criterion, errors, lens, lifted-base, monad-control, statistics, test-framework, test-framework-hunit, test-framework-quickcheck2, transformers-base
Dependencies removed: MonadCatchIO-transformers, either
Dependency ranges changed: aeson, attoparsec, base, blaze-builder, blaze-html, bytestring, containers, directory, directory-tree, dlist, filepath, hashable, map-syntax, mtl, process, random, text, time, transformers, unordered-containers, vector, xmlhtml
API changes (from Hackage documentation)
- Heist.SpliceAPI: ($$) :: Splices (a -> b) -> a -> Splices b
- Heist.SpliceAPI: applyS :: a -> Splices (a -> b) -> Splices b
- Heist.SpliceAPI: mapNames :: (Text -> Text) -> Splices a -> Splices a
- Heist.SpliceAPI: mapS :: (a -> b) -> Splices a -> Splices b
- Heist.SpliceAPI: namespaceSplices :: Text -> Splices a -> Splices a
- Heist.SpliceAPI: noSplices :: Splices s
- Heist.SpliceAPI: prefixSplices :: Text -> Text -> Splices a -> Splices a
- Heist.SpliceAPI: type Splices s = MapSyntax Text s
- Heist.SpliceAPI: type SplicesM s a = MapSyntaxM Text s a
- Heist.Splices.Markdown: MarkdownException :: ByteString -> MarkdownException
- Heist.Splices.Markdown: NoMarkdownFileException :: NoMarkdownFileException
- Heist.Splices.Markdown: PandocMissingException :: PandocMissingException
+ Heist: SpliceError :: [(TPath, Maybe FilePath, Text)] -> Maybe FilePath -> [Text] -> Text -> SpliceError
+ Heist: [spliceHistory] :: SpliceError -> [(TPath, Maybe FilePath, Text)]
+ Heist: [spliceMsg] :: SpliceError -> Text
+ Heist: [spliceTemplateFile] :: SpliceError -> Maybe FilePath
+ Heist: [visibleSplices] :: SpliceError -> [Text]
+ Heist: data SpliceError
+ Heist: hcCompiledTemplateFilter :: Functor f => ((TPath -> Bool) -> f (TPath -> Bool)) -> HeistConfig m -> f (HeistConfig m)
+ Heist: scCompiledTemplateFilter :: Functor f => ((TPath -> Bool) -> f (TPath -> Bool)) -> SpliceConfig m -> f (SpliceConfig m)
+ Heist: spliceErrorText :: SpliceError -> Text
+ Heist: type Splices s = MapSyntax Text s
+ Heist.Internal.Types: SpliceError :: [(TPath, Maybe FilePath, Text)] -> Maybe FilePath -> [Text] -> Text -> SpliceError
+ Heist.Internal.Types: [_scCompiledTemplateFilter] :: SpliceConfig m -> TPath -> Bool
+ Heist.Internal.Types: [_splicePath] :: HeistState m -> [(TPath, Maybe FilePath, Text)]
+ Heist.Internal.Types: [spliceHistory] :: SpliceError -> [(TPath, Maybe FilePath, Text)]
+ Heist.Internal.Types: [spliceMsg] :: SpliceError -> Text
+ Heist.Internal.Types: [spliceTemplateFile] :: SpliceError -> Maybe FilePath
+ Heist.Internal.Types: [visibleSplices] :: SpliceError -> [Text]
+ Heist.Internal.Types: data SpliceError
+ Heist.Internal.Types: hcCompiledTemplateFilter :: Functor f => ((TPath -> Bool) -> f (TPath -> Bool)) -> HeistConfig m -> f (HeistConfig m)
+ Heist.Internal.Types: scCompiledTemplateFilter :: Functor f => ((TPath -> Bool) -> f (TPath -> Bool)) -> SpliceConfig m -> f (SpliceConfig m)
+ Heist.Splices: ifElseCSplice :: Monad m => Bool -> Splice m
+ Heist.Splices: ifElseISplice :: Monad m => Bool -> Splice m
+ Heist.Splices.Markdown: data PandocOptions
+ Heist.Splices.Markdown: defaultPandocOptions :: PandocOptions
+ Heist.Splices.Markdown: instance GHC.Classes.Eq Heist.Splices.Markdown.PandocOptions
+ Heist.Splices.Markdown: instance GHC.Classes.Ord Heist.Splices.Markdown.PandocOptions
+ Heist.Splices.Markdown: instance GHC.Show.Show Heist.Splices.Markdown.PandocOptions
+ Heist.Splices.Markdown: pandocArgs :: Functor f => ([String] -> f [String]) -> PandocOptions -> f PandocOptions
+ Heist.Splices.Markdown: pandocBaseDir :: Functor f => (Maybe FilePath -> f (Maybe FilePath)) -> PandocOptions -> f PandocOptions
+ Heist.Splices.Markdown: pandocExecutable :: Functor f => (FilePath -> f FilePath) -> PandocOptions -> f PandocOptions
+ Heist.Splices.Markdown: pandocSplice :: MonadIO m => PandocOptions -> Splice m
+ Heist.Splices.Markdown: pandocWrapDiv :: Functor f => (Maybe Text -> f (Maybe Text)) -> PandocOptions -> f PandocOptions
+ Heist.Splices.Markdown: setPandocArgs :: [String] -> PandocOptions -> PandocOptions
+ Heist.Splices.Markdown: setPandocBaseDir :: Maybe FilePath -> PandocOptions -> PandocOptions
+ Heist.Splices.Markdown: setPandocExecutable :: FilePath -> PandocOptions -> PandocOptions
+ Heist.Splices.Markdown: setPandocWrapDiv :: Maybe Text -> PandocOptions -> PandocOptions
- Heist: initHeist :: Monad n => HeistConfig n -> EitherT [String] IO (HeistState n)
+ Heist: initHeist :: Monad n => HeistConfig n -> IO (Either [String] (HeistState n))
- Heist: initHeistWithCacheTag :: MonadIO n => HeistConfig n -> EitherT [String] IO (HeistState n, CacheTagState)
+ Heist: initHeistWithCacheTag :: MonadIO n => HeistConfig n -> IO (Either [String] (HeistState n, CacheTagState))
- Heist: loadTemplates :: FilePath -> EitherT [String] IO TemplateRepo
+ Heist: loadTemplates :: FilePath -> IO (Either [String] TemplateRepo)
- Heist: reloadTemplates :: TemplateRepo -> EitherT [String] IO TemplateRepo
+ Heist: reloadTemplates :: TemplateRepo -> IO (Either [String] TemplateRepo)
- Heist: type TemplateLocation = EitherT [String] IO TemplateRepo
+ Heist: type TemplateLocation = IO (Either [String] TemplateRepo)
- Heist.Compiled: deferMany :: Monad n => (RuntimeSplice n a -> Splice n) -> RuntimeSplice n [a] -> Splice n
+ Heist.Compiled: deferMany :: (Foldable f, Monad n) => (RuntimeSplice n a -> Splice n) -> RuntimeSplice n (f a) -> Splice n
- Heist.Compiled: manyWithSplices :: Monad n => Splice n -> Splices (RuntimeSplice n a -> Splice n) -> RuntimeSplice n [a] -> Splice n
+ Heist.Compiled: manyWithSplices :: (Foldable f, Monad n) => Splice n -> Splices (RuntimeSplice n a -> Splice n) -> RuntimeSplice n (f a) -> Splice n
- Heist.Internal.Types: HeistState :: HashMap Text (HeistT m m Template) -> HashMap TPath DocumentFile -> HashMap Text (HeistT m IO (DList (Chunk m))) -> !(HashMap TPath ([Chunk m], MIMEType)) -> HashMap Text (AttrSplice m) -> Bool -> TPath -> Int -> [DocType] -> Maybe FilePath -> KeyGen -> Bool -> Markup -> Text -> [Text] -> Bool -> Int -> HeistState m
+ Heist.Internal.Types: HeistState :: HashMap Text (HeistT m m Template) -> HashMap TPath DocumentFile -> HashMap Text (HeistT m IO (DList (Chunk m))) -> !(HashMap TPath ([Chunk m], MIMEType)) -> HashMap Text (AttrSplice m) -> Bool -> TPath -> [(TPath, Maybe FilePath, Text)] -> Int -> [DocType] -> Maybe FilePath -> KeyGen -> Bool -> Markup -> Text -> [SpliceError] -> Bool -> Int -> HeistState m
- Heist.Internal.Types: SpliceConfig :: Splices (Splice m) -> Splices (Splice IO) -> Splices (Splice m) -> Splices (AttrSplice m) -> [TemplateLocation] -> SpliceConfig m
+ Heist.Internal.Types: SpliceConfig :: Splices (Splice m) -> Splices (Splice IO) -> Splices (Splice m) -> Splices (AttrSplice m) -> [TemplateLocation] -> (TPath -> Bool) -> SpliceConfig m
- Heist.Internal.Types: [_spliceErrors] :: HeistState m -> [Text]
+ Heist.Internal.Types: [_spliceErrors] :: HeistState m -> [SpliceError]
- Heist.Internal.Types: type TemplateLocation = EitherT [String] IO TemplateRepo
+ Heist.Internal.Types: type TemplateLocation = IO (Either [String] TemplateRepo)
- Heist.Splices.Apply: applyImpl :: MonadIO n => Splice n
+ Heist.Splices.Apply: applyImpl :: Monad n => Splice n
- Heist.Splices.Apply: applyNodes :: MonadIO n => Template -> Text -> Splice n
+ Heist.Splices.Apply: applyNodes :: Monad n => Template -> Text -> Splice n
- Heist.Splices.Bind: bindImpl :: MonadIO n => Splice n
+ Heist.Splices.Bind: bindImpl :: Monad n => Splice n
- Heist.Splices.BindStrict: bindStrictImpl :: MonadIO n => Splice n
+ Heist.Splices.BindStrict: bindStrictImpl :: Monad n => Splice n
- Heist.TemplateDirectory: newTemplateDirectory :: MonadIO n => FilePath -> HeistConfig n -> EitherT [String] IO (TemplateDirectory n)
+ Heist.TemplateDirectory: newTemplateDirectory :: MonadIO n => FilePath -> HeistConfig n -> IO (Either [String] (TemplateDirectory n))
Files
- README.md +3/−1
- heist.cabal +110/−19
- src/Heist.hs +80/−65
- src/Heist/Common.hs +38/−14
- src/Heist/Compiled/Internal.hs +55/−36
- src/Heist/Internal/Types.hs +42/−12
- src/Heist/Internal/Types/HeistState.hs +85/−29
- src/Heist/SpliceAPI.hs +0/−102
- src/Heist/Splices.hs +29/−1
- src/Heist/Splices/Apply.hs +2/−4
- src/Heist/Splices/Bind.hs +1/−2
- src/Heist/Splices/BindStrict.hs +1/−2
- src/Heist/Splices/Cache.hs +5/−2
- src/Heist/Splices/Json.hs +10/−6
- src/Heist/Splices/Markdown.hs +202/−35
- src/Heist/TemplateDirectory.hs +11/−11
- test/.ghci +0/−5
- test/README +0/−1
- test/heist-testsuite.cabal +0/−101
- test/runTestsAndCoverage.sh +0/−48
- test/suite/Benchmark.hs +3/−3
- test/suite/Heist/Compiled/Tests.hs +124/−34
- test/suite/Heist/Interpreted/Tests.hs +31/−4
- test/suite/Heist/TestCommon.hs +11/−10
- test/suite/Heist/Tests.hs +22/−13
- test/suite/Heist/Tutorial/CompiledSplices.lhs +4/−4
- test/suite/Heist/Tutorial/Imports.hs +3/−2
- test/suite/TestSuite.hs +5/−1
README.md view
@@ -1,5 +1,7 @@ # Heist +[](https://travis-ci.org/snapframework/heist)+ Heist, part of the [Snap Framework](http://www.snapframework.com/), is a Haskell library for xml/html templating. It uses simple XML tags to bind values to your templates in a straightforward way. For example, if you were to@@ -15,7 +17,7 @@ Likewise, if you need to add text to an attribute, <bind tag="special">special-id</bind>- <div id="$(special)">very special</div>+ <div id="${special}">very special</div> gives you
heist.cabal view
@@ -1,5 +1,5 @@ name: heist-version: 0.14.1.4+version: 1.0.0.0 synopsis: An Haskell template system supporting both HTML5 and XML. description: Heist is a powerful template system that supports both HTML5 and XML.@@ -27,9 +27,10 @@ author: Doug Beardsley, Gregory Collins maintainer: snap@snapframework.com build-type: Simple-cabal-version: >= 1.6+cabal-version: >= 1.8.0.4 homepage: http://snapframework.com/ category: Web, Snap+Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 extra-source-files: .ghci,@@ -52,10 +53,6 @@ LICENSE, README.md, README.SNAP.md,- test/.ghci,- test/heist-testsuite.cabal,- test/README,- test/runTestsAndCoverage.sh, test/suite/Benchmark.hs, test/suite/Heist/Compiled/Tests.hs, test/suite/Heist/Interpreted/Tests.hs,@@ -119,7 +116,6 @@ Heist.Compiled.LowLevel, Heist.Internal.Types, Heist.Interpreted,- Heist.SpliceAPI, Heist.Splices, Heist.Splices.Apply, Heist.Splices.Bind,@@ -139,38 +135,37 @@ Heist.Interpreted.Internal build-depends:- MonadCatchIO-transformers >= 0.2.1 && < 0.4, aeson >= 0.6 && < 0.12, attoparsec >= 0.10 && < 0.14,- base >= 4.5 && < 5,+ base >= 4 && < 5, blaze-builder >= 0.2 && < 0.5, blaze-html >= 0.4 && < 0.9, bytestring >= 0.9 && < 0.11, containers >= 0.2 && < 0.6, directory >= 1.1 && < 1.3, directory-tree >= 0.10 && < 0.13,- dlist >= 0.5 && < 0.8,- either >= 3.1 && < 4.5,+ dlist >= 0.5 && < 0.9, filepath >= 1.3 && < 1.5, hashable >= 1.1 && < 1.3,+ lifted-base >= 0.2 && < 0.3, map-syntax >= 0.2 && < 0.3,+ monad-control >= 0.3 && < 1.1, mtl >= 2.0 && < 2.3,- process >= 1.1 && < 1.3,+ process >= 1.1 && < 1.5, random >= 1.0.1.0 && < 1.2, text >= 0.10 && < 1.3,- time >= 1.1 && < 1.6,- transformers >= 0.3 && < 0.5,+ time >= 1.1 && < 1.7,+ transformers >= 0.3 && < 0.6,+ transformers-base >= 0.4 && < 0.5, unordered-containers >= 0.1.4 && < 0.3, vector >= 0.9 && < 0.12,- xmlhtml >= 0.2.3 && < 0.3+ xmlhtml >= 0.2.3.5 && < 0.3 if impl(ghc >= 6.12.0)- ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind else- ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2-- ghc-prof-options: -prof -auto-all+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields Extensions: GeneralizedNewtypeDeriving,@@ -189,3 +184,99 @@ type: git location: https://github.com/snapframework/heist.git +Test-suite testsuite+ hs-source-dirs: src test/suite+ type: exitcode-stdio-1.0+ main-is: TestSuite.hs++ build-depends:+ HUnit >= 1.2 && < 2,+ QuickCheck >= 2 && < 2.9,+ lens >= 4.3 && < 4.15,+ test-framework >= 0.4 && < 0.9,+ test-framework-hunit >= 0.2.7 && < 0.4,+ test-framework-quickcheck2 >= 0.2.12.1 && < 0.4,+ aeson,+ attoparsec,+ base,+ bifunctors >= 5.3 && < 5.4,+ blaze-builder,+ blaze-html,+ bytestring,+ containers,+ directory,+ directory-tree,+ dlist,+ errors,+ filepath,+ hashable,+ lifted-base,+ map-syntax,+ monad-control,+ mtl,+ process,+ random,+ text,+ time,+ transformers,+ transformers-base,+ unordered-containers,+ vector,+ xmlhtml+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded+ Extensions: OverloadedStrings++Executable benchmark+ hs-source-dirs: src test/suite+ main-is: Benchmark.hs++ build-depends:+ HUnit,+ criterion >= 1.0 && < 1.2,+ test-framework,+ test-framework-hunit,++ -- Copied from regular dependencies:++ aeson,+ attoparsec,+ base,+ blaze-builder,+ blaze-html,+ bytestring,+ containers,+ directory,+ directory-tree,+ dlist,+ errors,+ filepath,+ hashable,+ lifted-base,+ map-syntax,+ monad-control,+ mtl,+ process,+ random,+ statistics >= 0.11 && < 0.14,+ text,+ time,+ transformers,+ transformers-base,+ unordered-containers,+ vector,+ xmlhtml++ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded+ -fno-warn-unused-do-bind -rtsopts++ Extensions:+ GeneralizedNewtypeDeriving,+ PackageImports,+ ScopedTypeVariables,+ DeriveDataTypeable,+ FlexibleInstances,+ MultiParamTypeClasses,+ UndecidableInstances,+ OverloadedStrings,+ TypeSynonymInstances,+ NoMonomorphismRestriction
src/Heist.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} @@ -39,6 +40,7 @@ , RuntimeSplice , Chunk , HeistState+ , SpliceError(..) , HeistT -- * Lenses (can be used with lens or lens-family)@@ -47,6 +49,7 @@ , scCompiledSplices , scAttributeSplices , scTemplateLocations+ , scCompiledTemplateFilter , hcSpliceConfig , hcNamespace , hcErrorNotBound@@ -55,6 +58,7 @@ , hcCompiledSplices , hcAttributeSplices , hcTemplateLocations+ , hcCompiledTemplateFilter -- * HeistT functions , templateNames@@ -76,16 +80,15 @@ , getDoc , getXMLDoc , tellSpliceError+ , spliceErrorText , orError- , module Heist.SpliceAPI+ , Splices ) where -------------------------------------------------------------------------------import Control.Exception (SomeException)-import Control.Monad.CatchIO+import Control.Exception.Lifted import Control.Monad.State-import Control.Monad.Trans.Either import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Either@@ -103,7 +106,6 @@ import Heist.Common import qualified Heist.Compiled.Internal as C import qualified Heist.Interpreted.Internal as I-import Heist.SpliceAPI import Heist.Splices import Heist.Internal.Types ------------------------------------------------------------------------------@@ -147,11 +149,11 @@ allErrors :: [Either String (TPath, v)]- -> EitherT [String] IO (HashMap TPath v)+ -> Either [String] (HashMap TPath v) allErrors tlist = case errs of- [] -> right $ Map.fromList $ rights tlist- _ -> left errs+ [] -> Right $ Map.fromList $ rights tlist+ _ -> Left errs where errs = lefts tlist @@ -160,18 +162,22 @@ -- | Loads templates from disk. This function returns just a template map so -- you can load multiple directories and combine the maps before initializing -- your HeistState.-loadTemplates :: FilePath -> EitherT [String] IO TemplateRepo+loadTemplates :: FilePath -> IO (Either [String] TemplateRepo) loadTemplates dir = do- d <- lift $ readDirectoryWith (loadTemplate dir) dir- allErrors $ F.fold (free d)+ d <- readDirectoryWith (loadTemplate dir) dir+#if MIN_VERSION_directory_tree(0,11,0)+ return $ allErrors $ F.fold (dirTree d)+#else+ return $ allErrors $ F.fold (free d)+#endif ------------------------------------------------------------------------------ -- | Reloads all the templates an an existing TemplateRepo.-reloadTemplates :: TemplateRepo -> EitherT [String] IO TemplateRepo+reloadTemplates :: TemplateRepo -> IO (Either [String] TemplateRepo) reloadTemplates repo = do- tlist <- lift $ mapM loadOrKeep $ Map.toList repo- allErrors tlist+ tlist <- mapM loadOrKeep $ Map.toList repo+ return $ allErrors tlist where loadOrKeep (p,df) = case dfFile df of@@ -202,7 +208,7 @@ -- | Creates an empty HeistState. emptyHS :: HE.KeyGen -> HeistState m emptyHS kg = HeistState Map.empty Map.empty Map.empty Map.empty Map.empty- True [] 0 [] Nothing kg False Html "" [] False 0+ True [] [] 0 [] Nothing kg False Html "" [] False 0 ------------------------------------------------------------------------------@@ -224,11 +230,13 @@ -- function. initHeist :: Monad n => HeistConfig n- -> EitherT [String] IO (HeistState n)+ -> IO (Either [String] (HeistState n)) initHeist hc = do- keyGen <- lift HE.newKeyGen+ keyGen <- HE.newKeyGen repos <- sequence $ _scTemplateLocations $ _hcSpliceConfig hc- initHeist' keyGen hc (Map.unions repos)+ case sequence repos of+ Left es -> return $ Left es+ Right rs -> initHeist' keyGen hc (Map.unions rs) ------------------------------------------------------------------------------@@ -243,29 +251,28 @@ => HE.KeyGen -> HeistConfig n -> TemplateRepo- -> EitherT [String] IO (HeistState n)+ -> IO (Either [String] (HeistState n)) initHeist' keyGen (HeistConfig sc ns enn) repo = do let empty = emptyHS keyGen- let (SpliceConfig i lt c a _) = sc- tmap <- preproc keyGen lt repo ns+ let (SpliceConfig i lt c a _ f) = sc+ etmap <- preproc keyGen lt repo ns let prefix = mkSplicePrefix ns- is <- runHashMap $ mapK (prefix<>) i- cs <- runHashMap $ mapK (prefix<>) c- as <- runHashMap $ mapK (prefix<>) a- let hs1 = empty { _spliceMap = is- , _templateMap = tmap- , _compiledSpliceMap = cs- , _attrSpliceMap = as- , _splicePrefix = prefix- , _errorNotBound = enn- }- EitherT $ C.compileTemplates hs1--- liftIO $ when (not $ null $ _spliceErrors hs2) $ do--- putStrLn "Finished compiling with errors..."--- mapM_ T.putStrLn $ _spliceErrors hs2--- case _spliceErrors hs2 of--- [] -> return hs2--- es -> left $ map T.unpack es+ let eis = runHashMap $ mapK (prefix<>) i+ ecs = runHashMap $ mapK (prefix<>) c+ eas = runHashMap $ mapK (prefix<>) a+ let hs1 = do+ tmap <- etmap+ is <- eis+ cs <- ecs+ as <- eas+ return $ empty { _spliceMap = is+ , _templateMap = tmap+ , _compiledSpliceMap = cs+ , _attrSpliceMap = as+ , _splicePrefix = prefix+ , _errorNotBound = enn+ }+ either (return . Left) (C.compileTemplates f) hs1 ------------------------------------------------------------------------------@@ -274,19 +281,22 @@ -> Splices (I.Splice IO) -> TemplateRepo -> Text- -> EitherT [String] IO TemplateRepo+ -> IO (Either [String] TemplateRepo) preproc keyGen splices templates ns = do- sm <- runHashMap splices- let hs = (emptyHS keyGen) { _spliceMap = sm- , _templateMap = templates- , _preprocessingMode = True- , _splicePrefix = mkSplicePrefix ns }- let eval a = evalHeistT a (X.TextNode "") hs- tPairs <- lift $ mapM (eval . preprocess) $ Map.toList templates- let bad = lefts tPairs- if not (null bad)- then left bad- else right $ Map.fromList $ rights tPairs+ let esm = runHashMap splices+ case esm of+ Left errs -> return $ Left errs+ Right sm -> do+ let hs = (emptyHS keyGen) { _spliceMap = sm+ , _templateMap = templates+ , _preprocessingMode = True+ , _splicePrefix = mkSplicePrefix ns }+ let eval a = evalHeistT a (X.TextNode "") hs+ tPairs <- mapM (eval . preprocess) $ Map.toList templates+ let bad = lefts tPairs+ return $ if not (null bad)+ then Left bad+ else Right $ Map.fromList $ rights tPairs ------------------------------------------------------------------------------@@ -311,22 +321,27 @@ -- implementation. initHeistWithCacheTag :: MonadIO n => HeistConfig n- -> EitherT [String] IO (HeistState n, CacheTagState)+ -> IO (Either [String] (HeistState n, CacheTagState)) initHeistWithCacheTag (HeistConfig sc ns enn) = do (ss, cts) <- liftIO mkCacheTag let tag = "cache"- keyGen <- lift HE.newKeyGen-- repos <- sequence $ _scTemplateLocations sc- -- We have to do one preprocessing pass with the cache setup splice. This- -- has to happen for both interpreted and compiled templates, so we do it- -- here by itself because interpreted templates don't get the same load- -- time splices as compiled templates.- rawWithCache <- preproc keyGen (tag ## ss) (Map.unions repos) ns-- let sc' = SpliceConfig (tag #! cacheImpl cts) mempty- (tag #! cacheImplCompiled cts) mempty mempty- let hc = HeistConfig (mappend sc sc') ns enn- hs <- initHeist' keyGen hc rawWithCache- return (hs, cts)+ keyGen <- HE.newKeyGen + erepos <- sequence $ _scTemplateLocations sc+ case sequence erepos of+ Left es -> return $ Left es+ Right repos -> do+ -- We have to do one preprocessing pass with the cache setup splice. This+ -- has to happen for both interpreted and compiled templates, so we do it+ -- here by itself because interpreted templates don't get the same load+ -- time splices as compiled templates.+ eRawWithCache <- preproc keyGen (tag ## ss) (Map.unions repos) ns+ case eRawWithCache of+ Left es -> return $ Left es+ Right rawWithCache -> do+ let sc' = SpliceConfig (tag #! cacheImpl cts) mempty+ (tag #! cacheImplCompiled cts)+ mempty mempty (const True)+ let hc = HeistConfig (mappend sc sc') ns enn+ hs <- initHeist' keyGen hc rawWithCache+ return $ fmap (,cts) hs
src/Heist/Common.hs view
@@ -1,15 +1,15 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} module Heist.Common where -------------------------------------------------------------------------------import Control.Applicative (Alternative (..), Applicative (..), (<$>))+import Control.Applicative (Alternative (..)) import Control.Exception (SomeException)-import qualified Control.Monad.CatchIO as C+import qualified Control.Exception.Lifted as C import Control.Monad (liftM, mplus)-import Control.Monad.Trans.Either import qualified Data.Attoparsec.Text as AP import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -20,24 +20,27 @@ import Data.List (isSuffixOf) import Data.Map.Syntax import Data.Maybe (isJust)-import Data.Monoid (Monoid (..), (<>))+import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Heist.Internal.Types.HeistState import System.FilePath (pathSeparator) import qualified Text.XmlHtml as X+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (Applicative (..), (<$>))+import Data.Monoid (Monoid (..))+#endif ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ runHashMap- :: (Monad m)- => Splices s- -> EitherT [String] m (HashMap T.Text s)+ :: Splices s+ -> Either [String] (HashMap T.Text s) runHashMap ms = case runMapSyntax Map.lookup Map.insert ms of- Left keys -> left $ map (T.unpack . mkMsg) keys- Right hm -> right $ hm+ Left keys -> Left $ map (T.unpack . mkMsg) keys+ Right hm -> Right hm where mkMsg k = "You tried to bind "<>k<>" more than once!" @@ -87,8 +90,29 @@ -- | Adds an error message to the list of splice processing errors. tellSpliceError :: Monad m => Text -> HeistT n m () tellSpliceError msg = do- fullMsg <- heistErrMsg msg- modifyHS (\hs -> hs { _spliceErrors = fullMsg : _spliceErrors hs })+ hs <- getHS+ let spliceError = SpliceError+ { spliceHistory = _splicePath hs+ , spliceTemplateFile = _curTemplateFile hs+ , visibleSplices = Map.keys $ _compiledSpliceMap hs+ , 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 ------------------------------------------------------------------------------
src/Heist/Compiled/Internal.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoMonomorphismRestriction #-}@@ -33,6 +34,11 @@ import qualified Text.XmlHtml as X import qualified Text.XmlHtml.HTML.Meta as X ------------------------------------------------------------------------------+#if !MIN_VERSION_base(4,8,0)+import Data.Foldable (Foldable)+#endif+import qualified Data.Foldable as Foldable+------------------------------------------------------------------------------ import Heist.Common import Heist.Internal.Types.HeistState ------------------------------------------------------------------------------@@ -45,7 +51,7 @@ -- The more interesting part of the type signature is what comes before the -- return value. The first type parameter in @'HeistT' n IO@ is the runtime -- monad. This reveals that the Chunks know about the runtime monad. The--- second type parameter in @HeistT n IO@ is @IO@. This tells is that the+-- second type parameter in @HeistT n IO@ is @IO@. This tells us that the -- compiled splices themselves are run in the IO monad, which will usually -- mean at load time. Compiled splices run at load time, and they return -- computations that run at runtime.@@ -159,17 +165,26 @@ ------------------------------------------------------------------------------ compileTemplates :: Monad n- => HeistState n+ => (TPath -> Bool)+ -> HeistState n -> IO (Either [String] (HeistState n))-compileTemplates hs = do- (tmap, hs') <- runHeistT compileTemplates' (X.TextNode "") hs+compileTemplates f hs = do+ (tmap, hs') <- runHeistT (compileTemplates' f) (X.TextNode "") hs let pre = _splicePrefix hs'+ let canError = _errorNotBound hs'+ let errs = _spliceErrors hs' let nsErr = if not (T.null pre) && (_numNamespacedTags hs' == 0) then Left [noNamespaceSplicesMsg $ T.unpack pre] else Right ()- return $ case _spliceErrors hs' of- [] -> nsErr >> (Right $! hs { _compiledTemplateMap = tmap })- es -> Left $ either (++) (const id) nsErr $ map T.unpack es+ return $ if canError+ then case errs of+ [] -> nsErr >>+ (Right $! hs { _compiledTemplateMap = tmap })+ es -> Left $ either (++) (const id) nsErr $+ map (T.unpack . spliceErrorText) es+ else nsErr >> (Right $! hs { _compiledTemplateMap = tmap+ , _spliceErrors = errs+ }) ------------------------------------------------------------------------------@@ -187,11 +202,12 @@ ------------------------------------------------------------------------------ compileTemplates' :: Monad n- => HeistT n IO (H.HashMap TPath ([Chunk n], MIMEType))-compileTemplates' = do+ => (TPath -> Bool)+ -> HeistT n IO (H.HashMap TPath ([Chunk n], MIMEType))+compileTemplates' f = do hs <- getHS let tpathDocfiles :: [(TPath, DocumentFile)]- tpathDocfiles = map (\(a,b) -> (a, b))+ tpathDocfiles = filter (f . fst) (H.toList $ _templateMap hs) foldM runOne H.empty tpathDocfiles where@@ -257,11 +273,9 @@ lookupSplice nm = do pre <- getsHS _splicePrefix res <- getsHS (H.lookup nm . _compiledSpliceMap)- canError <- getsHS _errorNotBound if isNothing res && T.isPrefixOf pre nm && not (T.null pre) then do- when canError $- tellSpliceError $ "No splice bound for " `mappend` nm+ tellSpliceError $ "No splice bound for " `mappend` nm return Nothing else return res @@ -272,14 +286,18 @@ -- compileNode to generate the appropriate runtime computation. runNode :: Monad n => X.Node -> Splice n runNode node = localParamNode (const node) $ do- pre <- getsHS _splicePrefix+ hs <- getHS+ 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 compileNode node+ else localHS (\hs' -> hs' {_splicePath =+ (_curContext hs', _curTemplateFile hs',+ X.elementTag node):(_splicePath hs')}) $+ compileNode node parseAttrs :: X.Node -> X.Node@@ -613,9 +631,11 @@ --------------------------------------------------------------------------------- | Converts a pure Node splice function to a pure Builder splice function.+-- | This is the same as htmlNodeSplice. nodeSplice :: (a -> [X.Node]) -> a -> Builder nodeSplice f = X.renderHtmlFragment X.UTF8 . f+{-# DEPRECATED nodeSplice+ "Use xmlNodeSplice or htmlNodeSplice, will be removed in Heist 1.1" #-} ------------------------------------------------------------------------------@@ -657,31 +677,34 @@ ------------------------------------------------------------------------------+{-# INLINE foldMapM #-}+foldMapM :: (Monad f, Monoid m, Foldable list)+ => (a -> f m)+ -> list a+ -> f m+foldMapM f =+ Foldable.foldlM (\xs x -> xs `seq` liftM (xs <>) (f x)) mempty++------------------------------------------------------------------------------ -- | Like withSplices, but evaluates the splice repeatedly for each element in -- a list generated at runtime.-manyWithSplices :: Monad n+manyWithSplices :: (Foldable f, Monad n) => Splice n -> Splices (RuntimeSplice n a -> Splice n)- -> RuntimeSplice n [a]+ -> RuntimeSplice n (f a) -> Splice n-manyWithSplices splice splices runtimeAction = do- p <- newEmptyPromise- let splices' = mapV ($ getPromise p) splices- chunks <- withLocalSplices splices' mempty splice- return $ yieldRuntime $ do- items <- runtimeAction- res <- forM items $ \item -> putPromise p item >> codeGen chunks- return $ mconcat res+manyWithSplices splice splices runtimeAction =+ manyWith splice splices mempty runtimeAction ------------------------------------------------------------------------------ -- | More powerful version of manyWithSplices that lets you also define -- attribute splices.-manyWith :: (Monad n)+manyWith :: (Foldable f, Monad n) => Splice n -> Splices (RuntimeSplice n a -> Splice n) -> Splices (RuntimeSplice n a -> AttrSplice n)- -> RuntimeSplice n [a]+ -> RuntimeSplice n (f a) -> Splice n manyWith splice splices attrSplices runtimeAction = do p <- newEmptyPromise@@ -690,27 +713,23 @@ chunks <- withLocalSplices splices' attrSplices' splice return $ yieldRuntime $ do items <- runtimeAction- res <- forM items $ \item -> putPromise p item >> codeGen chunks- return $ mconcat res+ foldMapM (\item -> putPromise p item >> codeGen chunks) items ------------------------------------------------------------------------------ -- | Similar to 'mapSplices' in interpreted mode. Gets a runtime list of -- items and applies a compiled runtime splice function to each element of the -- list.-deferMany :: Monad n+deferMany :: (Foldable f, Monad n) => (RuntimeSplice n a -> Splice n)- -> RuntimeSplice n [a]+ -> RuntimeSplice n (f a) -> Splice n deferMany f getItems = do promise <- newEmptyPromise chunks <- f $ getPromise promise return $ yieldRuntime $ do items <- getItems- res <- forM items $ \item -> do- putPromise promise item- codeGen chunks- return $ mconcat res+ foldMapM (\item -> putPromise promise item >> codeGen chunks) items ------------------------------------------------------------------------------
src/Heist/Internal/Types.hs view
@@ -21,11 +21,14 @@ ) where -------------------------------------------------------------------------------import Control.Applicative-import Control.Monad.Trans.Either import Data.HashMap.Strict (HashMap)-import Data.Monoid import Data.Text (Text)++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+import Data.Monoid+#endif+ ------------------------------------------------------------------------------ import qualified Heist.Compiled.Internal as C import qualified Heist.Interpreted.Internal as I@@ -41,7 +44,7 @@ -- | An IO action for getting a template repo from this location. By not just -- using a directory path here, we support templates loaded from a database, -- retrieved from the network, or anything else you can think of.-type TemplateLocation = EitherT [String] IO TemplateRepo+type TemplateLocation = IO (Either [String] TemplateRepo) ------------------------------------------------------------------------------@@ -54,24 +57,28 @@ -- | The splices and templates Heist will use. To bind a splice simply -- include it in the appropriate place here. data SpliceConfig m = SpliceConfig- { _scInterpretedSplices :: Splices (I.Splice m)+ { _scInterpretedSplices :: Splices (I.Splice m) -- ^ Interpreted splices are the splices that Heist has always had. -- They return a list of nodes and are processed at runtime.- , _scLoadTimeSplices :: Splices (I.Splice IO)+ , _scLoadTimeSplices :: Splices (I.Splice IO) -- ^ Load time splices are like interpreted splices because they -- return a list of nodes. But they are like compiled splices because -- they are processed once at load time. All of Heist's built-in -- splices should be used as load time splices.- , _scCompiledSplices :: Splices (C.Splice m)+ , _scCompiledSplices :: Splices (C.Splice m) -- ^ Compiled splices return a DList of Chunks and are processed at -- load time to generate a runtime monad action that will be used to -- render the template.- , _scAttributeSplices :: Splices (AttrSplice m)+ , _scAttributeSplices :: Splices (AttrSplice m) -- ^ Attribute splices are bound to attribute names and return a list -- of attributes.- , _scTemplateLocations :: [TemplateLocation]+ , _scTemplateLocations :: [TemplateLocation] -- ^ A list of all the locations that Heist should get its templates -- from.+ , _scCompiledTemplateFilter :: TPath -> Bool+ -- ^ Predicate function to control which templates to compile. Using+ -- templates filtered out with this is still possible via+ -- callTemplate. } @@ -135,11 +142,24 @@ setter sc v = sc { _scTemplateLocations = v } +------------------------------------------------------------------------------+-- | Lens for compiled template filter+-- :: Simple Lens (SpliceConfig m) (TBool -> Bool)+scCompiledTemplateFilter+ :: Functor f+ => ((TPath -> Bool) -> f (TPath -> Bool))+ -> SpliceConfig m -> f (SpliceConfig m)+scCompiledTemplateFilter = lens _scCompiledTemplateFilter setter+ where+ setter sc v = sc { _scCompiledTemplateFilter = v }++ instance Monoid (SpliceConfig m) where- mempty = SpliceConfig mempty mempty mempty mempty mempty- mappend (SpliceConfig a1 b1 c1 d1 e1) (SpliceConfig a2 b2 c2 d2 e2) =+ mempty = SpliceConfig mempty mempty mempty mempty mempty (const True)+ mappend (SpliceConfig a1 b1 c1 d1 e1 f1)+ (SpliceConfig a2 b2 c2 d2 e2 f2) = SpliceConfig (mappend a1 a2) (mappend b1 b2) (mappend c1 c2)- (mappend d1 d2) (mappend e1 e2)+ (mappend d1 d2) (mappend e1 e2) (\x -> f1 x && f2 x) data HeistConfig m = HeistConfig@@ -239,5 +259,15 @@ => ([TemplateLocation] -> f [TemplateLocation]) -> HeistConfig m -> f (HeistConfig m) hcTemplateLocations = hcSpliceConfig . scTemplateLocations +++------------------------------------------------------------------------------+-- | Lens for compiled template filter+-- :: Simple Lens (SpliceConfig m) (TBool -> Bool)+hcCompiledTemplateFilter+ :: Functor f+ => ((TPath -> Bool) -> f (TPath -> Bool))+ -> HeistConfig m -> f (HeistConfig m)+hcCompiledTemplateFilter = hcSpliceConfig . scCompiledTemplateFilter
src/Heist/Internal/Types/HeistState.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-|@@ -19,32 +20,46 @@ module Heist.Internal.Types.HeistState where -------------------------------------------------------------------------------import Blaze.ByteString.Builder-import Control.Applicative-import Control.Arrow-import Control.Monad.CatchIO (MonadCatchIO)-import qualified Control.Monad.CatchIO as C-import Control.Monad.Cont+import Blaze.ByteString.Builder (Builder)+import Control.Applicative (Alternative (..))+import Control.Arrow (first)+import Control.Monad (MonadPlus (..), ap)+import Control.Monad.Base+import Control.Monad.Cont (MonadCont (..)) #if MIN_VERSION_mtl(2,2,1) import Control.Monad.Except (MonadError (..)) #else import Control.Monad.Error (MonadError (..)) #endif-import Control.Monad.Reader-import Control.Monad.State.Strict-import Data.ByteString.Char8 (ByteString)-import Data.DList (DList)-import qualified Data.HashMap.Strict as H-import Data.HashMap.Strict (HashMap)-import Data.HeterogeneousEnvironment (HeterogeneousEnvironment)+import Control.Monad.Fix (MonadFix (..))+import Control.Monad.Reader (MonadReader (..))+import Control.Monad.State.Strict (MonadState (..), StateT)+import Control.Monad.Trans (MonadIO (..), MonadTrans (..))+import Control.Monad.Trans.Control+import Data.ByteString.Char8 (ByteString)+import Data.DList (DList)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as H+import Data.HeterogeneousEnvironment (HeterogeneousEnvironment) import qualified Data.HeterogeneousEnvironment as HE import Data.Map.Syntax-import Data.Monoid-import Data.Text (Text)-import qualified Data.Text as T-import Data.Text.Encoding-import Data.Typeable-import qualified Text.XmlHtml as X+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8)+#if MIN_VERSION_base (4,7,0)+import Data.Typeable (Typeable)+#else+import Data.Typeable (TyCon, Typeable(..),+ Typeable1(..), mkTyCon,+ mkTyConApp)+#endif++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative (Applicative (..), (<$>))+import Data.Monoid (Monoid(..))+#endif++import qualified Text.XmlHtml as X ------------------------------------------------------------------------------ @@ -151,6 +166,16 @@ ------------------------------------------------------------------------------+-- | Detailed information about a splice error.+data SpliceError = SpliceError+ { spliceHistory :: [(TPath, Maybe FilePath, Text)]+ , spliceTemplateFile :: Maybe FilePath+ , visibleSplices :: [Text]+ , spliceMsg :: Text+ } deriving ( Show, Eq )+++------------------------------------------------------------------------------ -- | 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@@@ -175,6 +200,8 @@ , _recurse :: Bool -- | The path to the template currently being processed. , _curContext :: TPath+ -- | Stack of the splices used.+ , _splicePath :: [(TPath, Maybe FilePath, Text)] -- | A counter keeping track of the current recursion depth to prevent -- infinite loops. , _recursionDepth :: Int@@ -198,7 +225,7 @@ , _splicePrefix :: Text -- | List of errors encountered during splice processing.- , _spliceErrors :: [Text]+ , _spliceErrors :: [SpliceError] -- | Whether to throw an error when a tag wih the heist namespace does not -- correspond to a bound splice. When not using a namespace, this flag is@@ -332,16 +359,45 @@ return (a, s) ---------------------------------------------------------------------------------- | MonadCatchIO instance-instance MonadCatchIO m => MonadCatchIO (HeistT n m) where- catch (HeistT a) h = HeistT $ \r s -> do- let handler e = runHeistT (h e) r s- C.catch (a r s) handler- block (HeistT m) = HeistT $ \r s -> C.block (m r s)- unblock (HeistT m) = HeistT $ \r s -> C.unblock (m r s)+instance MonadBase b m => MonadBase b (HeistT n m) where+ liftBase = lift . liftBase +#if MIN_VERSION_monad_control(1,0,0)+instance MonadTransControl (HeistT n) where+ type StT (HeistT n) a = (a, HeistState n)+ liftWith f = HeistT $ \n s -> do+ res <- f $ \(HeistT g) -> g n s+ return (res, s)+ restoreT k = HeistT $ \_ _ -> k+ {-# INLINE liftWith #-}+ {-# INLINE restoreT #-} ++instance MonadBaseControl b m => MonadBaseControl b (HeistT n m) where+ type StM (HeistT n m) a = ComposeSt (HeistT n) m a+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINE liftBaseWith #-}+ {-# INLINE restoreM #-}+#else+instance MonadTransControl (HeistT n) where+ newtype StT (HeistT n) a = StHeistT {unStHeistT :: (a, HeistState n)}+ liftWith f = HeistT $ \n s -> do+ res <- f $ \(HeistT g) -> liftM StHeistT $ g n s+ return (res, s)+ restoreT k = HeistT $ \_ _ -> liftM unStHeistT k+ {-# INLINE liftWith #-}+ {-# INLINE restoreT #-}+++instance MonadBaseControl b m => MonadBaseControl b (HeistT n m) where+ newtype StM (HeistT n m) a = StMHeist {unStMHeist :: ComposeSt (HeistT n) m a}+ liftBaseWith = defaultLiftBaseWith StMHeist+ restoreM = defaultRestoreM unStMHeist+ {-# INLINE liftBaseWith #-}+ {-# INLINE restoreM #-}+#endif+ ------------------------------------------------------------------------------ -- | MonadFix passthrough instance instance MonadFix m => MonadFix (HeistT n m) where@@ -453,7 +509,7 @@ -- returns the Node for the @speech@ tag and its children. @getParamNode >>= -- childNodes@ returns a list containing one 'TextNode' containing part of -- Hamlet's speech. @liftM (getAttribute \"author\") getParamNode@ would--- return @Just "Shakespeare"@.+-- return @Just \"Shakespeare\"@. getParamNode :: Monad m => HeistT n m X.Node getParamNode = HeistT $ curry return {-# INLINE getParamNode #-}
− src/Heist/SpliceAPI.hs
@@ -1,102 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}--{-|--An API implementing a convenient syntax for defining and manipulating splices.-This module was born from the observation that a list of tuples is-semantically ambiguous about how duplicate keys should be handled.-Additionally, the syntax is inherently rather cumbersome and difficult to work-with. This API takes advantage of do notation to provide a very light syntax-for defining splices while at the same time eliminating the semantic ambiguity-of alists.--Here's how you can define splices:--> mySplices :: Splices Text-> mySplices = do-> "firstName" ## "John"-> "lastName" ## "Smith"---}--module Heist.SpliceAPI- {-# DEPRECATED "Use Data.Map.Syntax from the map-syntax package instead" #-}- ( SplicesM- , Splices- , noSplices- , mapS- , applyS- , ($$)- , mapNames- , prefixSplices- , namespaceSplices- , module Data.Map.Syntax- ) where---------------------------------------------------------------------------------import Data.Map.Syntax-import Data.Monoid-import Data.Text (Text)-import qualified Data.Text as T-import Heist.Internal.Types.HeistState (Splices)----------------------------------------------------------------------------------{-# DEPRECATED SplicesM, applyS, ($$)- "Use functions from the map-syntax package instead" #-}--type SplicesM s a = MapSyntaxM Text s a--noSplices :: Splices s-noSplices = mempty-{-# DEPRECATED noSplices "Use mempty instead" #-}------------------------------------------------------------------------------------ | Maps a function over all the splices.-mapS :: (a -> b) -> Splices a -> Splices b-mapS = mapV-{-# DEPRECATED mapS "Use mapV from the map-syntax package instead" #-}------------------------------------------------------------------------------------ | Applies an argument to a splice function.-applyS :: a -> Splices (a -> b) -> Splices b-applyS a = mapS ($a)------------------------------------------------------------------------------------ | Infix operator for @flip applyS@-($$) :: Splices (a -> b) -> a -> Splices b-($$) = flip applyS-infixr 0 $$------------------------------------------------------------------------------------ | Maps a function over all the splice names.-mapNames :: (Text -> Text) -> Splices a -> Splices a-mapNames = mapK-{-# DEPRECATED mapNames "Use mapK from the map-syntax package instead" #-}------------------------------------------------------------------------------------ | Adds a prefix to the tag names for a list of splices. If the existing--- tag name is empty, then the new tag name is just the prefix. Otherwise the--- new tag name is the prefix followed by the separator followed by the--- existing name.-prefixSplices :: Text -> Text -> Splices a -> Splices a-prefixSplices sep pre = mapK f- where- f t = if T.null t then pre else T.concat [pre,sep,t]------------------------------------------------------------------------------------ | 'prefixSplices' specialized to use a colon as separator in the style of--- XML namespaces.-namespaceSplices :: Text -> Splices a -> Splices a-namespaceSplices = prefixSplices ":"-
src/Heist/Splices.hs view
@@ -1,6 +1,10 @@+{-# LANGUAGE CPP #-}+ module Heist.Splices ( ifISplice , ifCSplice+ , ifElseISplice+ , ifElseCSplice , module Heist.Splices.Apply , module Heist.Splices.Bind , module Heist.Splices.Cache@@ -9,7 +13,10 @@ , module Heist.Splices.Markdown ) where -import Data.Monoid+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid(..))+#endif+ import qualified Heist.Compiled as C import qualified Heist.Interpreted as I import Heist.Splices.Apply@@ -19,6 +26,7 @@ import Heist.Splices.Ignore import Heist.Splices.Markdown import Heist.Internal.Types.HeistState+import qualified Text.XmlHtml as X ------------------------------------------------------------------------------ -- | Run the splice contents if given condition is True, make splice disappear@@ -47,3 +55,23 @@ else return mempty ++------------------------------------------------------------------------------+-- | Implements an if/then/else conditional splice. It splits its children+-- around the <else/> element to get the markup to be used for the two cases.+ifElseISplice :: Monad m => Bool -> I.Splice m+ifElseISplice cond = getParamNode >>= (rewrite . X.childNodes)+ where+ rewrite nodes = + let (ns, ns') = break (\n -> X.tagName n==Just "else") nodes+ in I.runNodeList $ if cond then ns else (drop 1 ns') +++------------------------------------------------------------------------------+-- | Implements an if/then/else conditional splice. It splits its children+-- around the <else/> element to get the markup to be used for the two cases.+ifElseCSplice :: Monad m => Bool -> C.Splice m+ifElseCSplice cond = getParamNode >>= (rewrite . X.childNodes)+ where rewrite nodes = + let (ns, ns') = break (\n -> X.tagName n==Just "else") nodes+ in C.runNodeList $ if cond then ns else (drop 1 ns')
src/Heist/Splices/Apply.hs view
@@ -1,10 +1,8 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-} module Heist.Splices.Apply where -------------------------------------------------------------------------------import Control.Monad.Trans import Data.Maybe import Data.Text (Text) import qualified Data.Text as T@@ -69,7 +67,7 @@ ------------------------------------------------------------------------------ -- | Applies a template as if the supplied nodes were the children of the -- <apply> tag.-applyNodes :: MonadIO n => Template -> Text -> Splice n+applyNodes :: Monad n => Template -> Text -> Splice n applyNodes nodes template = do hs <- getHS maybe (return [] `orError` err)@@ -84,7 +82,7 @@ ------------------------------------------------------------------------------ -- | Implementation of the apply splice.-applyImpl :: MonadIO n => Splice n+applyImpl :: Monad n => Splice n applyImpl = do node <- getParamNode let err = "must supply \"" ++ T.unpack applyAttr ++
src/Heist/Splices/Bind.hs view
@@ -1,7 +1,6 @@ module Heist.Splices.Bind where -------------------------------------------------------------------------------import Control.Monad.Trans import Data.Text (Text) import qualified Data.Text as T import qualified Text.XmlHtml as X@@ -25,7 +24,7 @@ ------------------------------------------------------------------------------ -- | Implementation of the bind splice.-bindImpl :: MonadIO n => Splice n+bindImpl :: Monad n => Splice n bindImpl = do node <- getParamNode let err = "must supply \"" ++ T.unpack bindAttr ++
src/Heist/Splices/BindStrict.hs view
@@ -1,7 +1,6 @@ module Heist.Splices.BindStrict where -------------------------------------------------------------------------------import Control.Monad.Trans import Data.Text (Text) import qualified Data.Text as T import qualified Text.XmlHtml as X@@ -20,7 +19,7 @@ ------------------------------------------------------------------------------ -- | Implementation of the bind splice.-bindStrictImpl :: MonadIO n => Splice n+bindStrictImpl :: Monad n => Splice n bindStrictImpl = do node <- getParamNode cs <- runChildren
src/Heist/Splices/Cache.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -- | The \"cache\" splice ensures that its contents are cached and only@@ -35,10 +36,12 @@ import qualified Data.Text as T import Data.Text.Read import Data.Time.Clock-import Data.Word import System.Random import Text.XmlHtml +#if !MIN_VERSION_base(4,8,0)+import Data.Word (Word)+#endif ------------------------------------------------------------------------------ import qualified Heist.Compiled.Internal as C
src/Heist/Splices/Json.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} module Heist.Splices.Json ( bindJson@@ -97,9 +98,12 @@ go (x:xs) !value = findIn value >>= go xs where findIn (Object obj) = Map.lookup x obj+ findIn (Array arr) = tryReadIndex >>= \i -> arr V.!? i findIn _ = Nothing + tryReadIndex = fmap fst . listToMaybe . reads . T.unpack $ x + ------------------------------------------------------------------------------ asHtml :: Monad m => Text -> m [Node] asHtml t =@@ -149,7 +153,7 @@ -------------------------------------------------------------------------------explodeTag :: (Monad n) => JsonMonad n n [Node]+explodeTag :: forall n. (Monad n) => JsonMonad n n [Node] explodeTag = ask >>= go where --------------------------------------------------------------------------@@ -166,7 +170,7 @@ "snippet" ## asHtml t --------------------------------------------------------------------------- goArray :: (Monad n) => V.Vector Value -> JsonMonad n n [Node]+ goArray :: V.Vector Value -> JsonMonad n n [Node] goArray a = do lift stopRecursion dl <- V.foldM f id a@@ -180,7 +184,7 @@ -- search the param node for attribute \"var=expr\", search the given JSON -- object for the expression, and if it's found run the JsonMonad action m -- using the restricted JSON object.- varAttrTag :: (Monad m) => Value -> (JsonMonad m m [Node]) -> Splice m+ varAttrTag :: Value -> (JsonMonad n n [Node]) -> Splice n varAttrTag v m = do node <- getParamNode maybe (noVar node) (hasVar node) $ getAttribute "var" node@@ -203,7 +207,7 @@ (findExpr expr v) --------------------------------------------------------------------------- genericBindings :: Monad n => JsonMonad n n (Splices (Splice n))+ genericBindings :: JsonMonad n n (Splices (Splice n)) genericBindings = ask >>= \v -> return $ do "with" ## varAttrTag v explodeTag "snippet" ## varAttrTag v snippetTag
src/Heist/Splices/Markdown.hs view
@@ -1,4 +1,6 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-} {-| The \"markdown\" splice formats markdown content as HTML and inserts it into the document. @@ -9,22 +11,100 @@ and converted to HTML. This splice requires that the \"pandoc\" executable is in your path.++You can add custom pandoc splice with 'pandocSplice'. It is not limited to+markdown input, and can process anything pandoc can.++For example you can create a page with generated table of contents, using+heist template as pandoc template.++> <!-- _wrap.tpl -->+> <html>+> <head> <title> <pageTitle/> </title> </head>+>+> <div class="nav"> <pageToc/> </div>+> <apply-content/>+> </html>++And pandoc template, which would bind @pageTitle@ and @pageToc@ splices and+applies "_wrap" template.++> <!-- _pandoc.tpl -->+> <apply template="_wrap.tpl">+> <bind tag="pageTitle"> $title$</bind>+> <bind tag="pageToc"> $toc$</bind>+> $body$+> </apply>++Bind splice pandoc splice. Set it to not wrap in div, or it will break html+from _wrap.tpl++> splices = "docmarkdown" ## pandocSplice opts+> where+> opts = setPandocArgs ["-S", "--no-wrap", "--toc"+> , "--standalone"+> , "--template", "_pandoc.tpl"+> , "--html5"]+> $ setPandocWrapDiv Nothing+> $ defaultPandocOptions+>++And then use it to render your markdown file+++> <!-- apidocs.tpl -->+> <DOCTYPE html>+> <html lang="en">+> <head>+> <link href="/static/css/site.css rel="stylesheet">+> </head>+> <body>+> <apply template="_navbar.tpl" />+> <docmarkdown file="apidocs.md"/>+> </body>+ -}-module Heist.Splices.Markdown where+module Heist.Splices.Markdown+ (+ -- * Exceptions+ PandocMissingException+ , MarkdownException+ , NoMarkdownFileException+ -- * Markdown Splice+ , markdownTag+ , markdownSplice+ -- * Generic pandoc splice+ , pandocSplice+ -- ** Pandoc Options+ , PandocOptions+ , defaultPandocOptions+ , setPandocExecutable+ , setPandocArgs+ , setPandocBaseDir+ , setPandocWrapDiv+ -- ** Lens for 'PandocOptions'+ , pandocExecutable+ , pandocArgs+ , pandocBaseDir+ , pandocWrapDiv+ -- * Internal helper functions+ , pandoc+ , pandocBS+ , readProcessWithExitCode'+ ) where -------------------------------------------------------------------------------import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as BC-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Data.Maybe import Control.Concurrent-import Control.Exception (throwIO)+import Control.Exception.Lifted import Control.Monad-import Control.Monad.CatchIO import Control.Monad.Trans+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import Data.Typeable import System.Directory import System.Exit@@ -33,17 +113,21 @@ import System.Process import Text.XmlHtml +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif+ ------------------------------------------------------------------------------ import Heist.Common-import Heist.Interpreted.Internal import Heist.Internal.Types.HeistState+import Heist.Interpreted.Internal data PandocMissingException = PandocMissingException deriving (Typeable) instance Show PandocMissingException where show PandocMissingException =- "Cannot find the \"pandoc\" executable; is it on your $PATH?"+ "Cannot find the \"pandoc\" executable. If you have Haskell, then install it with \"cabal install\". Otherwise you can download it from http://johnmacfarlane.net/pandoc/installing.html. Then make sure it is in your $PATH." instance Exception PandocMissingException @@ -68,69 +152,156 @@ instance Exception NoMarkdownFileException where +--------------------------------------------------------------------------------++data PandocOptions = PandocOptions+ { _pandocExecutable :: FilePath+ , _pandocArgs :: [String] -- ^ Arguments to pandoc+ , _pandocBaseDir :: Maybe FilePath -- ^ Base directory for input files+ -- defaults to template path+ , _pandocWrapDiv :: Maybe Text -- ^ Wrap content in div with class+ } deriving (Eq, Ord, Show)++-- | Default options+defaultPandocOptions :: PandocOptions+defaultPandocOptions = PandocOptions "pandoc"+ ["-S", "--no-wrap"]+ Nothing+ (Just "markdown")++-- | Name of pandoc executable+setPandocExecutable :: FilePath -> PandocOptions -> PandocOptions+setPandocExecutable e opt = opt { _pandocExecutable = e }++-- | Arguments passed to pandoc+setPandocArgs :: [String] -> PandocOptions -> PandocOptions+setPandocArgs args opt = opt { _pandocArgs = args }++-- | Base directory for input files, defaults to current template dir+setPandocBaseDir :: Maybe FilePath -> PandocOptions -> PandocOptions+setPandocBaseDir bd opt = opt { _pandocBaseDir = bd }++-- | Wrap pandoc output in div with class. Appends node attributes to+-- div and appends class to ones specified on node.+setPandocWrapDiv :: Maybe Text -> PandocOptions -> PandocOptions+setPandocWrapDiv wd opt = opt { _pandocWrapDiv = wd }++pandocExecutable :: Functor f =>+ (FilePath -> f FilePath) -> PandocOptions -> f PandocOptions+pandocExecutable f po = (\e -> po { _pandocExecutable = e})+ <$> f (_pandocExecutable po)++pandocArgs :: Functor f =>+ ([String] -> f [String]) -> PandocOptions -> f PandocOptions+pandocArgs f po = (\a -> po { _pandocArgs = a}) <$> f (_pandocArgs po)++pandocBaseDir :: Functor f =>+ (Maybe FilePath -> f (Maybe FilePath)) -> PandocOptions -> f PandocOptions+pandocBaseDir f po = (\b -> po {_pandocBaseDir = b }) <$> f (_pandocBaseDir po)++pandocWrapDiv :: Functor f =>+ (Maybe Text -> f (Maybe Text)) -> PandocOptions -> f PandocOptions+pandocWrapDiv f po = (\w -> po {_pandocWrapDiv = w}) <$> f (_pandocWrapDiv po)+ ------------------------------------------------------------------------------ -- | Default name for the markdown splice. markdownTag :: Text markdownTag = "markdown" --------------------------------------------------------------------------------- | Implementation of the markdown splice.+-- | Default markdown splice with executable "pandoc" and options "-S --no-wrap" markdownSplice :: MonadIO m => Splice m-markdownSplice = do- templateDir <- liftM (fmap takeDirectory) getTemplateFilePath- pdMD <- liftIO $ findExecutable "pandoc"+markdownSplice= pandocSplice defaultPandocOptions - when (isNothing pdMD) $ liftIO $ throwIO PandocMissingException+-- | Implementation of the markdown splice.+pandocSplice :: MonadIO m => PandocOptions -> Splice m+pandocSplice PandocOptions{..} = do+ templateDir <- liftM (fmap takeDirectory) getTemplateFilePath+ pdMD <- liftIO $ findExecutable _pandocExecutable + pandocExe <- case pdMD of+ Nothing -> liftIO $ throwIO PandocMissingException+ Just pd -> return pd+ let withDir tp = fromMaybe tp _pandocBaseDir+ pandocFile f tp = pandocWith pandocExe _pandocArgs (withDir tp) f tree <- getParamNode (source,markup) <- liftIO $ case getAttribute "file" tree of Just f -> do m <- maybe (liftIO $ throwIO NoMarkdownFileException )- (\tp -> pandoc (fromJust pdMD) tp $ T.unpack f)+ (pandocFile (T.unpack f)) templateDir return (T.unpack f,m) Nothing -> do- m <- pandocBS (fromJust pdMD) $ T.encodeUtf8 $ nodeText tree+ m <- pandocWithBS pandocExe _pandocArgs $ T.encodeUtf8 $ nodeText tree return ("inline_splice",m) let ee = parseHTML source markup+ nodeAttrs = case tree of+ Element _ a _ -> a+ _ -> []+ nodeClass = lookup "class" nodeAttrs+ attrs = filter (\(name, _) -> name /= "class" && name /= "file") nodeAttrs case ee of Left e -> throw $ MarkdownException $ BC.pack ("Error parsing markdown output: " ++ e)- Right d -> return (docContent d)+ Right d -> return $ wrapResult nodeClass attrs (docContent d) + where+ wrapResult nodeClass attrs body = case _pandocWrapDiv of+ Nothing -> body+ Just cls -> let finalAttrs = ("class", appendClass nodeClass cls):attrs+ in [Element "div" finalAttrs body]+ appendClass Nothing cls = cls+ appendClass (Just orig) cls = T.concat [orig, " ", cls] + pandoc :: FilePath -> FilePath -> FilePath -> IO ByteString pandoc pandocPath templateDir inputFile = do- (ex, sout, serr) <- readProcessWithExitCode' pandocPath args ""-- when (isFail ex) $ throw $ MarkdownException serr+ sout <- pandocWith pandocPath args templateDir inputFile return $ BC.concat [ "<div class=\"markdown\">\n" , sout , "\n</div>" ] where- isFail ExitSuccess = False- isFail _ = True-- args = [ "-S", "--no-wrap", templateDir </> inputFile ]+ args = [ "-S", "--no-wrap"] pandocBS :: FilePath -> ByteString -> IO ByteString pandocBS pandocPath s = do+ sout <- pandocWithBS pandocPath args s+ return $ BC.concat [ "<div class=\"markdown\">\n"+ , sout+ , "\n</div>" ]++ where+ args = [ "-S", "--no-wrap" ]+++pandocWith :: FilePath -> [String] -> FilePath -> FilePath -> IO ByteString+pandocWith path args templateDir inputFile = do+ (ex, sout, serr) <- readProcessWithExitCode' path args' ""++ when (isFail ex) $ throw $ MarkdownException serr+ return sout++ where+ isFail ExitSuccess = False+ isFail _ = True++ args' = args ++ [templateDir </> inputFile ]++pandocWithBS :: FilePath -> [String] -> ByteString -> IO ByteString+pandocWithBS pandocPath args s = do -- using the crummy string functions for convenience here (ex, sout, serr) <- readProcessWithExitCode' pandocPath args s when (isFail ex) $ throw $ MarkdownException serr- return $ BC.concat [ "<div class=\"markdown\">\n"- , sout- , "\n</div>" ]+ return sout where isFail ExitSuccess = False isFail _ = True- args = [ "-S", "--no-wrap" ] -- a version of readProcessWithExitCode that does I/O properly@@ -177,7 +348,3 @@ err <- readMVar errM return (ex, out, err)----
src/Heist/TemplateDirectory.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleContexts #-} {-| This module defines a TemplateDirectory data structure for convenient@@ -20,7 +19,6 @@ import Control.Concurrent import Control.Monad import Control.Monad.Trans-import Control.Monad.Trans.Either import Heist import Heist.Internal.Types import Heist.Splices.Cache@@ -44,14 +42,17 @@ => FilePath -> HeistConfig n -- namespaced tag.- -> EitherT [String] IO (TemplateDirectory n)+ -> IO (Either [String] (TemplateDirectory n)) newTemplateDirectory dir hc = do let sc = (_hcSpliceConfig hc) { _scTemplateLocations = [loadTemplates dir] } let hc' = hc { _hcSpliceConfig = sc }- (hs,cts) <- initHeistWithCacheTag hc'- tsMVar <- liftIO $ newMVar hs- ctsMVar <- liftIO $ newMVar cts- return $ TemplateDirectory dir hc' tsMVar ctsMVar+ epair <- initHeistWithCacheTag hc'+ case epair of+ Left es -> return $ Left es+ Right (hs,cts) -> do+ tsMVar <- liftIO $ newMVar hs+ ctsMVar <- liftIO $ newMVar cts+ return $ Right $ TemplateDirectory dir hc' tsMVar ctsMVar ------------------------------------------------------------------------------@@ -63,7 +64,7 @@ -> HeistConfig n -> IO (TemplateDirectory n) newTemplateDirectory' dir hc = do- res <- runEitherT $ newTemplateDirectory dir hc+ res <- newTemplateDirectory dir hc either (error . concat) return res @@ -88,9 +89,8 @@ => TemplateDirectory n -> IO (Either String ()) reloadTemplateDirectory (TemplateDirectory p hc tsMVar ctsMVar) = do- ehs <- runEitherT $ do- let sc = (_hcSpliceConfig hc) { _scTemplateLocations = [loadTemplates p] }- initHeistWithCacheTag (hc { _hcSpliceConfig = sc })+ let sc = (_hcSpliceConfig hc) { _scTemplateLocations = [loadTemplates p] }+ ehs <- initHeistWithCacheTag (hc { _hcSpliceConfig = sc }) leftPass ehs $ \(hs,cts) -> do modifyMVar_ tsMVar (const $ return hs) modifyMVar_ ctsMVar (const $ return cts)
− test/.ghci
@@ -1,5 +0,0 @@-:set -XOverloadedStrings-:set -Wall-:set -i../src-:set -isuite-:set -hide-package MonadCatchIO-mtl
− test/README
@@ -1,1 +0,0 @@-Various test applications and such for the Snap Framework
− test/heist-testsuite.cabal
@@ -1,101 +0,0 @@-name: heist-testsuite-version: 0.1.1-build-type: Simple-cabal-version: >= 1.6--Executable testsuite- hs-source-dirs: ../src suite- main-is: TestSuite.hs-- build-depends:- HUnit >= 1.2 && < 2,- QuickCheck >= 2 && < 2.8,- MonadCatchIO-transformers >= 0.2.1 && < 0.4,- test-framework >= 0.4 && < 0.9,- test-framework-hunit >= 0.2.7 && < 0.4,- test-framework-quickcheck2 >= 0.2.12.1 && < 0.4,- aeson >= 0.6 && < 0.12,- attoparsec >= 0.10 && < 0.14,- base >= 4.5 && < 5,- blaze-builder >= 0.2 && < 0.5,- blaze-html >= 0.4 && < 0.9,- bytestring >= 0.9 && < 0.11,- containers >= 0.2 && < 0.6,- directory >= 1.1 && < 1.3,- directory-tree >= 0.10 && < 0.13,- dlist >= 0.5 && < 0.8,- either >= 3.1 && < 4.5,- errors >= 1.4 && < 1.5,- filepath >= 1.3 && < 1.5,- hashable >= 1.1 && < 1.3,- lens >= 4.3 && < 4.14,- mtl >= 2.0 && < 2.3,- process >= 1.1 && < 1.3,- random >= 1.0.1.0 && < 1.2,- text >= 0.10 && < 1.3,- time >= 1.1 && < 1.6,- transformers >= 0.2 && < 0.5,- unordered-containers >= 0.1.4 && < 0.3,- vector >= 0.9 && < 0.12,- xmlhtml >= 0.2.3 && < 0.3--- ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded- Extensions: OverloadedStrings--Executable benchmark- hs-source-dirs: ../src suite- main-is: Benchmark.hs-- build-depends:- MonadCatchIO-transformers >= 0.3 && < 0.4,- HUnit >= 1.2 && < 1.3,- criterion >= 1.0 && < 1.1,- test-framework >= 0.4 && < 0.9,- test-framework-hunit >= 0.2 && < 0.4,-- -- Copied from regular dependencies:-- aeson >= 0.6 && < 0.12,- attoparsec >= 0.10 && < 0.14,- base >= 4.5 && < 5,- blaze-builder >= 0.2 && < 0.5,- blaze-html >= 0.4 && < 0.9,- bytestring >= 0.9 && < 0.11,- containers >= 0.2 && < 0.6,- directory >= 1.1 && < 1.3,- directory-tree >= 0.10 && < 0.13,- dlist >= 0.5 && < 0.8,- either >= 3.1 && < 4.5,- errors >= 1.4 && < 1.5,- filepath >= 1.3 && < 1.5,- hashable >= 1.1 && < 1.3,- map-syntax >= 0.1 && < 0.3,- mtl >= 2.0 && < 2.3,- process >= 1.1 && < 1.3,- random >= 1.0.1.0 && < 1.2,- statistics >= 0.11 && < 0.14,- text >= 0.10 && < 1.3,- time >= 1.1 && < 1.6,- transformers >= 0.2 && < 0.5,- unordered-containers >= 0.1.4 && < 0.3,- vector >= 0.9 && < 0.12,- xmlhtml >= 0.2.3 && < 0.3-- ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded- -fno-warn-unused-do-bind -rtsopts-- ghc-prof-options: -prof -auto-all-- Extensions:- GeneralizedNewtypeDeriving,- PackageImports,- ScopedTypeVariables,- DeriveDataTypeable,- FlexibleInstances,- MultiParamTypeClasses,- UndecidableInstances,- OverloadedStrings,- TypeSynonymInstances,- NoMonomorphismRestriction-
− test/runTestsAndCoverage.sh
@@ -1,48 +0,0 @@-#!/bin/sh--set -e--SUITE=./dist/build/testsuite/testsuite--rm -f testsuite.tix--if [ ! -f $SUITE ]; then- cat <<EOF-Testsuite executable not found, please run:- cabal configure -ftest-then- cabal build-EOF- exit;-fi--./dist/build/testsuite/testsuite -j4 -a1000 $*--DIR=dist/hpc--rm -Rf $DIR-mkdir -p $DIR--EXCLUDES='Main-Heist.Compiled.Tests-Heist.Interpreted.Tests-Heist.Tutorial.AttributeSplices-Heist.Tutorial.CompiledSplices-Heist.Tutorial.Imports-Heist.TestCommon-Heist.Tests'--EXCL=""--for m in $EXCLUDES; do- EXCL="$EXCL --exclude=$m"-done--hpc markup $EXCL --destdir=$DIR testsuite >/dev/null 2>&1--rm -f testsuite.tix--cat <<EOF--Test coverage report written to $DIR.-EOF
test/suite/Benchmark.hs view
@@ -32,10 +32,10 @@ ------------------------------------------------------------------------------ loadWithCache baseDir = do- etm <- runEitherT $ do+ etm <- runExceptT $ do let sc = SpliceConfig mempty defaultLoadTimeSplices mempty mempty- [loadTemplates baseDir]- initHeistWithCacheTag $ HeistConfig sc "" False+ [loadTemplates baseDir] (const True)+ ExceptT $ initHeistWithCacheTag $ HeistConfig sc "" False either (error . unlines) (return . fst) etm main = do
test/suite/Heist/Compiled/Tests.hs view
@@ -6,9 +6,13 @@ import Control.Error 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.Map.Syntax import Data.Monoid+import qualified Data.Set as Set import Data.Text.Encoding import Test.Framework (Test) import Test.Framework.Providers.HUnit@@ -39,6 +43,9 @@ , testCase "compiled/no-ns-splices" noNsSplices , testCase "compiled/nsbind" nsBindTest , testCase "compiled/nsbinderr" nsBindErrorTest+ , testCase "compiled/nscall" nsCallTest+ , testCase "compiled/nscallerr" nsCallErrTest+ , testCase "compiled/nsbindstack" nsBindStackTest , testCase "compiled/doctype" doctypeTest ] @@ -48,7 +55,7 @@ H.assertEqual "compiled state splice" expected res where expected =- mappend doctype "\n <html> 3 </html> "+ mappend doctype "\n\n<html>\n3\n</html>\n" peopleTest :: IO () peopleTest = do@@ -56,7 +63,7 @@ H.assertEqual "people splice" expected res where expected =- " <p>Doe, John: 42 years old</p> <p>Smith, Jane: 21 years old</p> "+ "\n<p>Doe, John: 42 years old</p>\n\n<p>Smith, Jane: 21 years old</p>\n\n" templateHC :: HeistConfig IO templateHC = HeistConfig sc "" False@@ -67,8 +74,8 @@ genericTest :: String -> ByteString -> ByteString -> IO () genericTest nm template expected = do- res <- runEitherT $ do- hs <- initHeist templateHC+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist templateHC runner <- noteT ["Error rendering"] $ hoistMaybe $ renderTemplate hs template b <- lift $ fst runner@@ -80,12 +87,12 @@ doctypeTest = genericTest "doctype test" "rss" expected where expected = encodeUtf8- "<rss><channel><link>http://www.devalot.com/</link></channel></rss> "+ "<rss><channel><link>http://www.devalot.com/</link></channel></rss>\n" namespaceTest1 :: IO () namespaceTest1 = do- res <- runEitherT $ do- hs <- initHeist templateHC+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist templateHC runner <- noteT ["Error rendering"] $ hoistMaybe $ renderTemplate hs "namespaces" b <- lift $ fst runner@@ -93,13 +100,13 @@ H.assertEqual "namespace test 1" (Right expected) res where- expected = "Alpha\naoeu Beta\n<h:foo aoeu='htns'>Inside h:foo</h:foo> End\n"+ expected = "Alpha\naoeu\nBeta\n<h:foo aoeu='htns'>Inside h:foo</h:foo>\nEnd\n" namespaceTest2 :: IO () namespaceTest2 = do- res <- runEitherT $ do- hs <- initHeist $ templateHC & hcErrorNotBound .~ True+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist $ templateHC & hcErrorNotBound .~ True runner <- noteT ["Error rendering"] $ hoistMaybe $ renderTemplate hs "namespaces" b <- lift $ fst runner@@ -107,13 +114,13 @@ H.assertEqual "namespace test 2" (Right expected) res where- expected = "Alpha\naoeu Beta\n<h:foo aoeu='htns'>Inside h:foo</h:foo> End\n"+ expected = "Alpha\naoeu\nBeta\n<h:foo aoeu='htns'>Inside h:foo</h:foo>\nEnd\n" namespaceTest3 :: IO () namespaceTest3 = do- res <- runEitherT $ do- hs <- initHeist $ templateHC & hcNamespace .~ "h"+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist $ templateHC & hcNamespace .~ "h" runner <- noteT ["Error rendering"] $ hoistMaybe $ renderTemplate hs "namespaces" b <- lift $ fst runner@@ -121,13 +128,13 @@ H.assertEqual "namespace test 3" (Right expected) res where- expected = "Alpha\n<foo aoeu='htns'>Inside foo</foo> Beta\naoeu End\n"+ expected = "Alpha\n<foo aoeu='htns'>Inside foo</foo>\nBeta\naoeu\nEnd\n" namespaceTest4 :: IO () namespaceTest4 = do- res <- runEitherT $ do- hs <- initHeist $ templateHC & hcNamespace .~ "h"+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist $ templateHC & hcNamespace .~ "h" & hcErrorNotBound .~ True runner <- noteT ["Error rendering"] $ hoistMaybe $ renderTemplate hs "namespaces"@@ -136,13 +143,13 @@ H.assertEqual "namespace test 4" (Right expected) res where- expected = "Alpha\n<foo aoeu='htns'>Inside foo</foo> Beta\naoeu End\n"+ expected = "Alpha\n<foo aoeu='htns'>Inside foo</foo>\nBeta\naoeu\nEnd\n" namespaceTest5 :: IO () namespaceTest5 = do- res <- runEitherT $ do- hs <- initHeist $ templateHC & hcNamespace .~ "h"+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist $ templateHC & hcNamespace .~ "h" & hcCompiledSplices .~ mempty & hcErrorNotBound .~ True runner <- noteT ["Error rendering"] $ hoistMaybe $@@ -157,8 +164,8 @@ -- this test will throw an error. noNsSplices :: IO () noNsSplices = do- res <- runEitherT $ do- hs <- initHeist hc+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist hc runner <- noteT ["Error rendering"] $ hoistMaybe $ renderTemplate hs "test" b <- lift $ fst runner@@ -172,27 +179,40 @@ & scTemplateLocations .~ [loadTemplates "templates-no-ns"] -nsBindTemplateHC :: HeistConfig IO-nsBindTemplateHC = HeistConfig sc "h" False+nsBindTemplateHC :: String -> HeistConfig IO+nsBindTemplateHC dir = HeistConfig sc "h" False where sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices & scCompiledSplices .~ nsBindTestSplices- & scTemplateLocations .~ [loadTemplates "templates-nsbind"]+ & scTemplateLocations .~ [loadTemplates dir] + nsBindTestSplices :: Splices (Splice IO)-nsBindTestSplices = "main" ## do+nsBindTestSplices = do+ "call" ## do+ tpl <- withSplices (callTemplate "_call")+ nsBindSubSplices (return ())+ return $ yieldRuntime $ codeGen tpl+ "main" ## nsBindSubImpl (return ())+ "main2" ## nsBindSubImpl (return ())+++nsBindSubImpl :: RuntimeSplice IO b -> Splice IO+nsBindSubImpl _ = do tpl <- withSplices runChildren nsBindSubSplices (return ()) return $ yieldRuntime $ codeGen tpl + nsBindSubSplices :: Splices (RuntimeSplice IO () -> Splice IO)-nsBindSubSplices = mapV (pureSplice . textSplice) $- "sub" ## const "asdf"+nsBindSubSplices = do+ "sub" ## pureSplice . textSplice $ const "asdf"+ "recurse" ## nsBindSubImpl nsBindTest :: IO () nsBindTest = do- res <- runEitherT $ do- hs <- initHeist $ nsBindTemplateHC+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist $ (nsBindTemplateHC "templates-nsbind") runner <- noteT ["Error rendering"] $ hoistMaybe $ renderTemplate hs "nsbind" b <- lift $ fst runner@@ -200,17 +220,87 @@ H.assertEqual "namespace bind test" (Right expected) res where- expected = "Alpha\n Beta\nasdf Gamma\n<sub></sub> "+ expected = "Alpha\n\nBeta\nasdf\nGamma\n<sub></sub>\n\n" +------------------------------------------------------------------------------+-- | Test splice error reporting. nsBindErrorTest :: IO () nsBindErrorTest = do- res <- runEitherT $ do- hs <- initHeist $ nsBindTemplateHC- & hcErrorNotBound .~ True+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist $ (nsBindTemplateHC "templates-nsbind")+ & hcErrorNotBound .~ True runner <- noteT ["Error rendering"] $ hoistMaybe $ renderTemplate hs "nsbinderror" b <- lift $ fst runner return $ toByteString b - H.assertEqual "namespace bind error test" (Left ["templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid"]) res+ 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"+++------------------------------------------------------------------------------+-- | Test splice error data structure.+nsBindStackTest :: IO ()+nsBindStackTest = do+ res <- initHeist (nsBindTemplateHC "templates-nsbind") >>=+ return . (either Left (Right . _spliceErrors))++ H.assertEqual "namespace bind stack test" (Right [ err1, err2, err3 ]) res+ where+ err1 = SpliceError [ ( ["nsbinderror"]+ , Just "templates-nsbind/nsbinderror.tpl"+ , "h:main2") ]+ (Just "templates-nsbind/nsbinderror.tpl")+ ["h:sub","h:recurse","h:call","h:main2","h:main"]+ "No splice bound for h:invalid3"+ err2 = SpliceError [ ( ["nsbinderror"]+ , Just "templates-nsbind/nsbinderror.tpl"+ , "h:recurse")+ , ( ["nsbinderror"]+ , Just "templates-nsbind/nsbinderror.tpl"+ ,"h:main") ]+ (Just "templates-nsbind/nsbinderror.tpl")+ ["h:sub","h:recurse","h:call","h:main2","h:main"]+ "No splice bound for h:invalid2"+ err3 = SpliceError []+ (Just "templates-nsbind/nsbinderror.tpl")+ ["h:call","h:main2","h:main"]+ "No splice bound for h:invalid1"+++nsCallTest :: IO ()+nsCallTest = do+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist $ (nsBindTemplateHC "templates-nscall")+ & hcErrorNotBound .~ True+ & hcCompiledTemplateFilter .~ nsFilter+ runner <- noteT ["Error rendering"] $ hoistMaybe $+ renderTemplate hs "nscall"+ b <- lift $ fst runner+ return $ toByteString b++ H.assertEqual "namespace call test" (Right "Top\n\nInside 1\nCalled\nasdf\n\nInside 2\n\n") res+ where+ nsFilter = (/=) (fromIntegral $ ord '_') . B.head . head+++nsCallErrTest :: IO ()+nsCallErrTest = do+ res <- runExceptT $ do+ hs <- ExceptT $ initHeist $ (nsBindTemplateHC "templates-nscall")+ & hcErrorNotBound .~ True+ runner <- noteT ["Error rendering"] $ hoistMaybe $+ renderTemplate hs "nscall"+ b <- lift $ fst runner+ return $ toByteString b++ H.assertEqual "namespace call error test"+ (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"
test/suite/Heist/Interpreted/Tests.hs view
@@ -36,13 +36,13 @@ ------------------------------------------------------------------------------ import Heist import Heist.Common+import Heist.Internal.Types import Heist.Interpreted.Internal import Heist.Splices.Apply import Heist.Splices.Ignore import Heist.Splices.Json import Heist.Splices.Markdown import Heist.TestCommon-import Heist.Internal.Types import qualified Text.XmlHtml as X import qualified Text.XmlHtml.Cursor as X @@ -61,6 +61,8 @@ , testCase "heist/attributeSubstitution" attrSubstTest , testCase "heist/bindAttribute" bindAttrTest , testCase "heist/markdown" markdownTest+ , testCase "heist/pandoc" pandocTest+ , testCase "heist/pandoc_div" pandocDivTest , testCase "heist/title_expansion" titleExpansion , testCase "heist/textarea_expansion" textareaExpansion , testCase "heist/div_expansion" divExpansion@@ -139,7 +141,7 @@ ets <- loadIO "templates" mempty mempty mempty mempty either (error "Error loading templates") (\ts -> do let tm = _templateMap ts- H.assertEqual "loadTest size" 38 $ Map.size tm+ H.assertEqual "loadTest size" 41 $ Map.size tm ) ets @@ -183,7 +185,7 @@ where indexRes = B.concat [doctype- ,"\n <html>\n<div id='pre_{att}_post'>\n/index\n</div>\n</html>\n"+ ,"\n\n<html>\n<div id='pre_{att}_post'>\n/index\n</div>\n</html>\n" ] ------------------------------------------------------------------------------@@ -240,7 +242,32 @@ markdownTest :: H.Assertion markdownTest = renderTest "markdown" markdownHtmlExpected +----------------------------------------------------------------------------- +-- | Pandoc test on a file+pandocTest :: H.Assertion+pandocTest = renderTest "pandoc" pandocNoDivHtmlExpected++pandocDivTest :: H.Assertion+pandocDivTest = renderTest "pandocdiv" pandocDivHtmlExpected++pandocNoDivHtmlExpected :: ByteString+pandocNoDivHtmlExpected = "<p>This <em>is</em> a test.</p>"++pandocDivHtmlExpected :: ByteString+pandocDivHtmlExpected =+ "<div class='foo test' id='pandoc'><p>This <em>is</em> a test.</p></div>"+ -- Implementaton dependent. Class is prepended in current implementation,+ -- it will be first attribute++pandocTestSplices :: Splices (Splice IO)+pandocTestSplices = do+ "pandocnodiv" ## pandocSplice optsNoDiv+ "pandocdiv" ## pandocSplice optsDiv+ where+ optsNoDiv = setPandocWrapDiv Nothing defaultPandocOptions+ optsDiv = setPandocWrapDiv (Just "test") defaultPandocOptions+ ------------------------------------------------------------------------------ jsonValueTest :: H.Assertion jsonValueTest = do@@ -268,7 +295,7 @@ -> ByteString -- ^ expected result -> H.Assertion renderTest templateName expectedResult = do- ets <- loadT "templates" mempty mempty mempty mempty+ ets <- loadT "templates" mempty pandocTestSplices mempty mempty let ts = either (error "Error loading templates") id ets check ts expectedResult
test/suite/Heist/TestCommon.hs view
@@ -35,11 +35,11 @@ -> Splices (C.Splice m) -> Splices (AttrSplice m) -> IO (Either [String] (HeistState m))-loadT baseDir a b c d = runEitherT $ do+loadT baseDir a b c d = runExceptT $ do let sc = SpliceConfig (defaultInterpretedSplices `mappend` a) (defaultLoadTimeSplices `mappend` b) c d- [loadTemplates baseDir]- initHeist $ HeistConfig sc "" False+ [loadTemplates baseDir] (const True)+ ExceptT $ initHeist $ HeistConfig sc "" False ------------------------------------------------------------------------------@@ -49,21 +49,21 @@ -> Splices (C.Splice IO) -> Splices (AttrSplice IO) -> IO (Either [String] (HeistState IO))-loadIO baseDir a b c d = runEitherT $ do+loadIO baseDir a b c d = runExceptT $ do let sc = SpliceConfig (defaultInterpretedSplices >> a) (defaultLoadTimeSplices >> b) c d- [loadTemplates baseDir]- initHeist $ HeistConfig sc "" False+ [loadTemplates baseDir] (const True)+ ExceptT $ initHeist $ HeistConfig sc "" False ------------------------------------------------------------------------------ loadHS :: FilePath -> IO (HeistState IO) loadHS baseDir = do- etm <- runEitherT $ do+ etm <- runExceptT $ do let sc = SpliceConfig defaultInterpretedSplices defaultLoadTimeSplices mempty mempty- [loadTemplates baseDir]- initHeist $ HeistConfig sc "" False+ [loadTemplates baseDir] (const True)+ ExceptT $ initHeist $ HeistConfig sc "" False either (error . concat) return etm @@ -75,7 +75,8 @@ loadEmpty a b c d = do let sc = SpliceConfig (defaultInterpretedSplices `mappend` a) (defaultLoadTimeSplices `mappend` b) c d mempty- res <- runEitherT $ initHeist $ HeistConfig sc "" False+ (const True)+ res <- initHeist $ HeistConfig sc "" False either (error . concat) return res
test/suite/Heist/Tests.hs view
@@ -1,4 +1,6 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+ module Heist.Tests ( tests ) where@@ -51,11 +53,19 @@ ets where expected = sort+#if MIN_VERSION_base(4,9,0)+ ["templates-bad/apply-missing-attr.tpl: must supply \"template\" attribute in <apply>\nCallStack (from HasCallStack):\n error, called at src/Heist/Common.hs:76:15 in main:Heist.Common"+ ,"templates-bad/apply-template-not-found.tpl: apply tag cannot find template \"/page\"\nCallStack (from HasCallStack):\n error, called at src/Heist/Common.hs:76:15 in main:Heist.Common"+ ,"templates-bad/bind-infinite-loop.tpl: template recursion exceeded max depth, you probably have infinite splice recursion!\nCallStack (from HasCallStack):\n error, called at src/Heist/Common.hs:76:15 in main:Heist.Common"+ ,"templates-bad/bind-missing-attr.tpl: must supply \"tag\" attribute in <bind>\nCallStack (from HasCallStack):\n error, called at src/Heist/Common.hs:76:15 in main:Heist.Common"+ ]+#else ["templates-bad/bind-infinite-loop.tpl: template recursion exceeded max depth, you probably have infinite splice recursion!" ,"templates-bad/apply-template-not-found.tpl: apply tag cannot find template \"/page\"" ,"templates-bad/bind-missing-attr.tpl: must supply \"tag\" attribute in <bind>" ,"templates-bad/apply-missing-attr.tpl: must supply \"template\" attribute in <apply>" ]+#endif attrSpliceTest :: IO ()@@ -81,8 +91,8 @@ where expected1 = "<input type='checkbox' value='foo' checked />\n<input type='checkbox' value='bar' />\n" expected2 = "<input type='checkbox' value='foo' />\n<input type='checkbox' value='bar' checked />\n"- expected3 = "<input type=\"checkbox\" value=\"foo\" checked /> <input type=\"checkbox\" value=\"bar\" /> "- expected4 = "<input type=\"checkbox\" value=\"foo\" /> <input type=\"checkbox\" value=\"bar\" checked /> "+ expected3 = "<input type=\"checkbox\" value=\"foo\" checked />\n<input type=\"checkbox\" value=\"bar\" />\n"+ expected4 = "<input type=\"checkbox\" value=\"foo\" />\n<input type=\"checkbox\" value=\"bar\" checked />\n" fooSplice :: I.Splice (StateT Int IO) fooSplice = do@@ -94,7 +104,7 @@ tdirCacheTest = do let rSplices = ("foosplice" ## fooSplice) dSplices = ("foosplice" ## stateSplice)- sc = SpliceConfig rSplices mempty dSplices mempty mempty+ sc = SpliceConfig rSplices mempty dSplices mempty mempty (const True) hc = HeistConfig sc "" False td <- newTemplateDirectory' "templates" hc @@ -155,7 +165,7 @@ ["<html><head>\n<link href='wrapper-link' />\n" ,"<link href='nav-link' />\n\n<link href='index-link' />" ,"</head>\n\n<body>\n\n<div>nav bar</div>\n\n\n"- ,"<div>index page</div>\n\n</body>\n</html> "+ ,"<div>index page</div>\n\n</body>\n</html>\n\n" ] bindApplyInteractionTest :: IO ()@@ -169,13 +179,13 @@ H.assertEqual "interpreted failure" iExpected iOut where cExpected = B.intercalate "\n"- [" This is a test."- ,"===bind content=== Another test line."- ,"apply content Last test line."- ," "+ ["\nThis is a test."+ ,"===bind content===\nAnother test line."+ ,"apply content\nLast test line."+ ,"\n" ] iExpected = B.unlines- [" This is a test."+ ["\nThis is a test." ,"===bind content===" ,"Another test line." ,"apply content"@@ -190,11 +200,10 @@ backslashHandlingTest = do hs <- loadHS "templates" cOut <- cRender hs "backslash"- H.assertEqual "compiled failure" cExpected cOut+ H.assertEqual "compiled failure" expected cOut iOut <- iRender hs "backslash"- H.assertEqual "interpreted failure" iExpected iOut+ H.assertEqual "interpreted failure" expected iOut where- cExpected = "<foo regex='abc\\d+\\\\e'></foo> "- iExpected = "<foo regex='abc\\d+\\\\e'></foo>\n"+ expected = "<foo regex='abc\\d+\\\\e'></foo>\n"
test/suite/Heist/Tutorial/CompiledSplices.lhs view
@@ -110,11 +110,11 @@ > -> Splices (C.Splice n) > -> IO (HeistState n) > load baseDir splices = do-> tmap <- runEitherT $ do+> tmap <- runExceptT $ do > let sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices > & scCompiledSplices .~ splices > & scTemplateLocations .~ [loadTemplates baseDir]-> initHeist $ emptyHeistConfig & hcNamespace .~ ""+> ExceptT $ initHeist $ emptyHeistConfig & hcNamespace .~ "" > & hcErrorNotBound .~ False > & hcSpliceConfig .~ sc > either (error . concat) return tmap@@ -148,7 +148,7 @@ > > personSplices :: Monad n > => Splices (RuntimeSplice n Person -> C.Splice n)-> personSplices = mapS (C.pureSplice . C.textSplice) $ do+> personSplices = mapV (C.pureSplice . C.textSplice) $ do > "firstName" ## pFirstName > "lastName" ## pLastName > "age" ## pack . show . pAge@@ -269,7 +269,7 @@ < < splices :: Monad n < => Splices (RuntimeSplice n (Text, Text) -> C.Splice n)-< splices = mapS (C.pureSplice . C.nodeSplice) $ do+< splices = mapS (C.pureSplice . C.htmlNodeSplice) $ do < "user" ## (:[]) . TextNode . fst < "value" ## (:[]) . TextNode . snd
test/suite/Heist/Tutorial/Imports.hs view
@@ -10,11 +10,12 @@ , T.Text , T.pack , ByteString- , runEitherT+ , runExceptT+ , ExceptT(..) ) where import Blaze.ByteString.Builder-import Control.Error (runEitherT)+import Control.Error (runExceptT, ExceptT(..)) import Control.Monad import Control.Monad.Trans import qualified Control.Monad.Trans.State as ST
test/suite/TestSuite.hs view
@@ -1,5 +1,6 @@ module Main where +import System.Directory import Test.Framework (defaultMain, testGroup) import qualified Heist.Interpreted.Tests@@ -7,7 +8,10 @@ import qualified Heist.Tests main :: IO ()-main = defaultMain tests+main = do+ -- Need to change directory after we switched to cabal test infra+ setCurrentDirectory "test"+ defaultMain tests where tests = [ testGroup "Heist.Interpreted.Tests" Heist.Interpreted.Tests.tests , testGroup "Heist.Compiled.Tests"