dabaa45 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Add `freshIdentifier` to Hakyll.Core.Rules

dabaa45Jasper Van der Jeugt15 years ago

src/Hakyll/Core/Rules.hs+14−11

compare with master

unifiedsplit

@@ -26,6 +26,7 @@ module Hakyll.Core.Rules

26 , resources

27 , metaCompile

28 , metaCompileWith

29+ , freshIdentifier

29 ) where

30 ) where

31import Control.Applicative ((<$>))

32import Control.Applicative ((<$>))

@@ -208,17 +209,9 @@ metaCompile :: (Binary a, Typeable a, Writable a)

208 -- ^ Compiler generating the other compilers

209 -- ^ Compiler generating the other compilers

209 -> Rules

210 -> Rules

210 -- ^ Resulting rules

211 -- ^ Resulting rules

211−metaCompile compiler = RulesM $ do

212+metaCompile compiler = do

212− -- Create an identifier from the state

213− state <- get

214− let index = rulesMetaCompilerIndex state

215− id' = fromCapture "Hakyll.Core.Rules.metaCompile/*" (show index)

213+ id' <- freshIdentifier "Hakyll.Core.Rules.metaCompile"

216−

217− -- Update the state with a new identifier

218− put $ state {rulesMetaCompilerIndex = index + 1}

219−

220− -- Fallback to 'metaCompileWith' with now known identifier

221− unRulesM $ metaCompileWith id' compiler

214+ metaCompileWith id' compiler

222

215

223-- | Version of 'metaCompile' that allows you to specify a custom identifier for

216-- | Version of 'metaCompile' that allows you to specify a custom identifier for

224-- the metacompiler.

217-- the metacompiler.

@@ -243,3 +236,13 @@ metaCompileWith identifier compiler = RulesM $ do

243 compilers = [(id', compiler >>> arr makeRule )]

236 compilers = [(id', compiler >>> arr makeRule )]

244

237

245 tell $ RuleSet mempty compilers mempty

238 tell $ RuleSet mempty compilers mempty

239+

240+-- | Generate a fresh Identifier with a given prefix

241+freshIdentifier :: String -- ^ Prefix

242+ -> RulesM (Identifier a) -- ^ Fresh identifier

243+freshIdentifier prefix = RulesM $ do

244+ state <- get

245+ let index = rulesNextIdentifier state

246+ id' = parseIdentifier $ prefix ++ "/" ++ show index

247+ put $ state {rulesNextIdentifier = index + 1}

248+ return id'

src/Hakyll/Core/Rules/Internal.hs+2−2

@@ -56,7 +56,7 @@ instance Monoid RuleSet where

56-- | Rule state

57--

58data RuleState = RuleState

59− { rulesMetaCompilerIndex :: Int

59+ { rulesNextIdentifier :: Int

60 } deriving (Show)

62-- | Rule environment

@@ -84,7 +84,7 @@ runRules :: RulesM a -> ResourceProvider -> RuleSet

84runRules rules provider = nubCompilers $

85 evalState (execWriterT $ runReaderT (unRulesM rules) env) state

86 where

87− state = RuleState {rulesMetaCompilerIndex = 0}

87+ state = RuleState {rulesNextIdentifier = 0}

88 env = RuleEnvironment { rulesResourceProvider = provider

89 , rulesPattern = mempty

90 , rulesGroup = Nothing