hakyll 2.3.1 → 2.4

raw patch · 17 files changed

+310/−167 lines, 17 filesdep +blaze-htmlPVP ok

version bump matches the API change (PVP)

Dependencies added: blaze-html

API changes (from Hackage documentation)

Files

• hakyll.cabal +5/−3
• src/Text/Hakyll.hs +30/−1
• src/Text/Hakyll/ContextManipulations.hs +6/−0
• src/Text/Hakyll/CreateContext.hs +24/−9
• src/Text/Hakyll/Feed.hs +1/−0
• src/Text/Hakyll/File.hs +1/−1
• src/Text/Hakyll/HakyllMonad.hs +23/−2
• src/Text/Hakyll/Internal/Cache.hs +22/−0
• src/Text/Hakyll/Internal/CompressCss.hs +2/−2
• src/Text/Hakyll/Internal/FileType.hs +1/−0
• src/Text/Hakyll/Internal/Page.hs +0/−121
• src/Text/Hakyll/Internal/Template.hs +10/−8
• src/Text/Hakyll/Page.hs +105/−0
• src/Text/Hakyll/Pandoc.hs +57/−0
• src/Text/Hakyll/Render.hs +3/−2
• src/Text/Hakyll/Tags.hs +13/−11
• src/Text/Hakyll/Util.hs +7/−7

@@ -1,5 +1,5 @@ Name:               hakyll-Version:            2.3.1+Version:            2.4  Synopsis:           A simple static site generator library. Description:        A simple static site generator library, mainly aimed at@@ -40,7 +40,8 @@                     old-time == 1.*,                     time >= 1.1,                     binary >= 0.5,-                    hamlet >= 0.4.2+                    hamlet >= 0.4.2,+                    blaze-html >= 0.2 && <= 0.3   exposed-modules:  Network.Hakyll.SimpleServer                     Text.Hakyll                     Text.Hakyll.Context@@ -52,6 +53,8 @@                     Text.Hakyll.Render                     Text.Hakyll.HakyllAction                     Text.Hakyll.Paginate+                    Text.Hakyll.Page+                    Text.Hakyll.Pandoc                     Text.Hakyll.Util                     Text.Hakyll.Tags                     Text.Hakyll.Feed@@ -60,7 +63,6 @@                     Text.Hakyll.Internal.Cache                     Text.Hakyll.Internal.CompressCss                     Text.Hakyll.Internal.FileType-                    Text.Hakyll.Internal.Page                     Text.Hakyll.Internal.Template                     Text.Hakyll.Internal.Template.Template                     Text.Hakyll.Internal.Template.Hamlet

@@ -12,6 +12,22 @@     , hakyll     , hakyllWithConfiguration     , runDefaultHakyll++    , module Text.Hakyll.Context+    , module Text.Hakyll.ContextManipulations+    , module Text.Hakyll.CreateContext+    , module Text.Hakyll.File+    , module Text.Hakyll.HakyllMonad+    , module Text.Hakyll.Regex+    , module Text.Hakyll.Render+    , module Text.Hakyll.HakyllAction+    , module Text.Hakyll.Paginate+    , module Text.Hakyll.Page+    , module Text.Hakyll.Pandoc+    , module Text.Hakyll.Util+    , module Text.Hakyll.Tags+    , module Text.Hakyll.Feed+    , module Text.Hakyll.Configurations.Static     ) where  import Control.Concurrent (forkIO, threadDelay)@@ -26,8 +42,21 @@ import Text.Hamlet (defaultHamletSettings)  import Network.Hakyll.SimpleServer (simpleServer)-import Text.Hakyll.HakyllMonad+import Text.Hakyll.Context+import Text.Hakyll.ContextManipulations+import Text.Hakyll.CreateContext import Text.Hakyll.File+import Text.Hakyll.HakyllMonad+import Text.Hakyll.Regex+import Text.Hakyll.Render+import Text.Hakyll.HakyllAction+import Text.Hakyll.Paginate+import Text.Hakyll.Page+import Text.Hakyll.Pandoc+import Text.Hakyll.Util+import Text.Hakyll.Tags+import Text.Hakyll.Feed+import Text.Hakyll.Configurations.Static  -- | The default reader options for pandoc parsing. --

