f969950 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Playing around with groups

f969950Jasper Van der Jeugt16 years ago

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

compare with master

unifiedsplit

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

26 , parseIdentifier

27 , toFilePath

28 , setGroup

29− , hasGroup

30 ) where

29 ) where

32import Control.Arrow (second)

31import Control.Arrow (second)

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

79-- | Set the identifier group for some identifier

78-- | Set the identifier group for some identifier

80--

79--

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

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

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

81+setGroup g (Identifier _ p) = Identifier 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'

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

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

36 , parseGlob

37 , predicate

38 , regex

39+ , inGroup

39 , matches

40 , matches

40 , filterMatches

41 , filterMatches

41 , capture

42 , capture

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

106regex :: String -> Pattern

107regex :: String -> Pattern

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

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

108

109

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+

109-- | Check if an identifier matches a pattern

116-- | Check if an identifier matches a pattern

110--

117--

111matches :: Pattern -> Identifier -> Bool

118matches :: Pattern -> Identifier -> Bool

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

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

19 ( RulesM

20 , Rules

21 , match

22+ , group

22 , compile

23 , compile

23 , create

24 , create

24 , route

25 , route

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

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

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

30import Control.Monad.Writer (tell)

31import Control.Monad.Writer (tell)

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

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

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

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

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

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

34import Data.Monoid (mempty, mappend)

35import Data.Monoid (mempty, mappend)

35import qualified Data.Set as S

36import qualified Data.Set as S

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

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

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

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

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

60 -> Rules

61 -> Rules

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

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

67+ tell $ RuleSet mempty compilers' mempty

62 where

68 where

63− compilers' = map (second boxCompiler) compilers

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

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

66-- | Add resources

71-- | Add resources

67--

72--

68tellResources :: [Resource]

73tellResources :: [Resource]

69 -> Rules

74 -> Rules

75+tellResources resources = RulesM $ tell $

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

76+ RuleSet mempty mempty $ S.fromList resources

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

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

73--

79--

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

78 { rulesPattern = rulesPattern env `mappend` pattern

84 { rulesPattern = rulesPattern env `mappend` pattern

79 }

85 }

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+

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

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

82--

95--

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

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

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

112--

125--

113route :: Routes -> Rules

126route :: Routes -> Rules

114route route' = RulesM $ do

127route route' = RulesM $ do

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

129+ -- group

115 pattern <- rulesPattern <$> ask

130 pattern <- rulesPattern <$> ask

131+ group' <- rulesGroup <$> ask

116− unRulesM $ tellRoute $ matchRoute pattern route'

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

117

133

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

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

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

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

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

154 -- Create an identifier from the state

170 -- Create an identifier from the state

155 state <- get

171 state <- get

156 let index = rulesMetaCompilerIndex state

172 let index = rulesMetaCompilerIndex state

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

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

158

174

159 -- Update the state with a new identifier

175 -- Update the state with a new identifier

160 put $ state {rulesMetaCompilerIndex = index + 1}

176 put $ state {rulesMetaCompilerIndex = index + 1}

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

172 -- ^ Compiler generating the other compilers

188 -- ^ Compiler generating the other compilers

173 -> Rules

189 -> Rules

174 -- ^ Resulting rules

190 -- ^ Resulting rules

175−metaCompileWith identifier compiler = RulesM $ tell $

191+metaCompileWith identifier compiler = RulesM $ do

176− RuleSet mempty compilers mempty

192+ group' <- rulesGroup <$> ask

177− where

193+

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

195+ id' = setGroup group' identifier

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

178− makeRule = MetaCompileRule . map (second box)

197+ makeRule = MetaCompileRule . map (second box)

198+ -- Entire boxing function

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

200+ -- Resulting compiler list

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

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

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

202+

203+ tell $ RuleSet mempty compilers mempty

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

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

63data RuleEnvironment = RuleEnvironment

64 { rulesResourceProvider :: ResourceProvider

65 , rulesPattern :: Pattern

66+ , rulesGroup :: Maybe String

66 }

67 }

68-- | The monad used to compose rules

69-- | The monad used to compose rules

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

85 state = RuleState {rulesMetaCompilerIndex = 0}

86 state = RuleState {rulesMetaCompilerIndex = 0}

86 env = RuleEnvironment { rulesResourceProvider = provider

87 env = RuleEnvironment { rulesResourceProvider = provider

87 , rulesPattern = mempty

88 , rulesPattern = mempty

89+ , rulesGroup = Nothing

88 }

90 }