Added ReaderT to our stack.

9 files changed, 98 insertions, 52 deletions

diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs
index e23e211..2586c02 100644
--- a/src/Text/Hakyll.hs
+++ b/src/Text/Hakyll.hs
@@ -1,28 +1,42 @@
 module Text.Hakyll
-    ( hakyll
+    ( defaultHakyllConfiguration
+    , hakyll
     ) where
 
+import Control.Monad.Reader (runReaderT)
+import qualified Data.Map as M
+
 import Network.Hakyll.SimpleServer (simpleServer)
+import Text.Hakyll.Hakyll
 
 import System.Environment (getArgs, getProgName)
 import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
 
+-- | Default hakyll configuration.
+defaultHakyllConfiguration :: HakyllConfiguration
+defaultHakyllConfiguration = HakyllConfiguration
+    { hakyllDestination = "_site"
+    , hakyllGlobalContext = M.empty
+    }
+
 -- | Main function to run hakyll.
-hakyll :: IO () -> IO ()
-hakyll buildFunction = do
+hakyll :: HakyllConfiguration -> Hakyll () -> IO ()
+hakyll configuration buildFunction = do
     args <- getArgs
-    case args of ["build"]      -> build buildFunction
+    case args of ["build"]      -> build'
                  ["clean"]      -> clean
-                 ["preview", p] -> build buildFunction >> server (read p)
-                 ["preview"]    -> build buildFunction >> server 8000
+                 ["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 :: IO () -> IO ()
-build buildFunction = do putStrLn "Generating..."
-                         buildFunction
+build :: HakyllConfiguration -> Hakyll () -> IO ()
+build configuration buildFunction = do putStrLn "Generating..."
+                                       runReaderT buildFunction configuration
 
 -- | Clean up directories.
 clean :: IO ()
diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs
index 0ed91d5..3dd2538 100644
--- a/src/Text/Hakyll/File.hs
+++ b/src/Text/Hakyll/File.hs
@@ -17,6 +17,8 @@ import System.Directory
 import System.FilePath
 import Control.Monad
 import Data.List (isPrefixOf)
+import Text.Hakyll.Hakyll (Hakyll)
+import Control.Monad.Reader (liftIO)
 
 -- | Auxiliary function to remove pathSeparators form the start. We don't deal
 --   with absolute paths here. We also remove $root from the start.
@@ -90,8 +92,10 @@ havingExtension :: String -> [FilePath] -> [FilePath]
 havingExtension extension = filter ((==) extension . takeExtension)
 
 -- | Perform an IO action on every file in a given directory.
-directory :: (FilePath -> IO ()) -> FilePath -> IO ()
-directory action dir = getRecursiveContents dir >>= mapM_ action
+directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
+directory action dir = do
+    contents <- liftIO $ getRecursiveContents dir
+    mapM_ action contents
 
 -- | Check if a cache file is still valid.
 isCacheValid :: FilePath -> [FilePath] -> IO Bool
diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs
new file mode 100644
index 0000000..3690914
--- /dev/null
+++ b/src/Text/Hakyll/Hakyll.hs
@@ -0,0 +1,15 @@
+module Text.Hakyll.Hakyll
+    ( HakyllConfiguration (..)
+    , Hakyll
+    ) where
+
+import Text.Hakyll.Context (Context)
+import System.FilePath (FilePath)
+import Control.Monad.Reader (ReaderT)
+
+data HakyllConfiguration = HakyllConfiguration
+    { hakyllDestination :: FilePath
+    , hakyllGlobalContext :: Context
+    }
+
+type Hakyll = ReaderT HakyllConfiguration IO
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 0b7776b..cbb881f 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -11,10 +11,12 @@ import qualified Data.List as L
 import Data.Maybe (fromMaybe)
 
 import Control.Parallel.Strategies (rnf, ($|))
+import Control.Monad.Reader (liftIO)
 
 import System.FilePath (FilePath, takeExtension)
 import System.IO
 
+import Text.Hakyll.Hakyll (Hakyll)
 import Text.Hakyll.File
 import Text.Hakyll.Util (trim)
 import Text.Hakyll.Context (Context)
@@ -66,9 +68,9 @@ renderFunction ext = writeHtmlString writerOptions
     readFunction _           = readMarkdown
 
 -- | Read metadata header from a file handle.
-readMetaData :: Handle -> IO [(String, String)]
+readMetaData :: Handle -> Hakyll [(String, String)]
 readMetaData handle = do
-    line <- hGetLine handle
+    line <- liftIO $ hGetLine handle
     if isDelimiter line
         then return []
         else do others <- readMetaData handle
@@ -81,8 +83,8 @@ isDelimiter :: String -> Bool
 isDelimiter = L.isPrefixOf "---"
 
 -- | Used for caching of files.
-cachePage :: Page -> IO ()
-cachePage page@(Page mapping) = do
+cachePage :: Page -> Hakyll ()
+cachePage page@(Page mapping) = liftIO $ do
     let destination = toCache $ getURL page
     makeDirectories destination
     handle <- openFile destination WriteMode
@@ -98,21 +100,21 @@ cachePage page@(Page mapping) = do
 -- | 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 -> IO Page
+readPage :: FilePath -> Hakyll Page
 readPage pagePath = do
     -- Check cache.
-    getFromCache <- isCacheValid cacheFile [pagePath]
+    getFromCache <- liftIO $ isCacheValid cacheFile [pagePath]
     let path = if getFromCache then cacheFile else pagePath
 
     -- Read file.
-    handle <- openFile path ReadMode
-    line <- hGetLine handle
+    handle <- liftIO $ openFile path ReadMode
+    line <- liftIO $ hGetLine handle
     (metaData, body) <-
         if isDelimiter line
             then do md <- readMetaData handle
-                    b <- hGetContents handle
+                    b <- liftIO $ hGetContents handle
                     return (md, b)
-            else do b <- hGetContents handle
+            else do b <- liftIO $ hGetContents handle
                     return ([], line ++ "\n" ++ b)
 
     -- Render file
@@ -123,7 +125,7 @@ readPage pagePath = do
             , ("path", pagePath)
             ] ++ metaData
 
-    seq (($|) id rnf rendered) $ hClose handle
+    seq (($|) id rnf rendered) $ liftIO $ hClose handle
 
     -- Cache if needed
     if getFromCache then return () else cachePage page
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index d8deea2..4b22836 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -11,10 +11,12 @@ module Text.Hakyll.Render
     ) where
 
 import Control.Monad (unless, mapM)
