hakyll 1.1 → 1.2

raw patch · 16 files changed

+485/−227 lines, 16 filesdep +QuickCheckdep +binarydep −parallelPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, binary

Dependencies removed: parallel

API changes (from Hackage documentation)

Files

• hakyll.cabal +12/−9
• src/Text/Hakyll.hs +21/−24
• src/Text/Hakyll/CompressCSS.hs +0/−34
• src/Text/Hakyll/Context.hs +35/−2
• src/Text/Hakyll/File.hs +21/−11
• src/Text/Hakyll/Hakyll.hs +4/−0
• src/Text/Hakyll/Internal/Cache.hs +30/−0
• src/Text/Hakyll/Internal/CompressCSS.hs +36/−0
• src/Text/Hakyll/Internal/Render.hs +68/−0
• src/Text/Hakyll/Internal/Template.hs +121/−0
• src/Text/Hakyll/Page.hs +47/−14
• src/Text/Hakyll/Render.hs +23/−18
• src/Text/Hakyll/Render/Internal.hs +0/−94
• src/Text/Hakyll/Renderables.hs +6/−2
• src/Text/Hakyll/Tags.hs +54/−15
• src/Text/Hakyll/Util.hs +7/−4

@@ -1,5 +1,5 @@ Name:           hakyll-Version:        1.1+Version:        1.2  Synopsis:       A simple static site generator library. Description:@@ -34,18 +34,21 @@                    mtl >= 1.1,                    old-locale >= 1,                    time >= 1,-                   parallel >= 2-  exposed-modules: Text.Hakyll+                   binary >= 0.5,+                   QuickCheck >= 2+  exposed-modules: Network.Hakyll.SimpleServer+                   Text.Hakyll+                   Text.Hakyll.Context+                   Text.Hakyll.File                    Text.Hakyll.Hakyll+                   Text.Hakyll.Regex                    Text.Hakyll.Render                    Text.Hakyll.Renderable                    Text.Hakyll.Renderables-                   Text.Hakyll.CompressCSS-                   Text.Hakyll.File                    Text.Hakyll.Page                    Text.Hakyll.Util                    Text.Hakyll.Tags-                   Text.Hakyll.Context-                   Text.Hakyll.Regex-                   Network.Hakyll.SimpleServer-  other-modules: Text.Hakyll.Render.Internal+                   Text.Hakyll.Internal.Cache+                   Text.Hakyll.Internal.CompressCSS+                   Text.Hakyll.Internal.Render+                   Text.Hakyll.Internal.Template

@@ -4,7 +4,7 @@     , hakyllWithConfiguration     ) where -import Control.Monad.Reader (runReaderT)+import Control.Monad.Reader (runReaderT, liftIO) import Control.Monad (when) import qualified Data.Map as M import System.Environment (getArgs, getProgName)@@ -17,6 +17,8 @@ defaultHakyllConfiguration :: HakyllConfiguration defaultHakyllConfiguration = HakyllConfiguration     { additionalContext = M.empty+    , siteDirectory = "_site"+    , cacheDirectory = "_cache"     }  -- | Hakyll with a default configuration.@@ -27,32 +29,27 @@ hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO () hakyllWithConfiguration configuration buildFunction = do     args <- getArgs-    case args of ["build"]      -> build'-                 ["clean"]      -> clean-                 ["preview", p] -> build' >> server (read p)-                 ["preview"]    -> build' >> server 8000-                 ["server", p]  -> server (read p)-                 ["server"]     -> server 8000-                 _              -> help-  where-    build' = build configuration buildFunction---- | Build the site.-build :: HakyllConfiguration -> Hakyll () -> IO ()-build configuration buildFunction = do putStrLn "Generating..."-                                       runReaderT buildFunction configuration+    let f = case args of ["build"]      -> buildFunction+                         ["clean"]      -> clean+                         ["preview", p] -> buildFunction >> server (read p)+                         ["preview"]    -> buildFunction >> server 8000+                         ["server", p]  -> server (read p)+                         ["server"]     -> server 8000+                         _              -> help+    runReaderT f configuration  -- | Clean up directories.-clean :: IO ()-clean = remove' "_site"+clean :: Hakyll ()+clean = do askHakyll siteDirectory >>= remove'+           askHakyll cacheDirectory >>= remove'   where-    remove' dir = do putStrLn $ "Removing " ++ dir ++ "..."-                     exists <- doesDirectoryExist dir-                     when exists $ removeDirectoryRecursive dir+    remove' dir = liftIO $ do putStrLn $ "Removing " ++ dir ++ "..."+                              exists <- doesDirectoryExist dir+                              when exists $ removeDirectoryRecursive dir  -- | Show usage information.-help :: IO ()-help = do+help :: Hakyll ()+help = liftIO $ do     name <- getProgName     putStrLn $  "This is a Hakyll site generator program. You should always\n"              ++ "run it from the project root directory.\n"@@ -64,5 +61,5 @@              ++ name ++ " preview [port]  Generate site, then start a server.\n"              ++ name ++ " server [port]   Run a local test server.\n" -server :: Integer -> IO ()-server p = simpleServer (fromIntegral p) "_site"+server :: Integer -> Hakyll ()+server p = askHakyll siteDirectory >>= liftIO . simpleServer (fromIntegral p)

