dac3fac · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Rules will be in IO...

dac3facJasper Van der Jeugt14 years ago

hakyll.cabal+4−4

compare with master

unifiedsplit

@@ -101,10 +101,6 @@ Library

101 Hakyll.Core.Logger

102 Hakyll.Core.Resource

103 Hakyll.Core.Resource.Provider

104− Hakyll.Core.Resource.Provider.Internal

105− Hakyll.Core.Resource.Metadata

106− Hakyll.Core.Resource.MetadataCache

107− Hakyll.Core.Resource.Modified

108 Hakyll.Core.Routes

104 Hakyll.Core.Routes

109 Hakyll.Core.Rules

105 Hakyll.Core.Rules

110 Hakyll.Core.Run

106 Hakyll.Core.Run

@@ -136,6 +132,10 @@ Library

136 Other-Modules:

132 Other-Modules:

137 Hakyll.Core.Compiler.Internal

133 Hakyll.Core.Compiler.Internal

138 Hakyll.Core.DirectedGraph.Internal

134 Hakyll.Core.DirectedGraph.Internal

135+ Hakyll.Core.Resource.Metadata

136+ Hakyll.Core.Resource.MetadataCache

137+ Hakyll.Core.Resource.Modified

138+ Hakyll.Core.Resource.Provider.Internal

139 Hakyll.Core.Rules.Internal

140 Hakyll.Web.Page.Internal

141 Hakyll.Web.Template.Internal

src/Hakyll/Core/Resource/Modified.hs+1−1

@@ -42,7 +42,7 @@ resourceModified rp r

42 <*> resourceModified rp (resourceMetadataResource r)

43 modifyIORef cacheRef (M.insert r m)

45− -- Important!

45+ -- Important! (But ugly)

46 when m $ resourceInvalidateMetadataCache rp r

48 return m

src/Hakyll/Core/Rules.hs+57−38

@@ -1,3 +1,4 @@

1+--------------------------------------------------------------------------------

1-- | This module provides a declarative DSL in which the user can specify the

2-- | This module provides a declarative DSL in which the user can specify the

2-- different rules used to run the compilers.

3-- different rules used to run the compilers.

3--

4--

@@ -13,8 +14,8 @@

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

14-- > match "css/*" $ do

14-- > route idRoute

15-- > route idRoute

15-- > compile compressCssCompiler

16-- > compile compressCssCompiler

16−--

17+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

17−{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}

