From 2b9858a8f9212219718625b7c5891bcb11cbaefb Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Fri, 11 Feb 2011 17:52:19 +0100
Subject: Add Resource type for improved type-safety

---
 src/Hakyll/Core/Compiler.hs         | 8 ++++----
 src/Hakyll/Core/ResourceProvider.hs | 7 ++++++-
 src/Hakyll/Core/Rules.hs            | 6 ++++--
 3 files changed, 14 insertions(+), 7 deletions(-)

(limited to 'src/Hakyll/Core')

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index 85b912c..bbb5737 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -87,7 +87,7 @@ getRouteFor = fromJob $ \identifier -> CompilerM $ do
 
 -- | Get the resource we are compiling as a string
 --
-getResourceString :: Compiler a String
+getResourceString :: Compiler Resource String
 getResourceString = getIdentifier >>> getResourceString'
   where
     getResourceString' = fromJob $ \id' -> CompilerM $ do
@@ -165,8 +165,8 @@ requireAllA pattern = (id &&& requireAll_ pattern >>>)
 
 cached :: (Binary a, Typeable a, Writable a)
        => String
-       -> Compiler () a
-       -> Compiler () a
+       -> Compiler Resource a
+       -> Compiler Resource a
 cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
     identifier <- compilerIdentifier <$> ask
     store <- compilerStore <$> ask
@@ -174,7 +174,7 @@ cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
     liftIO $ putStrLn $
         show identifier ++ ": " ++ if modified then "MODIFIED" else "OK"
     if modified
-        then do v <- unCompilerM $ j ()
+        then do v <- unCompilerM $ j Resource
                 liftIO $ storeSet store name identifier v
                 return v
         else do v <- liftIO $ storeGet store name identifier
diff --git a/src/Hakyll/Core/ResourceProvider.hs b/src/Hakyll/Core/ResourceProvider.hs
index d5f2ea3..980f001 100644
--- a/src/Hakyll/Core/ResourceProvider.hs
+++ b/src/Hakyll/Core/ResourceProvider.hs
@@ -3,7 +3,8 @@
 -- the concrete instance.
 --
 module Hakyll.Core.ResourceProvider
-    ( ResourceProvider (..)
+    ( Resource (..)
+    , ResourceProvider (..)
     , resourceExists
     , resourceDigest
     , resourceModified
@@ -19,6 +20,10 @@ import OpenSSL.Digest (MessageDigest (MD5))
 import Hakyll.Core.Identifier
 import Hakyll.Core.Store
 
+-- | A resource
+--
+data Resource = Resource
+
 -- | A value responsible for retrieving and listing resources
 --
 data ResourceProvider = ResourceProvider
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index fbdd533..78cbac7 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -39,6 +39,7 @@ import Hakyll.Core.Routes
 import Hakyll.Core.CompiledItem
 import Hakyll.Core.Writable
 import Hakyll.Core.Rules.Internal
+import Hakyll.Core.Util.Arrow
 
 -- | Add a route
 --
@@ -62,10 +63,11 @@ tellCompilers compilers = RulesM $ tell $ RuleSet mempty $
 -- happen. In this case, you might want to have a look at 'create'.
 --
 compile :: (Binary a, Typeable a, Writable a)
-        => Pattern -> Compiler () a -> Rules
+        => Pattern -> Compiler Resource a -> Rules
 compile pattern compiler = RulesM $ do
     identifiers <- matches pattern . resourceList <$> ask
-    unRulesM $ tellCompilers $ zip identifiers (repeat compiler)
+    unRulesM $ tellCompilers $ zip identifiers $ repeat $
+        constA Resource >>> compiler
 
 -- | Add a compilation rule
 --
-- 
cgit v1.2.3