@@ -1,34 +0,0 @@-module Text.Hakyll.CompressCSS-    ( compressCSS-    ) where--import Data.List (isPrefixOf)--import Text.Hakyll.Regex (substituteRegex)---- | Compress CSS to speed up your site.-compressCSS :: String -> String-compressCSS = compressSeparators-            . stripComments-            . compressWhitespace---- | Compresses certain forms of separators.-compressSeparators :: String -> String-compressSeparators = substituteRegex "; *}" "}" -                   . substituteRegex " *([{};:]) *" "\\1"-                   . substituteRegex ";;*" ";"---- | Compresses all whitespace.-compressWhitespace :: String -> String-compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " "---- | Function that strips CSS comments away.-stripComments :: String -> String-stripComments [] = []-stripComments str-    | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str-    | otherwise = head str : stripComments (tail str)-  where-    eatComments str' | null str' = []-                     | isPrefixOf "*/" str' = drop 2 str'-                     | otherwise = eatComments $ tail str'

@@ -3,13 +3,15 @@     ( Context     , ContextManipulation     , renderValue+    , changeValue     , renderDate+    , changeExtension     ) where  import qualified Data.Map as M import Data.Map (Map) import System.Locale (defaultTimeLocale)-import System.FilePath (takeFileName)+import System.FilePath (takeFileName, addExtension, dropExtension) import Data.Time.Format (parseTime, formatTime) import Data.Time.Clock (UTCTime) import Data.Maybe (fromMaybe)@@ -22,7 +24,9 @@ -- | Type for context manipulating functions. type ContextManipulation = Context -> Context --- | Do something with a value of a context.+-- | Do something with a value in a "Context", but keep the old value as well.+--   This is probably the most common function to construct a+--   "ContextManipulation". renderValue :: String -- ^ Key of which the value should be copied.             -> String -- ^ Key the value should be copied to.             -> (String -> String) -- ^ Function to apply on the value.@@ -31,8 +35,23 @@     Nothing      -> context     (Just value) -> M.insert dst (f value) context +-- | Change a value in a "Context".+--+--   > import Data.Char (toUpper)+--   > changeValue "title" (map toUpper)+--+--   Will put the title in UPPERCASE.+changeValue :: String -- ^ Key of which the value should be changed.+            -> (String -> String) -- ^ Function to apply on the value.+            -> ContextManipulation+changeValue key = renderValue key key+ -- | When the context has a key called @path@ in a @yyyy-mm-dd-title.extension@ --   format (default for pages), this function can render the date.+--+--   > renderDate "date" "%B %e, %Y" "Date unknown"+--+--   Will render something like @January 32, 2010@. renderDate :: String -- ^ Key in which the rendered date should be placed.            -> String -- ^ Format to use on the date.            -> String -- ^ Default value when the date cannot be parsed.@@ -47,3 +66,17 @@                                   "%Y-%m-%d"                                   dateString :: Maybe UTCTime                 return $ formatTime defaultTimeLocale format time++-- | Change the extension of a file. This is only needed when you want to+--   render, for example, mardown to @.php@ files instead of @.html@ files.+--+--   > renderChainWith (changeExtension "php")+--   >                 ["templates/default.html"]+--   >                 (createPagePath "test.markdown")+--+--   Will render to @test.php@ instead of @test.html@.+changeExtension :: String -- ^ Extension to change to.+                   -> ContextManipulation+changeExtension extension = changeValue "url" changeExtension'+  where+    changeExtension' = flip addExtension extension . dropExtension

