6e7a80e · hakyll · git.iko.soy

git.iko.soy/hakyll

Simpler rules

commit6e7a80e8a3a4ac5d77a2f520cd8ecc1aba6f32ef authorJasper Van der Jeugt <m@jaspervdj.be> dateSat 24 Nov 2012, 13:34 (14 years ago) parent0a6b2b2

6 files changed+59−61

compare with master

unifiedsplit

src/Hakyll/Core/Identifier/Pattern.hs+27−3 src/Hakyll/Core/Rules.hs+10−39 src/Hakyll/Core/Rules/Internal.hs+4−13 tests/Hakyll/Core/Identifier/Tests.hs+12−1 tests/Hakyll/Core/Runtime/Tests.hs+5−4 tests/TestSuite/Util.hs+1−1

src/Hakyll/Core/Identifier/Pattern.hs+27−3

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

4848 -- * Manipulating patterns

4949 , complement

5050 , withVersion

51+ , fromLiteral

5152

5253 -- * Applying patterns

5354 , matches

@@ -143,8 +144,18 @@ instance IsString Pattern where

143144

144145--------------------------------------------------------------------------------

145146instance Monoid Pattern where

146− mempty = Everything

147− mappend = And

147+ mempty = Everything

148+ mappend x y = optimize $ And x y

149+

150+

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

152+-- | THis is necessary for good 'isLiteral' results

153+optimize :: Pattern -> Pattern

154+optimize (Complement x) = Complement (optimize x)

155+optimize (And x Everything) = x

156+optimize (And Everything y) = y

157+optimize (And x y) = And (optimize x) (optimize y)

158+optimize p = p

148159

149160

150161--------------------------------------------------------------------------------

@@ -197,7 +208,20 @@ complement = Complement

197208--

198209-- > "foo/*.markdown" `withVersion` "pdf"

199210withVersion :: Pattern -> String -> Pattern

200−withVersion p v = And p $ fromVersion $ Just v

211+withVersion p v = optimize $ And p $ fromVersion $ Just v

212+

213+

214+--------------------------------------------------------------------------------

215+-- | Check if a pattern is a literal. @"*.markdown"@ is not a literal but

216+-- @"posts.markdown"@ is.

217+fromLiteral :: Pattern -> Maybe Identifier

218+fromLiteral pattern = case pattern of

219+ Glob p -> fmap fromFilePath $ foldr fromLiteral' (Just "") p

220+ _ -> Nothing

221+ where

222+ fromLiteral' (Literal x) (Just y) = Just $ x ++ y

223+ fromLiteral' _ _ = Nothing

224+

201225

202226

203227--------------------------------------------------------------------------------

src/Hakyll/Core/Rules.hs+10−39

@@ -21,10 +21,7 @@ module Hakyll.Core.Rules

2121 , match

2222 , group

2323 , compile

24− , create

2524 , route

26− , resources

27− , freshIdentifier

2825 ) where

2926

3027

@@ -32,7 +29,6 @@ module Hakyll.Core.Rules

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

3330import Control.Arrow (second)

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

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

3632import Control.Monad.Writer (tell)

3733import Data.Monoid (mappend, mempty)

3834import qualified Data.Set as S

@@ -81,11 +77,10 @@ tellResources resources' = Rules $ tell $

8177

8278

8379--------------------------------------------------------------------------------

84−-- | Only compile/route items satisfying the given predicate

8580match :: Pattern -> Rules b -> Rules b

86−match pattern = Rules . local addPredicate . unRules

81+match pattern = Rules . local addPattern . unRules

8782 where

88− addPredicate env = env

83+ addPattern env = env

8984 { rulesPattern = rulesPattern env `mappend` pattern

9085 }

9186

@@ -135,26 +130,15 @@ group g = Rules . local setVersion' . unRules

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

136131 => Compiler (Item a) -> Rules ()

137132compile compiler = do

138− ids <- resources

139− tellCompilers [(id', compiler) | id' <- ids]

140− tellResources ids

141−

133+ pattern <- Rules $ rulesPattern <$> ask

134+ ids <- case fromLiteral pattern of

135+ Just id' -> return [id']

136+ Nothing -> do

137+ ids <- resources

138+ tellResources ids

139+ return ids

142140

143−--------------------------------------------------------------------------------

144−-- | Add a compilation rule

145−--

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

147−-- we are creating the item from scratch. This is useful if you want to create a

148−-- page on your site that just takes content from other items -- but has no

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

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

151−-- used).

152−create :: (Binary a, Typeable a, Writable a)

153− => Identifier -> Compiler (Item a) -> Rules ()

154−create id' compiler = Rules $ do

155− version' <- rulesVersion <$> ask

156− let id'' = setVersion version' id'

157− unRules $ tellCompilers [(id'', compiler)]

