hakyll 1.3 → 1.4

raw patch · 13 files changed

+186/−104 lines, 13 filesdep +old-timePVP ok

version bump matches the API change (PVP)

Dependencies added: old-time

API changes (from Hackage documentation)

Files

• hakyll.cabal +3/−2
• src/Text/Hakyll.hs +39/−7
• src/Text/Hakyll/File.hs +60/−26
• src/Text/Hakyll/Hakyll.hs +4/−0
• src/Text/Hakyll/Internal/Cache.hs +1/−1
• src/Text/Hakyll/Internal/CompressCSS.hs +0/−36
• src/Text/Hakyll/Internal/CompressCss.hs +36/−0
• src/Text/Hakyll/Internal/Render.hs +1/−2
• src/Text/Hakyll/Page.hs +15/−6
• src/Text/Hakyll/Render.hs +6/−5
• src/Text/Hakyll/Renderable.hs +2/−2
• src/Text/Hakyll/Renderables.hs +14/−12
• src/Text/Hakyll/Util.hs +5/−5

@@ -1,5 +1,5 @@ Name:           hakyll-Version:        1.3+Version:        1.4  Synopsis:       A simple static site generator library. Description:@@ -33,6 +33,7 @@                    network >= 2,                    mtl >= 1.1,                    old-locale >= 1,+                   old-time >= 1,                    time >= 1,                    binary >= 0.5,                    QuickCheck >= 2@@ -49,6 +50,6 @@                    Text.Hakyll.Util                    Text.Hakyll.Tags                    Text.Hakyll.Internal.Cache-                   Text.Hakyll.Internal.CompressCSS+                   Text.Hakyll.Internal.CompressCss                    Text.Hakyll.Internal.Render                    Text.Hakyll.Internal.Template

@@ -1,38 +1,52 @@+-- | This is the main Hakyll module, exporting the important @hakyl@ function.+--+--   Most configurations would use this @hakyll@ function more or less as the+--   main function:+--+--   > main = hakyll $ do+--   >     directory css "css"+--   >     directory static "images"+-- module Text.Hakyll     ( defaultHakyllConfiguration     , hakyll     , hakyllWithConfiguration     ) where -import Control.Monad.Reader (runReaderT, liftIO)+import Control.Monad.Reader (runReaderT, liftIO, ask)+import Control.Concurrent (forkIO, threadDelay) import Control.Monad (when) import qualified Data.Map as M import System.Environment (getArgs, getProgName) import System.Directory (doesDirectoryExist, removeDirectoryRecursive)+import System.Time (getClockTime)  import Network.Hakyll.SimpleServer (simpleServer) import Text.Hakyll.Hakyll+import Text.Hakyll.File --- | Default hakyll configuration.+-- | The default hakyll configuration. defaultHakyllConfiguration :: HakyllConfiguration defaultHakyllConfiguration = HakyllConfiguration     { additionalContext = M.empty     , siteDirectory = "_site"     , cacheDirectory = "_cache"+    , enableIndexUrl = False+    , previewPollDelay = 1000000     } --- | Hakyll with a default configuration.+-- | Main function to run Hakyll with the default configuration. hakyll :: Hakyll () -> IO () hakyll = hakyllWithConfiguration defaultHakyllConfiguration --- | Main function to run hakyll with a configuration.+-- | Main function to run hakyll with a custom configuration. hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO () hakyllWithConfiguration configuration buildFunction = do     args <- getArgs     let f = case args of ["build"]      -> buildFunction                          ["clean"]      -> clean-                         ["preview", p] -> buildFunction >> server (read p)-                         ["preview"]    -> buildFunction >> server 8000+                         ["preview", p] -> preview buildFunction (read p)+                         ["preview"]    -> preview buildFunction 8000                          ["server", p]  -> server (read p)                          ["server"]     -> server 8000                          _              -> help@@ -47,6 +61,23 @@                               exists <- doesDirectoryExist dir                               when exists $ removeDirectoryRecursive dir +-- | Autocompile mode.+preview :: Hakyll () -> Integer -> Hakyll ()+preview buildFunction port = do+    buildFunction+    _ <- startServer+    liftIO getClockTime >>= run+  where+    startServer = do configuration <- ask+                     liftIO $ forkIO $ runReaderT (server port) configuration+    run time = do delay <- askHakyll previewPollDelay+                  liftIO $ threadDelay delay+                  contents <- getRecursiveContents "."+                  valid <- isMoreRecent time contents+                  if valid then run time+                           else do buildFunction+                                   liftIO getClockTime >>= run+ -- | Show usage information. help :: Hakyll () help = liftIO $ do@@ -58,8 +89,9 @@              ++ name ++ " build           Generate the site.\n"              ++ name ++ " clean           Clean up and remove cache.\n"              ++ name ++ " help            Show this message.\n"-             ++ name ++ " preview [port]  Generate site, then start a server.\n"+             ++ name ++ " preview [port]  Run a server and autocompile.\n"              ++ name ++ " server [port]   Run a local test server.\n" +-- | Start a server at the given port number. server :: Integer -> Hakyll () server p = askHakyll siteDirectory >>= liftIO . simpleServer (fromIntegral p)