@@ -2,13 +2,14 @@ --   files and directories. module Text.Hakyll.File     ( toDestination+    , toCache     , toURL     , toRoot     , removeSpaces     , makeDirectories     , getRecursiveContents     , havingExtension-    , isCacheValid+    , isMoreRecent     , directory     ) where @@ -18,7 +19,7 @@ import Data.List (isPrefixOf) import Control.Monad.Reader (liftIO) -import Text.Hakyll.Hakyll (Hakyll)+import Text.Hakyll.Hakyll  -- | Auxiliary function to remove pathSeparators form the start. We don't deal --   with absolute paths here. We also remove $root from the start.@@ -31,10 +32,18 @@     path' = if "$root" `isPrefixOf` path then drop 5 path                                          else path --- | Convert a relative filepath to a filepath in the destination (@_site@).-toDestination :: FilePath -> FilePath-toDestination path = "_site" </> removeLeadingSeparator path+-- | Convert a relative filepath to a filepath in the destination+--   (default: @_site@).+toDestination :: FilePath -> Hakyll FilePath+toDestination path = do dir <- askHakyll siteDirectory+                        return $ dir </> removeLeadingSeparator path +-- | Convert a relative filepath to a filepath in the cache+--   (default: @_cache@).+toCache :: FilePath -> Hakyll FilePath+toCache path = do dir <- askHakyll cacheDirectory+                  return $ dir </> removeLeadingSeparator path+ -- | Get the url for a given page. toURL :: FilePath -> FilePath toURL path = if takeExtension path `elem` [ ".markdown"@@ -47,6 +56,7 @@                                           , ".rst"                                           , ".text"                                           , ".tex"+                                          , ".lhs"                                           ]                 then flip addExtension ".html" $ dropExtension path                 else path@@ -103,14 +113,14 @@ directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll () directory action dir = getRecursiveContents dir >>= mapM_ action --- | Check if a cache file is still valid.-isCacheValid :: FilePath -- ^ The cached file.+-- | Check if a file is newer then a number of given files.+isMoreRecent :: FilePath -- ^ The cached file.              -> [FilePath] -- ^ Dependencies of the cached file.              -> Hakyll Bool-isCacheValid cache depends = do-    exists <- liftIO $ doesFileExist cache+isMoreRecent file depends = do+    exists <- liftIO $ doesFileExist file     if not exists         then return False         else do dependsModified <- liftIO $ mapM getModificationTime depends-                cacheModified <- liftIO $ getModificationTime cache-                return (cacheModified >= maximum dependsModified)+                fileModified <- liftIO $ getModificationTime file+                return (fileModified >= maximum dependsModified)

@@ -15,6 +15,10 @@     { -- | An additional context to use when rendering. This additional context       --   is used globally.       additionalContext :: Context+    , -- | Directory where the site is placed.+      siteDirectory :: FilePath+    , -- | Directory for cache files.+      cacheDirectory :: FilePath     }  -- | Our custom monad stack.

@@ -0,0 +1,30 @@+module Text.Hakyll.Internal.Cache+    ( storeInCache+    , getFromCache+    , isCacheMoreRecent+    ) where++import Control.Monad ((<=<))+import Control.Monad.Reader (liftIO)+import Text.Hakyll.Hakyll (Hakyll)+import Text.Hakyll.File+import Data.Binary++-- | We can store all datatypes instantiating @Binary@ to the cache. The cache+--   directory is specified by the @HakyllConfiguration@, usually @_cache@.+storeInCache :: (Binary a) => a -> FilePath -> Hakyll ()+storeInCache value path = do+    cachePath <- toCache path+    makeDirectories cachePath+    liftIO $ encodeFile cachePath value++-- | Get a value from the cache. The filepath given should not be located in the+--   cache. This function performs a timestamp check on the filepath and the+--   filepath in the cache, and only returns the cached value when it is still+--   up-to-date.+getFromCache :: (Binary a) => FilePath -> Hakyll a+getFromCache = liftIO . decodeFile <=< toCache++-- | 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 isMoreRecent depends

@@ -0,0 +1,36 @@+-- | Module used for CSS compression. The compression is currently in a simple+--   state, but would typically reduce the number of bytes by about 25%.+module Text.Hakyll.Internal.CompressCSS+    ( compressCSS+    ) where++import Data.List (isPrefixOf)++import Text.Hakyll.Regex (substituteRegex)++-- | Compress CSS to speed up your site.+compressCSS :: String -> String+compressCSS = compressSeparators+            . stripComments+            . compressWhitespace++-- | Compresses certain forms of separators.+compressSeparators :: String -> String+compressSeparators = substituteRegex "; *}" "}" +                   . substituteRegex " *([{};:]) *" "\\1"+                   . substituteRegex ";;*" ";"++-- | Compresses all whitespace.+compressWhitespace :: String -> String+compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " "++-- | Function that strips CSS comments away.+stripComments :: String -> String+stripComments [] = []+stripComments str+    | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str+    | otherwise = head str : stripComments (tail str)+  where+    eatComments str' | null str' = []+                     | isPrefixOf "*/" str' = drop 2 str'+                     | otherwise = eatComments $ tail str'

