heist 0.11.1 → 0.12.0
raw patch · 12 files changed
+241/−174 lines, 12 filesdep +transformersPVP ok
version bump matches the API change (PVP)
Dependencies added: transformers
API changes (from Hackage documentation)
- Heist: hcTemplates :: HeistConfig m -> TemplateRepo
- Heist.Compiled: addSplices :: Monad m => [(Text, Splice n)] -> HeistT n m ()
- Heist.Compiled: mapInputPromise :: Monad n => (a -> b) -> (Promise b -> Splice n) -> Promise a -> Splice n
- Heist.Compiled: nodeSplice :: (a -> [Node]) -> a -> Builder
- Heist.Compiled: nodeSplices :: [(Text, a -> [Node])] -> [(Text, a -> Builder)]
- Heist.Compiled: yieldLater :: Monad n => n Builder -> DList (Chunk n)
+ Heist: _curMarkup :: HeistState m -> Markup
+ Heist: hcTemplateLocations :: HeistConfig m -> [TemplateLocation]
+ Heist: reloadTemplates :: TemplateRepo -> EitherT [String] IO TemplateRepo
+ Heist: type TemplateLocation = EitherT [String] IO TemplateRepo
+ Heist: type TemplateRepo = HashMap TPath DocumentFile
+ Heist.Compiled: htmlSplice :: (a -> [Node]) -> a -> Builder
+ Heist.Compiled: htmlSplices :: [(Text, a -> [Node])] -> [(Text, a -> Builder)]
- Heist: HeistConfig :: [(Text, Splice m)] -> [(Text, Splice IO)] -> [(Text, Splice m)] -> [(Text, AttrSplice m)] -> TemplateRepo -> HeistConfig m
+ Heist: HeistConfig :: [(Text, Splice m)] -> [(Text, Splice IO)] -> [(Text, Splice m)] -> [(Text, AttrSplice m)] -> [TemplateLocation] -> HeistConfig m
- Heist: 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 -> HeistState m
+ Heist: 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 -> HeistState m
- Heist.Compiled: manyWithSplices :: Monad n => Splice n -> [(Text, Promise a -> Splice n)] -> n [a] -> Splice n
+ Heist.Compiled: manyWithSplices :: Monad n => Splice n -> [(Text, Promise a -> Splice n)] -> RuntimeSplice n [a] -> Splice n
- Heist.Compiled: repromise :: Monad n => (a -> n b) -> [(d, Promise b -> Splice n)] -> [(d, Promise a -> Splice n)]
+ Heist.Compiled: repromise :: Monad n => (a -> RuntimeSplice n b) -> [(d, Promise b -> Splice n)] -> [(d, Promise a -> Splice n)]
- Heist.Compiled: repromise' :: Monad n => (a -> n b) -> (Promise b -> Splice n) -> Promise a -> Splice n
+ Heist.Compiled: repromise' :: Monad n => (a -> RuntimeSplice n b) -> (Promise b -> Splice n) -> Promise a -> Splice n
- Heist.Compiled: repromiseMay :: Monad n => (a -> n (Maybe b)) -> [(d, Promise b -> Splice n)] -> [(d, Promise a -> Splice n)]
+ Heist.Compiled: repromiseMay :: Monad n => (a -> RuntimeSplice n (Maybe b)) -> [(d, Promise b -> Splice n)] -> [(d, Promise a -> Splice n)]
- Heist.Compiled: repromiseMay' :: Monad n => (a -> n (Maybe b)) -> (Promise b -> Splice n) -> Promise a -> Splice n
+ Heist.Compiled: repromiseMay' :: Monad n => (a -> RuntimeSplice n (Maybe b)) -> (Promise b -> Splice n) -> Promise a -> Splice n
- Heist.Compiled: runAttributesRaw :: (Monad m, Monad n) => [(Text, Text)] -> HeistT n m (RuntimeSplice n [(Text, Text)])
+ Heist.Compiled: runAttributesRaw :: Monad n => [(Text, Text)] -> HeistT n IO (RuntimeSplice n [(Text, Text)])
- Heist.Compiled: withPureSplices :: Monad n => Splice n -> [(Text, a -> Builder)] -> n a -> Splice n
+ Heist.Compiled: withPureSplices :: Monad n => Splice n -> [(Text, a -> Builder)] -> RuntimeSplice n a -> Splice n
- Heist.Compiled: withSplices :: Monad n => Splice n -> [(Text, Promise a -> Splice n)] -> n a -> Splice n
+ Heist.Compiled: withSplices :: Monad n => Splice n -> [(Text, Promise a -> Splice n)] -> RuntimeSplice n a -> Splice n
Files
- heist.cabal +2/−1
- src/Heist.hs +77/−34
- src/Heist/Common.hs +24/−15
- src/Heist/Compiled.hs +2/−5
- src/Heist/Compiled/Internal.hs +102/−98
- src/Heist/Splices/Apply.hs +6/−0
- src/Heist/TemplateDirectory.hs +2/−4
- src/Heist/Types.hs +9/−0
- test/suite/Benchmark.hs +1/−2
- test/suite/Heist/Interpreted/Tests.hs +9/−5
- test/suite/Heist/TestCommon.hs +5/−8
- test/suite/Heist/Tutorial/CompiledSplices.lhs +2/−2
heist.cabal view
@@ -1,5 +1,5 @@ name: heist-version: 0.11.1+version: 0.12.0 synopsis: An Haskell template system supporting both HTML5 and XML. description: Heist is a powerful template system that supports both HTML5 and XML.@@ -155,6 +155,7 @@ random >= 1.0.1.0 && < 1.1, text >= 0.10 && < 0.12, time >= 1.1 && < 1.5,+ transformers >= 0.3 && < 0.4, unordered-containers >= 0.1.4 && < 0.3, vector >= 0.9 && < 0.11, xmlhtml >= 0.2.1 && < 0.3
src/Heist.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-} {-| @@ -17,6 +18,7 @@ ( -- * Primary Heist initialization functions loadTemplates+ , reloadTemplates , addTemplatePathPrefix , initHeist , initHeistWithCacheTag@@ -24,9 +26,11 @@ , defaultLoadTimeSplices -- * Core Heist data types+ , HeistConfig(..)+ , TemplateRepo+ , TemplateLocation , Template , TPath- , HeistConfig(..) , MIMEType , DocumentFile(..) , AttrSplice@@ -79,29 +83,38 @@ type TemplateRepo = HashMap TPath DocumentFile ++------------------------------------------------------------------------------+-- | 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++ data HeistConfig m = HeistConfig { hcInterpretedSplices :: [(Text, I.Splice m)]- -- ^ Interpreted splices are the splices that Heist has always had. They- -- return a list of nodes and are processed at runtime.+ -- ^ Interpreted splices are the splices that Heist has always had. They+ -- return a list of nodes and are processed at runtime. , hcLoadTimeSplices :: [(Text, 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.+ -- ^ 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. , hcCompiledSplices :: [(Text, 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.+ -- ^ 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. , hcAttributeSplices :: [(Text, AttrSplice m)]- -- ^ Attribute splices are bound to attribute names and return a list of- -- attributes.- , hcTemplates :: TemplateRepo- -- ^ Templates returned from the 'loadTemplates' function.+ -- ^ Attribute splices are bound to attribute names and return a list of+ -- attributes.+ , hcTemplateLocations :: [TemplateLocation]+ -- ^ A list of all the locations that Heist should get its templates+ -- from. } instance Monoid (HeistConfig m) where- mempty = HeistConfig [] [] [] [] Map.empty+ mempty = HeistConfig [] [] [] [] mempty mappend (HeistConfig a b c d e) (HeistConfig a' b' c' d' e') = HeistConfig (a `mappend` a') (b `mappend` b')@@ -111,9 +124,11 @@ --------------------------------------------------------------------------------- | The built-in set of static splices. All the splices that used to be--- enabled by default are included here. To get the normal Heist behavior you--- should include these in the hcLoadTimeSplices list in your HeistConfig.+-- | The built-in set of splices that you should use in compiled splice mode.+-- This list includes everything from 'defaultInterpretedSplices' plus a+-- splice for the content tag that errors out when it sees any instance of the+-- old content tag, which has now been moved to two separate tags called+-- apply-content and bind-content. defaultLoadTimeSplices :: MonadIO m => [(Text, (I.Splice m))] defaultLoadTimeSplices = ("content", deprecatedContentCheck) -- To be removed in later versions@@ -123,7 +138,9 @@ ------------------------------------------------------------------------------ -- | The built-in set of static splices. All the splices that used to be -- enabled by default are included here. To get the normal Heist behavior you--- should include these in the hcLoadTimeSplices list in your HeistConfig.+-- should include these in the hcLoadTimeSplices list in your HeistConfig. If+-- you are using interpreted splice mode, then you might also want to bind the+-- 'deprecatedContentCheck' splice to the content tag as a load time splice. defaultInterpretedSplices :: MonadIO m => [(Text, (I.Splice m))] defaultInterpretedSplices = [ (applyTag, applyImpl)@@ -133,6 +150,16 @@ ] +allErrors :: [Either String (TPath, v)]+ -> EitherT [String] IO (HashMap TPath v)+allErrors tlist =+ case errs of+ [] -> right $ Map.fromList $ rights tlist+ _ -> left errs+ where+ errs = lefts tlist++ ------------------------------------------------------------------------------ -- | Loads templates from disk. This function returns just a template map so -- you can load multiple directories and combine the maps before initializing@@ -140,14 +167,27 @@ loadTemplates :: FilePath -> EitherT [String] IO TemplateRepo loadTemplates dir = do d <- lift $ readDirectoryWith (loadTemplate dir) dir- let tlist = F.fold (free d)- errs = lefts tlist- case errs of- [] -> right $ Map.fromList $ rights tlist- _ -> left errs+ allErrors $ F.fold (free d) ------------------------------------------------------------------------------+-- | Reloads all the templates an an existing TemplateRepo.+reloadTemplates :: TemplateRepo -> EitherT [String] IO TemplateRepo+reloadTemplates repo = do+ tlist <- lift $ mapM loadOrKeep $ Map.toList repo+ allErrors tlist+ where+ loadOrKeep (p,df) =+ case dfFile df of+ Nothing -> return $ Right (p, df)+ Just fp -> do+ df' <- loadTemplate' fp+ return $ fmap (p,) $ case df' of+ [t] -> t+ _ -> Left "Template repo has non-templates"+++------------------------------------------------------------------------------ -- | Adds a path prefix to a templates in a map returned by loadTemplates. If -- you want to add multiple levels of directories, separate them with slashes -- as in "foo/bar". Using an empty string as a path prefix will leave the@@ -165,8 +205,8 @@ ------------------------------------------------------------------------------ -- | 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+emptyHS kg = HeistState Map.empty Map.empty Map.empty Map.empty Map.empty+ True [] 0 [] Nothing kg False Html ------------------------------------------------------------------------------@@ -191,16 +231,18 @@ -> EitherT [String] IO (HeistState n) initHeist hc = do keyGen <- lift HE.newKeyGen- initHeist' keyGen hc+ repos <- sequence $ hcTemplateLocations hc+ initHeist' keyGen hc (Map.unions repos) initHeist' :: Monad n => HE.KeyGen -> HeistConfig n+ -> TemplateRepo -> EitherT [String] IO (HeistState n)-initHeist' keyGen (HeistConfig i lt c a rawTemplates) = do+initHeist' keyGen (HeistConfig i lt c a locations) repo = do let empty = emptyHS keyGen- tmap <- preproc keyGen lt rawTemplates+ tmap <- preproc keyGen lt repo let hs1 = empty { _spliceMap = Map.fromList i , _templateMap = tmap , _compiledSpliceMap = Map.fromList c@@ -244,26 +286,27 @@ ------------------------------------------------------------------------------ -- | Wrapper around initHeist that also sets up a cache tag. It sets up both -- compiled and interpreted versions of the cache tag splices. If you need to--- do configure the cache tag differently than how this function does it, you+-- configure the cache tag differently than how this function does it, you -- will still probably want to pattern your approach after this function's -- implementation. initHeistWithCacheTag :: MonadIO n => HeistConfig n -> EitherT [String] IO (HeistState n, CacheTagState)-initHeistWithCacheTag (HeistConfig i lt c a rawTemplates) = do+initHeistWithCacheTag (HeistConfig i lt c a locations) = do (ss, cts) <- liftIO mkCacheTag let tag = "cache" keyGen <- lift HE.newKeyGen + repos <- sequence locations -- 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)] rawTemplates+ rawWithCache <- preproc keyGen [(tag, ss)] $ Map.unions repos let hc' = HeistConfig ((tag, cacheImpl cts) : i) lt ((tag, cacheImplCompiled cts) : c)- a rawWithCache- hs <- initHeist' keyGen hc'+ a locations+ hs <- initHeist' keyGen hc' rawWithCache return (hs, cts)
src/Heist/Common.hs view
@@ -203,22 +203,31 @@ loadTemplate :: String -- ^ path of the template root -> String -- ^ full file path (includes the template root) -> IO [Either String (TPath, DocumentFile)] --TemplateMap-loadTemplate templateRoot fname- | isHTMLTemplate = do- c <- getDoc fname- return [fmap (\t -> (splitLocalPath $ BC.pack tName, t)) c]- | isXMLTemplate = do- c <- getXMLDoc fname- return [fmap (\t -> (splitLocalPath $ BC.pack tName, t)) c]- | otherwise = return []+loadTemplate templateRoot fname = do+ c <- loadTemplate' fname+ return $ map (fmap (\t -> (splitLocalPath $ BC.pack tName, t))) c where -- tName is path relative to the template root directory- isHTMLTemplate = ".tpl" `isSuffixOf` fname- isXMLTemplate = ".xtpl" `isSuffixOf` fname- correction = if last templateRoot == '/' then 0 else 1- extLen = if isHTMLTemplate then 4 else 5- tName = drop ((length templateRoot)+correction) $- -- We're only dropping the template root, not the whole path- take ((length fname) - extLen) fname+ isHTMLTemplate = ".tpl" `isSuffixOf` fname+ correction = if last templateRoot == '/' then 0 else 1+ extLen = if isHTMLTemplate then 4 else 5+ tName = drop ((length templateRoot)+correction) $+ -- We're only dropping the template root, not the whole path+ take ((length fname) - extLen) fname+++------------------------------------------------------------------------------+-- | Loads a template at the specified path, choosing the appropriate parser+-- based on the file extension. The template is only loaded if it has a+-- \".tpl\" or \".xtpl\" extension. Returns an empty list if the extension+-- doesn't match.+loadTemplate' :: String -> IO [Either String DocumentFile]+loadTemplate' fullDiskPath+ | isHTMLTemplate = liftM (:[]) $ getDoc fullDiskPath+ | isXMLTemplate = liftM (:[]) $ getXMLDoc fullDiskPath+ | otherwise = return []+ where+ isHTMLTemplate = ".tpl" `isSuffixOf` fullDiskPath+ isXMLTemplate = ".xtpl" `isSuffixOf` fullDiskPath ------------------------------------------------------------------------------
src/Heist/Compiled.hs view
@@ -26,12 +26,11 @@ , prefixSplices , namespaceSplices , textSplices- , nodeSplices+ , htmlSplices , pureSplices , textSplice- , nodeSplice+ , htmlSplice , pureSplice- , mapInputPromise , repromise , repromiseMay , repromise'@@ -57,8 +56,6 @@ , yieldRuntimeEffect , yieldPureText , yieldRuntimeText- , yieldLater- , addSplices , withLocalSplices -- * Lower level promise functions
src/Heist/Compiled/Internal.hs view
@@ -137,10 +137,18 @@ => [(Text, a -> [X.Node])] -> Promise a -> HeistT n IO (RuntimeSplice n Builder)-promiseChildrenWithNodes =- promiseChildrenWithTrans (X.renderHtmlFragment X.UTF8)+promiseChildrenWithNodes ss p = do+ markup <- getsHS _curMarkup+ promiseChildrenWithTrans (renderFragment markup) ss p +renderFragment :: Markup -> [X.Node] -> Builder+renderFragment markup ns =+ case markup of+ Html -> X.renderHtmlFragment X.UTF8 ns+ Xml -> X.renderXmlFragment X.UTF8 ns++ ------------------------------------------------------------------------------ -- | Yields pure text known at load time. pureTextChunk :: Text -> Chunk n@@ -188,14 +196,6 @@ --------------------------------------------------------------------------------- | This lets you turn a plain runtime monad function returning a Builder--- into a compiled splice.-yieldLater :: Monad n => n Builder -> DList (Chunk n)-yieldLater = yieldRuntime . RuntimeSplice . lift-{-# INLINE yieldLater #-}--------------------------------------------------------------------------------- -- | Returns a computation that performs load-time splice processing on the -- supplied list of nodes. runNodeList :: Monad n => [X.Node] -> Splice n@@ -235,7 +235,11 @@ -> DocumentFile -> IO [Chunk n] compileTemplate hs tpath df = do- !chunks <- runSplice nullNode hs $! runDocumentFile tpath df+ let markup = case dfDoc df of+ X.XmlDocument _ _ _ -> Xml+ X.HtmlDocument _ _ _ -> Html+ hs' = hs { _curMarkup = markup }+ !chunks <- runSplice nullNode hs' $! runDocumentFile tpath df return chunks where -- This gets overwritten in runDocumentFile@@ -331,9 +335,9 @@ runNode :: Monad n => X.Node -> Splice n runNode node = localParamNode (const node) $ do isStatic <- subtreeIsStatic node+ markup <- getsHS _curMarkup if isStatic- then return $! yieldPure $!- X.renderHtmlFragment X.UTF8 [parseAttrs node]+ then return $! yieldPure $! renderFragment markup [parseAttrs node] else compileNode node @@ -446,6 +450,35 @@ ------------------------------------------------------------------------------+-- |+parseAtt2 :: Monad n+ => (Text, Text)+ -> HeistT n IO (RuntimeSplice n [(Text, Text)])+parseAtt2 (k,v) = do+ mas <- getsHS (H.lookup k . _attrSpliceMap)+ maybe doInline (return . doAttrSplice) mas++ where+ cvt (Literal x) = return $ return x+ cvt (Ident x) =+ localParamNode (const $ X.Element x [] []) $ getAttributeSplice2 x++ -- Handles inline parsing of $() splice syntax in attributes+ doInline = do+ let ast = case AP.feed (AP.parse attParser v) "" of+ (AP.Done _ res) -> res+ (AP.Fail _ _ _) -> []+ (AP.Partial _ ) -> []+ chunks <- mapM cvt ast+ return $ do+ list <- sequence chunks+ return [(k, T.concat list)]++ -- Handles attribute splices+ doAttrSplice splice = splice v+++------------------------------------------------------------------------------ -- | Performs splice processing on a list of attributes. This is useful in -- situations where you need to stop recursion, but still run splice -- processing on the node's attributes.@@ -457,16 +490,12 @@ -- | Performs splice processing on a list of attributes. This is useful in -- situations where you need to stop recursion, but still run splice -- processing on the node's attributes.-runAttributesRaw :: (Monad m, Monad n)+runAttributesRaw :: Monad n => [(Text, Text)]- -> HeistT n m (RuntimeSplice n [(Text, Text)])+ -> HeistT n IO (RuntimeSplice n [(Text, Text)]) runAttributesRaw attrs = do- arrs <- mapM runSingle attrs+ arrs <- mapM parseAtt2 attrs return $ liftM concat $ sequence arrs- where- runSingle p@(k,v) = do- mas <- getsHS (H.lookup k . _attrSpliceMap)- return $ maybe (return [p]) ($v) mas attrToChunk :: Text -> DList (Chunk n) -> DList (Chunk n)@@ -500,6 +529,17 @@ {-# INLINE getAttributeSplice #-} +getAttributeSplice2 :: Monad n => Text -> HeistT n IO (RuntimeSplice n Text)+getAttributeSplice2 name = do+ mSplice <- lookupSplice name+ case mSplice of+ Nothing -> return $ return $ T.concat ["${", name, "}"]+ Just splice -> do+ res <- splice+ return $ liftM (T.decodeUtf8 . toByteString) $ codeGen res+{-# INLINE getAttributeSplice2 #-}++ ------------------------------------------------------------------------------ -- | Promises are used for referencing the results of future runtime -- computations during load time splice processing.@@ -555,51 +595,6 @@ -- $ "deferenced empty promise created at" ++ from -- return prom -- {-# INLINE newEmptyPromiseWithError #-}--- --- --- --------------------------------------------------------------------------------- -- | Creates a promise for a future runtime computation.--- promise :: (Monad n) => n a -> HeistT n IO (Promise a)--- promise act = runtimeSplicePromise (lift act)--- {-# INLINE promise #-}--- --- --- --------------------------------------------------------------------------------- -- | Turns a RuntimeSplice computation into a promise.--- runtimeSplicePromise :: (Monad n)--- => RuntimeSplice n a--- -> HeistT n IO (Promise a)--- runtimeSplicePromise act = do--- prom <- newEmptyPromiseWithError "runtimeSplicePromise"--- --- let m = do--- x <- act--- putPromise prom x--- return ()--- --- yieldRuntimeEffect m--- return prom--- {-# INLINE runtimeSplicePromise #-}--- --- --- --------------------------------------------------------------------------------- -- | Sets up a runtime transformation on a 'Promise'.--- withPromise :: (Monad n)--- => Promise a--- -> (a -> n b)--- -> HeistT n IO (Promise b)--- withPromise promA f = do--- promB <- newEmptyPromiseWithError "withPromise"--- --- let m = do--- a <- getPromise promA--- b <- lift $ f a--- putPromise promB b--- return ()--- --- yieldRuntimeEffect m--- return promB--- {-# INLINE withPromise #-} ------------------------------------------------------------------------------@@ -624,15 +619,6 @@ -- | Adds a list of compiled splices to the splice map. This function is -- useful because it allows compiled splices to bind other compiled splices -- during load-time splice processing.-addSplices :: Monad m => [(Text, Splice n)] -> HeistT n m ()-addSplices ss = modifyHS (bindSplices ss)-{-# DEPRECATED addSplices "addSplices will be removed in the next release! Use withLocalSplices instead."#-}------------------------------------------------------------------------------------ | Adds a list of compiled splices to the splice map. This function is--- useful because it allows compiled splices to bind other compiled splices--- during load-time splice processing. withLocalSplices :: [(Text, Splice n)] -> [(Text, AttrSplice n)] -> HeistT n IO a@@ -719,14 +705,14 @@ ------------------------------------------------------------------------------ -- | Converts pure Node splices to pure Builder splices.-nodeSplices :: [(Text, a -> [X.Node])] -> [(Text, a -> Builder)]-nodeSplices = mapSnd nodeSplice+htmlSplices :: [(Text, a -> [X.Node])] -> [(Text, a -> Builder)]+htmlSplices = mapSnd htmlSplice ------------------------------------------------------------------------------ -- | Converts a pure Node splice function to a pure Builder splice function.-nodeSplice :: (a -> [X.Node]) -> a -> Builder-nodeSplice f = X.renderHtmlFragment X.UTF8 . f+htmlSplice :: (a -> [X.Node]) -> a -> Builder+htmlSplice f = X.renderHtmlFragment X.UTF8 . f ------------------------------------------------------------------------------@@ -746,25 +732,17 @@ return $ f a -mapInputPromise :: Monad n- => (a -> b)- -> (Promise b -> Splice n)- -> Promise a -> Splice n-mapInputPromise f = repromise' (return . f)-{-# DEPRECATED mapInputPromise "Use repromise' instead."#-}-- ------------------------------------------------------------------------------ -- | Change the promise type of a splice function. repromise' :: Monad n- => (a -> n b)+ => (a -> RuntimeSplice n b) -> (Promise b -> Splice n) -> Promise a -> Splice n repromise' f pf p = do p2 <- newEmptyPromise let action = yieldRuntimeEffect $ do a <- getPromise p- putPromise p2 =<< lift (f a)+ putPromise p2 =<< f a res <- pf p2 return $ action `mappend` res @@ -772,7 +750,7 @@ ------------------------------------------------------------------------------ -- | Repromise a list of splices. repromise :: Monad n- => (a -> n b)+ => (a -> RuntimeSplice n b) -> [(d, Promise b -> Splice n)] -> [(d, Promise a -> Splice n)] repromise f = mapSnd (repromise' f)@@ -783,7 +761,7 @@ -- fail. If a Nothing is encountered, then the splice will generate no -- output. repromiseMay' :: Monad n- => (a -> n (Maybe b))+ => (a -> RuntimeSplice n (Maybe b)) -> (Promise b -> Splice n) -> Promise a -> Splice n repromiseMay' f pf p = do@@ -791,7 +769,7 @@ action <- pf p2 return $ yieldRuntime $ do a <- getPromise p- mb <- lift (f a)+ mb <- f a case mb of Nothing -> return mempty Just b -> do@@ -802,7 +780,7 @@ ------------------------------------------------------------------------------ -- | repromiseMay' for a list of splices. repromiseMay :: Monad n- => (a -> n (Maybe b))+ => (a -> RuntimeSplice n (Maybe b)) -> [(d, Promise b -> Splice n)] -> [(d, Promise a -> Splice n)] repromiseMay f = mapSnd (repromiseMay' f)@@ -845,16 +823,39 @@ return $ mconcat res +------------------------------------------------------------------------------+-- | Another useful way of combining groups of splices.+-- FIXME - We probably need to export this+--applyDeferred :: Monad n+-- => RuntimeSplice n a+-- -> [(Text, Promise a -> Splice n)]+-- -> [(Text, Splice n)]+--applyDeferred m = applySnd m . mapSnd defer+++------------------------------------------------------------------------------+-- | This is kind of the opposite of defer. Not sure what to name it yet.+-- FIXME - This is a really common pattern, so I think we do want to expose it+--deferred :: (Monad n)+-- => (t -> RuntimeSplice n Builder)+-- -> Promise t+-- -> Splice n+--deferred f p = return $ yieldRuntime $ f =<< getPromise p+++------------------------------------------------------------------------------+-- | Runs a splice computation with a list of splices that are functions of+-- runtime data. withSplices :: Monad n => Splice n -> [(Text, Promise a -> Splice n)]- -> n a+ -> RuntimeSplice n a -> Splice n withSplices splice splices runtimeAction = do p <- newEmptyPromise let splices' = mapSnd ($p) splices chunks <- withLocalSplices splices' [] splice- let fillPromise = yieldRuntimeEffect $ putPromise p =<< lift runtimeAction+ let fillPromise = yieldRuntimeEffect $ putPromise p =<< runtimeAction return $ fillPromise `mappend` chunks @@ -869,7 +870,7 @@ -- You'll frequently use 'runChildren' here. -> [(Text, Promise a -> Splice n)] -- ^ List of splices to bind- -> n [a]+ -> RuntimeSplice n [a] -- ^ Runtime action returning a list of items to render. -> Splice n manyWithSplices splice splices runtimeAction = do@@ -877,18 +878,21 @@ let splices' = mapSnd ($p) splices chunks <- withLocalSplices splices' [] splice return $ yieldRuntime $ do- items <- lift runtimeAction+ items <- runtimeAction res <- forM items $ \item -> putPromise p item >> codeGen chunks return $ mconcat res +------------------------------------------------------------------------------+-- | Like 'withSplices', but works for \"pure\" splices that don't operate in+-- the HeistT monad. withPureSplices :: Monad n => Splice n -> [(Text, a -> Builder)]- -> n a+ -> RuntimeSplice n a -> Splice n withPureSplices splice splices action = do- let fieldSplice g = return $ yieldRuntime $ liftM g $ lift action+ let fieldSplice g = return $ yieldRuntime $ liftM g action let splices' = map (second fieldSplice) splices withLocalSplices splices' [] splice
src/Heist/Splices/Apply.hs view
@@ -93,6 +93,12 @@ Just template -> applyNodes (X.childNodes node) template +------------------------------------------------------------------------------+-- | This splice crashes with an error message. Its purpose is to provide a+-- load-time warning to anyone still using the old content tag in their+-- templates. In Heist 0.10, tho content tag was replaced by two separate+-- apply-content and bind-content tags used by the apply and bind splices+-- respectively. deprecatedContentCheck :: Monad m => Splice m deprecatedContentCheck = return [] `orError` unwords
src/Heist/TemplateDirectory.hs view
@@ -42,8 +42,7 @@ -> HeistConfig n -> EitherT [String] IO (TemplateDirectory n) newTemplateDirectory dir hc = do- templates <- loadTemplates dir- let hc' = hc { hcTemplates = templates }+ let hc' = hc { hcTemplateLocations = [loadTemplates dir] } (hs,cts) <- initHeistWithCacheTag hc' tsMVar <- liftIO $ newMVar hs ctsMVar <- liftIO $ newMVar cts@@ -84,8 +83,7 @@ -> IO (Either String ()) reloadTemplateDirectory (TemplateDirectory p hc tsMVar ctsMVar) = do ehs <- runEitherT $ do- templates <- loadTemplates p- initHeistWithCacheTag (hc { hcTemplates = templates })+ initHeistWithCacheTag (hc { hcTemplateLocations = [loadTemplates p] }) leftPass ehs $ \(hs,cts) -> do modifyMVar_ tsMVar (const $ return hs) modifyMVar_ ctsMVar (const $ return cts)
src/Heist/Types.hs view
@@ -72,6 +72,11 @@ ------------------------------------------------------------------------------+-- | Designates whether a document should be treated as XML or HTML.+data Markup = Xml | Html+++------------------------------------------------------------------------------ -- | Monad used for runtime splice execution. newtype RuntimeSplice m a = RuntimeSplice { unRT :: StateT HeterogeneousEnvironment m a@@ -166,6 +171,10 @@ -- preprocessing, errors should stop execution and be reported. During -- template rendering, it's better to skip the errors and render the page. , _preprocessingMode :: Bool++ -- | This is needed because compiled templates are generated with a bunch+ -- of calls to renderFragment rather than a single call to render.+ , _curMarkup :: Markup }
test/suite/Benchmark.hs view
@@ -31,8 +31,7 @@ loadWithCache baseDir = do etm <- runEitherT $ do- templates <- loadTemplates baseDir- let hc = HeistConfig [] defaultLoadTimeSplices [] [] templates+ let hc = HeistConfig [] defaultLoadTimeSplices [] [] [loadTemplates baseDir] initHeistWithCacheTag hc either (error . unlines) (return . fst) etm
test/suite/Heist/Interpreted/Tests.hs view
@@ -71,6 +71,7 @@ , testCase "heist/attrSpliceContext" attrSpliceContext , testCase "heist/json/values" jsonValueTest , testCase "heist/json/object" jsonObjectTest+ , testCase "heist/renderXML" xmlNotHtmlTest ] @@ -137,7 +138,7 @@ ets <- loadIO "templates" [] [] [] [] either (error "Error loading templates") (\ts -> do let tm = _templateMap ts- H.assertEqual "loadTest size" 36 $ Map.size tm+ H.assertEqual "loadTest size" 37 $ Map.size tm ) ets @@ -195,7 +196,7 @@ where splices = defaultLoadTimeSplices ++ [("foo", return [X.TextNode "meaning_of_everything"])]- + check str ts expected = do Just (resDoc, _) <- renderTemplate ts "attrs" H.assertEqual str expected $ toByteString $ resDoc@@ -338,7 +339,7 @@ result <- evalHeistT markdownSplice (X.TextNode "This *is* a test.") hs- H.assertEqual "Markdown text" markdownHtmlExpected + H.assertEqual "Markdown text" markdownHtmlExpected (B.filter (/= '\n') $ toByteString $ X.render (X.HtmlDocument X.UTF8 Nothing result)) @@ -358,7 +359,7 @@ ignoreTest = do es <- loadEmpty [] [] [] [] res <- evalHeistT ignoreImpl- (X.Element "ignore" [("tag", "ignorable")] + (X.Element "ignore" [("tag", "ignorable")] [X.TextNode "This should be ignored"]) es H.assertEqual "<ignore> tag" [] res @@ -372,6 +373,10 @@ res <- runHeistT k (X.TextNode "") hs H.assertBool "lookup context test" $ isJust $ fst res +------------------------------------------------------------------------------+xmlNotHtmlTest :: H.Assertion+xmlNotHtmlTest = renderTest "rss" expected where+ expected = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><rss><channel><link>http://www.devalot.com/</link></channel></rss>" ------------------------------------------------------------------------------ identStartChar :: [Char]@@ -636,4 +641,3 @@ --prn = L.putStrLn . formatNode --runTests :: IO () --runTests = defaultMain tests-
test/suite/Heist/TestCommon.hs view
@@ -6,8 +6,8 @@ import Control.Monad.Trans import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B-import qualified Data.HashMap.Strict as Map import Data.Maybe+import Data.Monoid import Data.Text (Text) @@ -35,9 +35,8 @@ -> [(Text, AttrSplice m)] -> IO (Either [String] (HeistState m)) loadT baseDir a b c d = runEitherT $ do- ts <- loadTemplates baseDir let hc = HeistConfig (defaultInterpretedSplices ++ a)- (defaultLoadTimeSplices ++ b) c d ts+ (defaultLoadTimeSplices ++ b) c d [loadTemplates baseDir] initHeist hc @@ -49,9 +48,8 @@ -> [(Text, AttrSplice IO)] -> IO (Either [String] (HeistState IO)) loadIO baseDir a b c d = runEitherT $ do- ts <- loadTemplates baseDir let hc = HeistConfig (defaultInterpretedSplices ++ a)- (defaultLoadTimeSplices ++ b) c d ts+ (defaultLoadTimeSplices ++ b) c d [loadTemplates baseDir] initHeist hc @@ -59,9 +57,8 @@ loadHS :: FilePath -> IO (HeistState IO) loadHS baseDir = do etm <- runEitherT $ do- templates <- loadTemplates baseDir let hc = HeistConfig defaultInterpretedSplices- defaultLoadTimeSplices [] [] templates+ defaultLoadTimeSplices [] [] [loadTemplates baseDir] initHeist hc either (error . concat) return etm @@ -73,7 +70,7 @@ -> IO (HeistState IO) loadEmpty a b c d = do let hc = HeistConfig (defaultInterpretedSplices ++ a)- (defaultLoadTimeSplices ++ b) c d Map.empty+ (defaultLoadTimeSplices ++ b) c d mempty res <- runEitherT $ initHeist hc either (error . concat) return res
test/suite/Heist/Tutorial/CompiledSplices.lhs view
@@ -107,8 +107,8 @@ > -> IO (HeistState n) > load baseDir splices = do > tmap <- runEitherT $ do-> templates <- loadTemplates baseDir-> let hc = HeistConfig [] defaultLoadTimeSplices splices [] templates+> let hc = HeistConfig [] defaultLoadTimeSplices splices []+> [loadTemplates baseDir] > initHeist hc > either (error . concat) return tmap