diff options
author | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2011-02-11 17:52:19 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2011-02-11 17:52:19 +0100 |
commit | 2b9858a8f9212219718625b7c5891bcb11cbaefb (patch) | |
tree | a4c502a199a8ce9ffc51ef096f7f5848ae0f0093 | |
parent | fc6df44c2218f5c0265c978a02f9cb7fcf50562a (diff) | |
download | hakyll-2b9858a8f9212219718625b7c5891bcb11cbaefb.tar.gz |
Add Resource type for improved type-safety
-rw-r--r-- | src/Hakyll/Core/Compiler.hs | 8 | ||||
-rw-r--r-- | src/Hakyll/Core/ResourceProvider.hs | 7 | ||||
-rw-r--r-- | src/Hakyll/Core/Rules.hs | 6 | ||||
-rw-r--r-- | src/Hakyll/Web.hs | 11 | ||||
-rw-r--r-- | src/Hakyll/Web/Page.hs | 3 | ||||
-rw-r--r-- | src/Hakyll/Web/Template.hs | 5 |
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 |