f969950 · hakyll · git.iko.soy

git.iko.soy/hakyll

Playing around with groups

commitf9699509771346ec53c0acc82c014a355857557d authorJasper Van der Jeugt <jaspervdj@gmail.com> dateMon 11 Apr 2011, 21:57 (16 years ago) parentb9efc54

4 files changed+46−20

compare with master

unifiedsplit

src/Hakyll/Core/Identifier.hs+2−8 src/Hakyll/Core/Identifier/Pattern.hs+7 src/Hakyll/Core/Rules.hs+35−12 src/Hakyll/Core/Rules/Internal.hs+2

src/Hakyll/Core/Identifier.hs+2−8

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

2626 , parseIdentifier

2727 , toFilePath

2828 , setGroup

29− , hasGroup

3029 ) where

3130

3231import Control.Arrow (second)

@@ -78,10 +77,5 @@ toFilePath = identifierPath

7877

7978-- | Set the identifier group for some identifier

8079--

81−setGroup :: String -> Identifier -> Identifier

82−setGroup g (Identifier _ p) = Identifier (Just g) p

83−

84−-- | Check if an identifier belongs to a certain group

85−--

86−hasGroup :: String -> Identifier -> Bool

87−hasGroup g (Identifier g' _) = Just g == g'

80+setGroup :: Maybe String -> Identifier -> Identifier

81+setGroup g (Identifier _ p) = Identifier g p

src/Hakyll/Core/Identifier/Pattern.hs+7

@@ -36,6 +36,7 @@ module Hakyll.Core.Identifier.Pattern

3636 , parseGlob

3737 , predicate

3838 , regex

39+ , inGroup

3940 , matches

4041 , filterMatches

4142 , capture

@@ -106,6 +107,12 @@ predicate = Predicate

106107regex :: String -> Pattern

107108regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath

108109

110+-- | Create a 'Pattern' which matches if the identifier is in a certain group

111+-- (or in no group)

112+--

113+inGroup :: Maybe String -> Pattern

114+inGroup group = predicate $ (== group) . identifierGroup

115+

109116-- | Check if an identifier matches a pattern

110117--

111118matches :: Pattern -> Identifier -> Bool

src/Hakyll/Core/Rules.hs+35−12

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

1919 ( RulesM

2020 , Rules

2121 , match

22+ , group

2223 , compile

2324 , create

2425 , route

@@ -29,7 +30,7 @@ module Hakyll.Core.Rules

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

3031import Control.Monad.Writer (tell)

3132import Control.Monad.Reader (ask, local)

32−import Control.Arrow (second, (>>>), arr, (>>^))

33+import Control.Arrow (second, (>>>), arr, (>>^), (***))

3334import Control.Monad.State (get, put)

3435import Data.Monoid (mempty, mappend)

3536import qualified Data.Set as S

@@ -58,16 +59,21 @@ tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty

5859tellCompilers :: (Binary a, Typeable a, Writable a)

5960 => [(Identifier, Compiler () a)]

6061 -> Rules

61−tellCompilers compilers = RulesM $ tell $ RuleSet mempty compilers' mempty

62+tellCompilers compilers = RulesM $ do

63+ -- We box the compilers so they have a more simple type, and we apply the

64+ -- current group to the corresponding identifiers

65+ group' <- rulesGroup <$> ask

66+ let compilers' = map (setGroup group' *** boxCompiler) compilers

67+ tell $ RuleSet mempty compilers' mempty

6268 where

63− compilers' = map (second boxCompiler) compilers

6469 boxCompiler = (>>> arr compiledItem >>> arr CompileRule)

6570

6671-- | Add resources

6772--

6873tellResources :: [Resource]

6974 -> Rules

70−tellResources resources = RulesM $ tell $ RuleSet mempty mempty $ S.fromList resources

75+tellResources resources = RulesM $ tell $

76+ RuleSet mempty mempty $ S.fromList resources

7177

7278-- | Only compile/route items satisfying the given predicate

7379--

@@ -78,6 +84,13 @@ match pattern = RulesM . local addPredicate . unRulesM

7884 { rulesPattern = rulesPattern env `mappend` pattern

7985 }

8086

87+-- | Greate a group of compilers

88+--

89+group :: String -> Rules -> Rules

90+group g = RulesM . local setGroup' . unRulesM

91+ where

92+ setGroup' env = env { rulesGroup = Just g }

93+

8194-- | Add a compilation rule to the rules.

8295--

8396-- This instructs all resources to be compiled using the given compiler. When

@@ -112,8 +125,11 @@ create identifier compiler = tellCompilers [(identifier, compiler)]

112125--

113126route :: Routes -> Rules

114127route route' = RulesM $ do

128+ -- We want the route only to be applied if we match the current pattern and

129+ -- group

115130 pattern <- rulesPattern <$> ask

116− unRulesM $ tellRoute $ matchRoute pattern route'

131+ group' <- rulesGroup <$> ask

132+ unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route'

117133

118134-- | Apart from regular compilers, one is also able to specify metacompilers.

119135-- Metacompilers are a special class of compilers: they are compilers which

@@ -154,7 +170,7 @@ metaCompile compiler = RulesM $ do

154170 -- Create an identifier from the state

155171 state <- get

156172 let index = rulesMetaCompilerIndex state

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

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

158174

159175 -- Update the state with a new identifier

160176 put $ state {rulesMetaCompilerIndex = index + 1}

@@ -172,9 +188,16 @@ metaCompileWith :: (Binary a, Typeable a, Writable a)

172188 -- ^ Compiler generating the other compilers

173189 -> Rules

174190 -- ^ Resulting rules

175−metaCompileWith identifier compiler = RulesM $ tell $

176− RuleSet mempty compilers mempty

177− where

178− makeRule = MetaCompileRule . map (second box)

179− compilers = [(identifier, compiler >>> arr makeRule )]

180− box = (>>> fromDependency identifier >>^ CompileRule . compiledItem)

191+metaCompileWith identifier compiler = RulesM $ do

192+ group' <- rulesGroup <$> ask

193+

194+ let -- Set the correct group on the identifier

195+ id' = setGroup group' identifier

196+ -- Function to box an item into a rule

197+ makeRule = MetaCompileRule . map (second box)

198+ -- Entire boxing function

199+ box = (>>> fromDependency id' >>^ CompileRule . compiledItem)

200+ -- Resulting compiler list

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

202+

203+ tell $ RuleSet mempty compilers mempty

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

@@ -63,6 +63,7 @@ data RuleState = RuleState

6363data RuleEnvironment = RuleEnvironment

6464 { rulesResourceProvider :: ResourceProvider

6565 , rulesPattern :: Pattern

66+ , rulesGroup :: Maybe String

6667 }

6768

6869-- | The monad used to compose rules

@@ -85,4 +86,5 @@ runRules rules provider =

8586 state = RuleState {rulesMetaCompilerIndex = 0}

8687 env = RuleEnvironment { rulesResourceProvider = provider

8788 , rulesPattern = mempty

89+ , rulesGroup = Nothing

8890 }