First careful transition from data to arrows. It compiles, but that's about it.

4 files changed, 77 insertions, 35 deletions

diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs
index f8b3373..e228404 100644
--- a/src/Text/Hakyll/Paginate.hs
+++ b/src/Text/Hakyll/Paginate.hs
@@ -5,8 +5,11 @@ module Text.Hakyll.Paginate
     , paginate
     ) where
 
+import Control.Applicative ((<$>))
+
+import Text.Hakyll.Context
 import Text.Hakyll.Renderables
-import Text.Hakyll.Renderable (Renderable, getUrl)
+import Text.Hakyll.RenderAction
 import Text.Hakyll.Util (link)
 
 -- | A configuration for a pagination.
@@ -46,14 +49,15 @@ defaultPaginateConfiguration = PaginateConfiguration
 --   When @$previous@ or @$next@ are not available, they will be just a label
 --   without a link. The same goes for when we are on the first or last page for
 --   @$first@ and @$last@.
-paginate :: (Renderable a)
-         => PaginateConfiguration
-         -> [a]
-         -> [CombinedRenderable a CustomPage]
+paginate :: PaginateConfiguration
+         -> [RenderAction () Context]
+         -> [RenderAction () Context]
 paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
   where
     -- Create a link with a given label, taken from the configuration.
-    linkWithLabel f r = link (f configuration) `fmap` getUrl r
+    linkWithLabel f r = case actionDestination r of
+        Just l  -> link (f configuration) <$> l
+        Nothing -> error "No link found for pagination."
 
     -- The main function that creates combined renderables by recursing over
     -- the list of renderables.
@@ -75,6 +79,6 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
                 , ("first", Right first)
                 , ("last", Right last')
                 , ("index", Left $ show index)
-                , ("length", Left $ show $ length $ renderables)
+                , ("length", Left $ show $ length renderables)
                 ]
         in (x `combine` customPage) : paginate' (Just x) xs (index + 1)
diff --git a/src/Text/Hakyll/Regex.hs b/src/Text/Hakyll/Regex.hs
index 96db2d2..ba7ee46 100644
--- a/src/Text/Hakyll/Regex.hs
+++ b/src/Text/Hakyll/Regex.hs
@@ -15,7 +15,7 @@ matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])
 matchRegexAll = matchM
 
 -- | Replaces every occurance of the given regexp with the replacement string.
-subRegex :: Regex -- ^ Search pattern
+subRegex :: Regex  -- ^ Search pattern
          -> String -- ^ Input string
          -> String -- ^ Replacement text
          -> String -- ^ Output string
diff --git a/src/Text/Hakyll/RenderAction.hs b/src/Text/Hakyll/RenderAction.hs
new file mode 100644
index 0000000..a84ce46
--- /dev/null
+++ b/src/Text/Hakyll/RenderAction.hs
@@ -0,0 +1,40 @@
+module Text.Hakyll.RenderAction
+    ( RenderAction (..)
+    , fromRenderable
+    ) where
+
+import Prelude hiding ((.), id)
+import Control.Category
+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)
+    , actionFunction     :: a -> Hakyll b
+    }
+
+instance Category RenderAction where
+    id = RenderAction
+        { actionDependencies = []
+        , actionDestination  = Nothing
+        , actionFunction     = return
+        }
+
+    x . y = RenderAction
+        { actionDependencies = actionDependencies x ++ actionDependencies y
+        , actionDestination  = actionDestination y `mplus` actionDestination 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
+    }
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs
index b16b2bd..136bd85 100644
--- a/src/Text/Hakyll/Renderables.hs
+++ b/src/Text/Hakyll/Renderables.hs
@@ -1,6 +1,5 @@
 module Text.Hakyll.Renderables
-    ( CustomPage
-    , createCustomPage
+    ( createCustomPage
     , createListing
     , createListingWith
     , PagePath
@@ -12,7 +11,8 @@ module Text.Hakyll.Renderables
 
 import qualified Data.Map as M
 import Control.Arrow (second)
-import Control.Monad (liftM)
+import Control.Monad (liftM, liftM2, mplus)
+import Control.Applicative ((<$>))
 
 import Data.Binary
 
@@ -22,13 +22,7 @@ import Text.Hakyll.Renderable
 import Text.Hakyll.File
 import Text.Hakyll.Context
 import Text.Hakyll.Render
-
--- | A custom page.
-data CustomPage = CustomPage 
-    { customPageUrl :: String,
-      customPageDependencies :: [FilePath],
-      customPageContext :: [(String, Either String (Hakyll String))]
-    }
+import Text.Hakyll.RenderAction
 
 -- | Create a custom page.
 --   
@@ -37,11 +31,18 @@ data CustomPage = CustomPage
 --   A @Hakyll String@ is preferred for more complex data, since it allows
 --   dependency checking. A @String@ is obviously more simple to use in some
 --   cases.
-createCustomPage :: String -- ^ Destination of the page, relative to _site.
-                 -> [FilePath] -- ^ Dependencies of the page.
-                 -> [(String, Either String (Hakyll String))] -- ^ Mapping.
-                 -> CustomPage
-createCustomPage = CustomPage
+createCustomPage :: String
+                 -> [FilePath]
+                 -> [(String, Either String (Hakyll String))]
+                 -> RenderAction () Context
+createCustomPage url dependencies association = RenderAction
+    { actionDependencies = dependencies
+    , actionDestination  = Just $ return url
+    , actionFunction     = actionFunction'
+    }
+  where
+    mtuple (a, b) = b >>= \b' -> return (a, b')
+    actionFunction' () = M.fromList <$> mapM (mtuple . second (either return id)) association
 
 -- | A @createCustomPage@ function specialized in creating listings.
 --
@@ -61,7 +62,7 @@ createListing :: (Renderable a)
               -> FilePath -- ^ Template to render all items with.
               -> [a] -- ^ Renderables in the list.
               -> [(String, String)] -- ^ Additional context.
-              -> CustomPage
+              -> RenderAction () Context
 createListing = createListingWith id
 
 -- | A @createCustomPage@ function specialized in creating listings.
@@ -74,7 +75,7 @@ createListingWith :: (Renderable a)
                   -> FilePath -- ^ Template to render all items with.
                   -> [a] -- ^ Renderables in the list.
                   -> [(String, String)] -- ^ Additional context.
-                  -> CustomPage
+                  -> RenderAction () Context
 createListingWith manipulation url template renderables additional =
     createCustomPage url dependencies context
   where
@@ -83,14 +84,6 @@ createListingWith manipulation url template renderables additional =
     concatenation = renderAndConcatWith manipulation [template] renderables
     additional' = map (second Left) additional
 
-instance Renderable CustomPage where
-    getDependencies = customPageDependencies
-    getUrl = return . customPageUrl
-    toContext page = do
-        values <- mapM (either return id . snd) (customPageContext page)
-        let pairs = zip (map fst $ customPageContext page) values
-        return $ M.fromList $ ("url", customPageUrl page) : pairs
-
 -- | PagePath is a class that wraps a FilePath. This is used to render Pages
 --   without reading them first through use of caching.
 newtype PagePath = PagePath FilePath
@@ -122,8 +115,13 @@ data CombinedRenderable a b = CombinedRenderable a b
 --
 --   Since renderables are always more or less key-value maps, you can see
 --   this as a @union@ between two maps.
-combine :: (Renderable a, Renderable b) => a -> b -> CombinedRenderable a b
-combine = CombinedRenderable
+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 ())
+    }
 
 -- | Combine two renderables and set a custom URL. This behaves like @combine@,
 --   except that for the @url@ field, the given URL is always chosen.