18+{-# LANGUAGE OverloadedStrings #-}

18module Hakyll.Core.Rules

19module Hakyll.Core.Rules

19 ( RulesM

20 ( RulesM

20 , Rules

21 , Rules

@@ -29,35 +30,43 @@ module Hakyll.Core.Rules

29 , freshIdentifier

30 , freshIdentifier

30 ) where

31 ) where

32−import Control.Applicative ((<$>))

33−import Control.Monad.Writer (tell)

34−import Control.Monad.Reader (ask, local)

35−import Control.Arrow ((>>>), arr, (>>^), (***))

36−import Control.Monad.State (get, put)

37−import Data.Monoid (mempty, mappend)

38−import qualified Data.Set as S

39−

40−import Data.Typeable (Typeable)

41−import Data.Binary (Binary)

42−

43−import Hakyll.Core.Resource

44−import Hakyll.Core.Resource.Provider

45−import Hakyll.Core.Identifier

46−import Hakyll.Core.Identifier.Pattern

47−import Hakyll.Core.Compiler.Internal

48−import Hakyll.Core.Routes

49−import Hakyll.Core.CompiledItem

50−import Hakyll.Core.Writable

51−import Hakyll.Core.Rules.Internal

52−import Hakyll.Core.Util.Arrow

34+--------------------------------------------------------------------------------

35+import Control.Applicative ((<$>))

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

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

38+import Control.Monad.State (get, put)

39+import Control.Monad.Writer (tell)

40+import Data.Monoid (mappend, mempty)

41+import qualified Data.Set as S

42+

43+

44+--------------------------------------------------------------------------------

45+import Data.Binary (Binary)

46+import Data.Typeable (Typeable)

47+

48+

49+--------------------------------------------------------------------------------

50+import Hakyll.Core.CompiledItem

51+import Hakyll.Core.Compiler.Internal

52+import Hakyll.Core.Identifier

53+import Hakyll.Core.Identifier.Pattern

54+import Hakyll.Core.Resource

55+import Hakyll.Core.Resource.Provider

56+import Hakyll.Core.Routes

57+import Hakyll.Core.Rules.Internal

58+import Hakyll.Core.Util.Arrow

59+import Hakyll.Core.Writable

60+

61+

62+--------------------------------------------------------------------------------

54-- | Add a route

63-- | Add a route

55−--

56tellRoute :: Routes -> Rules

64tellRoute :: Routes -> Rules

57tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty

65tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty

67+

68+--------------------------------------------------------------------------------

59-- | Add a number of compilers

69-- | Add a number of compilers

60−--

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

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

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

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

63 -> Rules

72 -> Rules

@@ -68,15 +77,17 @@ tellCompilers compilers = RulesM $ do

68 where

77 where

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

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

80+

81+--------------------------------------------------------------------------------

71-- | Add resources

82-- | Add resources

72−--

73tellResources :: [Resource]

83tellResources :: [Resource]

74 -> Rules

84 -> Rules

75tellResources resources' = RulesM $ tell $

85tellResources resources' = RulesM $ tell $

76 RuleSet mempty mempty $ S.fromList resources'

86 RuleSet mempty mempty $ S.fromList resources'

88+

89+--------------------------------------------------------------------------------

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

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

79−--

80match :: Pattern a -> RulesM b -> RulesM b

91match :: Pattern a -> RulesM b -> RulesM b

81match pattern = RulesM . local addPredicate . unRulesM

92match pattern = RulesM . local addPredicate . unRulesM

82 where

93 where

@@ -84,8 +95,9 @@ match pattern = RulesM . local addPredicate . unRulesM

84 { rulesPattern = rulesPattern env `mappend` castPattern pattern

95 { rulesPattern = rulesPattern env `mappend` castPattern pattern

85 }

96 }

98+

99+--------------------------------------------------------------------------------

87-- | Greate a group of compilers

100-- | Greate a group of compilers

88−--

89-- Imagine you have a page that you want to render, but you also want the raw

101-- Imagine you have a page that you want to render, but you also want the raw

90-- content available on your site.

102-- content available on your site.

91--

103--

@@ -114,18 +126,18 @@ match pattern = RulesM . local addPredicate . unRulesM

114--

126--

115-- This will put the compiler for the raw content in a separate group

127-- This will put the compiler for the raw content in a separate group

116-- (@\"raw\"@), which causes it to be compiled as well.

128-- (@\"raw\"@), which causes it to be compiled as well.

117−--

118group :: String -> RulesM a -> RulesM a

129group :: String -> RulesM a -> RulesM a

119group g = RulesM . local setGroup' . unRulesM

130group g = RulesM . local setGroup' . unRulesM

120 where

131 where

121 setGroup' env = env { rulesGroup = Just g }

132 setGroup' env = env { rulesGroup = Just g }

122

133

134+

135+--------------------------------------------------------------------------------

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

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

124--

137--

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

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

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

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

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

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

128−--

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

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

130 => Compiler Resource a -> RulesM (Pattern a)

142 => Compiler Resource a -> RulesM (Pattern a)

131compile compiler = do

143compile compiler = do

@@ -134,7 +146,9 @@ compile compiler = do

134 (identifier, constA (fromIdentifier identifier) >>> compiler)

146 (identifier, constA (fromIdentifier identifier) >>> compiler)

135 tellResources $ map fromIdentifier ids

147 tellResources $ map fromIdentifier ids

136 return $ list ids

148 return $ list ids

137−

149+

150+

151+--------------------------------------------------------------------------------

138-- | Add a compilation rule

152-- | Add a compilation rule

139--

153--

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

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

@@ -143,7 +157,6 @@ compile compiler = do

143-- actual content itself. Note that the group of the given identifier is

157-- actual content itself. Note that the group of the given identifier is

144-- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been

158-- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been

145-- used).

159-- used).

146−--

147create :: (Binary a, Typeable a, Writable a)

160create :: (Binary a, Typeable a, Writable a)

148 => Identifier a -> Compiler () a -> RulesM (Identifier a)

161 => Identifier a -> Compiler () a -> RulesM (Identifier a)

149create id' compiler = RulesM $ do

162create id' compiler = RulesM $ do

@@ -152,10 +165,11 @@ create id' compiler = RulesM $ do

152 unRulesM $ tellCompilers [(id'', compiler)]

165 unRulesM $ tellCompilers [(id'', compiler)]

153 return id''

166 return id''

154

167

168+

169+--------------------------------------------------------------------------------

155-- | Add a route.

170-- | Add a route.

156--

171--

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

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

158−--

159route :: Routes -> Rules

173route :: Routes -> Rules

160route route' = RulesM $ do

174route route' = RulesM $ do

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

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

@@ -164,9 +178,10 @@ route route' = RulesM $ do

164 group' <- rulesGroup <$> ask

178 group' <- rulesGroup <$> ask

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

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

166

180

181+

182+--------------------------------------------------------------------------------

167-- | Get a list of resources matching the current pattern. This will also set

183-- | Get a list of resources matching the current pattern. This will also set

168-- the correct group to the identifiers.

184-- the correct group to the identifiers.

169−--

170resources :: RulesM [Identifier a]

185resources :: RulesM [Identifier a]

171resources = RulesM $ do

186resources = RulesM $ do

172 pattern <- rulesPattern <$> ask

187 pattern <- rulesPattern <$> ask

@@ -176,6 +191,8 @@ resources = RulesM $ do

176 where

191 where

177 toId g = setGroup g . toIdentifier

192 toId g = setGroup g . toIdentifier

178

193

194+

195+--------------------------------------------------------------------------------

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

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

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

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

181-- produce other compilers.

198-- produce other compilers.

@@ -205,9 +222,8 @@ resources = RulesM $ do

205-- For simple hakyll systems, it is no need for this construction. More

222-- For simple hakyll systems, it is no need for this construction. More

206-- formally, it is only needed when the content of one or more items determines

223-- formally, it is only needed when the content of one or more items determines

207-- which items must be rendered.

224-- which items must be rendered.

208−--

209metaCompile :: (Binary a, Typeable a, Writable a)

225metaCompile :: (Binary a, Typeable a, Writable a)

210− => Compiler () [(Identifier a, Compiler () a)]

226+ => Compiler () [(Identifier a, Compiler () a)]

211 -- ^ Compiler generating the other compilers

227 -- ^ Compiler generating the other compilers

212 -> Rules

228 -> Rules

213 -- ^ Resulting rules

229 -- ^ Resulting rules

@@ -215,13 +231,14 @@ metaCompile compiler = do

215 id' <- freshIdentifier "Hakyll.Core.Rules.metaCompile"

231 id' <- freshIdentifier "Hakyll.Core.Rules.metaCompile"

216 metaCompileWith id' compiler

232 metaCompileWith id' compiler

217

233

234+

235+--------------------------------------------------------------------------------

218-- | Version of 'metaCompile' that allows you to specify a custom identifier for

236-- | Version of 'metaCompile' that allows you to specify a custom identifier for

219-- the metacompiler.

237-- the metacompiler.

220−--

221metaCompileWith :: (Binary a, Typeable a, Writable a)

238metaCompileWith :: (Binary a, Typeable a, Writable a)

222 => Identifier ()

239 => Identifier ()

223 -- ^ Identifier for this compiler

240 -- ^ Identifier for this compiler

224− -> Compiler () [(Identifier a, Compiler () a)]

241+ -> Compiler () [(Identifier a, Compiler () a)]

225 -- ^ Compiler generating the other compilers

242 -- ^ Compiler generating the other compilers

226 -> Rules

243 -> Rules

227 -- ^ Resulting rules

244 -- ^ Resulting rules

@@ -239,6 +256,8 @@ metaCompileWith identifier compiler = RulesM $ do

239

256

240 tell $ RuleSet mempty compilers mempty

257 tell $ RuleSet mempty compilers mempty

241

258

259+

260+--------------------------------------------------------------------------------

242-- | Generate a fresh Identifier with a given prefix

261-- | Generate a fresh Identifier with a given prefix

243freshIdentifier :: String -- ^ Prefix

262freshIdentifier :: String -- ^ Prefix

244 -> RulesM (Identifier a) -- ^ Fresh identifier

263 -> RulesM (Identifier a) -- ^ Fresh identifier

src/Hakyll/Core/Rules/Internal.hs+48−33

@@ -1,6 +1,7 @@

1+--------------------------------------------------------------------------------

1-- | Internal rules module for types which are not exposed to the user

2-- | Internal rules module for types which are not exposed to the user

2−--

3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3−{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-}

4+{-# LANGUAGE Rank2Types #-}

4module Hakyll.Core.Rules.Internal

5module Hakyll.Core.Rules.Internal

5 ( CompileRule (..)

6 ( CompileRule (..)

6 , RuleSet (..)

7 , RuleSet (..)

@@ -11,34 +12,38 @@ module Hakyll.Core.Rules.Internal

11 , runRules

12 , runRules

12 ) where

13 ) where

14−import Control.Applicative (Applicative)

15−import Control.Monad.Writer (WriterT, execWriterT)

16−import Control.Monad.Reader (ReaderT, runReaderT)

17−import Control.Monad.State (State, evalState)

18−import Data.Monoid (Monoid, mempty, mappend)

19−import Data.Set (Set)

20−import qualified Data.Map as M

21−

22−import Hakyll.Core.Resource

23−import Hakyll.Core.Resource.Provider

24−import Hakyll.Core.Identifier

25−import Hakyll.Core.Identifier.Pattern

26−import Hakyll.Core.Compiler.Internal

27−import Hakyll.Core.Routes

28−import Hakyll.Core.CompiledItem

16+--------------------------------------------------------------------------------

17+import Control.Applicative (Applicative)

18+import Control.Monad.RWS (RWST, runRWST)

19+import qualified Data.Map as M

20+import Data.Monoid (Monoid, mappend, mempty)

21+import Data.Set (Set)

22+

23+

24+--------------------------------------------------------------------------------

25+import Hakyll.Core.CompiledItem

26+import Hakyll.Core.Compiler.Internal

27+import Hakyll.Core.Identifier

28+import Hakyll.Core.Identifier.Pattern

29+import Hakyll.Core.Resource

30+import Hakyll.Core.Resource.Provider

31+import Hakyll.Core.Routes

32+

33+

34+--------------------------------------------------------------------------------

30-- | Output of a compiler rule

35-- | Output of a compiler rule

31--

36--

32-- * The compiler will produce a simple item. This is the most common case.

37-- * The compiler will produce a simple item. This is the most common case.

33--

38--

34-- * The compiler will produce more compilers. These new compilers need to be

39-- * The compiler will produce more compilers. These new compilers need to be

35-- added to the runtime if possible, since other items might depend upon them.

40-- added to the runtime if possible, since other items might depend upon them.

36−--

37data CompileRule = CompileRule CompiledItem

41data CompileRule = CompileRule CompiledItem

38 | MetaCompileRule [(Identifier (), Compiler () CompileRule)]

42 | MetaCompileRule [(Identifier (), Compiler () CompileRule)]

44+

45+--------------------------------------------------------------------------------

40-- | A collection of rules for the compilation process

46-- | A collection of rules for the compilation process

41−--

42data RuleSet = RuleSet

47data RuleSet = RuleSet

43 { -- | Routes used in the compilation structure

48 { -- | Routes used in the compilation structure

44 rulesRoutes :: Routes

49 rulesRoutes :: Routes

@@ -48,51 +53,61 @@ data RuleSet = RuleSet

48 rulesResources :: Set Resource

53 rulesResources :: Set Resource

49 }

54 }

56+

57+--------------------------------------------------------------------------------

51instance Monoid RuleSet where

58instance Monoid RuleSet where

52 mempty = RuleSet mempty mempty mempty

59 mempty = RuleSet mempty mempty mempty

53 mappend (RuleSet r1 c1 s1) (RuleSet r2 c2 s2) =

60 mappend (RuleSet r1 c1 s1) (RuleSet r2 c2 s2) =

54 RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2)

61 RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2)