@@ -0,0 +1,68 @@+-- | Internal module do some low-level rendering.+module Text.Hakyll.Internal.Render+    ( substitute+    , regularSubstitute+    , finalSubstitute+    , pureRenderWith+    , pureRenderAndConcatWith+    , pureRenderChainWith+    , writePage+    ) where++import qualified Data.Map as M+import Control.Monad.Reader (liftIO)+import Data.List (foldl')+import Data.Maybe (fromMaybe)++import Text.Hakyll.Context (Context, ContextManipulation)+import Text.Hakyll.Renderable+import Text.Hakyll.Page+import Text.Hakyll.File+import Text.Hakyll.Hakyll+import Text.Hakyll.Internal.Template++-- | A pure render function.+pureRenderWith :: ContextManipulation -- ^ Manipulation to apply on the context.+               -> Template -- ^ Template to use for rendering.+               -> Context -- ^ Renderable object to render with given template.+               -> Context -- ^ The body of the result will contain the render.+pureRenderWith manipulation template context =+    -- Ignore $root when substituting here. We will only replace that in the+    -- final render (just before writing).+    let contextIgnoringRoot = M.insert "root" "$root" (manipulation context)+        body = regularSubstitute template contextIgnoringRoot+    in M.insert "body" body context++-- | A pure renderAndConcat function.+pureRenderAndConcatWith :: ContextManipulation -- ^ Manipulation to apply.+                        -> [Template] -- ^ Templates to use.+                        -> [Context] -- ^ Different renderables.+                        -> String+pureRenderAndConcatWith manipulation templates =+    concatMap renderAndConcat+  where+    renderAndConcat = fromMaybe "" . M.lookup "body"+                    . pureRenderChainWith manipulation templates++-- | A pure renderChain function.+pureRenderChainWith :: ContextManipulation+                    -> [Template]+                    -> Context+                    -> Context+pureRenderChainWith manipulation templates context =+    let initial = manipulation context+    in foldl' (flip $ pureRenderWith id) initial templates++-- | Write a page to the site destination. Final action after render+--   chains and such.+writePage :: Page -> Hakyll ()+writePage page = do+    additionalContext' <- askHakyll additionalContext+    destination <- toDestination url+    let context = additionalContext' `M.union` M.singleton "root" (toRoot url)+    makeDirectories destination+    -- Substitute $root here, just before writing.+    liftIO $ writeFile destination $ finalSubstitute (fromString $ getBody page)+                                                     context+  where+    url = getURL page

@@ -0,0 +1,121 @@+module Text.Hakyll.Internal.Template+    ( Template+    , fromString+    , readTemplate+    , substitute+    , regularSubstitute+    , finalSubstitute+    ) where++import qualified Data.Map as M+import Data.List (isPrefixOf)+import Data.Char (isAlphaNum)+import Data.Binary+import Control.Monad (liftM, liftM2, replicateM)+import Data.Maybe (fromMaybe)+import System.FilePath ((</>))+import Control.Monad.Reader (liftIO)++import Test.QuickCheck++import Text.Hakyll.Hakyll (Hakyll)+import Text.Hakyll.Context (Context)+import Text.Hakyll.Internal.Cache++-- | Datatype used for template substitutions.+data Template = Chunk String Template+              | Identifier String Template+              | EscapeCharacter Template+              | End+              deriving (Show, Read, Eq)++-- | Construct a "Template" from a string.+fromString :: String -> Template+fromString [] = End+fromString string+    | "$$" `isPrefixOf` string = EscapeCharacter (fromString $ tail tail')+    | "$" `isPrefixOf` string = let (key, rest) = span isAlphaNum tail'+                                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.+readTemplate :: FilePath -> Hakyll Template+readTemplate path = do+    isCacheMoreRecent' <- isCacheMoreRecent fileName [path]+    if isCacheMoreRecent' then getFromCache fileName+                          else do content <- liftIO $ readFile path+                                  let template = fromString content+                                  storeInCache template fileName+                                  return template+  where +    fileName = "templates" </> path++-- | Substitutes @$identifiers@ in the given "Template" by values from the given+--   "Context". When a key is not found, it is left as it is. You can specify+--   the characters used to replace escaped dollars (@$$@) here.+substitute :: String -> Template -> Context -> String +substitute escaper (Chunk chunk template) context =+    chunk ++ substitute escaper template context+substitute escaper (Identifier key template) context =+    replacement ++ substitute escaper template context+  where+    replacement = fromMaybe ('$' : key) $ M.lookup key context+substitute escaper (EscapeCharacter template) context =+    escaper ++ substitute escaper template context+substitute _ End _ = []++-- | "substitute" for use during a chain. This will leave escaped characters as+--   they are.+regularSubstitute :: Template -> Context -> String+regularSubstitute = substitute "$$"++-- | "substitute" for the end of a chain (just before writing). This renders+--   escaped characters.+finalSubstitute :: Template -> Context -> String+finalSubstitute = substitute "$"+    +instance Binary Template where+    put (Chunk string template) = put (0 :: Word8) >> put string >> put template+    put (Identifier key template) = put (1 :: Word8) >> put key >> put template+    put (EscapeCharacter template) = put (2 :: Word8) >> put template+    put (End) = put (3 :: Word8)++    get = do tag <- getWord8+             case tag of 0 -> liftM2 Chunk get get+                         1 -> liftM2 Identifier get get+                         2 -> liftM EscapeCharacter get+                         3 -> return End+                         _ -> error "Error reading template"++-- | Generate arbitrary templates from a given length.+arbitraryTemplate :: Int -> Gen Template+arbitraryTemplate 0 = return End+arbitraryTemplate length' = oneof [ do chunk <- chunk'+                                       template' >>= return . Chunk chunk+                                  , do key <- key'+                                       template' >>= return . Identifier key+                                  , template' >>= return . EscapeCharacter+                                  ]+  where+    template' = arbitraryTemplate (length' - 1)+    -- Generate keys.+    key' = do l <- choose (5, 10)+              replicateM l $ choose ('a', 'z')+    -- Generate non-empty chunks.+    chunk' = do string <- arbitrary+                let sanitized = filter (/= '$') string+                return $ if null sanitized then "foo"+                                           else sanitized++-- | Make "Template" testable.+instance Arbitrary Template where+    arbitrary = choose (0, 20) >>= arbitraryTemplate++    shrink (Chunk chunk template) = [template, Chunk chunk End]+    shrink (Identifier key template) = [template, Identifier key End]+    shrink (EscapeCharacter template) = [template, EscapeCharacter End]+    shrink End = []