@@ -9,6 +9,7 @@     , renderDateWithLocale     , changeExtension     , renderBody+    , takeBody     ) where  import Control.Monad (liftM)@@ -115,3 +116,8 @@ renderBody :: (String -> String)            -> HakyllAction Context Context renderBody = renderValue "body" "body"++-- | Get the resulting body text from a context+--+takeBody :: HakyllAction Context String+takeBody = arr $ fromMaybe "" . M.lookup "body" . unContext

@@ -5,37 +5,40 @@     ( createPage     , createCustomPage     , createListing+    , addField     , combine     , combineWithUrl     ) where +import Prelude hiding (id)+ import qualified Data.Map as M-import Control.Arrow (second)+import Control.Arrow (second, arr, (&&&), (***)) import Control.Monad (liftM2) import Control.Applicative ((<$>))+import Control.Arrow ((>>>))+import Control.Category (id) -import Text.Hakyll.File import Text.Hakyll.Context import Text.Hakyll.HakyllAction import Text.Hakyll.Render-import Text.Hakyll.Internal.Page+import Text.Hakyll.Page+import Text.Hakyll.Pandoc+import Text.Hakyll.Internal.Cache  -- | Create a @Context@ from a page file stored on the disk. This is probably --   the most common way to create a @Context@. createPage :: FilePath -> HakyllAction () Context-createPage path = HakyllAction-    { actionDependencies = [path]-    , actionUrl          = Left $ toUrl path-    , actionFunction     = const (readPage path)-    }+createPage path = cacheAction "pages" $ readPageAction path >>> renderAction --- | Create a "custom page" @Context@.+-- | Create a custom page @Context@. --    --   The association list given maps keys to values for substitution. Note --   that as value, you can either give a @String@ or a --   @HakyllAction () String@. The latter is preferred for more complex data, --   since it allows dependency checking. A @String@ is obviously more simple --   to use in some cases.+-- createCustomPage :: FilePath                  -> [(String, Either String (HakyllAction () String))]                  -> HakyllAction () Context@@ -68,6 +71,18 @@   where     context = ("body", Right concatenation) : additional     concatenation = renderAndConcat templates renderables++-- | Add a field to a 'Context'.+--+addField :: String                                  -- ^ Key+         -> Either String (HakyllAction () String)  -- ^ Value+         -> HakyllAction Context Context            -- ^ Result+addField key value =   arr (const ()) &&& id+                   >>> value' *** id+                   >>> arr (uncurry insert)+  where+    value' = arr (const ()) >>> either (arr . const) id value+    insert v = Context . M.insert key v . unContext  -- | Combine two @Context@s. The url will always be taken from the first --   @Renderable@. Also, if a `$key` is present in both renderables, the