+import Control.Monad.Reader (liftIO)
 
 import System.Directory (copyFile)
 import System.IO
 
+import Text.Hakyll.Hakyll (Hakyll)
 import Text.Hakyll.Context (ContextManipulation)
 import Text.Hakyll.Page
 import Text.Hakyll.Renderable
@@ -26,17 +28,17 @@ import Text.Hakyll.Render.Internal
 -- | Execute an IO action only when the cache is invalid.
 depends :: FilePath -- ^ File to be rendered or created.
         -> [FilePath] -- ^ Files the render depends on.
-        -> IO () -- ^ IO action to execute when the file is out of date.
-        -> IO ()
+        -> Hakyll () -- ^ IO action to execute when the file is out of date.
+        -> Hakyll ()
 depends file dependencies action = do
-    valid <- isCacheValid (toDestination file) dependencies
+    valid <- liftIO $ isCacheValid (toDestination file) dependencies
     unless valid action
 
 -- | Render to a Page.
 render :: Renderable a
        => FilePath -- ^ Template to use for rendering.
        -> a -- ^ Renderable object to render with given template.
-       -> IO Page -- ^ The body of the result will contain the render.
+       -> Hakyll Page -- ^ The body of the result will contain the render.
 render = renderWith id
 
 -- | Render to a Page. This function allows you to manipulate the context
