f6c65aa · hakyll · git.iko.soy

git.iko.soy/hakyll

Works-for-me implementation of nested rules

commitf6c65aadd7e07bad9deda2d1d9ecc7ca5610e429 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateMon 4 Apr 2011, 20:49 (16 years ago) parentc8588f1

3 files changed+52−22

compare with master

unifiedsplit

src/Hakyll/Core/Routes.hs+8−9 src/Hakyll/Core/Rules.hs+31−11 src/Hakyll/Core/Rules/Internal.hs+13−2

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

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

3030 , runRoutes

3131 , idRoute

3232 , setExtension

33− , ifMatch

33+ , matchRoute

3434 , customRoute

3535 , gsubRoute

3636 , composeRoutes

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

4141import System.FilePath (replaceExtension)

4242

4343import Hakyll.Core.Identifier

44−import Hakyll.Core.Identifier.Pattern

4544import Hakyll.Core.Util.String

4645

4746-- | Type used for a route

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

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

8685 . unRoutes idRoute

8786

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

89−-- pattern, fail otherwise.

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

88+-- otherwise

9089--

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

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

93− if doesMatch pattern id' then route id'

94− else Nothing

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

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

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

9593

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'

9796--

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

9998customRoute f = Routes $ Just . f

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

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

1414module Hakyll.Core.Rules

1515 ( RulesM

1616 , Rules

17+ , matchPattern

18+ , matchPredicate

1719 , compile

1820 , create

1921 , route

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

2325

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

2527import Control.Monad.Writer (tell)

26−import Control.Monad.Reader (ask)

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

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

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

2931import Data.Monoid (mempty)

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

6365 -> Rules

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

6567

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+

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

6783--

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

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

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

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

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

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

7187--

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

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

74−compile pattern compiler = RulesM $ do

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

89+ => Compiler Resource a -> Rules

90+compile compiler = RulesM $ do

91+ matcher <- rulesMatcher <$> ask

92+ provider <- rulesResourceProvider <$> ask

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

7694 unRulesM $ do

7795 tellCompilers $ flip map identifiers $ \identifier ->

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

7997 tellResources $ map Resource identifiers

80−

98+

8199-- | Add a compilation rule

82100--

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

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

91109

92110-- | Add a route.

93111--

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

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

95113--

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

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

114+route :: Routes -> Rules

115+route route' = RulesM $ do

116+ matcher <- rulesMatcher <$> ask

117+ unRulesM $ tellRoute $ matchRoute matcher route'

98118

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

100120-- 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

55 ( CompileRule (..)

66 , RuleSet (..)

77 , RuleState (..)

8+ , RuleEnvironment (..)

89 , RulesM (..)

910 , Rules

1011 , runRules

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

5556 { rulesMetaCompilerIndex :: Int

5657 } deriving (Show)

5758

59+-- | Rule environment

60+--

61+data RuleEnvironment = RuleEnvironment

62+ { rulesResourceProvider :: ResourceProvider

63+ , rulesMatcher :: Identifier -> Bool

64+ }

65+

5866-- | The monad used to compose rules

5967--

6068newtype RulesM a = RulesM

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

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

6270 } deriving (Monad, Functor, Applicative)

6371

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

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

7078--

7179runRules :: Rules -> ResourceProvider -> RuleSet

7280runRules rules provider =

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

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

7482 where

7583 state = RuleState {rulesMetaCompilerIndex = 0}

84+ env = RuleEnvironment { rulesResourceProvider = provider

85+ , rulesMatcher = const True

86+ }