@@ -17,6 +17,7 @@ -- --   Furthermore, the feed will be generated, but will be incorrect (it won't --   validate) if an empty list is passed.+-- module Text.Hakyll.Feed     ( FeedConfiguration (..)     , renderRss

@@ -34,7 +34,7 @@ removeLeadingSeparator :: FilePath -> FilePath removeLeadingSeparator [] = [] removeLeadingSeparator path-    | head path' `elem` pathSeparators = tail path'+    | head path' `elem` pathSeparators = drop 1 path'     | otherwise                        = path'   where     path' = if "$root" `isPrefixOf` path then drop 5 path

@@ -6,11 +6,14 @@     , askHakyll     , getAdditionalContext     , logHakyll+    , forkHakyllWait+    , concurrentHakyll     ) where  import Control.Monad.Trans (liftIO)-import Control.Monad.Reader (ReaderT, ask)-import Control.Monad (liftM)+import Control.Concurrent.MVar (MVar, putMVar, newEmptyMVar, readMVar)+import Control.Monad.Reader (ReaderT, ask, runReaderT)+import Control.Monad (liftM, forM, forM_) import qualified Data.Map as M import System.IO (hPutStrLn, stderr) @@ -76,3 +79,21 @@ -- logHakyll :: String -> Hakyll () logHakyll = liftIO . hPutStrLn stderr++-- | Perform a concurrent hakyll action. Returns an MVar you can wait on+--+forkHakyllWait :: Hakyll () -> Hakyll (MVar ())+forkHakyllWait action = do+    mvar <- liftIO newEmptyMVar+    config <- ask+    liftIO $ do+        runReaderT action config+        putMVar mvar ()+    return mvar++-- | Perform a number of concurrent hakyll actions, and waits for them to finish+--+concurrentHakyll :: [Hakyll ()] -> Hakyll ()+concurrentHakyll actions = do+    mvars <- forM actions forkHakyllWait+    forM_ mvars (liftIO . readMVar)

@@ -2,14 +2,17 @@     ( storeInCache     , getFromCache     , isCacheMoreRecent+    , cacheAction     ) where  import Control.Monad ((<=<)) import Control.Monad.Reader (liftIO) import Data.Binary+import System.FilePath ((</>))  import Text.Hakyll.File import Text.Hakyll.HakyllMonad (Hakyll)+import Text.Hakyll.HakyllAction  -- | We can store all datatypes instantiating @Binary@ to the cache. The cache --   directory is specified by the @HakyllConfiguration@, usually @_cache@.@@ -29,3 +32,22 @@ -- | Check if a file in the cache is more recent than a number of other files. isCacheMoreRecent :: FilePath -> [FilePath] -> Hakyll Bool isCacheMoreRecent file depends = toCache file >>= flip isFileMoreRecent depends++-- | Cache an entire arrow+--+cacheAction :: Binary a+            => String+            -> HakyllAction () a+            -> HakyllAction () a+cacheAction key action = action { actionFunction = const cacheFunction }+  where+    cacheFunction = do+        -- Construct a filename+        fileName <- fmap (key </>) $ either id (const $ return "unknown")+                                   $ actionUrl action+        -- Check the cache+        cacheOk <- isCacheMoreRecent fileName $ actionDependencies action+        if cacheOk then getFromCache fileName+                   else do result <- actionFunction action ()+                           storeInCache result fileName+                           return result

@@ -29,8 +29,8 @@ stripComments [] = [] stripComments str     | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str-    | otherwise = head str : stripComments (tail str)+    | otherwise = head str : stripComments (drop 1 str)   where     eatComments str' | null str' = []                      | isPrefixOf "*/" str' = drop 2 str'-                     | otherwise = eatComments $ tail str'+                     | otherwise = eatComments $ drop 1 str'

@@ -32,6 +32,7 @@     getFileType' ".mdwn"     = Markdown     getFileType' ".mkd"      = Markdown     getFileType' ".mkdwn"    = Markdown+    getFileType' ".page"     = Markdown     getFileType' ".rst"      = ReStructuredText     getFileType' ".tex"      = LaTeX     getFileType' ".text"     = Text

