summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2012-01-16 14:35:43 +0100
committerJasper Van der Jeugt <m@jaspervdj.be>2012-01-16 14:35:43 +0100
commitdabaa4532b767d5ab10204e6efa6f71c8eb96b7b (patch)
treec4bdc967afd0099d55ba8944c458c814e1b76fe1 /src/Hakyll
parent01826260f9ce534df0df2dd6251dd234118b7040 (diff)
downloadhakyll-dabaa4532b767d5ab10204e6efa6f71c8eb96b7b.tar.gz
Add `freshIdentifier` to Hakyll.Core.Rules
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Core/Rules.hs25
-rw-r--r--src/Hakyll/Core/Rules/Internal.hs4
2 files changed, 16 insertions, 13 deletions
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index eb75a2e..2e3e52c 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -26,6 +26,7 @@ module Hakyll.Core.Rules
, resources
, metaCompile
, metaCompileWith
+ , freshIdentifier
) where
import Control.Applicative ((<$>))
@@ -208,17 +209,9 @@ metaCompile :: (Binary a, Typeable a, Writable a)
-- ^ Compiler generating the other compilers
-> Rules
-- ^ Resulting rules
-metaCompile compiler = RulesM $ do
- -- Create an identifier from the state
- state <- get
- let index = rulesMetaCompilerIndex state
- id' = fromCapture "Hakyll.Core.Rules.metaCompile/*" (show index)
-
- -- Update the state with a new identifier
- put $ state {rulesMetaCompilerIndex = index + 1}
-
- -- Fallback to 'metaCompileWith' with now known identifier
- unRulesM $ metaCompileWith id' compiler
+metaCompile compiler = do
+ id' <- freshIdentifier "Hakyll.Core.Rules.metaCompile"
+ metaCompileWith id' compiler
-- | Version of 'metaCompile' that allows you to specify a custom identifier for
-- the metacompiler.
@@ -243,3 +236,13 @@ metaCompileWith identifier compiler = RulesM $ do
compilers = [(id', compiler >>> arr makeRule )]
tell $ RuleSet mempty compilers mempty
+
+-- | Generate a fresh Identifier with a given prefix
+freshIdentifier :: String -- ^ Prefix
+ -> RulesM (Identifier a) -- ^ Fresh identifier
+freshIdentifier prefix = RulesM $ do
+ state <- get
+ let index = rulesNextIdentifier state
+ id' = parseIdentifier $ prefix ++ "/" ++ show index
+ put $ state {rulesNextIdentifier = index + 1}
+ return id'
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index fd13f7a..55c4446 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -56,7 +56,7 @@ instance Monoid RuleSet where
-- | Rule state
--
data RuleState = RuleState
- { rulesMetaCompilerIndex :: Int
+ { rulesNextIdentifier :: Int
} deriving (Show)
-- | Rule environment
@@ -84,7 +84,7 @@ runRules :: RulesM a -> ResourceProvider -> RuleSet
runRules rules provider = nubCompilers $
evalState (execWriterT $ runReaderT (unRulesM rules) env) state
where
- state = RuleState {rulesMetaCompilerIndex = 0}
+ state = RuleState {rulesNextIdentifier = 0}
env = RuleEnvironment { rulesResourceProvider = provider
, rulesPattern = mempty
, rulesGroup = Nothing