summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2011-02-11 17:52:19 +0100
committerJasper Van der Jeugt <jaspervdj@gmail.com>2011-02-11 17:52:19 +0100
commit2b9858a8f9212219718625b7c5891bcb11cbaefb (patch)
treea4c502a199a8ce9ffc51ef096f7f5848ae0f0093
parentfc6df44c2218f5c0265c978a02f9cb7fcf50562a (diff)
downloadhakyll-2b9858a8f9212219718625b7c5891bcb11cbaefb.tar.gz
Add Resource type for improved type-safety
-rw-r--r--src/Hakyll/Core/Compiler.hs8
-rw-r--r--src/Hakyll/Core/ResourceProvider.hs7
-rw-r--r--src/Hakyll/Core/Rules.hs6
-rw-r--r--src/Hakyll/Web.hs11
-rw-r--r--src/Hakyll/Web/Page.hs3
-rw-r--r--src/Hakyll/Web/Template.hs5
6 files changed, 25 insertions, 15 deletions
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
--
diff --git a/src/Hakyll/Web.hs b/src/Hakyll/Web.hs
index 617e2de..ae86301 100644
--- a/src/Hakyll/Web.hs
+++ b/src/Hakyll/Web.hs
@@ -19,6 +19,7 @@ import Text.Hamlet (HamletSettings)
import Hakyll.Core.Compiler
import Hakyll.Core.Writable
import Hakyll.Core.Identifier
+import Hakyll.Core.ResourceProvider
import Hakyll.Web.Page
import Hakyll.Web.Pandoc
import Hakyll.Web.Template
@@ -26,7 +27,7 @@ import Hakyll.Web.RelativizeUrls
import Hakyll.Web.Util.String
import Hakyll.Web.CompressCss
-defaultPageRead :: Compiler () (Page String)
+defaultPageRead :: Compiler Resource (Page String)
defaultPageRead = cached "Hakyll.Web.defaultPageRead" $
pageRead >>> addDefaultFields >>> arr applySelf >>> pageRenderPandoc
@@ -36,17 +37,17 @@ defaultRelativizeUrls = getRoute &&& id >>^ uncurry relativize
relativize Nothing = id
relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)
-defaultTemplateRead :: Compiler () Template
+defaultTemplateRead :: Compiler Resource Template
defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $ templateRead
-defaultTemplateReadWith :: HamletSettings -> Compiler () Template
+defaultTemplateReadWith :: HamletSettings -> Compiler Resource Template
defaultTemplateReadWith settings = cached "Hakyll.Web.defaultTemplateReadWith" $
templateReadWith settings
-defaultCopyFile :: Compiler () CopyFile
+defaultCopyFile :: Compiler Resource CopyFile
defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath
-defaultCompressCss :: Compiler () String
+defaultCompressCss :: Compiler Resource String
defaultCompressCss = getResourceString >>^ compressCss
defaultApplyTemplate :: Identifier -- ^ Template
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index 220ee29..03995cd 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -68,6 +68,7 @@ import Data.Ord (comparing)
import Hakyll.Core.Identifier
import Hakyll.Core.Compiler
+import Hakyll.Core.ResourceProvider
import Hakyll.Web.Page.Internal
import Hakyll.Web.Page.Read
import Hakyll.Web.Page.Metadata
@@ -90,7 +91,7 @@ toMap (Page m b) = M.insert "body" b m
-- | Read a page (do not render it)
--
-pageRead :: Compiler a (Page String)
+pageRead :: Compiler Resource (Page String)
pageRead = getResourceString >>^ readPage
-- | Add a number of default metadata fields to a page. These fields include:
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 9ea4183..6e6ad67 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -58,6 +58,7 @@ import Text.Hamlet (HamletSettings, defaultHamletSettings)
import Hakyll.Core.Compiler
import Hakyll.Core.Identifier
+import Hakyll.Core.ResourceProvider
import Hakyll.Web.Template.Internal
import Hakyll.Web.Template.Read
import Hakyll.Web.Page
@@ -85,12 +86,12 @@ applySelf page = applyTemplate (readTemplate $ pageBody page) page
-- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed
-- as such.
--
-templateRead :: Compiler a Template
+templateRead :: Compiler Resource Template
templateRead = templateReadWith defaultHamletSettings
-- | Version of 'templateRead' that enables custom settings.
--
-templateReadWith :: HamletSettings -> Compiler a Template
+templateReadWith :: HamletSettings -> Compiler Resource Template
templateReadWith settings =
getIdentifier &&& getResourceString >>^ uncurry read'
where