@@ -1,121 +0,0 @@--- | A module for dealing with @Page@s. This module is mostly internally used.-module Text.Hakyll.Internal.Page-    ( readPage-    ) where--import qualified Data.Map as M-import Data.List (isPrefixOf)-import Data.Char (isSpace)-import Control.Monad.Reader (liftIO)-import System.FilePath-import Control.Monad.State (State, evalState, get, put)--import Text.Pandoc--import Text.Hakyll.Context (Context (..))-import Text.Hakyll.File-import Text.Hakyll.HakyllMonad-import Text.Hakyll.Regex (substituteRegex, matchesRegex)-import Text.Hakyll.Util (trim)-import Text.Hakyll.Internal.Cache-import Text.Hakyll.Internal.FileType---- | Get a render function for a given extension.-getRenderFunction :: FileType -> Hakyll (String -> String)-getRenderFunction Html = return id-getRenderFunction Text = return id-getRenderFunction UnknownFileType = return id-getRenderFunction fileType = do-    parserState <- askHakyll pandocParserState-    writerOptions <- askHakyll pandocWriterOptions-    return $ writeHtmlString writerOptions-           . readFunction fileType (readOptions parserState fileType)-  where-    readFunction ReStructuredText        = readRST-    readFunction LaTeX                   = readLaTeX-    readFunction Markdown                = readMarkdown-    readFunction LiterateHaskellMarkdown = readMarkdown-    readFunction t                       = error $ "Cannot render " ++ show t--    readOptions options LiterateHaskellMarkdown = options-        { stateLiterateHaskell = True }-    readOptions options _                       = options---- | Split a page into sections.-splitAtDelimiters :: [String] -> State (Maybe String) [[String]]-splitAtDelimiters [] = return []-splitAtDelimiters ls@(x:xs) = do-    delimiter <- get-    if not (isDelimiter delimiter x)-        then return [ls]-        else do let proper = takeWhile (== '-') x-                    (content, rest) = break (isDelimiter $ Just proper) xs-                put $ Just proper-                rest' <- splitAtDelimiters rest-                return $ (x : content) : rest'-  where-    isDelimiter old = case old of-        Nothing  -> isPossibleDelimiter-        (Just d) -> (== d) . takeWhile (== '-')---- | Check if the given string is a metadata delimiter.-isPossibleDelimiter :: String -> Bool-isPossibleDelimiter = isPrefixOf "---"---- | Read one section of a page.-readSection :: (String -> String) -- ^ Render function.-            -> Bool -- ^ If this section is the first section in the page.-            -> [String] -- ^ Lines in the section.-            -> [(String, String)] -- ^ Key-values extracted.-readSection _ _ [] = []-readSection renderFunction isFirst ls-    | not isDelimiter' = body ls-    | isNamedDelimiter = readSectionMetaData ls-    | isFirst = readSimpleMetaData (tail ls)-    | otherwise = body (tail ls)-  where-    isDelimiter' = isPossibleDelimiter (head ls)-    isNamedDelimiter = head ls `matchesRegex` "^----*  *[a-zA-Z0-9][a-zA-Z0-9]*"-    body ls' = [("body", renderFunction $ unlines ls')]--    readSimpleMetaData = map readPair . filter (not . all isSpace)-    readPair = trimPair . break (== ':')-    trimPair (key, value) = (trim key, trim $ tail value)--    readSectionMetaData [] = []-    readSectionMetaData (header:value) =-        let key = substituteRegex "[^a-zA-Z0-9]" "" header-        in [(key, renderFunction $ unlines value)]---- | Read a page from a file. Metadata is supported, and if the filename---   has a @.markdown@ extension, it will be rendered using pandoc.-readPageFromFile :: FilePath -> Hakyll Context-readPageFromFile path = do-    renderFunction <- getRenderFunction $ getFileType path-    let sectionFunctions = map (readSection renderFunction)-                               (True : repeat False)--    -- Read file.-    contents <- liftIO $ readFile path-    url <- toUrl path-    let sections = evalState (splitAtDelimiters $ lines contents) Nothing-        sectionsData = concat $ zipWith ($) sectionFunctions sections-        context = M.fromList $-            ("url", url) : ("path", path) : category ++ sectionsData--    return $ Context context-  where-    category = let dirs = splitDirectories $ takeDirectory path-               in [("category", last dirs) | not (null dirs)]---- | Read a page. Might fetch it from the cache if available. Otherwise, it will---   read it from the file given and store it in the cache.-readPage :: FilePath -> Hakyll Context-readPage path = do-    isCacheMoreRecent' <- isCacheMoreRecent fileName [path]-    if isCacheMoreRecent' then getFromCache fileName-                          else do page <- readPageFromFile path-                                  storeInCache page fileName-                                  return page-  where-    fileName = "pages" </> path

