Made site and cache directory configurable. Caching stubs.

hakyll.cabal

@@ -49,3 +49,4 @@ library
                    Text.Hakyll.Regex
                    Network.Hakyll.SimpleServer
   other-modules: Text.Hakyll.Render.Internal
+                 Text.Hakyll.Internal.Cache

src/Text/Hakyll.hs

@@ -4,7 +4,7 @@ module Text.Hakyll
     , 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 @@ import Text.Hakyll.Hakyll
 defaultHakyllConfiguration :: HakyllConfiguration
 defaultHakyllConfiguration = HakyllConfiguration
     { additionalContext = M.empty
+    , siteDirectory = "_site"
+    , cacheDirectory = "_cache"
     }
 
 -- | Hakyll with a default configuration.
@@ -27,32 +29,27 @@ hakyll = hakyllWithConfiguration defaultHakyllConfiguration
 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 @@ help = do
              ++ 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)

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)

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.

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

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)

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

tests/Tests.hs

@@ -45,9 +45,6 @@ tests = [ testGroup "Util group"
             ]
 
         , testGroup "File group"
-            [ testCase "toDestination 1" test_to_destination1
-            , testCase "toDestination 2" test_to_destination2
-            , testCase "toDestination 3" test_to_destination3
             , testCase "toRoot 1" test_to_root1
             , testCase "toRoot 2" test_to_root2
             , testCase "toRoot 3" test_to_root3
@@ -112,15 +109,6 @@ test_render_date2 = M.lookup "date" rendered @?= Just "Unknown date"
     rendered = renderDate "date" "%B %e, %Y" "Unknown date" $
                           M.singleton "path" "2009-badness-30-a-title.markdown"
 
--- toDestination test cases
-test_to_destination1 = toDestination "/posts/foo.html"
-                     @?= "_site/posts/foo.html"
-
-test_to_destination2 = toDestination "$root/posts/foo.html"
-                     @?= "_site/posts/foo.html"
-
-test_to_destination3 = toDestination "foo.html" @?= "_site/foo.html"
-
 -- toRoot test cases
 test_to_root1 = toRoot "/posts/foo.html" @?= ".."
 test_to_root2 = toRoot "posts/foo.html" @?= ".."