f6c65aa · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Works-for-me implementation of nested rules

f6c65aaJasper Van der Jeugt16 years ago

src/Hakyll/Core/Routes.hs+8−9

compare with master

unifiedsplit

@@ -30,7 +30,7 @@ module Hakyll.Core.Routes

30 , runRoutes

31 , idRoute

32 , setExtension

33− , ifMatch

33+ , matchRoute

34 , customRoute

35 , gsubRoute

36 , composeRoutes

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

41import System.FilePath (replaceExtension)

43import Hakyll.Core.Identifier

44−import Hakyll.Core.Identifier.Pattern

45import Hakyll.Core.Util.String

44import Hakyll.Core.Util.String

47-- | Type used for a route

46-- | Type used for a route

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

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

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

86 . unRoutes idRoute

85 . unRoutes idRoute

88−-- | Modify a route: apply the route if the identifier matches the given

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

89−-- pattern, fail otherwise.

88+-- otherwise

90--

89--

91−ifMatch :: Pattern -> Routes -> Routes

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

92−ifMatch pattern (Routes route) = Routes $ \id' ->

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

93− if doesMatch pattern id' then route id'

94− else Nothing

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

96−-- | Create a custom route. This should almost always be used with 'ifMatch'.

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

95+-- 'matchRoute'

97--

96--

98customRoute :: (Identifier -> FilePath) -> Routes

97customRoute :: (Identifier -> FilePath) -> Routes

99customRoute f = Routes $ Just . f

98customRoute f = Routes $ Just . f

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

@@ -14,6 +14,8 @@

14module Hakyll.Core.Rules

15 ( RulesM

16 , Rules

17+ , matchPattern

18+ , matchPredicate

17 , compile

19 , compile

18 , create

20 , create

19 , route

21 , route

@@ -23,7 +25,7 @@ module Hakyll.Core.Rules

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

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

25import Control.Monad.Writer (tell)

27import Control.Monad.Writer (tell)

26−import Control.Monad.Reader (ask)

28+import Control.Monad.Reader (ask, local)

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

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

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

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

29import Data.Monoid (mempty)

31import Data.Monoid (mempty)

@@ -63,21 +65,37 @@ tellResources :: [Resource]

63 -> Rules

65 -> Rules

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

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

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

69+--

70+matchPattern :: Pattern -> Rules -> Rules

71+matchPattern pattern = matchPredicate (doesMatch pattern)

72+

73+-- | Only compile/route items satisfying the given predicate

74+--

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

76+matchPredicate predicate = RulesM . local addPredicate . unRulesM

77+ where

78+ addPredicate env = env

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

80+ }

81+

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

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

67--

83--

68−-- This instructs all resources matching the given pattern to be compiled using

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

69−-- the given compiler. When no resources match the given pattern, nothing will

85+-- no resources match the current selection, nothing will happen. In this case,

70−-- happen. In this case, you might want to have a look at 'create'.

86+-- you might want to have a look at 'create'.

71--

87--

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

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

73− => Pattern -> Compiler Resource a -> Rules

89+ => Compiler Resource a -> Rules

74−compile pattern compiler = RulesM $ do

90+compile compiler = RulesM $ do

91+ matcher <- rulesMatcher <$> ask

92+ provider <- rulesResourceProvider <$> ask

75− identifiers <- matches pattern . map unResource . resourceList <$> ask

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

76 unRulesM $ do

94 unRulesM $ do

77 tellCompilers $ flip map identifiers $ \identifier ->

95 tellCompilers $ flip map identifiers $ \identifier ->

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

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

79 tellResources $ map Resource identifiers

97 tellResources $ map Resource identifiers

80−

98+

81-- | Add a compilation rule

99-- | Add a compilation rule

82--

100--

83-- This sets a compiler for the given identifier. No resource is needed, since

101-- This sets a compiler for the given identifier. No resource is needed, since

@@ -91,10 +109,12 @@ create identifier compiler = tellCompilers [(identifier, compiler)]

109

92-- | Add a route.

110-- | Add a route.

93--

111--

94−-- This adds a route for all items matching the given pattern.

112+-- This adds a route for all items matching the current pattern.

95--

113--

96−route :: Pattern -> Routes -> Rules

114+route :: Routes -> Rules

97−route pattern route' = tellRoute $ ifMatch pattern route'

115+route route' = RulesM $ do

116+ matcher <- rulesMatcher <$> ask

117+ unRulesM $ tellRoute $ matchRoute matcher route'

118

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

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

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

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

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

@@ -5,6 +5,7 @@ module Hakyll.Core.Rules.Internal

5 ( CompileRule (..)

6 , RuleSet (..)

7 , RuleState (..)

8+ , RuleEnvironment (..)

8 , RulesM (..)

9 , RulesM (..)

9 , Rules

10 , Rules

10 , runRules

11 , runRules

@@ -55,10 +56,17 @@ data RuleState = RuleState

55 { rulesMetaCompilerIndex :: Int

56 { rulesMetaCompilerIndex :: Int

56 } deriving (Show)

57 } deriving (Show)

59+-- | Rule environment

60+--

61+data RuleEnvironment = RuleEnvironment

62+ { rulesResourceProvider :: ResourceProvider

63+ , rulesMatcher :: Identifier -> Bool

64+ }

65+

58-- | The monad used to compose rules

66-- | The monad used to compose rules

59--

67--

60newtype RulesM a = RulesM

68newtype RulesM a = RulesM

61− { unRulesM :: ReaderT ResourceProvider (WriterT RuleSet (State RuleState)) a

69+ { unRulesM :: ReaderT RuleEnvironment (WriterT RuleSet (State RuleState)) a

62 } deriving (Monad, Functor, Applicative)

70 } deriving (Monad, Functor, Applicative)

64-- | Simplification of the RulesM type; usually, it will not return any

72-- | Simplification of the RulesM type; usually, it will not return any

@@ -70,6 +78,9 @@ type Rules = RulesM ()

70--

78--

71runRules :: Rules -> ResourceProvider -> RuleSet

79runRules :: Rules -> ResourceProvider -> RuleSet

72runRules rules provider =

80runRules rules provider =

73− evalState (execWriterT $ runReaderT (unRulesM rules) provider) state

81+ evalState (execWriterT $ runReaderT (unRulesM rules) env) state

74 where

82 where

75 state = RuleState {rulesMetaCompilerIndex = 0}

83 state = RuleState {rulesMetaCompilerIndex = 0}

84+ env = RuleEnvironment { rulesResourceProvider = provider

85+ , rulesMatcher = const True

86+ }