@@ -7,6 +7,7 @@     , finalSubstitute     ) where +import Control.Arrow ((>>>)) import Control.Applicative ((<$>)) import Data.List (isPrefixOf) import Data.Char (isAlphaNum)@@ -16,8 +17,11 @@  import Text.Hakyll.Context (Context (..)) import Text.Hakyll.HakyllMonad (Hakyll)+import Text.Hakyll.HakyllAction+import Text.Hakyll.Pandoc import Text.Hakyll.Internal.Cache-import Text.Hakyll.Internal.Page+import Text.Hakyll.Page+import Text.Hakyll.ContextManipulations import Text.Hakyll.Internal.Template.Template import Text.Hakyll.Internal.Template.Hamlet @@ -29,15 +33,13 @@     fromString' [] = []     fromString' string         | "$$" `isPrefixOf` string =-            EscapeCharacter : (fromString' $ tail tail')+            EscapeCharacter : (fromString' $ drop 2 string)         | "$" `isPrefixOf` string =-            let (key, rest) = span isAlphaNum tail'+            let (key, rest) = span isAlphaNum $ drop 1 string             in Identifier key : fromString' rest         | otherwise =             let (chunk, rest) = break (== '$') string             in Chunk chunk : fromString' rest-      where-        tail' = tail string  -- | Read a @Template@ from a file. This function might fetch the @Template@ --   from the cache, if available.@@ -55,9 +57,9 @@   where      fileName = "templates" </> path     readDefaultTemplate = do-        page <- unContext <$> readPage path-        let body = fromMaybe (error $ "No body in template " ++ fileName)-                             (M.lookup "body" page)+        body <- runHakyllAction $   readPageAction path+                                >>> renderAction+                                >>> takeBody         return $ fromString body      readHamletTemplate = fromHamletRT <$> readHamletRT path

@@ -0,0 +1,105 @@+-- | A module for dealing with @Page@s. This module is mostly internally used.+module Text.Hakyll.Page+    ( PageSection (..)+    , readPage+    , readPageAction+    ) where++import Data.List (isPrefixOf)+import Data.Char (isSpace)+import Control.Monad.Reader (liftIO)+import System.FilePath+import Control.Monad.State (State, evalState, get, put)++import Text.Hakyll.File+import Text.Hakyll.HakyllMonad+import Text.Hakyll.HakyllAction+import Text.Hakyll.Regex (substituteRegex, matchesRegex)+import Text.Hakyll.Util (trim)++-- | A page is first parsed into a number of page sections. A page section+-- consists of:+--+-- * A key+--+-- * A value+--+-- * A 'Bool' flag, indicating if the value is applicable for rendering+--+data PageSection = PageSection {unPageSection :: (String, String, Bool)}+                 deriving (Show)++-- | Split a page into sections.+--+splitAtDelimiters :: [String] -> State (Maybe String) [[String]]+splitAtDelimiters [] = return []+splitAtDelimiters ls@(x:xs) = do+    delimiter <- get+    if not (isDelimiter delimiter x)+        then return [ls]+        else do let proper = takeWhile (== '-') x+                    (content, rest) = break (isDelimiter $ Just proper) xs+                put $ Just proper+                rest' <- splitAtDelimiters rest+                return $ (x : content) : rest'+  where+    isDelimiter old = case old of+        Nothing  -> isPossibleDelimiter+        (Just d) -> (== d) . takeWhile (== '-')++-- | Check if the given string is a metadata delimiter.+isPossibleDelimiter :: String -> Bool+isPossibleDelimiter = isPrefixOf "---"++-- | Read one section of a page.+--+readSection :: Bool -- ^ If this section is the first section in the page.+            -> [String] -- ^ Lines in the section.+            -> [PageSection] -- ^ Key-values extracted.+readSection _ [] = []+readSection isFirst ls+    | not isDelimiter' = [body ls]+    | isNamedDelimiter = readSectionMetaData ls+    | isFirst = readSimpleMetaData (drop 1 ls)+    | otherwise = [body (drop 1 ls)]+  where+    isDelimiter' = isPossibleDelimiter (head ls)+    isNamedDelimiter = head ls `matchesRegex` "^----*  *[a-zA-Z0-9][a-zA-Z0-9]*"+    body ls' = PageSection ("body", unlines ls', True)++    readSimpleMetaData = map readPair . filter (not . all isSpace)+    readPair = trimPair . break (== ':')+    trimPair (key, value) = PageSection (trim key, trim (drop 1 value), False)++    readSectionMetaData [] = []+    readSectionMetaData (header:value) =+        let key = substituteRegex "[^a-zA-Z0-9]" "" header+        in [PageSection (key, unlines value, True)]++-- | Read a page from a file. Metadata is supported.+--+readPage :: FilePath -> Hakyll [PageSection]+readPage path = do+    let sectionFunctions = map readSection $ True : repeat False++    -- Read file.+    contents <- liftIO $ readFile path+    url <- toUrl path+    let sections = evalState (splitAtDelimiters $ lines contents) Nothing+        sectionsData = concat $ zipWith ($) sectionFunctions sections++    return $ PageSection ("url", url, False)+           : PageSection ("path", path, False)+           : (category ++ sectionsData)+  where+    category = let dirs = splitDirectories $ takeDirectory path+               in [PageSection ("category", last dirs, False) | not (null dirs)]++-- | Read a page from a file. Metadata is supported.+--+readPageAction :: FilePath -> HakyllAction () [PageSection]+readPageAction path = HakyllAction+    { actionDependencies = [path]+    , actionUrl          = Left $ toUrl path+    , actionFunction     = const $ readPage path+    }