@@ -1,23 +1,25 @@+-- | A module for dealing with "Page"s. This module is mostly internally used. module Text.Hakyll.Page      ( Page     , fromContext     , getValue     , getBody     , readPage-    , splitAtDelimiters     ) where  import qualified Data.Map as M import Data.List (isPrefixOf) import Data.Char (isSpace) import Data.Maybe (fromMaybe)-import Control.Parallel.Strategies (rdeepseq, ($|))+import Control.Monad (liftM, replicateM) import Control.Monad.Reader (liftIO)-import System.FilePath (takeExtension)-import System.IO+import System.FilePath (takeExtension, (</>)) +import Test.QuickCheck import Text.Pandoc+import Data.Binary +import Text.Hakyll.Internal.Cache import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.File import Text.Hakyll.Util (trim)@@ -28,6 +30,7 @@ -- | A Page is basically key-value mapping. Certain keys have special --   meanings, like for example url, body and title. data Page = Page Context+          deriving (Show, Read, Eq)  -- | Create a Page from a key-value mapping. fromContext :: Context -> Page@@ -65,12 +68,15 @@ getRenderFunction :: String -> (String -> String) getRenderFunction ".html" = id getRenderFunction ext = writeHtmlString writerOptions-                      . readFunction ext readerOptions+                      . readFunction ext (readOptions ext)   where     readFunction ".rst" = readRST     readFunction ".tex" = readLaTeX     readFunction _      = readMarkdown +    readOptions ".lhs"  = readerOptions { stateLiterateHaskell = True }+    readOptions _       = readerOptions+ -- | Split a page into sections. splitAtDelimiters :: [String] -> [[String]] splitAtDelimiters [] = []@@ -110,31 +116,58 @@  -- | Read a page from a file. Metadata is supported, and if the filename --   has a @.markdown@ extension, it will be rendered using pandoc.-readPage :: FilePath -> Hakyll Page-readPage path = do+readPageFromFile :: FilePath -> Hakyll Page+readPageFromFile path = do     let renderFunction = getRenderFunction $ takeExtension path         sectionFunctions = map (readSection renderFunction)                                (True : repeat False)      -- Read file.-    handle <- liftIO $ openFile path ReadMode-    sections <- fmap (splitAtDelimiters . lines )-                     (liftIO $ hGetContents handle)--    let context = concat $ zipWith ($) sectionFunctions sections+    contents <- liftIO $ readFile path+    let sections = splitAtDelimiters $ lines contents+        context = concat $ zipWith ($) sectionFunctions sections         page = fromContext $ M.fromList $             [ ("url", url)             , ("path", path)             ] ++ context -    seq (($|) id rdeepseq context) $ liftIO $ hClose handle-     return page   where     url = toURL path +-- | 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 Page+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+ -- Make pages renderable. instance Renderable Page where     getDependencies = (:[]) . getPagePath     getURL = getPageURL     toContext (Page page) = return page++-- Make pages serializable.+instance Binary Page where+    put (Page context) = put $ M.toAscList context+    get = liftM (Page . M.fromAscList) get++-- | Generate an arbitrary page.+arbitraryPage :: Gen Page+arbitraryPage = do keys <- listOf key'+                   values <- arbitrary+                   return $ Page $ M.fromList $ zip keys values+  where+    key' = do l <- choose (5, 10)+              replicateM l $ choose ('a', 'z')++-- Make pages testable+instance Arbitrary Page where+    arbitrary = arbitraryPage+    shrink (Page context) = map (Page . flip M.delete context) $ M.keys context

