ff118fe · hakyll · git.iko.soy

git.iko.soy/hakyll

Simplify match implementation(s)

commitff118fec98ef02e2eead2a752d9c6619a2e891df authorJasper Van der Jeugt <jaspervdj@gmail.com> dateTue 5 Apr 2011, 11:58 (16 years ago) parent4925dd8

3 files changed+25−25

compare with master

unifiedsplit

src/Hakyll/Core/Routes.hs+5−4 src/Hakyll/Core/Rules.hs+17−19 src/Hakyll/Core/Rules/Internal.hs+3−2

src/Hakyll/Core/Routes.hs+5−4

@@ -41,6 +41,7 @@ import Control.Monad (mplus)

4141import System.FilePath (replaceExtension)

4242

4343import Hakyll.Core.Identifier

44+import Hakyll.Core.Identifier.Pattern

4445import Hakyll.Core.Util.String

4546

4647-- | Type used for a route

@@ -84,12 +85,12 @@ setExtension :: String -> Routes

8485setExtension extension = Routes $ fmap (`replaceExtension` extension)

8586 . unRoutes idRoute

8687

87−-- | Apply the route if the identifier matches the given predicate, fail

88+-- | Apply the route if the identifier matches the given pattern, fail

8889-- otherwise

8990--

90−matchRoute :: (Identifier -> Bool) -> Routes -> Routes

91−matchRoute predicate (Routes route) = Routes $ \id' ->

92− if predicate id' then route id' else Nothing

91+matchRoute :: Pattern -> Routes -> Routes

92+matchRoute pattern (Routes route) = Routes $ \id' ->

93+ if matches pattern id' then route id' else Nothing

9394

9495-- | Create a custom route. This should almost always be used with

9596-- 'matchRoute'

src/Hakyll/Core/Rules.hs+17−19

@@ -7,15 +7,18 @@

77-- A typical usage example would be:

88--

99-- > main = hakyll $ do

10−-- > route "posts/*" (setExtension "html")

11−-- > compile "posts/*" someCompiler

10+-- > match "posts/*" $ do

11+-- > route (setExtension "html")

12+-- > compile someCompiler

13+-- > match "css/*" $ do

14+-- > route idRoute

15+-- > compile compressCssCompiler

1216--

1317{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}

1418module Hakyll.Core.Rules

1519 ( RulesM

1620 , Rules

17− , matchPattern

18− , matchPredicate

21+ , match

1922 , compile

2023 , create

2124 , route

@@ -28,7 +31,7 @@ import Control.Monad.Writer (tell)

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

2932import Control.Arrow (second, (>>>), arr, (>>^))

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

31−import Data.Monoid (mempty)

34+import Data.Monoid (mempty, mappend)

3235import qualified Data.Set as S

3336

3437import Data.Typeable (Typeable)

@@ -65,18 +68,13 @@ tellResources :: [Resource]

6568 -> Rules

6669tellResources resources = RulesM $ tell $ RuleSet mempty mempty $ S.fromList resources

6770

68−-- | Only compile/route items matching the given pattern

69−--

70−matchPattern :: Pattern -> Rules -> Rules

71−matchPattern pattern = matchPredicate (doesMatch pattern)

72−

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

7472--

75−matchPredicate :: (Identifier -> Bool) -> Rules -> Rules

76−matchPredicate predicate = RulesM . local addPredicate . unRulesM

73+match :: Pattern -> Rules -> Rules

74+match pattern = RulesM . local addPredicate . unRulesM

7775 where

7876 addPredicate env = env

79− { rulesMatcher = \id' -> rulesMatcher env id' && predicate id'

77+ { rulesPattern = rulesPattern env `mappend` pattern

8078 }

8179

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

@@ -88,13 +86,13 @@ matchPredicate predicate = RulesM . local addPredicate . unRulesM

8886compile :: (Binary a, Typeable a, Writable a)

8987 => Compiler Resource a -> Rules

9088compile compiler = RulesM $ do

91− matcher <- rulesMatcher <$> ask

89+ pattern <- rulesPattern <$> ask

9290 provider <- rulesResourceProvider <$> ask

93− let identifiers = filter matcher $ map unResource $ resourceList provider

91+ let ids = filterMatches pattern $ map unResource $ resourceList provider

9492 unRulesM $ do

95− tellCompilers $ flip map identifiers $ \identifier ->

93+ tellCompilers $ flip map ids $ \identifier ->

9694 (identifier, constA (Resource identifier) >>> compiler)

97− tellResources $ map Resource identifiers

95+ tellResources $ map Resource ids

9896

9997-- | Add a compilation rule

10098--

@@ -113,8 +111,8 @@ create identifier compiler = tellCompilers [(identifier, compiler)]

113111--

114112route :: Routes -> Rules

115113route route' = RulesM $ do

116− matcher <- rulesMatcher <$> ask

117− unRulesM $ tellRoute $ matchRoute matcher route'

114+ pattern <- rulesPattern <$> ask

115+ unRulesM $ tellRoute $ matchRoute pattern route'

118116

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

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

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

@@ -20,6 +20,7 @@ import Data.Set (Set)

2020

2121import Hakyll.Core.ResourceProvider

2222import Hakyll.Core.Identifier

23+import Hakyll.Core.Identifier.Pattern

2324import Hakyll.Core.Compiler.Internal

2425import Hakyll.Core.Routes

2526import Hakyll.Core.CompiledItem

@@ -60,7 +61,7 @@ data RuleState = RuleState

6061--

6162data RuleEnvironment = RuleEnvironment

6263 { rulesResourceProvider :: ResourceProvider

63− , rulesMatcher :: Identifier -> Bool

64+ , rulesPattern :: Pattern

6465 }

6566

6667-- | The monad used to compose rules

@@ -82,5 +83,5 @@ runRules rules provider =

8283 where

8384 state = RuleState {rulesMetaCompilerIndex = 0}

8485 env = RuleEnvironment { rulesResourceProvider = provider

85− , rulesMatcher = const True

86+ , rulesPattern = mempty

8687 }