63+

64+--------------------------------------------------------------------------------

56-- | Rule state

65-- | Rule state

57−--

58data RuleState = RuleState

66data RuleState = RuleState

59 { rulesNextIdentifier :: Int

67 { rulesNextIdentifier :: Int

60 } deriving (Show)

68 } deriving (Show)

70+

71+--------------------------------------------------------------------------------

62-- | Rule environment

72-- | Rule environment

63−--

64data RuleEnvironment = RuleEnvironment

73data RuleEnvironment = RuleEnvironment

65 { rulesResourceProvider :: ResourceProvider

74 { rulesResourceProvider :: ResourceProvider

66 , rulesPattern :: forall a. Pattern a

75 , rulesPattern :: forall a. Pattern a

67 , rulesGroup :: Maybe String

76 , rulesGroup :: Maybe String

68 }

77 }

79+

80+--------------------------------------------------------------------------------

70-- | The monad used to compose rules

81-- | The monad used to compose rules

71−--

72newtype RulesM a = RulesM

82newtype RulesM a = RulesM

73− { unRulesM :: ReaderT RuleEnvironment (WriterT RuleSet (State RuleState)) a

83+ { unRulesM :: RWST RuleEnvironment RuleSet RuleState IO a

74 } deriving (Monad, Functor, Applicative)

84 } deriving (Monad, Functor, Applicative)

