hakyll 2.2.2 → 2.3

raw patch · 10 files changed

+299/−61 lines, 10 filesdep +hamletdep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: hamlet

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• hakyll.cabal +7/−3
• src/Text/Hakyll.hs +39/−3
• src/Text/Hakyll/Configurations/Static.hs +59/−0
• src/Text/Hakyll/File.hs +42/−9
• src/Text/Hakyll/HakyllAction.hs +1/−3
• src/Text/Hakyll/HakyllMonad.hs +24/−0
• src/Text/Hakyll/Internal/Template.hs +31/−42
• src/Text/Hakyll/Internal/Template/Hamlet.hs +56/−0
• src/Text/Hakyll/Internal/Template/Template.hs +34/−0
• src/Text/Hakyll/Paginate.hs +6/−1

@@ -1,5 +1,5 @@ Name:               hakyll-Version:            2.2.2+Version:            2.3  Synopsis:           A simple static site generator library. Description:        A simple static site generator library, mainly aimed at@@ -38,8 +38,9 @@                     mtl == 1.*,                     old-locale == 1.*,                     old-time == 1.*,-                    time == 1.*,-                    binary >= 0.5+                    time >= 1.2,+                    binary >= 0.5,+                    hamlet >= 0.4.2   exposed-modules:  Network.Hakyll.SimpleServer                     Text.Hakyll                     Text.Hakyll.Context@@ -54,9 +55,12 @@                     Text.Hakyll.Util                     Text.Hakyll.Tags                     Text.Hakyll.Feed+                    Text.Hakyll.Configurations.Static   other-modules:    Paths_hakyll                     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

@@ -11,18 +11,23 @@     ( defaultHakyllConfiguration     , hakyll     , hakyllWithConfiguration+    , runDefaultHakyll     ) where +import Control.Concurrent (forkIO, threadDelay) import Control.Monad.Reader (runReaderT, liftIO, ask) import Control.Monad (when) import Data.Monoid (mempty) import System.Environment (getArgs, getProgName) import System.Directory (doesDirectoryExist, removeDirectoryRecursive)+import System.Time (getClockTime)  import Text.Pandoc+import Text.Hamlet (defaultHamletSettings)  import Network.Hakyll.SimpleServer (simpleServer) import Text.Hakyll.HakyllMonad+import Text.Hakyll.File  -- | The default reader options for pandoc parsing. --@@ -52,8 +57,10 @@     , siteDirectory       = "_site"     , cacheDirectory      = "_cache"     , enableIndexUrl      = False+    , previewMode         = BuildOnRequest     , pandocParserState   = defaultPandocParserState     , pandocWriterOptions = defaultPandocWriterOptions+    , hamletSettings      = defaultHamletSettings     }  -- | Main function to run Hakyll with the default configuration. The@@ -74,14 +81,36 @@     args <- getArgs     let f = case args of ["build"]      -> buildFunction                          ["clean"]      -> clean-                         ["preview", p] -> server (read p) buildFunction-                         ["preview"]    -> server 8000 buildFunction+                         ["preview", p] -> preview (read p) +                         ["preview"]    -> preview defaultPort                          ["rebuild"]    -> clean >> buildFunction                          ["server", p]  -> server (read p) (return ())-                         ["server"]     -> server 8000 (return ())+                         ["server"]     -> server defaultPort (return ())                          _              -> help     runReaderT f configuration+  where+    preview port = case previewMode configuration of+        BuildOnRequest  -> server port buildFunction+        BuildOnInterval -> do+            let pIO = runReaderT (previewThread buildFunction) configuration+            _ <- liftIO $ forkIO pIO+            server port (return ()) +    defaultPort = 8000++-- | A preview thread that periodically recompiles the site.+--+previewThread :: Hakyll ()  -- ^ Build function+              -> Hakyll ()  -- ^ Result+previewThread buildFunction = run =<< liftIO getClockTime+  where+    delay = 1000000+    run time = do liftIO $ threadDelay delay+                  contents <- getRecursiveContents "."+                  valid <- isMoreRecent time contents+                  when valid buildFunction+                  run =<< liftIO getClockTime+ -- | Clean up directories. -- clean :: Hakyll ()@@ -118,3 +147,10 @@     root <- askHakyll siteDirectory     let preRespondIO = runReaderT preRespond configuration     liftIO $ simpleServer (fromIntegral port) root preRespondIO++-- | Run a Hakyll action with default settings. This is mostly aimed at testing+-- code.+--+runDefaultHakyll :: Hakyll a -> IO a+runDefaultHakyll f =+    runReaderT f $ defaultHakyllConfiguration "http://example.com"

