Moved some more functions from the IO monad to the Hakyll monad stack.

4 files changed, 38 insertions, 30 deletions

diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs
index 3dd2538..ed2bbea 100644
--- a/src/Text/Hakyll/File.hs
+++ b/src/Text/Hakyll/File.hs
@@ -63,20 +63,20 @@ removeSpaces = map swap
 
 -- | Given a path to a file, try to make the path writable by making
 --   all directories on the path.
-makeDirectories :: FilePath -> IO ()
-makeDirectories path = createDirectoryIfMissing True dir
+makeDirectories :: FilePath -> Hakyll ()
+makeDirectories path = liftIO $ createDirectoryIfMissing True dir
   where
     dir = takeDirectory path
 
 -- | Get all contents of a directory. Note that files starting with a dot (.)
 --   will be ignored.
-getRecursiveContents :: FilePath -> IO [FilePath]
+getRecursiveContents :: FilePath -> Hakyll [FilePath]
 getRecursiveContents topdir = do
-    names <- getDirectoryContents topdir
+    names <- liftIO $ getDirectoryContents topdir
     let properNames = filter isProper names
     paths <- forM properNames $ \name -> do
         let path = topdir </> name
-        isDirectory <- doesDirectoryExist path
+        isDirectory <- liftIO $ doesDirectoryExist path
         if isDirectory
             then getRecursiveContents path
             else return [path]
@@ -87,20 +87,24 @@ getRecursiveContents topdir = do
 -- | A filter that takes all file names with a given extension. Prefix the
 --   extension with a dot:
 --
---   > havingExtension ".markdown" ["index.markdown", "style.css"] == ["index.markdown"]
+--   > havingExtension ".markdown" [ "index.markdown"
+--   >                             , "style.css"
+--   >                             ] == ["index.markdown"]
 havingExtension :: String -> [FilePath] -> [FilePath]
 havingExtension extension = filter ((==) extension . takeExtension)
 
--- | Perform an IO action on every file in a given directory.
+-- | Perform a Hakyll action on every file in a given directory.
 directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
 directory action dir = do
-    contents <- liftIO $ getRecursiveContents dir
+    contents <- getRecursiveContents dir
     mapM_ action contents
 
 -- | Check if a cache file is still valid.
-isCacheValid :: FilePath -> [FilePath] -> IO Bool
-isCacheValid cache depends = doesFileExist cache >>= \exists ->
-    if not exists then return False
-                  else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum
-                          cacheModified <- getModificationTime cache
-                          return (cacheModified >= dependsModified)
+isCacheValid :: FilePath -> [FilePath] -> Hakyll Bool
+isCacheValid cache depends = do
+    exists <- liftIO $ doesFileExist cache
+    if not exists
+        then return False
+        else do dependsModified <- liftIO $ mapM getModificationTime depends
+                cacheModified <- liftIO $ getModificationTime cache
+                return (cacheModified >= maximum dependsModified)
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 6c73ff3..652a1c6 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -84,26 +84,30 @@ isDelimiter = L.isPrefixOf "---"
 
 -- | Used for caching of files.
 cachePage :: Page -> Hakyll ()
-cachePage page@(Page mapping) = liftIO $ do
-    let destination = toCache $ getURL page
+cachePage page@(Page mapping) = do
     makeDirectories destination
-    handle <- openFile destination WriteMode
-    hPutStrLn handle "---"
-    mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping
-    hPutStrLn handle "---"
-    hPutStr handle $ getBody page
-    hClose handle
+    liftIO writePageToCache
   where
+    writePageToCache = do
+        handle <- openFile destination WriteMode
+        hPutStrLn handle "---"
+        mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping
+        hPutStrLn handle "---"
+        hPutStr handle $ getBody page
+        hClose handle
+
     writePair h (k, v) = do hPutStr h $ k ++ ": " ++ v
                             hPutStrLn h ""
 
+    destination = toCache $ getURL page
+
 -- | Read a page from a file. Metadata is supported, and if the filename
 --   has a .markdown extension, it will be rendered using pandoc. Note that
 --   pages are not templates, so they should not contain $identifiers.
 readPage :: FilePath -> Hakyll Page
 readPage pagePath = do
     -- Check cache.
-    getFromCache <- liftIO $ isCacheValid cacheFile [pagePath]
+    getFromCache <- isCacheValid cacheFile [pagePath]
     let path = if getFromCache then cacheFile else pagePath
 
     -- Read file.
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index 4b22836..870c953 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -31,7 +31,7 @@ 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 <- liftIO $ isCacheValid (toDestination file) dependencies
+    valid <- isCacheValid (toDestination file) dependencies
     unless valid action
 
 -- | Render to a Page.
@@ -93,17 +93,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] (liftIO action)
+static source = depends destination [source] action
   where
     destination = toDestination source
     action = do makeDirectories destination
-                copyFile source destination
+                liftIO $ copyFile source destination
 
 -- | Render a css file, compressing it.
 css :: FilePath -> Hakyll ()
-css source = depends destination [source] (liftIO css')
+css source = depends destination [source] css'
   where
     destination = toDestination source
-    css' = do contents <- readFile source
+    css' = do contents <- liftIO $ readFile source
               makeDirectories destination
-              writeFile destination (compressCSS contents)
+              liftIO $ writeFile destination (compressCSS contents)
diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs
index e6379bd..e296dd2 100644
--- a/src/Text/Hakyll/Render/Internal.hs
+++ b/src/Text/Hakyll/Render/Internal.hs
@@ -87,7 +87,7 @@ writePage page = do
     globalContext <- liftM hakyllGlobalContext ask 
     let destination = toDestination url
         context = (M.singleton "root" $ toRoot url) `M.union` globalContext
-    liftIO $ makeDirectories destination
+    makeDirectories destination
     -- Substitute $root here, just before writing.
     liftIO $ writeFile destination $ finalSubstitute (getBody page) context
   where