@@ -3,19 +3,21 @@ module Text.Hakyll.File     ( toDestination     , toCache-    , toURL+    , toUrl     , toRoot     , removeSpaces     , makeDirectories     , getRecursiveContents     , sortByBaseName     , havingExtension-    , isMoreRecent     , directory+    , isMoreRecent+    , isFileMoreRecent     ) where  import System.Directory import System.FilePath+import System.Time (ClockTime) import Control.Monad import Data.List (isPrefixOf, sortBy) import Control.Monad.Reader (liftIO)@@ -36,8 +38,15 @@ -- | 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+toDestination url = do dir <- askHakyll siteDirectory+                       enableIndexUrl' <- askHakyll enableIndexUrl+                       let destination = if enableIndexUrl' && separatorEnd+                               then dir </> noSeparator </> "index.html"+                               else dir </> noSeparator+                       return destination+  where+    noSeparator = removeLeadingSeparator url+    separatorEnd = not (null url) && last url == '/'  -- | Convert a relative filepath to a filepath in the cache --   (default: @_cache@).@@ -45,22 +54,39 @@ 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"-                                          , ".md"-                                          , ".mdn"-                                          , ".mdwn"-                                          , ".mkd"-                                          , ".mkdn"-                                          , ".mkdwn"-                                          , ".rst"-                                          , ".text"-                                          , ".tex"-                                          , ".lhs"-                                          ]-                then flip addExtension ".html" $ dropExtension path-                else path+-- | Get the url for a given page. For most extensions, this would be the path+--   itself. It's only for rendered extensions (@.markdown@, @.rst@, @.lhs@ this+--   function returns a path with a @.html@ extension instead.+toUrl :: FilePath -> Hakyll FilePath+toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl+                -- If the file does not have a renderable extension, like for+                -- example favicon.ico, we don't have to change it at all.+                return $ if not hasRenderableExtension+                            then path+                            -- If index url's are enabled, we create pick it+                            -- unless the page is an index already.+                            else if enableIndexUrl' && not isIndex+                                then indexUrl+                                else withSimpleHtmlExtension+  where+    hasRenderableExtension = takeExtension path `elem` [ ".markdown"+                                                       , ".md"+                                                       , ".mdn"+                                                       , ".mdwn"+                                                       , ".mkd"+                                                       , ".mkdn"+                                                       , ".mkdwn"+                                                       , ".rst"+                                                       , ".text"+                                                       , ".tex"+                                                       , ".lhs"+                                                       , ".htm"+                                                       , ".html"+                                                       ]+    isIndex = (dropExtension $ takeFileName path) == "index"+    withSimpleHtmlExtension = flip addExtension ".html" $ dropExtension path+    indexUrl = (dropExtension path) ++ "/"+                              -- | Get the relative url to the site root, for a given (absolute) url toRoot :: FilePath -> FilePath@@ -120,14 +146,22 @@ directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll () directory action dir = getRecursiveContents dir >>= mapM_ action --- | Check if a file is newer then a number of given files.-isMoreRecent :: FilePath -- ^ The cached file.+-- | Check if a timestamp is newer then a number of given files.+isMoreRecent :: ClockTime  -- ^ The time to check.              -> [FilePath] -- ^ Dependencies of the cached file.              -> Hakyll Bool-isMoreRecent file depends = do+isMoreRecent _ [] = return True+isMoreRecent timeStamp depends = do+    dependsModified <- liftIO $ mapM getModificationTime depends+    return (timeStamp >= maximum dependsModified)++-- | Check if a file is newer then a number of given files.+isFileMoreRecent :: FilePath   -- ^ The cached file.+                 -> [FilePath] -- ^ Dependencies of the cached file.+                 -> Hakyll Bool+isFileMoreRecent file depends = do     exists <- liftIO $ doesFileExist file     if not exists         then return False-        else do dependsModified <- liftIO $ mapM getModificationTime depends-                fileModified <- liftIO $ getModificationTime file-                return (fileModified >= maximum dependsModified)+        else do timeStamp <- liftIO $ getModificationTime file+                isMoreRecent timeStamp depends