@@ -0,0 +1,59 @@+-- | Module for a simple static configuration of a website.+--+-- The configuration works like this:+--+-- * The @templates/@ directory should contain one template.+--+-- * Renderable files in the directory tree are rendered using this template.+--+-- * The @static/@ directory is copied entirely (if it exists).+--+-- * All files in the @css/@ directory are compressed.+--+module Text.Hakyll.Configurations.Static+    ( staticConfiguration+    ) where++import Control.Applicative ((<$>))+import Control.Monad (filterM, forM_)++import Text.Hakyll.File ( getRecursiveContents, inDirectory, inHakyllDirectory+                        , directory )+import Text.Hakyll.Internal.FileType (isRenderableFile)+import Text.Hakyll.HakyllMonad (Hakyll, logHakyll)+import Text.Hakyll.Render (renderChain, css, static)+import Text.Hakyll.CreateContext (createPage)++-- | A simple configuration for an entirely static website.+--+staticConfiguration :: Hakyll ()+staticConfiguration = do+    -- Find all files not in _site or _cache.+    files <- filterM isRenderableFile' =<< getRecursiveContents "."++    -- Find a main template to use+    mainTemplate <- take 1 <$> getRecursiveContents templateDir+    logHakyll $ case mainTemplate of [] ->      "Using no template"+                                     (x : _) -> "Using template " ++ x++    -- Render all files using this template+    forM_ files $ renderChain mainTemplate . createPage++    -- Render a static directory+    directory static staticDir++    -- Render a css directory+    directory css cssDir+  where+    -- A file should have a renderable extension and not be in a hakyll+    -- directory, and not in a special directory.+    isRenderableFile' file = do+        inHakyllDirectory' <- inHakyllDirectory file+        return $  isRenderableFile file+               && not (any (inDirectory file) [templateDir, cssDir, staticDir])+               && not inHakyllDirectory'++    -- Directories+    templateDir = "templates"+    cssDir = "css"+    staticDir = "static"

@@ -5,6 +5,8 @@     , toCache     , toUrl     , toRoot+    , inDirectory+    , inHakyllDirectory     , removeSpaces     , makeDirectories     , getRecursiveContents@@ -16,6 +18,7 @@     ) where  import System.Directory+import Control.Applicative ((<$>)) import System.FilePath import System.Time (ClockTime) import Control.Monad@@ -85,6 +88,32 @@     emptyException [] = "."     emptyException x  = x +-- | Check if a file is in a given directory.+--+inDirectory :: FilePath  -- ^ File path+            -> FilePath  -- ^ Directory+            -> Bool      -- ^ Result+inDirectory path dir = case splitDirectories path of+    [] -> False+    (x : _) -> x == dir++-- | Check if a file is in a Hakyll directory. With a Hakyll directory, we mean+-- a directory that should be "ignored" such as the @_site@ or @_cache@+-- directory.+--+-- Example:+--+-- > inHakyllDirectory "_cache/pages/index.html"+--+-- Result:+--+-- > True+--+inHakyllDirectory :: FilePath -> Hakyll Bool+inHakyllDirectory path =+    or <$> mapM (liftM (inDirectory path) . askHakyll)+                [siteDirectory, cacheDirectory]+ -- | Swaps spaces for '-'. removeSpaces :: FilePath -> FilePath removeSpaces = map swap@@ -101,17 +130,21 @@  -- | Get all contents of a directory. Note that files starting with a dot (.) --   will be ignored.+-- getRecursiveContents :: FilePath -> Hakyll [FilePath] getRecursiveContents topdir = do-    names <- liftIO $ getDirectoryContents topdir-    let properNames = filter isProper names-    paths <- forM properNames $ \name -> do-        let path = topdir </> name-        isDirectory <- liftIO $ doesDirectoryExist path-        if isDirectory-            then getRecursiveContents path-            else return [path]-    return (concat paths)+    topdirExists <- liftIO $ doesDirectoryExist topdir+    if topdirExists+        then do names <- liftIO $ getDirectoryContents topdir+                let properNames = filter isProper names+                paths <- forM properNames $ \name -> do+                    let path = topdir </> name+                    isDirectory <- liftIO $ doesDirectoryExist path+                    if isDirectory+                        then getRecursiveContents path+                        else return [normalise path]+                return (concat paths)+        else return []   where     isProper = not . (== '.') . head 