86+

87+--------------------------------------------------------------------------------

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

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

77-- result.

89-- result.

78−--

79type Rules = RulesM ()

90type Rules = RulesM ()

92+

93+--------------------------------------------------------------------------------

81-- | Run a Rules monad, resulting in a 'RuleSet'

94-- | Run a Rules monad, resulting in a 'RuleSet'

82−--

83−runRules :: RulesM a -> ResourceProvider -> RuleSet

95+runRules :: RulesM a -> ResourceProvider -> IO RuleSet

84−runRules rules provider = nubCompilers $

96+runRules rules provider = do

85− evalState (execWriterT $ runReaderT (unRulesM rules) env) state

97+ (_, _, ruleSet) <- runRWST (unRulesM rules) env state

98+ return $ nubCompilers ruleSet

86 where

99 where

87 state = RuleState {rulesNextIdentifier = 0}

100 state = RuleState {rulesNextIdentifier = 0}

101+ env = RuleEnvironment

88− env = RuleEnvironment { rulesResourceProvider = provider

102+ { rulesResourceProvider = provider

89− , rulesPattern = mempty

103+ , rulesPattern = mempty

90− , rulesGroup = Nothing

104+ , rulesGroup = Nothing

91− }

105+ }

106

107+

108+--------------------------------------------------------------------------------

93-- | Remove duplicate compilers from the 'RuleSet'. When two compilers match an

109-- | Remove duplicate compilers from the 'RuleSet'. When two compilers match an

94-- item, we prefer the first one

110-- item, we prefer the first one

95−--

96nubCompilers :: RuleSet -> RuleSet

111nubCompilers :: RuleSet -> RuleSet

97nubCompilers set = set { rulesCompilers = nubCompilers' (rulesCompilers set) }

112nubCompilers set = set { rulesCompilers = nubCompilers' (rulesCompilers set) }

98 where

113 where

src/Hakyll/Core/Run.hs+2−2

@@ -52,8 +52,8 @@ run configuration rules = do

52 let (firstRun, oldGraph) = case graph of Store.Found g -> (False, g)

53 _ -> (True, mempty)

55− let ruleSet = runRules rules provider

55+ ruleSet <- timed logger "Running rules" $ runRules rules provider

56− compilers = rulesCompilers ruleSet

56+ let compilers = rulesCompilers ruleSet

58 -- Extract the reader/state

59 reader = unRuntime $ addNewCompilers compilers