Got it to compile again, disabled Tags for now.

7 files changed, 122 insertions, 155 deletions

diff --git a/src/Text/Hakyll/Internal/Page.hs b/src/Text/Hakyll/Internal/Page.hs
index 92e7249..4adddc5 100644
--- a/src/Text/Hakyll/Internal/Page.hs
+++ b/src/Text/Hakyll/Internal/Page.hs
@@ -21,11 +21,8 @@ import Data.Binary
 
 import Text.Hakyll.Internal.Cache
 import Text.Hakyll.Hakyll
-import Text.Hakyll.File
 import Text.Hakyll.Util (trim)
 import Text.Hakyll.Context (Context)
-import Text.Hakyll.Renderable
-import Text.Hakyll.RenderAction
 import Text.Hakyll.Regex (substituteRegex, matchesRegex)
 
 -- | A Page is basically key-value mapping. Certain keys have special
@@ -42,16 +39,6 @@ fromContext = Page
 getValue :: String -> Page -> String
 getValue str (Page page) = fromMaybe [] $ M.lookup str page
 
--- | Get the URL for a certain page. This should always be defined. If
---   not, it will error.
-getPageUrl :: Page -> String
-getPageUrl (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page
-
--- | Get the original page path.
-getPagePath :: Page -> String
-getPagePath (Page page) =
-    fromMaybe (error "No page path") $ M.lookup "path" page
-
 -- | Get the body for a certain page. When not defined, the body will be
 --   empty.
 getBody :: Page -> String
@@ -155,12 +142,6 @@ readPage path = do
   where
     fileName = "pages" </> path
 
--- Make pages renderable.
-instance Renderable Page where
-    getDependencies = (:[]) . getPagePath
-    getUrl = return . getPageUrl
-    toContext (Page page) = return page
-
 -- Make pages serializable.
 instance Binary Page where
     put (Page context) = put $ M.toAscList context
diff --git a/src/Text/Hakyll/Internal/Render.hs b/src/Text/Hakyll/Internal/Render.hs
index 00b74a7..0fae8a7 100644
--- a/src/Text/Hakyll/Internal/Render.hs
+++ b/src/Text/Hakyll/Internal/Render.hs
@@ -15,10 +15,9 @@ import Data.List (foldl')
 import Data.Maybe (fromMaybe)
 
 import Text.Hakyll.Context (Context, ContextManipulation)
-import Text.Hakyll.Renderable
 import Text.Hakyll.File
 import Text.Hakyll.Hakyll
-import Text.Hakyll.Internal.Page
+import Text.Hakyll.RenderAction
 import Text.Hakyll.Internal.Template
 
 -- | A pure render function.
@@ -55,13 +54,14 @@ pureRenderChainWith manipulation templates context =
 
 -- | Write a page to the site destination. Final action after render
 --   chains and such.
-writePage :: Page -> Hakyll ()
-writePage page = do
+writePage :: RenderAction Context ()
+writePage = createRenderAction $ \initialContext -> do
     additionalContext' <- askHakyll additionalContext
-    url <- getUrl page
-    destination <- toDestination url
+    let url = fromMaybe (error "No url defined at write time.")
+                        (M.lookup "url" initialContext)
+        body = fromMaybe "" (M.lookup "body" initialContext)
     let context = additionalContext' `M.union` M.singleton "root" (toRoot url)
+    destination <- toDestination url
     makeDirectories destination
     -- Substitute $root here, just before writing.
-    liftIO $ writeFile destination $ finalSubstitute (fromString $ getBody page)
-                                                     context
+    liftIO $ writeFile destination $ finalSubstitute (fromString body) context
diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs
index e228404..4a0782a 100644
--- a/src/Text/Hakyll/Paginate.hs
+++ b/src/Text/Hakyll/Paginate.hs
@@ -55,8 +55,8 @@ paginate :: PaginateConfiguration
 paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
   where
     -- Create a link with a given label, taken from the configuration.
-    linkWithLabel f r = case actionDestination r of
-        Just l  -> link (f configuration) <$> l
+    linkWithLabel f r = Right $ case actionUrl r of
+        Just l  -> createSimpleRenderAction $ link (f configuration) <$> l
         Nothing -> error "No link found for pagination."
 
     -- The main function that creates combined renderables by recursing over
@@ -66,18 +66,18 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
         let (previous, first) = case maybePrev of
                 (Just r) -> ( linkWithLabel previousLabel r
                             , linkWithLabel firstLabel (head renderables) )
-                Nothing  -> ( return $ previousLabel configuration
-                            , return $ firstLabel configuration )
+                Nothing  -> ( Left $ previousLabel configuration
+                            , Left $ firstLabel configuration )
             (next, last') = case xs of
                 (n:_) -> ( linkWithLabel nextLabel n
                          , linkWithLabel lastLabel (last renderables) )
-                []    -> ( return $ nextLabel configuration
-                         , return $ lastLabel configuration )
+                []    -> ( Left $ nextLabel configuration
+                         , Left $ lastLabel configuration )
             customPage = createCustomPage "" []
-                [ ("previous", Right previous)
-                , ("next", Right next)
-                , ("first", Right first)
-                , ("last", Right last')
+                [ ("previous", previous)
+                , ("next", next)
+                , ("first", first)
+                , ("last", last')
                 , ("index", Left $ show index)
                 , ("length", Left $ show $ length renderables)
                 ]
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index 98d1a3c..5915e36 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -13,15 +13,17 @@ module Text.Hakyll.Render
     ) where
 
 import Control.Monad (unless)
+import Control.Arrow ((>>>))
 import Control.Monad.Reader (liftIO)
 import System.Directory (copyFile)
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as M
 
 import Text.Hakyll.Hakyll (Hakyll)
-import Text.Hakyll.Context (ContextManipulation)
-import Text.Hakyll.Renderable
+import Text.Hakyll.Context (ContextManipulation, Context)
 import Text.Hakyll.File
+import Text.Hakyll.RenderAction
 import Text.Hakyll.Internal.CompressCss
-import Text.Hakyll.Internal.Page
 import Text.Hakyll.Internal.Render
 import Text.Hakyll.Internal.Template (readTemplate)
 
@@ -36,23 +38,24 @@ depends file dependencies action = do
     unless valid action
 
 -- | Render to a Page.
-render :: Renderable a
-       => FilePath    -- ^ Template to use for rendering.
-       -> a           -- ^ Renderable object to render with given template.
-       -> Hakyll Page -- ^ The body of the result will contain the render.
+render :: FilePath                     -- ^ Template to use for rendering.
+       -> RenderAction Context Context -- ^ The render computation.
 render = renderWith id
 
 -- | Render to a Page. This function allows you to manipulate the context
 --   first.
-renderWith :: Renderable a
-           => ContextManipulation -- ^ Manipulation to apply on the context.
-           -> FilePath            -- ^ Template to use for rendering.
-           -> a                   -- ^ Data to render.
-           -> Hakyll Page         -- ^ Result of the render operation.
-renderWith manipulation templatePath renderable = do
-    template <- readTemplate templatePath
-    context <- toContext renderable
-    return $ fromContext $ pureRenderWith manipulation template context
+renderWith :: ContextManipulation          -- ^ Manipulation to apply first.
+           -> FilePath                     -- ^ Template to use for rendering.
+           -> RenderAction Context Context -- ^ The render computation.
+renderWith manipulation templatePath = RenderAction
+    { actionDependencies = [templatePath]
+    , actionUrl          = Nothing
+    , actionFunction     = actionFunction'
+    }
+  where
+    actionFunction' context = do
+        template <- readTemplate templatePath
+        return $ pureRenderWith manipulation template context
 
 -- | Render each renderable with the given templates, then concatenate the
 --   result. So, basically this function:
@@ -64,24 +67,31 @@ renderWith manipulation templatePath renderable = do
 --
 --   * Concatenates the result.
 --
-renderAndConcat :: Renderable a
-                => [FilePath] -- ^ Templates to apply on every renderable.
-                -> [a]        -- ^ Renderables to render.
-                -> Hakyll String
+renderAndConcat :: [FilePath] -- ^ Templates to apply on every renderable.
+                -> [RenderAction () Context] -- ^ Renderables to render.
+                -> RenderAction () String
 renderAndConcat = renderAndConcatWith id
 
 -- | Render each renderable with the given templates, then concatenate the
 --   result. This function allows you to specify a @ContextManipulation@ to
 --   apply on every @Renderable@.
-renderAndConcatWith :: Renderable a
-                    => ContextManipulation
+renderAndConcatWith :: ContextManipulation
                     -> [FilePath]
-                    -> [a]
-                    -> Hakyll String
-renderAndConcatWith manipulation templatePaths renderables = do
-    templates <- mapM readTemplate templatePaths
-    contexts <- mapM toContext renderables
-    return $ pureRenderAndConcatWith manipulation templates contexts
+                    -> [RenderAction () Context]
+                    -> RenderAction () String
+renderAndConcatWith manipulation templatePaths renderables = RenderAction
+    { actionDependencies = renders >>= actionDependencies
+    , actionUrl           = Nothing
+    , actionFunction     = actionFunction'
+    }
+  where
+    render' = chain (map render templatePaths)
+    renders = map (>>> manipulationAction >>> render') renderables
+    manipulationAction = createManipulationAction manipulation
+
+    actionFunction' = \_ -> do
+        contexts <- mapM runRenderAction renders
+        return $ concatMap (fromMaybe "" . M.lookup "body") 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
@@ -93,23 +103,24 @@ renderAndConcatWith manipulation templatePaths renderables = do
 --
 --   This code will first render @warning.html@ using @templates/notice.html@,
 --   and will then render the result with @templates/default.html@.
-renderChain :: Renderable a => [FilePath] -> a -> Hakyll ()
+renderChain :: [FilePath] -> RenderAction () Context -> 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 -> Hakyll ()
-renderChainWith manipulation templatePaths renderable = do
-    url <- getUrl renderable
-    depends url dependencies render'
+renderChainWith :: ContextManipulation
+                -> [FilePath]
+                -> RenderAction () Context
+                -> Hakyll ()
+renderChainWith manipulation templatePaths initial =
+    runRenderAction renderChainWith'
   where
-    dependencies = getDependencies renderable ++ templatePaths
-    render' = do
-        templates <- mapM readTemplate templatePaths
-        context <- toContext renderable
-        let result = pureRenderChainWith manipulation templates context
-        writePage $ fromContext result
+    renderChainWith' :: RenderAction () ()
+    renderChainWith' = initial >>> manipulationAction >>> chain' >>> writePage
+
+    chain' = chain (map render templatePaths)
+    manipulationAction = createManipulationAction manipulation
+
 
 -- | Mark a certain file as static, so it will just be copied when the site is
 --   generated.
diff --git a/src/Text/Hakyll/RenderAction.hs b/src/Text/Hakyll/RenderAction.hs
index a84ce46..26fa445 100644
--- a/src/Text/Hakyll/RenderAction.hs
+++ b/src/Text/Hakyll/RenderAction.hs
@@ -1,6 +1,10 @@
 module Text.Hakyll.RenderAction
     ( RenderAction (..)
-    , fromRenderable
+    , createRenderAction
+    , createSimpleRenderAction
+    , createManipulationAction
+    , chain
+    , runRenderAction
     ) where
 
 import Prelude hiding ((.), id)
@@ -9,32 +13,42 @@ import Control.Monad ((<=<), mplus)
 
 import Text.Hakyll.Hakyll
 import Text.Hakyll.Context
-import Text.Hakyll.Renderable
 
 data RenderAction a b = RenderAction
     { actionDependencies :: [FilePath]
-    , actionDestination  :: Maybe (Hakyll FilePath)
+    , actionUrl          :: Maybe (Hakyll FilePath)
     , actionFunction     :: a -> Hakyll b
     }
 
+createRenderAction :: (a -> Hakyll b) -> RenderAction a b
+createRenderAction f = RenderAction
+    { actionDependencies = []
+    , actionUrl          = Nothing
+    , actionFunction     = f
+    }
+
+createSimpleRenderAction :: Hakyll b -> RenderAction () b
+createSimpleRenderAction x = createRenderAction (const x)
+
 instance Category RenderAction where
     id = RenderAction
         { actionDependencies = []
-        , actionDestination  = Nothing
+        , actionUrl          = Nothing
         , actionFunction     = return
         }
 
     x . y = RenderAction
         { actionDependencies = actionDependencies x ++ actionDependencies y
-        , actionDestination  = actionDestination y `mplus` actionDestination x
+        , actionUrl          = actionUrl y `mplus` actionUrl x
         , actionFunction     = actionFunction x <=< actionFunction y
         }
 
-fromRenderable :: (Renderable a)
-               => a
-               -> RenderAction () Context
-fromRenderable renderable = RenderAction
-    { actionDependencies = getDependencies renderable
-    , actionDestination  = Just $ getUrl renderable
-    , actionFunction     = const $ toContext renderable
-    }
+createManipulationAction :: ContextManipulation -> RenderAction Context Context
+createManipulationAction manipulation =
+    createRenderAction (return . manipulation)
+
+chain :: [RenderAction a a] -> RenderAction a a
+chain = foldl1 (>>>)
+
+runRenderAction :: RenderAction () a -> Hakyll a
+runRenderAction action = actionFunction action ()
diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs
deleted file mode 100644
index 60e75ee..0000000
--- a/src/Text/Hakyll/Renderable.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Text.Hakyll.Renderable
-    ( Renderable(toContext, getDependencies, getUrl)
-    ) where
-
-import Text.Hakyll.Hakyll (Hakyll)
-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 -> Hakyll Context
-
-    -- | Get the dependencies for the renderable. This is used for cache
-    --   invalidation.
-    getDependencies :: a -> [FilePath]
-
-    -- | Get the destination for the renderable.
-    getUrl :: a -> Hakyll FilePath
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs
index 42c05cc..37bd521 100644
--- a/src/Text/Hakyll/Renderables.hs
+++ b/src/Text/Hakyll/Renderables.hs
@@ -14,14 +14,11 @@ import Control.Arrow (second)
 import Control.Monad (liftM2, mplus)
 import Control.Applicative ((<$>))
 
-import Data.Binary
 
-import Text.Hakyll.Hakyll (Hakyll)
-import Text.Hakyll.Renderable
 import Text.Hakyll.File
 import Text.Hakyll.Context
-import Text.Hakyll.Render
 import Text.Hakyll.RenderAction
+import Text.Hakyll.Render
 import Text.Hakyll.Internal.Page
 
 -- | Create a custom page.
@@ -33,16 +30,17 @@ import Text.Hakyll.Internal.Page
 --   cases.
 createCustomPage :: String
                  -> [FilePath]
-                 -> [(String, Either String (Hakyll String))]
+                 -> [(String, Either String (RenderAction () String))]
                  -> RenderAction () Context
 createCustomPage url dependencies association = RenderAction
     { actionDependencies = dependencies
-    , actionDestination  = Just $ return url
-    , actionFunction     = actionFunction'
+    , actionUrl          = Just $ return url
+    , actionFunction     = \_ -> M.fromList <$> assoc'
     }
   where
     mtuple (a, b) = b >>= \b' -> return (a, b')
-    actionFunction' () = M.fromList <$> mapM (mtuple . second (either return id)) association
+    toHakyllString = second (either return runRenderAction)
+    assoc' = mapM (mtuple . toHakyllString) association
 
 -- | A @createCustomPage@ function specialized in creating listings.
 --
@@ -57,10 +55,9 @@ createCustomPage url dependencies association = RenderAction
 --   >                                                -- render the items with.
 --   >                      posts -- ^ Renderables to create the list with.
 --   >                      [("title", "Home")] -- ^ Additional context
-createListing :: (Renderable a)
-              => String -- ^ Destination of the page.
+createListing :: String -- ^ Destination of the page.
               -> FilePath -- ^ Template to render all items with.
-              -> [a] -- ^ Renderables in the list.
+              -> [RenderAction () Context] -- ^ Renderables in the list.
               -> [(String, String)] -- ^ Additional context.
               -> RenderAction () Context
 createListing = createListingWith id
@@ -69,17 +66,16 @@ createListing = createListingWith id
 --
 --   In addition to @createListing@, this function allows you to specify an
 --   extra @ContextManipulation@ for all @Renderable@s given.
-createListingWith :: (Renderable a)
-                  => ContextManipulation -- ^ Manipulation for the renderables.
+createListingWith :: ContextManipulation -- ^ Manipulation for the renderables.
                   -> String -- ^ Destination of the page.
                   -> FilePath -- ^ Template to render all items with.
-                  -> [a] -- ^ Renderables in the list.
+                  -> [RenderAction () Context] -- ^ Renderables in the list.
                   -> [(String, String)] -- ^ Additional context.
                   -> RenderAction () Context
 createListingWith manipulation url template renderables additional =
     createCustomPage url dependencies context
   where
-    dependencies = template : concatMap getDependencies renderables
+    dependencies = template : concatMap actionDependencies renderables
     context = ("body", Right concatenation) : additional'
     concatenation = renderAndConcatWith manipulation [template] renderables
     additional' = map (second Left) additional
@@ -93,7 +89,7 @@ newtype PagePath = PagePath FilePath
 createPagePath :: FilePath -> RenderAction () Context
 createPagePath path = RenderAction
     { actionDependencies = [path]
-    , actionDestination  = Just $ toUrl path
+    , actionUrl          = Just $ toUrl path
     , actionFunction     = const (readPage path)
     }
 
@@ -112,38 +108,21 @@ combine :: RenderAction () Context -> RenderAction () Context
         -> RenderAction () Context
 combine x y = RenderAction
     { actionDependencies = actionDependencies x ++ actionDependencies y
-    , actionDestination  = actionDestination x `mplus` actionDestination y
-    , actionFunction     = \_ -> liftM2 (M.union) (actionFunction x ()) (actionFunction y ())
+    , actionUrl          = actionUrl x `mplus` actionUrl y
+    , actionFunction     = \_ ->
+        liftM2 (M.union) (runRenderAction x) (runRenderAction y)
     }
 
 -- | Combine two renderables and set a custom URL. This behaves like @combine@,
 --   except that for the @url@ field, the given URL is always chosen.
-combineWithUrl :: (Renderable a, Renderable b)
-               => FilePath
-               -> a
-               -> b
-               -> CombinedRenderable a b
-combineWithUrl = CombinedRenderableWithUrl
-
--- Render combinations.
-instance (Renderable a, Renderable b)
-         => Renderable (CombinedRenderable a b) where
-
-    -- Add the dependencies.
-    getDependencies (CombinedRenderable a b) =
-        getDependencies a ++ getDependencies b
-    getDependencies (CombinedRenderableWithUrl _ a b) =
-        getDependencies a ++ getDependencies b
-
-    -- Take the url from the first renderable, or the specified URL.
-    getUrl (CombinedRenderable a _) = getUrl a
-    getUrl (CombinedRenderableWithUrl url _ _) = return url
-
-    -- Take a union of the contexts.
-    toContext (CombinedRenderable a b) = do
-        c1 <- toContext a
-        c2 <- toContext b
-        return $ c1 `M.union` c2
-    toContext (CombinedRenderableWithUrl url a b) = do
-        c <- toContext (CombinedRenderable a b)
-        return $ M.singleton "url" url `M.union` c
+combineWithUrl :: FilePath
+               -> RenderAction () Context
+               -> RenderAction () Context
+               -> RenderAction () Context
+combineWithUrl url x y = combine'
+    { actionUrl          = Just $ return url
+    , actionFunction     = \_ ->
+        (M.insert "url" url) <$> runRenderAction combine'
+    }
+  where
+    combine' = combine x y