Made site and cache directory configurable. Caching stubs.

5 files changed, 49 insertions, 23 deletions

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