@@ -12,9 +12,7 @@ import Control.Arrow import Control.Category import Control.Monad ((<=<), unless)-import Control.Monad.Reader (liftIO) import Prelude hiding ((.), id)-import System.IO (hPutStrLn, stderr)  import Text.Hakyll.File (toDestination, isFileMoreRecent) import Text.Hakyll.HakyllMonad@@ -65,7 +63,7 @@         Right _ -> error "No url when checking dependencies."     destination <- toDestination url     valid <- isFileMoreRecent destination $ actionDependencies action-    unless valid $ do liftIO $ hPutStrLn stderr $ "Rendering " ++ destination+    unless valid $ do logHakyll $ "Rendering " ++ destination                       runHakyllAction action  -- | Chain a number of @HakyllAction@ computations.

@@ -1,23 +1,36 @@ -- | Module describing the Hakyll monad stack. module Text.Hakyll.HakyllMonad     ( HakyllConfiguration (..)+    , PreviewMode (..)     , Hakyll     , askHakyll     , getAdditionalContext+    , logHakyll     ) where +import Control.Monad.Trans (liftIO) import Control.Monad.Reader (ReaderT, ask) import Control.Monad (liftM) import qualified Data.Map as M+import System.IO (hPutStrLn, stderr)  import Text.Pandoc (ParserState, WriterOptions)+import Text.Hamlet (HamletSettings)  import Text.Hakyll.Context (Context (..))  -- | Our custom monad stack.+-- type Hakyll = ReaderT HakyllConfiguration IO +-- | Preview mode.+--+data PreviewMode = BuildOnRequest+                 | BuildOnInterval+                 deriving (Show, Eq, Ord)+ -- | Hakyll global configuration type.+-- data HakyllConfiguration = HakyllConfiguration     { -- | Absolute URL of the site.       absoluteUrl         :: String@@ -30,10 +43,14 @@       cacheDirectory      :: FilePath     , -- | Enable index links.       enableIndexUrl      :: Bool+    , -- | The preview mode used+      previewMode         :: PreviewMode     , -- | Pandoc parsing options       pandocParserState   :: ParserState     , -- | Pandoc writer options       pandocWriterOptions :: WriterOptions+    , -- | Hamlet settings (if you use hamlet for templates)+      hamletSettings      :: HamletSettings     }  -- | Simplified @ask@ function for the Hakyll monad stack.@@ -48,7 +65,14 @@ askHakyll :: (HakyllConfiguration -> a) -> Hakyll a askHakyll = flip liftM ask +-- | Obtain the globally available, additional context.+-- getAdditionalContext :: HakyllConfiguration -> Context getAdditionalContext configuration =     let (Context c) = additionalContext configuration     in Context $ M.insert "absolute" (absoluteUrl configuration) c++-- | Write some log information.+--+logHakyll :: String -> Hakyll ()+logHakyll = liftIO . hPutStrLn stderr

@@ -10,8 +10,6 @@ import Control.Applicative ((<$>)) import Data.List (isPrefixOf) import Data.Char (isAlphaNum)-import Data.Binary-import Control.Monad (liftM, liftM2) import Data.Maybe (fromMaybe) import System.FilePath ((</>)) import qualified Data.Map as M@@ -20,25 +18,26 @@ import Text.Hakyll.HakyllMonad (Hakyll) import Text.Hakyll.Internal.Cache import Text.Hakyll.Internal.Page---- | Datatype used for template substitutions.-data Template = Chunk String Template-              | Identifier String Template-              | EscapeCharacter Template-              | End-              deriving (Show, Read, Eq)+import Text.Hakyll.Internal.Template.Template+import Text.Hakyll.Internal.Template.Hamlet  -- | 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)+fromString = Template . fromString'   where-    tail' = tail string+    fromString' [] = []+    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.@@ -48,28 +47,31 @@     if isCacheMoreRecent'         then getFromCache fileName         else do-            page <- unContext <$> readPage path-            let body = fromMaybe (error $ "No body in template " ++ fileName)-                                 (M.lookup "body" page)-                template = fromString body+            template <- if isHamletRTFile path+                            then readHamletTemplate+                            else readDefaultTemplate             storeInCache template fileName             return template   where      fileName = "templates" </> path+    readDefaultTemplate = do+        page <- unContext <$> readPage path+        let body = fromMaybe (error $ "No body in template " ++ fileName)+                             (M.lookup "body" page)+        return $ fromString body +    readHamletTemplate = fromHamletRT <$> readHamletRT 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+substitute escaper template context = substitute' =<< unTemplate template   where-    replacement = fromMaybe ('$' : key) $ M.lookup key $ unContext context-substitute escaper (EscapeCharacter template) context =-    escaper ++ substitute escaper template context-substitute _ End _ = []+    substitute' (Chunk chunk) = chunk+    substitute' (Identifier key) =+        fromMaybe ('$' : key) $ M.lookup key $ unContext context+    substitute' (EscapeCharacter) = escaper  -- | @substitute@ for use during a chain. This will leave escaped characters as --   they are.@@ -80,16 +82,3 @@ --   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"

