From 8602f23f7bcdcc3bec65ec98c70ee3f295482856 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 20 Jan 2010 16:46:22 +0100 Subject: Made site and cache directory configurable. Caching stubs. --- src/Text/Hakyll/File.hs | 31 ++++++++++++++++++++----------- src/Text/Hakyll/Hakyll.hs | 4 ++++ src/Text/Hakyll/Internal/Cache.hs | 12 ++++++++++++ src/Text/Hakyll/Render.hs | 21 +++++++++++---------- src/Text/Hakyll/Render/Internal.hs | 4 ++-- 5 files changed, 49 insertions(+), 23 deletions(-) create mode 100644 src/Text/Hakyll/Internal/Cache.hs (limited to 'src/Text/Hakyll') diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs index af40500..852436b 100644 --- a/src/Text/Hakyll/File.hs +++ b/src/Text/Hakyll/File.hs @@ -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 Control.Monad 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,9 +32,17 @@ removeLeadingSeparator path 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 @@ -103,14 +112,14 @@ havingExtension extension = filter ((==) extension . takeExtension) 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) diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs index af8c9c5..b33bbda 100644 --- a/src/Text/Hakyll/Hakyll.hs +++ b/src/Text/Hakyll/Hakyll.hs @@ -15,6 +15,10 @@ data HakyllConfiguration = HakyllConfiguration { -- | 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. diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs new file mode 100644 index 0000000..8e52bb4 --- /dev/null +++ b/src/Text/Hakyll/Internal/Cache.hs @@ -0,0 +1,12 @@ +module Text.Hakyll.Internal.Cache + ( storeInCache + , getFromCache + ) where + +import Text.Hakyll.Hakyll (Hakyll) + +storeInCache :: (Show a) => a -> FilePath -> Hakyll () +storeInCache = undefined + +getFromCache :: (Read a) => FilePath -> Hakyll (Maybe a) +getFromCache = undefined diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index a0f067f..030d999 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -28,7 +28,8 @@ depends :: FilePath -- ^ File to be rendered or created. -> 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. @@ -108,17 +109,17 @@ renderChainWith manipulation templatePaths renderable = -- | 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) diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs index d0b5814..51eecc7 100644 --- a/src/Text/Hakyll/Render/Internal.hs +++ b/src/Text/Hakyll/Render/Internal.hs @@ -85,8 +85,8 @@ pureRenderChainWith manipulation templates context = writePage :: Page -> Hakyll () writePage page = do additionalContext' <- askHakyll additionalContext - let destination = toDestination url - context = additionalContext' `M.union` M.singleton "root" (toRoot url) + 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 (getBody page) context -- cgit v1.2.3