@@ -45,15 +47,15 @@ renderWith :: Renderable a
            => ContextManipulation -- ^ Manipulation to apply on the context.
            -> FilePath -- ^ Template to use for rendering.
            -> a -- ^ Renderable object to render with given template.
-           -> IO Page -- ^ The body of the result will contain the render.
+           -> Hakyll Page -- ^ The body of the result will contain the render.
 renderWith manipulation templatePath renderable = do
-    template <- readFile templatePath
+    template <- liftIO $ readFile templatePath
     context <- toContext renderable
     return $ fromContext $ pureRenderWith manipulation template context
 
 -- | Render each renderable with the given template, then concatenate the
 --   result.
-renderAndConcat :: Renderable a => FilePath -> [a] -> IO String
+renderAndConcat :: Renderable a => FilePath -> [a] -> Hakyll String
 renderAndConcat = renderAndConcatWith id
 
 -- | Render each renderable with the given template, then concatenate the
@@ -63,41 +65,43 @@ renderAndConcatWith :: Renderable a
                     => ContextManipulation
                     -> FilePath
                     -> [a]
-                    -> IO String
+                    -> Hakyll String
 renderAndConcatWith manipulation templatePath renderables = do
-    template <- readFile templatePath
+    template <- liftIO $ readFile templatePath
     contexts <- mapM toContext renderables
     return $ pureRenderAndConcatWith manipulation template contexts
 
 -- | Chain a render action for a page with a number of templates. This will
 --   also write the result to the site destination. This is the preferred way
 --   to do general rendering.
-renderChain :: Renderable a => [FilePath] -> a -> IO ()
+renderChain :: Renderable a => [FilePath] -> a -> Hakyll ()
 renderChain = renderChainWith id
 
 -- | A more custom render chain that allows you to specify a
 --   "ContextManipulation" which to apply on the context when it is read first.
 renderChainWith :: Renderable a
-                => ContextManipulation -> [FilePath] -> a -> IO ()
+                => ContextManipulation -> [FilePath] -> a -> Hakyll ()
 renderChainWith manipulation templatePaths renderable =
-    depends (getURL renderable) (getDependencies renderable ++ templatePaths) $
-        do templates <- mapM readFile templatePaths
-           context <- toContext renderable
-           let result = pureRenderChainWith manipulation templates context
-           writePage $ fromContext result
+    depends (getURL renderable) dependencies render'
+  where
+    dependencies = (getDependencies renderable) ++ templatePaths
+    render' = do templates <- liftIO $ mapM readFile templatePaths
+                 context <- toContext renderable
+                 let result = pureRenderChainWith manipulation templates context
+                 writePage $ fromContext result
 
 -- | Mark a certain file as static, so it will just be copied when the site is
 --   generated.
-static :: FilePath -> IO ()
-static source = depends destination [source] action
+static :: FilePath -> Hakyll ()
+static source = depends destination [source] (liftIO action)
   where
     destination = toDestination source
     action = do makeDirectories destination
                 copyFile source destination
 
 -- | Render a css file, compressing it.