@@ -1,3 +1,5 @@+-- | Module containing rendering functions. All these functions are used to+--   render files to the @_site@ directory. module Text.Hakyll.Render      ( depends     , render@@ -19,8 +21,9 @@ import Text.Hakyll.Page import Text.Hakyll.Renderable import Text.Hakyll.File-import Text.Hakyll.CompressCSS-import Text.Hakyll.Render.Internal+import Text.Hakyll.Internal.Template (readTemplate)+import Text.Hakyll.Internal.CompressCSS+import Text.Hakyll.Internal.Render  -- | Execute an IO action only when the cache is invalid. depends :: FilePath -- ^ File to be rendered or created.@@ -28,7 +31,8 @@         -> Hakyll () -- ^ IO action to execute when the file is out of date.         -> Hakyll () depends file dependencies action = do-    valid <- isCacheValid (toDestination file) dependencies+    destination <- toDestination file+    valid <- isMoreRecent destination dependencies     unless valid action  -- | Render to a Page.@@ -46,7 +50,7 @@            -> a -- ^ Renderable object to render with given template.            -> Hakyll Page -- ^ The body of the result will contain the render. renderWith manipulation templatePath renderable = do-    template <- liftIO $ readFile templatePath+    template <- readTemplate templatePath     context <- toContext renderable     return $ fromContext $ pureRenderWith manipulation template context @@ -75,7 +79,7 @@                     -> [a]                     -> Hakyll String renderAndConcatWith manipulation templatePaths renderables = do-    templates <- liftIO $ mapM readFile templatePaths+    templates <- mapM readTemplate templatePaths     contexts <- mapM toContext renderables     return $ pureRenderAndConcatWith manipulation templates contexts @@ -100,25 +104,26 @@     depends (getURL renderable) dependencies render'   where     dependencies = getDependencies renderable ++ templatePaths-    render' = do templates <- liftIO $ mapM readFile templatePaths-                 context <- toContext renderable-                 let result = pureRenderChainWith manipulation templates context-                 writePage $ fromContext result+    render' = do+        templates <- mapM readTemplate templatePaths+        context <- toContext renderable+        let result = pureRenderChainWith manipulation templates context+        writePage $ fromContext result  -- | Mark a certain file as static, so it will just be copied when the site is --   generated. static :: FilePath -> Hakyll ()-static source = depends destination [source] action+static source = do destination <- toDestination source+                   depends destination [source] (action destination)   where-    destination = toDestination source-    action = do makeDirectories destination-                liftIO $ copyFile source destination+    action destination = do makeDirectories destination+                            liftIO $ copyFile source destination  -- | Render a css file, compressing it. css :: FilePath -> Hakyll ()-css source = depends destination [source] css'+css source = do destination <- toDestination source+                depends destination [source] (css' destination)   where-    destination = toDestination source-    css' = do contents <- liftIO $ readFile source-              makeDirectories destination-              liftIO $ writeFile destination (compressCSS contents)+    css' destination = do contents <- liftIO $ readFile source+                          makeDirectories destination+                          liftIO $ writeFile destination (compressCSS contents)

@@ -1,94 +0,0 @@--- | Internal module do some low-level rendering.-module Text.Hakyll.Render.Internal-    ( substitute-    , regularSubstitute-    , finalSubstitute-    , pureRenderWith-    , pureRenderAndConcatWith-    , pureRenderChainWith-    , writePage-    ) where--import qualified Data.Map as M-import Text.Hakyll.Context (Context, ContextManipulation)-import Control.Monad.Reader (liftIO)-import Data.List (isPrefixOf, foldl')-import Data.Char (isAlphaNum)-import Data.Maybe (fromMaybe)-import Control.Parallel.Strategies (rdeepseq, ($|))--import Text.Hakyll.Renderable-import Text.Hakyll.Page-import Text.Hakyll.File-import Text.Hakyll.Hakyll---- | Substitutes @$identifiers@ in the given string by values from the given---   "Context". When a key is not found, it is left as it is. You can here---   specify the characters used to replace escaped dollars (@$$@).-substitute :: String -> String -> Context -> String -substitute _ [] _ = []-substitute escaper string context -    | "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')-    | "$" `isPrefixOf` string = substituteKey-    | otherwise = head string : substitute' tail'-  where-    tail' = tail string-    (key, rest) = span isAlphaNum tail'-    replacement = fromMaybe ('$' : key) $ M.lookup key context-    substituteKey = replacement ++ substitute' rest-    substitute' str = substitute escaper str context---- | "substitute" for use during a chain.-regularSubstitute :: String -> Context -> String-regularSubstitute = substitute "$$"---- | "substitute" for the end of a chain (just before writing).-finalSubstitute :: String -> Context -> String-finalSubstitute = substitute "$"---- | A pure render function.-pureRenderWith :: ContextManipulation -- ^ Manipulation to apply on the context.-               -> String -- ^ Template to use for rendering.-               -> Context -- ^ Renderable object to render with given template.-               -> Context -- ^ The body of the result will contain the render.-pureRenderWith manipulation template context =-    -- Ignore $root when substituting here. We will only replace that in the-    -- final render (just before writing).-    let contextIgnoringRoot = M.insert "root" "$root" (manipulation context)-        body = regularSubstitute template contextIgnoringRoot-    -- Force the body to be rendered.-    in ($|) id rdeepseq (M.insert "body" body context)---- | A pure renderAndConcat function.-pureRenderAndConcatWith :: ContextManipulation-                        -> [String] -- ^ Templates to use.-                        -> [Context] -- ^ Different renderables.-                        -> String-pureRenderAndConcatWith manipulation templates contexts =-    foldl' renderAndConcat [] contexts-  where-    renderAndConcat chunk context =-        let rendered = pureRenderChainWith manipulation templates context-        in chunk ++ fromMaybe "" (M.lookup "body" rendered)---- | A pure renderChain function.-pureRenderChainWith :: ContextManipulation-                    -> [String]-                    -> Context-                    -> Context-pureRenderChainWith manipulation templates context =-    let initial = manipulation context-    in foldl' (flip $ pureRenderWith id) initial templates---- | Write a page to the site destination. Final action after render---   chains and such.-writePage :: Page -> Hakyll ()-writePage page = do-    additionalContext' <- askHakyll additionalContext-    let destination = toDestination url-        context = additionalContext' `M.union` M.singleton "root" (toRoot url)-    makeDirectories destination-    -- Substitute $root here, just before writing.-    liftIO $ writeFile destination $ finalSubstitute (getBody page) context-  where-    url = getURL page

@@ -64,10 +64,14 @@ -- | Combine two renderables. The url will always be taken from the first --   "Renderable". Also, if a `$key` is present in both renderables, the --   value from the first "Renderable" will be taken as well.+--+--   Since renderables are always more or less key-value maps, you can see+--   this as a @union@ between two maps. combine :: (Renderable a, Renderable b) => a -> b -> CombinedRenderable a b combine = CombinedRenderable --- | Combine two renderables and set a custom URL.+-- | Combine two renderables and set a custom URL. This behaves like "combine",+--   except that for the @url@ field, the given URL is always chosen. combineWithURL :: (Renderable a, Renderable b)                => FilePath                -> a@@ -75,7 +79,7 @@                -> CombinedRenderable a b combineWithURL = CombinedRenderableWithURL --- | Render combinations.+-- Render combinations. instance (Renderable a, Renderable b)          => Renderable (CombinedRenderable a b) where 

@@ -1,5 +1,19 @@ -- | Module containing some specialized functions to deal with tags. --   This Module follows certain conventions. Stick with them.+--+--   More concrete: all functions in this module assume that the tags are+--   located in the @tags@ field, and separated by commas. An example file+--   @foo.markdown@ could look like:+--+--   > ---+--   > author: Philip K. Dick+--   > title: Do androids dream of electric sheep?+--   > tags: future, science fiction, humanoid+--   > ---+--   > The novel is set in a post-apocalyptic near future, where the Earth and+--   > its populations have been damaged greatly by Nuclear...+--+--   All the following functions would work with such a format. module Text.Hakyll.Tags     ( readTagMap     , renderTagCloud@@ -10,20 +24,35 @@ import Data.List (intercalate) import Control.Monad (foldM) import Control.Arrow (second)+import Control.Applicative ((<$>))+import System.FilePath ((</>))  import Text.Hakyll.Hakyll (Hakyll)-import Text.Hakyll.Context (ContextManipulation, renderValue)-import Text.Hakyll.Render.Internal (finalSubstitute)+import Text.Hakyll.Context (ContextManipulation, changeValue) import Text.Hakyll.Regex import Text.Hakyll.Util import Text.Hakyll.Page+import Text.Hakyll.Internal.Cache+import Text.Hakyll.Internal.Template --- | Read a tag map. This creates a map from tags to page paths. This function---   assumes the tags are located in the @tags@ metadata field, separated by---   commas.-readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath])-readTagMap paths = foldM addPaths M.empty paths+-- | Read a tag map. This creates a map from tags to page paths.+--+--   You also have to give a unique identifier for every tagmap. This is for+--   caching reasons, so the tagmap will be stored in+--   @_cache/_tagmap/identifier@.+readTagMap :: String -- ^ Unique identifier for the tagmap.+           -> [FilePath]+           -> Hakyll (M.Map String [FilePath])+readTagMap identifier paths = do+    isCacheMoreRecent' <- isCacheMoreRecent fileName paths+    if isCacheMoreRecent' then M.fromAscList <$> getFromCache fileName+                          else do tagMap <- readTagMap'+                                  storeInCache (M.toAscList tagMap) fileName+                                  return tagMap   where+    fileName = "tagmaps" </> identifier++    readTagMap' = foldM addPaths M.empty paths     addPaths current path = do         page <- readPage path         let tags = map trim $ splitRegex "," $ getValue "tags" page@@ -40,11 +69,12 @@   where     renderTag :: (String, Float) -> String     renderTag (tag, count) = -        finalSubstitute "<a style=\"font-size: $size\" href=\"$url\">$tag</a>" $-                        M.fromList [ ("size", sizeTag count)-                                   , ("url", urlFunction tag)-                                   , ("tag", tag)-                                   ]+        finalSubstitute linkTemplate $ M.fromList [ ("size", sizeTag count)+                                                  , ("url", urlFunction tag)+                                                  , ("tag", tag)+                                                  ]+    linkTemplate =+        fromString "<a style=\"font-size: $size\" href=\"$url\">$tag</a>"      sizeTag :: Float -> String     sizeTag count = show size' ++ "%"@@ -59,10 +89,19 @@     tagCount :: [(String, Float)]     tagCount = map (second $ fromIntegral . length) $ M.toList tagMap --- Render all tags to links.-renderTagLinks :: (String -> String) -- ^ Function that produces an url for a tag.+-- | Render all tags to links.+--   +--   On your site, it is nice if you can display the tags on a page, but+--   naturally, most people would expect these are clickable.+--+--   So, this function takes a function to produce an url for a given tag, and+--   applies it on all tags.+--+--   Note that it is your own responsibility to ensure a page with such an url+--   exists.+renderTagLinks :: (String -> String) -- ^ Function to produce an url for a tag.                -> ContextManipulation-renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks'+renderTagLinks urlFunction = changeValue "tags" renderTagLinks'   where     renderTagLinks' = intercalate ", "                     . map ((\t -> link t $ urlFunction t) . trim)

@@ -1,3 +1,4 @@+-- | Miscellaneous text manipulation functions. module Text.Hakyll.Util      ( trim     , stripHTML@@ -6,26 +7,28 @@  import Data.Char (isSpace) --- | Trim a string (drop spaces and tabs at both sides).+-- | Trim a string (drop spaces, tabs and newlines at both sides). trim :: String -> String trim = reverse . trim' . reverse . trim'   where     trim' = dropWhile isSpace --- | Strip html tags.+-- | Strip html tags from the given string. stripHTML :: String -> String stripHTML []  = [] stripHTML str = let (beforeTag, rest) = break (== '<') str                     (_, afterTag)     = break (== '>') rest                 in beforeTag ++ stripHTML (tail' afterTag)-    -- We need a failsafe tail function.   where+    -- We need a failsafe tail function.     tail' [] = []     tail' xs = tail xs  -- | Make a HTML link. -- --   > link "foo" "bar.html" == "<a href='bar.html'>foo</a>"-link :: String -> String -> String+link :: String -- ^ Link text.+     -> String -- ^ Link destination.+     -> String link text destination = "<a href=\"" ++ destination ++ "\">"                       ++ text ++ "</a>"