Add `freshIdentifier` to Hakyll.Core.Rules

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