-css :: FilePath -> IO ()
-css source = depends destination [source] css'
+css :: FilePath -> Hakyll ()
+css source = depends destination [source] (liftIO css')
   where
     destination = toDestination source
     css' = do contents <- readFile source
diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs
index 3b9bfbb..379c4c9 100644
--- a/src/Text/Hakyll/Render/Internal.hs
+++ b/src/Text/Hakyll/Render/Internal.hs
@@ -11,6 +11,8 @@ module Text.Hakyll.Render.Internal
 
 import qualified Data.Map as M
 import Text.Hakyll.Context (Context, ContextManipulation)
+import Control.Monad.Reader (ask, liftIO)
+import Control.Monad (liftM)
 import Data.List (isPrefixOf, foldl')
 import Data.Char (isAlpha)
 import Data.Maybe (fromMaybe)
@@ -18,6 +20,7 @@ import Control.Parallel.Strategies (rnf, ($|))
 import Text.Hakyll.Renderable
 import Text.Hakyll.Page
 import Text.Hakyll.File
+import Text.Hakyll.Hakyll (Hakyll, hakyllGlobalContext)
 
 -- | Substitutes `$identifiers` in the given string by values from the given
 --   "Context". When a key is not found, it is left as it is. You can here
@@ -79,13 +82,13 @@ pureRenderChainWith manipulation templates context =
 
 -- | Write a page to the site destination. Final action after render
 --   chains and such.
-writePage :: Page -> IO ()
+writePage :: Page -> Hakyll ()
 writePage page = do
+    globalContext <- liftM hakyllGlobalContext ask 
     let destination = toDestination url
-    makeDirectories destination
-    writeFile destination body
+        context = (M.singleton "root" $ toRoot url) `M.union` globalContext
+    liftIO $ makeDirectories destination
+    -- Substitute $root here, just before writing.
+    liftIO $ writeFile destination $ finalSubstitute (getBody page) context
   where
     url = getURL page
-    -- Substitute $root here, just before writing.
-    body = finalSubstitute (getBody page)
-                           (M.singleton "root" $ toRoot url)
diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs
index c8e780e..cafdb3c 100644
--- a/src/Text/Hakyll/Renderable.hs
+++ b/src/Text/Hakyll/Renderable.hs
@@ -2,13 +2,14 @@ module Text.Hakyll.Renderable
     ( Renderable(toContext, getDependencies, getURL)
     ) where
 
+import Text.Hakyll.Hakyll (Hakyll)
 import System.FilePath (FilePath)
 import Text.Hakyll.Context (Context)
 
 -- | A class for datatypes that can be rendered to pages.
 class Renderable a where
     -- | Get a context to do substitutions with.
-    toContext :: a -> IO Context
+    toContext :: a -> Hakyll Context
 
     -- | Get the dependencies for the renderable. This is used for cache
     --   invalidation.
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs
index 26d1e86..19f25b5 100644
--- a/src/Text/Hakyll/Renderables.hs
+++ b/src/Text/Hakyll/Renderables.hs
@@ -5,6 +5,7 @@ module Text.Hakyll.Renderables
     , createPagePath
     ) where
 
+import Text.Hakyll.Hakyll (Hakyll)
 import System.FilePath (FilePath)
 import qualified Data.Map as M
 import Text.Hakyll.Page
@@ -15,13 +16,14 @@ import Text.Hakyll.File
 data CustomPage = CustomPage 
     { url :: String,
       dependencies :: [FilePath],
-      mapping :: [(String, Either String (IO String))]
+      mapping :: [(String, Either String (Hakyll String))]
     }
 
 -- | Create a custom page.
 createCustomPage :: String -- ^ Destination of the page, relative to _site.
                  -> [FilePath] -- ^ Dependencies of the page.
-                 -> [(String, Either String (IO String))] -- ^ Key - value mapping for rendering.
+                 -> [(String, Either String (Hakyll String))] -- ^ Key - value 
+                                                              --   mapping.
                  -> CustomPage
 createCustomPage = CustomPage
 
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 625584e..209d479 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -9,6 +9,7 @@ module Text.Hakyll.Tags
 import qualified Data.Map as M
 import Data.List (intercalate)
 import Control.Monad (foldM)
+import Text.Hakyll.Hakyll (Hakyll)
 
 import Text.Hakyll.Context (ContextManipulation, renderValue)
 import Text.Hakyll.Regex
@@ -19,7 +20,7 @@ import Control.Arrow (second)
 -- | Read a tag map. This creates a map from tags to page paths. This function
 --   assumes the tags are located in the `tags` metadata field, separated by
 --   commas.
-readTagMap :: [FilePath] -> IO (M.Map String [FilePath])
+readTagMap :: [FilePath] -> Hakyll (M.Map String [FilePath])
 readTagMap paths = foldM addPaths M.empty paths
   where
     addPaths current path = do