Made an abstract Renderable class. Still need some cleanup now.

5 files changed, 73 insertions, 45 deletions

diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 31e2135..0b0259a 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -1,14 +1,10 @@
 module Text.Hakyll.Page 
-    ( Page,
+    ( Page (..),
       PageValue,
       addContext,
-      toURL,
-      getURL,
       getBody,
       readPage,
-      pageFromList,
-      concatPages,
-      concatPagesWith
+      pageFromList
     ) where
 
 import qualified Data.Map as M
@@ -16,39 +12,41 @@ import qualified Data.List as L
 import qualified Data.ByteString.Lazy.Char8 as B
 import Data.Maybe
 import Control.Monad
+import Control.Arrow
 
 import System.FilePath
 import System.IO
 
 import Text.Hakyll.Util
+import Text.Hakyll.Renderable
 import Text.Pandoc
 
 -- | A Page is basically key-value mapping. Certain keys have special
 --   meanings, like for example url, body and title.
-type Page = M.Map String PageValue
+data Page = Page (M.Map String PageValue)
+
+getContext :: Page -> M.Map String PageValue
+getContext (Page page) = page
 
 -- | We use a ByteString for obvious reasons.
 type PageValue = B.ByteString
 
 -- | Add a key-value mapping to the Page.
 addContext :: String -> String -> Page -> Page
-addContext key value = M.insert key (B.pack value)
-
--- | Get the url for a given page.
-toURL :: FilePath -> FilePath
-toURL = flip addExtension ".html" . dropExtension
+addContext key value (Page page) = Page $ M.insert key (B.pack value) page
 
 -- | Get the URL for a certain page. This should always be defined. If
 --   not, it will return trash.html.
-getURL :: Page -> String
-getURL context = let result = M.lookup "url" context
-                 in case result of (Just url) -> B.unpack url
-                                   Nothing    -> error "URL is not defined."
+getPageURL :: Page -> String
+getPageURL page =
+    let result = M.lookup "url" $ getContext page
+    in case result of (Just url) -> B.unpack url
+                      Nothing    -> error "URL is not defined."
 
 -- | Get the body for a certain page. When not defined, the body will be
 --   empty.
 getBody :: Page -> PageValue
-getBody context = fromMaybe B.empty $ M.lookup "body" context
+getBody = fromMaybe B.empty . M.lookup "body" . getContext
 
 writerOptions :: WriterOptions
 writerOptions = defaultWriterOptions
@@ -80,7 +78,7 @@ cachePage page = do
     makeDirectories destination
     handle <- openFile destination WriteMode
     hPutStrLn handle "---"
-    mapM_ (writePair handle) $ M.toList page
+    mapM_ (writePair handle) $ M.toList $ getContext page
     hPutStrLn handle "---"
     B.hPut handle $ getBody page
     hClose handle
@@ -108,7 +106,7 @@ readPage pagePath = do
     -- Render file
     let rendered = B.pack $ (renderFunction $ takeExtension path) body
     seq rendered $ hClose handle
-    let page = M.insert "body" rendered $ addContext "url" url $ pageFromList context
+    let page = addContext "url" url $ Page $ M.fromList $ ("body", rendered) : map (second B.pack) context
 
     -- Cache if needed
     if getFromCache then return () else cachePage page
@@ -118,16 +116,12 @@ readPage pagePath = do
 
 -- | Create a key-value mapping page from an association list.
 pageFromList :: [(String, String)] -> Page
-pageFromList = M.fromList . map packPair
+pageFromList = Page . M.fromList . map packPair
     where packPair (k, v) = let pv = B.pack v
                             in seq pv (k, pv)
 
--- | Concat the bodies of pages, and return the result.
-concatPages :: [Page] -> PageValue
-concatPages = concatPagesWith "body"
-
--- | Concat certain values of pages, and return the result.
-concatPagesWith :: String -- ^ Key of which to concat the values.
-                -> [Page] -- ^ Pages to get the values from.
-                -> PageValue -- ^ The concatenation.
-concatPagesWith key = B.concat . map (fromMaybe B.empty . M.lookup key)
+-- Make pages renderable
+instance Renderable Page where
+    getDependencies = (:[]) . flip addExtension ".html" . dropExtension . getPageURL
+    getURL = getPageURL
+    toContext = return . M.mapKeys B.pack . getContext
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index 7c52d9b..b9b57b7 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -1,6 +1,6 @@
 module Text.Hakyll.Render 
     ( depends,
-      renderPage,
+      render,
       writePage,
       renderAndConcat,
       renderChain,
@@ -8,7 +8,7 @@ module Text.Hakyll.Render
       staticDirectory
     ) where
 
-import Text.Template
+import Text.Template hiding (render)
 import qualified Data.ByteString.Lazy.Char8 as B
 import qualified Data.Map as M
 import Control.Monad
@@ -17,6 +17,7 @@ import System.Directory
 import System.IO
 
 import Text.Hakyll.Page
+import Text.Hakyll.Renderable
 import Text.Hakyll.Util
 
 depends :: FilePath -> [FilePath] -> IO () -> IO ()
@@ -24,17 +25,14 @@ depends file dependencies action = do
     valid <- isCacheValid (toDestination file) dependencies
     unless valid action
 
-createContext :: Page -> Context
-createContext = M.fromList . map packPair . M.toList
-    where packPair (a, b) = (B.pack a, b)
-
-renderPage :: FilePath -> Page -> IO Page
-renderPage templatePath page = do
+render :: Renderable a => FilePath -> a -> IO Page
+render templatePath renderable = do
     handle <- openFile templatePath ReadMode
     templateString <- liftM B.pack $ hGetContents handle
     seq templateString $ hClose handle
-    let body = substitute templateString (createContext page)
-    return $ M.insert "body" body page
+    context <- toContext renderable
+    let body = substitute templateString context
+    return $ Page (M.insert "body" body $ M.mapKeys (B.unpack) context)
 
 writePage :: Page -> IO ()
 writePage page = do
@@ -47,15 +45,16 @@ renderAndConcat templatePath paths = foldM concatRender' B.empty paths
     where concatRender' :: B.ByteString -> FilePath -> IO B.ByteString
           concatRender' chunk path = do
               page <- readPage path
-              rendered <- renderPage templatePath page
+              rendered <- render templatePath page
               let body = getBody rendered
               return $ B.append chunk $ body
 
-renderChain :: [FilePath] -> FilePath -> IO ()
-renderChain templates pagePath = depends (toURL pagePath) (pagePath : templates) $
-    do page <- readPage pagePath
-       result <- foldM (flip renderPage) page templates
-       writePage result
+renderChain :: Renderable a => [FilePath] -> a -> IO ()
+renderChain templates renderable =
+    depends (getURL renderable) (getDependencies renderable ++ templates) $
+        do initialPage <- toContext renderable
+           result <- foldM (flip render) (Page $ M.mapKeys B.unpack initialPage) templates
+           writePage result
 
 static :: FilePath -> IO ()
 static source = do
diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs
new file mode 100644
index 0000000..12aff5b
--- /dev/null
+++ b/src/Text/Hakyll/Renderable.hs
@@ -0,0 +1,14 @@
+module Text.Hakyll.Renderable
+    ( Renderable,
+      toContext,
+      getDependencies,
+      getURL
+    ) where
+
+import System.FilePath
+import Text.Template
+
+class Renderable a where
+    toContext :: a -> IO Context
+    getDependencies :: a -> [FilePath]
+    getURL :: a -> FilePath
diff --git a/src/Text/Hakyll/RenderableFilePath.hs b/src/Text/Hakyll/RenderableFilePath.hs
new file mode 100644
index 0000000..f729a11
--- /dev/null
+++ b/src/Text/Hakyll/RenderableFilePath.hs
@@ -0,0 +1,16 @@
+module Text.Hakyll.RenderableFilePath
+    ( RenderableFilePath (..)
+    ) where
+
+import System.FilePath
+import Text.Hakyll.Renderable
+import Text.Hakyll.Util
+import Text.Hakyll.Page
+
+newtype RenderableFilePath = RenderableFilePath FilePath
+
+-- We can render filepaths
+instance Renderable RenderableFilePath where
+    getDependencies (RenderableFilePath path) = return path
+    getURL (RenderableFilePath path) = toURL path
+    toContext (RenderableFilePath path) = readPage path >>= toContext
diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs
index 1d79b4a..0b95927 100644
--- a/src/Text/Hakyll/Util.hs
+++ b/src/Text/Hakyll/Util.hs
@@ -1,6 +1,7 @@
 module Text.Hakyll.Util 
     ( toDestination,
       toCache,
+      toURL,
       makeDirectories,
       getRecursiveContents,
       trim,
@@ -20,6 +21,10 @@ toDestination path = "_site" </> path
 toCache :: FilePath -> FilePath
 toCache path = "_cache" </> path
 
+-- | Get the url for a given page.
+toURL :: FilePath -> FilePath
+toURL = flip addExtension ".html" . dropExtension
+
 -- | Given a path to a file, try to make the path writable by making
 --   all directories on the path.
 makeDirectories :: FilePath -> IO ()