141+ tellCompilers [(id', compiler) | id' <- ids]

158142

159143

160144--------------------------------------------------------------------------------

@@ -181,16 +165,3 @@ resources = Rules $ do

181165 provider <- rulesProvider <$> ask

182166 g <- rulesVersion <$> ask

183167 return $ filterMatches pattern $ map (setVersion g) $ resourceList provider

184−

185−

186−--------------------------------------------------------------------------------

187−-- | Generate a fresh Identifier with a given prefix

188−-- TODO: remove?

189−freshIdentifier :: String -- ^ Prefix

190− -> Rules Identifier -- ^ Fresh identifier

191−freshIdentifier prefix = Rules $ do

192− state <- get

193− let index = rulesNextIdentifier state

194− id' = fromFilePath $ prefix ++ "/" ++ show index

195− put $ state {rulesNextIdentifier = index + 1}

196− return id'

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

@@ -4,7 +4,6 @@

44{-# LANGUAGE Rank2Types #-}

55module Hakyll.Core.Rules.Internal

66 ( RuleSet (..)

7− , RuleState (..)

87 , RuleEnvironment (..)

98 , Rules (..)

109 , runRules

@@ -50,13 +49,6 @@ instance Monoid RuleSet where

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

5150

5251

53−--------------------------------------------------------------------------------

54−-- | Rule state

55−data RuleState = RuleState

56− { rulesNextIdentifier :: Int

57− } deriving (Show)

58−

59−

6052--------------------------------------------------------------------------------

6153-- | Rule environment

6254data RuleEnvironment = RuleEnvironment

@@ -69,7 +61,7 @@ data RuleEnvironment = RuleEnvironment

6961--------------------------------------------------------------------------------

7062-- | The monad used to compose rules

7163newtype Rules a = Rules

72− { unRules :: RWST RuleEnvironment RuleSet RuleState IO a

64+ { unRules :: RWST RuleEnvironment RuleSet () IO a

7365 } deriving (Monad, Functor, Applicative)

7466

7567

@@ -88,11 +80,10 @@ instance MonadMetadata Rules where

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

8981runRules :: Rules a -> Provider -> IO RuleSet

9082runRules rules provider = do

91− (_, _, ruleSet) <- runRWST (unRules rules) env state

83+ (_, _, ruleSet) <- runRWST (unRules rules) env ()

9284 return $ nubCompilers ruleSet

9385 where

94− state = RuleState {rulesNextIdentifier = 0}

95− env = RuleEnvironment

86+ env = RuleEnvironment

9687 { rulesProvider = provider

9788 , rulesPattern = mempty

9889 , rulesVersion = Nothing

@@ -103,6 +94,6 @@ runRules rules provider = do

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

10495-- item, we prefer the first one

10596nubCompilers :: RuleSet -> RuleSet

106−nubCompilers set = set { rulesCompilers = nubCompilers' (rulesCompilers set) }

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

10798 where

10899 nubCompilers' = M.toList . M.fromListWith (flip const)

tests/Hakyll/Core/Identifier/Tests.hs+12−1

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

88--------------------------------------------------------------------------------

9+import Data.Monoid (mappend, mempty)

910import Test.Framework (Test, testGroup)

1011import Test.HUnit ((@=?))

1112

@@ -19,11 +20,21 @@ import TestSuite.Util

1920--------------------------------------------------------------------------------

2021tests :: Test

2122tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat

22− [ captureTests

23+ [ isLiteralTests

24+ , captureTests

2325 , matchesTests

2426 ]

2527

2628

29+--------------------------------------------------------------------------------

30+isLiteralTests :: [Test]

31+isLiteralTests = fromAssertions "isLiteral"

32+ [ Just "index.html" @=? fromLiteral "index.html"

33+ , Nothing @=? fromLiteral "posts/*.markdown"

34+ , Just "test.txt" @=? fromLiteral ("test.txt" `mappend` mempty)

35+ ]

36+

37+

2738--------------------------------------------------------------------------------

2839captureTests :: [Test]

2940captureTests = fromAssertions "capture"

tests/Hakyll/Core/Runtime/Tests.hs+5−4

@@ -33,10 +33,11 @@ case01 = withTestConfiguration $ \config -> do

3333 saveSnapshot "raw" body

3434 return $ renderPandoc body

3535

36− match "bodies.txt" $ route idRoute

37− create "bodies.txt" $ do

38− items <- requireAllSnapshots "*.md" "raw" :: Compiler [Item String]

39− makeItem $ concat $ map itemBody items

36+ match "bodies.txt" $ do

37+ route idRoute

38+ compile $ do

39+ items <- requireAllSnapshots "*.md" "raw"

40+ makeItem $ concat $ map itemBody (items :: [Item String])

4041

4142 example <- readFile $ destinationDirectory config </> "example.html"

4243 lines example @?= ["<p>This is an example.</p>"]

tests/TestSuite/Util.hs+1−1

@@ -36,7 +36,7 @@ fromAssertions :: String -- ^ Name

3636 -> [Assertion] -- ^ Cases

3737 -> [Test] -- ^ Result tests

3838fromAssertions name =

39− zipWith testCase [printf "%s [%3d]" name n | n <- [1 :: Int ..]]

39+ zipWith testCase [printf "[%2d] %s" n name | n <- [1 :: Int ..]]

4040

4141

4242--------------------------------------------------------------------------------