@@ -19,6 +19,10 @@       siteDirectory :: FilePath     , -- | Directory for cache files.       cacheDirectory :: FilePath+    , -- | Enable index links.+      enableIndexUrl :: Bool+    , -- | Delay between polls in preview mode.+      previewPollDelay :: Int     }  -- | Our custom monad stack.

@@ -27,4 +27,4 @@  -- | 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+isCacheMoreRecent file depends = toCache file >>= flip isFileMoreRecent depends

@@ -1,36 +0,0 @@--- | 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,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'

@@ -58,11 +58,10 @@ writePage :: Page -> Hakyll () writePage page = do     additionalContext' <- askHakyll additionalContext+    url <- getUrl page     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

@@ -30,7 +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)+          deriving (Ord, Eq, Show, Read)  -- | Create a Page from a key-value mapping. fromContext :: Context -> Page@@ -43,8 +43,8 @@  -- | Get the URL for a certain page. This should always be defined. If --   not, it will error.-getPageURL :: Page -> String-getPageURL (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page+getPageUrl :: Page -> String+getPageUrl (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page  -- | Get the original page path. getPagePath :: Page -> String@@ -58,15 +58,24 @@  -- | The default reader options for pandoc parsing. readerOptions :: ParserState-readerOptions = defaultParserState { stateSmart = True }+readerOptions = defaultParserState+    { -- The following option causes pandoc to read smart typography, a nice+      -- and free bonus.+      stateSmart = True+    }  -- | The default writer options for pandoc rendering. writerOptions :: WriterOptions writerOptions = defaultWriterOptions+    { -- This option causes literate haskell to be written using '>' marks in+      -- html, which I think is a good default.+      writerLiterateHaskell = True+    }  -- | Get a render function for a given extension. getRenderFunction :: String -> (String -> String) getRenderFunction ".html" = id+getRenderFunction ".htm"  = id getRenderFunction ext = writeHtmlString writerOptions                       . readFunction ext (readOptions ext)   where@@ -124,6 +133,7 @@      -- Read file.     contents <- liftIO $ readFile path+    url <- toUrl path     let sections = splitAtDelimiters $ lines contents         context = concat $ zipWith ($) sectionFunctions sections         page = fromContext $ M.fromList $@@ -134,7 +144,6 @@      return page   where-    url = toURL path     category = let dirs = splitDirectories $ takeDirectory path                in [("category", last dirs) | not (null dirs)] @@ -153,7 +162,7 @@ -- Make pages renderable. instance Renderable Page where     getDependencies = (:[]) . getPagePath-    getURL = getPageURL+    getUrl = return . getPageUrl     toContext (Page page) = return page  -- Make pages serializable.

@@ -22,7 +22,7 @@ import Text.Hakyll.Renderable import Text.Hakyll.File import Text.Hakyll.Internal.Template (readTemplate)-import Text.Hakyll.Internal.CompressCSS+import Text.Hakyll.Internal.CompressCss import Text.Hakyll.Internal.Render  -- | Execute an IO action only when the cache is invalid.@@ -32,7 +32,7 @@         -> Hakyll () depends file dependencies action = do     destination <- toDestination file-    valid <- isMoreRecent destination dependencies+    valid <- isFileMoreRecent destination dependencies     unless valid action  -- | Render to a Page.@@ -100,8 +100,9 @@ --   @ContextManipulation@ which to apply on the context when it is read first. renderChainWith :: Renderable a                 => ContextManipulation -> [FilePath] -> a -> Hakyll ()-renderChainWith manipulation templatePaths renderable =-    depends (getURL renderable) dependencies render'+renderChainWith manipulation templatePaths renderable = do+    url <- getUrl renderable+    depends url dependencies render'   where     dependencies = getDependencies renderable ++ templatePaths     render' = do@@ -126,4 +127,4 @@   where     css' destination = do contents <- liftIO $ readFile source                           makeDirectories destination-                          liftIO $ writeFile destination (compressCSS contents)+                          liftIO $ writeFile destination (compressCss contents)

@@ -1,5 +1,5 @@ module Text.Hakyll.Renderable-    ( Renderable(toContext, getDependencies, getURL)+    ( Renderable(toContext, getDependencies, getUrl)     ) where  import Text.Hakyll.Hakyll (Hakyll)@@ -15,4 +15,4 @@     getDependencies :: a -> [FilePath]      -- | Get the destination for the renderable.-    getURL :: a -> FilePath+    getUrl :: a -> Hakyll FilePath

@@ -7,7 +7,7 @@     , createPagePath     , CombinedRenderable     , combine-    , combineWithURL+    , combineWithUrl     ) where  import qualified Data.Map as M@@ -25,7 +25,7 @@  -- | A custom page. data CustomPage = CustomPage -    { customPageURL :: String,+    { customPageUrl :: String,       customPageDependencies :: [FilePath],       customPageContext :: [(String, Either String (Hakyll String))]     }@@ -85,15 +85,16 @@  instance Renderable CustomPage where     getDependencies = customPageDependencies-    getURL = customPageURL+    getUrl = return . customPageUrl     toContext page = do         values <- mapM (either return id . snd) (customPageContext page)         let pairs = zip (map fst $ customPageContext page) values-        return $ M.fromList $ ("url", customPageURL page) : pairs+        return $ M.fromList $ ("url", customPageUrl page) : pairs  -- | PagePath is a class that wraps a FilePath. This is used to render Pages --   without reading them first through use of caching. data PagePath = PagePath FilePath+              deriving (Ord, Eq, Read, Show)  -- | Create a PagePath from a FilePath. createPagePath :: FilePath -> PagePath@@ -102,7 +103,7 @@ -- We can render filepaths instance Renderable PagePath where     getDependencies (PagePath path) = return path-    getURL (PagePath path) = toURL path+    getUrl (PagePath path) = toUrl path     toContext (PagePath path) = readPage path >>= toContext  -- We can serialize filepaths@@ -112,7 +113,8 @@  -- | A combination of two other renderables. data CombinedRenderable a b = CombinedRenderable a b-                            | CombinedRenderableWithURL FilePath a b+                            | CombinedRenderableWithUrl FilePath a b+                            deriving (Ord, Eq, Read, Show)  -- | Combine two renderables. The url will always be taken from the first --   @Renderable@. Also, if a `$key` is present in both renderables, the@@ -125,12 +127,12 @@  -- | 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)+combineWithUrl :: (Renderable a, Renderable b)                => FilePath                -> a                -> b                -> CombinedRenderable a b-combineWithURL = CombinedRenderableWithURL+combineWithUrl = CombinedRenderableWithUrl  -- Render combinations. instance (Renderable a, Renderable b)@@ -139,18 +141,18 @@     -- Add the dependencies.     getDependencies (CombinedRenderable a b) =         getDependencies a ++ getDependencies b-    getDependencies (CombinedRenderableWithURL _ a b) =+    getDependencies (CombinedRenderableWithUrl _ a b) =         getDependencies a ++ getDependencies b      -- Take the url from the first renderable, or the specified URL.-    getURL (CombinedRenderable a _) = getURL a-    getURL (CombinedRenderableWithURL url _ _) = url+    getUrl (CombinedRenderable a _) = getUrl a+    getUrl (CombinedRenderableWithUrl url _ _) = return url      -- Take a union of the contexts.     toContext (CombinedRenderable a b) = do         c1 <- toContext a         c2 <- toContext b         return $ c1 `M.union` c2-    toContext (CombinedRenderableWithURL url a b) = do+    toContext (CombinedRenderableWithUrl url a b) = do         c <- toContext (CombinedRenderable a b)         return $ M.singleton "url" url `M.union` c

@@ -1,7 +1,7 @@ -- | Miscellaneous text manipulation functions. module Text.Hakyll.Util      ( trim-    , stripHTML+    , stripHtml     , link     ) where @@ -14,11 +14,11 @@     trim' = dropWhile isSpace  -- | Strip html tags from the given string.-stripHTML :: String -> String-stripHTML []  = []-stripHTML str = let (beforeTag, rest) = break (== '<') str+stripHtml :: String -> String+stripHtml []  = []+stripHtml str = let (beforeTag, rest) = break (== '<') str                     (_, afterTag)     = break (== '>') rest-                in beforeTag ++ stripHTML (tail' afterTag)+                in beforeTag ++ stripHtml (tail' afterTag)   where     -- We need a failsafe tail function.     tail' [] = []