packages feed

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 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