cf98381 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Add event filtering based on pattern

cf98381Jasper Van der Jeugt14 years ago

hakyll.cabal+5−5

compare with master

unifiedsplit

@@ -164,9 +164,9 @@ Library

164

165 If flag(previewServer)

166 Build-depends:

167− snap-core >= 0.6 && < 0.10,

167+ snap-core >= 0.6 && < 0.10,

168− snap-server >= 0.6 && < 0.10,

168+ snap-server >= 0.6 && < 0.10,

169− fsnotify >= 0.0.6 && < 0.1,

169+ fsnotify >= 0.0.6 && < 0.1,

170 system-filepath >= 0.4.6 && <= 0.5

171 Cpp-options:

172 -DPREVIEW_SERVER

@@ -240,8 +240,8 @@ Test-suite hakyll-tests

240

241 If flag(previewServer)

242 Build-depends:

243− snap-core >= 0.6 && < 0.10,

243+ snap-core >= 0.6 && < 0.10,

244− snap-server >= 0.6 && < 0.10,

244+ snap-server >= 0.6 && < 0.10,

245 fsnotify >= 0.0.6 && < 0.1,

246 system-filepath >= 0.4.6 && <= 0.5

247 Cpp-options:

src/Hakyll/Commands.hs+3−2

@@ -21,6 +21,7 @@ import qualified Hakyll.Check as Check

21import Hakyll.Core.Configuration

22import Hakyll.Core.Logger (Verbosity)

23import Hakyll.Core.Rules

24+import Hakyll.Core.Rules.Internal

24import Hakyll.Core.Runtime

25import Hakyll.Core.Runtime

25import Hakyll.Core.Util.File

26import Hakyll.Core.Util.File

@@ -68,8 +69,8 @@ preview conf verbosity rules port = do

68 server conf port

69 server conf port

69 where

70 where

70 update = do

71 update = do

71− _ <- run conf verbosity rules

72+ (_, ruleSet) <- run conf verbosity rules

72− return ()

73+ return $ rulesPattern ruleSet

73#else

74#else

74preview _ _ _ _ = previewServerDisabled

75preview _ _ _ _ = previewServerDisabled

75#endif

76#endif

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

@@ -63,20 +63,26 @@ import Hakyll.Core.Writable

63--------------------------------------------------------------------------------

64-- | Add a route

65tellRoute :: Routes -> Rules ()

66−tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty

66+tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty mempty

69--------------------------------------------------------------------------------

70-- | Add a number of compilers

71tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()

72−tellCompilers compilers = Rules $ tell $ RuleSet mempty compilers mempty

72+tellCompilers compilers = Rules $ tell $ RuleSet mempty compilers mempty mempty

75--------------------------------------------------------------------------------

76-- | Add resources

77tellResources :: [Identifier] -> Rules ()

78tellResources resources' = Rules $ tell $

79− RuleSet mempty mempty $ S.fromList resources'

79+ RuleSet mempty mempty (S.fromList resources') mempty

80+

81+

82+--------------------------------------------------------------------------------

83+-- | Add a pattern

84+tellPattern :: Pattern -> Rules ()

85+tellPattern pattern = Rules $ tell $ RuleSet mempty mempty mempty pattern

82--------------------------------------------------------------------------------

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

@@ -116,6 +122,7 @@ flush = Rules $ do

116--------------------------------------------------------------------------------

122--------------------------------------------------------------------------------

117match :: Pattern -> Rules () -> Rules ()

123match :: Pattern -> Rules () -> Rules ()

118match pattern rules = do

124match pattern rules = do

125+ tellPattern pattern

119 flush

126 flush

120 ids <- getMatches pattern

127 ids <- getMatches pattern

121 tellResources ids

128 tellResources ids

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

@@ -47,14 +47,17 @@ data RuleSet = RuleSet

47 rulesCompilers :: [(Identifier, Compiler SomeItem)]

48 , -- | A set of the actually used files

49 rulesResources :: Set Identifier

50+ , -- | A pattern we can use to check if a file *would* be used. This is

51+ -- needed for the preview server.

52+ rulesPattern :: Pattern

50 }

53 }

53--------------------------------------------------------------------------------