@@ -0,0 +1,56 @@+-- | Support for Hamlet templates in Hakyll.+--+module Text.Hakyll.Internal.Template.Hamlet+    ( isHamletRTFile+    , readHamletRT+    , fromHamletRT+    ) where++import Control.Exception (try)+import Control.Monad.Trans (liftIO)+import System.FilePath (takeExtension)++import Text.Hamlet.RT++import Text.Hakyll.Internal.Template.Template+import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, hamletSettings, logHakyll)++-- | Determine if a file is a hamlet template by extension.+--+isHamletRTFile :: FilePath -> Bool+isHamletRTFile fileName = takeExtension fileName `elem` [".hamlet", ".hml"]++-- | Read a 'HamletRT' by file name.+--+readHamletRT :: FilePath         -- ^ Filename of the template+             -> Hakyll HamletRT  -- ^ Resulting hamlet template+readHamletRT fileName = do+    settings <- askHakyll hamletSettings+    string <- liftIO $ readFile fileName+    result <- liftIO $ try $ parseHamletRT settings string+    case result of+        Left (HamletParseException s) -> error' s+        Left (HamletUnsupportedDocException d) -> error' $ show d+        Left (HamletRenderException s) -> error' s+        Right x -> return x+  where+    error' s = do+        logHakyll $ "Parse of hamlet file " ++ fileName ++ " failed."+        logHakyll s+        error "Parse failed."++-- | Convert a 'HamletRT' to a 'Template'+--+fromHamletRT :: HamletRT  -- ^ Hamlet runtime template+             -> Template  -- ^ Hakyll template+fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd+  where+    fromSimpleDoc :: SimpleDoc -> TemplateElement+    fromSimpleDoc (SDRaw chunk) = Chunk chunk+    fromSimpleDoc (SDVar [var]) = Identifier var+    fromSimpleDoc (SDVar _) =+        error "Hakyll does not support '.' in identifier names when using \+              \hamlet templates."+    fromSimpleDoc _ =+        error "Only simple $key$ identifiers are allowed when using hamlet \+              \templates."

@@ -0,0 +1,34 @@+-- | Module containing the template data structure.+--+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Text.Hakyll.Internal.Template.Template+    ( Template (..)+    , TemplateElement (..)+    ) where++import Control.Applicative ((<$>))++import Data.Binary (Binary, get, getWord8, put, putWord8)++-- | Datatype used for template substitutions.+--+newtype Template = Template { unTemplate :: [TemplateElement] }+                 deriving (Show, Eq, Binary)++-- | Elements of a template.+--+data TemplateElement = Chunk String+                     | Identifier String+                     | EscapeCharacter+                     deriving (Show, Eq)++instance Binary TemplateElement where+    put (Chunk string)    = putWord8 0 >> put string+    put (Identifier key)  = putWord8 1 >> put key+    put (EscapeCharacter) = putWord8 2++    get = getWord8 >>= \tag ->+         case tag of 0 -> Chunk <$> get+                     1 -> Identifier <$> get+                     2 -> return EscapeCharacter+                     _ -> error "Error reading cached template"

@@ -1,4 +1,5 @@ -- | Module aimed to paginate web pages.+-- module Text.Hakyll.Paginate     ( PaginateConfiguration (..)     , defaultPaginateConfiguration@@ -13,6 +14,7 @@ import Text.Hakyll.Util (link)  -- | A configuration for a pagination.+-- data PaginateConfiguration = PaginateConfiguration     { -- | Label for the link to the previous page.       previousLabel :: String@@ -25,6 +27,7 @@     }  -- | A simple default configuration for pagination.+-- defaultPaginateConfiguration :: PaginateConfiguration defaultPaginateConfiguration = PaginateConfiguration     { previousLabel = "Previous"@@ -54,6 +57,7 @@ --   When @$previous@ or @$next@ are not available, they will be just a label --   without a link. The same goes for when we are on the first or last page for --   @$first@ and @$last@.+-- paginate :: PaginateConfiguration          -> [HakyllAction () Context]          -> [HakyllAction () Context]@@ -61,7 +65,8 @@   where     -- Create a link with a given label, taken from the configuration.     linkWithLabel f r = Right $ case actionUrl r of-        Left l  -> createSimpleHakyllAction $ link (f configuration) <$> l+        Left l  -> createSimpleHakyllAction $+            link (f configuration) . ("$root/" ++) <$> l         Right _ -> error "No link found for pagination."      -- The main function that creates combined renderables by recursing over