From 76ebcf97b4e2c993297aa914ce576fc0abd68d06 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Thu, 4 Mar 2010 00:02:37 +0100
Subject: First careful transition from data to arrows. It compiles, but that's
 about it.

---
 src/Text/Hakyll/RenderAction.hs | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)
 create mode 100644 src/Text/Hakyll/RenderAction.hs

(limited to 'src/Text/Hakyll/RenderAction.hs')

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
+    }
-- 
cgit v1.2.3