@@ -0,0 +1,57 @@+-- | Module exporting a pandoc arrow+--+module Text.Hakyll.Pandoc+    ( renderAction+    , renderActionWith+    ) where++import Data.Maybe (fromMaybe)+import qualified Data.Map as M+import Control.Arrow (second, (>>>), arr, (&&&))++import Text.Pandoc++import Text.Hakyll.Internal.FileType+import Text.Hakyll.Page+import Text.Hakyll.HakyllMonad+import Text.Hakyll.HakyllAction+import Text.Hakyll.Context++-- | Get a render function for a given extension.+--+getRenderFunction :: HakyllAction FileType (String -> String)+getRenderFunction = createHakyllAction $ \fileType -> case fileType of+    Html -> return id+    Text -> return id+    UnknownFileType -> return id+    _ -> do parserState <- askHakyll pandocParserState+            writerOptions <- askHakyll pandocWriterOptions+            return $ writeHtmlString writerOptions+                   . readFunction fileType (readOptions parserState fileType)+  where+    readFunction ReStructuredText        = readRST+    readFunction LaTeX                   = readLaTeX+    readFunction Markdown                = readMarkdown+    readFunction LiterateHaskellMarkdown = readMarkdown+    readFunction t                       = error $ "Cannot render " ++ show t++    readOptions options LiterateHaskellMarkdown = options+        { stateLiterateHaskell = True }+    readOptions options _                       = options++-- | An action that renders the list of page sections to a context using pandoc+--+renderAction :: HakyllAction [PageSection] Context+renderAction = (arr id &&& (getFileType' >>> getRenderFunction))+             >>> renderActionWith+  where+    getFileType' = arr $ getFileType . fromMaybe "unknown" . lookup "path" +                       . map (\(x, y, _) -> (x, y)) . map unPageSection++-- | An action to render pages, offering just a little more flexibility+--+renderActionWith :: HakyllAction ([PageSection], String -> String) Context+renderActionWith = createHakyllAction $ \(sections, render') -> return $+    Context $ M.fromList $ map (renderTriple render' . unPageSection) sections+  where+    renderTriple render' (k, v, r) = second (if r then render' else id) (k, v)

@@ -20,6 +20,7 @@ import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, getAdditionalContext) import Text.Hakyll.File import Text.Hakyll.HakyllAction+import Text.Hakyll.ContextManipulations import Text.Hakyll.Internal.CompressCss import Text.Hakyll.Internal.Template @@ -67,8 +68,8 @@     renders = map (>>> render') renderables      actionFunction' _ = do-        contexts <- mapM runHakyllAction renders-        return $ concatMap (fromMaybe "" . M.lookup "body" . unContext) contexts+        contexts <- mapM (runHakyllAction . (>>> takeBody)) renders+        return $ concat contexts  -- | Chain a render action for a page with a number of templates. This will --   also write the result to the site destination. This is the preferred way

@@ -27,6 +27,7 @@ --   @readTagMap@ or @readCategoryMap@ function, you also have to give a unique --   identifier to it. This identifier is simply for caching reasons, so Hakyll --   can tell different maps apart; it has no other use.+-- module Text.Hakyll.Tags     ( TagMap     , readTagMap@@ -43,6 +44,11 @@ import Control.Applicative ((<$>)) import System.FilePath +import Text.Blaze.Renderer.String (renderHtml)+import Text.Blaze.Html5 ((!), string, stringValue)+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+ import Text.Hakyll.Context (Context (..)) import Text.Hakyll.ContextManipulations (changeValue) import Text.Hakyll.CreateContext (createPage)@@ -51,7 +57,6 @@ import Text.Hakyll.HakyllAction import Text.Hakyll.Util import Text.Hakyll.Internal.Cache-import Text.Hakyll.Internal.Template  -- | Type for a tag map. --@@ -113,6 +118,8 @@                 -> HakyllAction () TagMap readCategoryMap = readMap $ maybeToList . M.lookup "category" . unContext +-- | Perform a @Hakyll@ action on every item in the tag+-- withTagMap :: HakyllAction () TagMap            -> (String -> [HakyllAction () Context] -> Hakyll ())            -> Hakyll ()@@ -130,16 +137,11 @@     renderTagCloud' tagMap =         return $ intercalate " " $ map (renderTag tagMap) (tagCount tagMap) -    renderTag tagMap (tag, count) = -        finalSubstitute linkTemplate $ Context $ M.fromList-            [ ("size", sizeTag tagMap count)-            , ("url", urlFunction tag)-            , ("tag", tag)-            ]--    linkTemplate =-        fromString "<a style=\"font-size: $size\" href=\"$url\">$tag</a>"-+    renderTag tagMap (tag, count) = renderHtml $+        H.a ! A.style (stringValue $ "font-size: " ++ sizeTag tagMap count)+            ! A.href (stringValue $ urlFunction tag)+            $ string tag+             sizeTag tagMap count = show (size' :: Int) ++ "%"       where         size' = floor $ minSize + relative tagMap count * (maxSize - minSize)

@@ -7,6 +7,10 @@  import Data.Char (isSpace) +import Text.Blaze.Html5 ((!), string, stringValue, a)+import Text.Blaze.Html5.Attributes (href)+import Text.Blaze.Renderer.String (renderHtml)+ -- | Trim a string (drop spaces, tabs and newlines at both sides). trim :: String -> String trim = reverse . trim' . reverse . trim'@@ -18,11 +22,7 @@ stripHtml []  = [] stripHtml str = let (beforeTag, rest) = break (== '<') str                     (_, afterTag)     = break (== '>') rest-                in beforeTag ++ stripHtml (tail' afterTag)-  where-    -- We need a failsafe tail function.-    tail' [] = []-    tail' xs = tail xs+                in beforeTag ++ stripHtml (drop 1 afterTag)  -- | Make a HTML link. --@@ -30,5 +30,5 @@ link :: String -- ^ Link text.      -> String -- ^ Link destination.      -> String-link text destination = "<a href=\"" ++ destination ++ "\">"-                      ++ text ++ "</a>"+link text destination = renderHtml $ a ! href (stringValue destination)+                                       $ string text