56--------------------------------------------------------------------------------

54instance Monoid RuleSet where

57instance Monoid RuleSet where

55− mempty = RuleSet mempty mempty mempty

58+ mempty = RuleSet mempty mempty mempty mempty

56− mappend (RuleSet r1 c1 s1) (RuleSet r2 c2 s2) =

59+ mappend (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =

57− RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2)

60+ RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)

60--------------------------------------------------------------------------------

63--------------------------------------------------------------------------------

src/Hakyll/Preview/Poll.hs+40−16

@@ -1,40 +1,64 @@

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

1module Hakyll.Preview.Poll

2module Hakyll.Preview.Poll

2 ( watchUpdates

3 ( watchUpdates

3 ) where

4 ) where

5--------------------------------------------------------------------------------

7--------------------------------------------------------------------------------

8+import Control.Concurrent.MVar (newMVar, putMVar, takeMVar)

9+import Control.Monad (when)

6−import Filesystem.Path.CurrentOS (decodeString, encodeString)

10+import Filesystem.Path.CurrentOS (decodeString, encodeString)

7−import System.FSNotify (startManagerConf, watchTree,

11+import System.Directory (canonicalizePath)

12+import System.FilePath (pathSeparators)

8− Event(..), WatchConfig(..))

13+import System.FSNotify (Event (..), WatchConfig (..),

14+ startManagerConf, watchTree)

15+

10--------------------------------------------------------------------------------

17--------------------------------------------------------------------------------

11import Hakyll.Core.Configuration

18import Hakyll.Core.Configuration

12−

19+import Hakyll.Core.Identifier

20+import Hakyll.Core.Identifier.Pattern

15--------------------------------------------------------------------------------

23--------------------------------------------------------------------------------

16-- | A thread that watches for updates in a 'providerDirectory' and recompiles

24-- | A thread that watches for updates in a 'providerDirectory' and recompiles

17-- a site as soon as any changes occur

25-- a site as soon as any changes occur

18−watchUpdates :: Configuration -> IO () -> IO ()

26+watchUpdates :: Configuration -> IO Pattern -> IO ()

19watchUpdates conf update = do

27watchUpdates conf update = do

28+ let providerDir = decodeString $ providerDirectory conf

29+ lock <- newMVar ()

20− _ <- update

30+ pattern <- update

31+ fullProviderDir <- canonicalizePath $ providerDirectory conf

21− manager <- startManagerConf (Debounce 0.1)

32+ manager <- startManagerConf (Debounce 0.1)

22− watchTree manager path (not . isRemove) update'

23− where

24− path = decodeString $ providerDirectory conf

25− update' evt = do

26− ignore <- shouldIgnoreFile conf $ eventPath evt

27− if ignore then return () else update

34+ let allowed event = do

35+ -- Absolute path of the changed file. This must be inside provider

36+ -- dir, since that's the only dir we're watching.

37+ let path = eventPath event

38+ relative = dropWhile (`elem` pathSeparators) $

39+ drop (length fullProviderDir) path

40+ identifier = fromFilePath relative

42+ shouldIgnore <- shouldIgnoreFile conf path

43+ return $ not shouldIgnore && matches pattern identifier

44+

45+ watchTree manager providerDir (not . isRemove) $ \event -> do

46+ () <- takeMVar lock

47+ allowed' <- allowed event

48+ when allowed' $ update >> return ()

49+ putMVar lock ()

50+

51+

52+--------------------------------------------------------------------------------

30eventPath :: Event -> FilePath

53eventPath :: Event -> FilePath

31eventPath evt = encodeString $ evtPath evt

54eventPath evt = encodeString $ evtPath evt

32 where

55 where

33− evtPath (Added p _) = p

56+ evtPath (Added p _) = p

34 evtPath (Modified p _) = p

57 evtPath (Modified p _) = p

35− evtPath (Removed p _) = p

58+ evtPath (Removed p _) = p

61+--------------------------------------------------------------------------------

38isRemove :: Event -> Bool

62isRemove :: Event -> Bool

39isRemove (Removed _ _) = True

63isRemove (Removed _ _) = True

40−isRemove _ = False

64+isRemove _ = False