on master help sign in
Refine code
259190eSimonas Kazlauskas
src/Hakyll/Commands.hs+4−10
@@ -13,7 +13,7 @@ module Hakyll.Commands
13
13
14
14
15--------------------------------------------------------------------------------
15--------------------------------------------------------------------------------
16−import System.Exit (ExitCode (ExitSuccess), exitWith)
16+import System.Exit (exitWith)
17
17
18
18
19--------------------------------------------------------------------------------
19--------------------------------------------------------------------------------
@@ -27,9 +27,6 @@ import Hakyll.Core.Util.File
27
27
28--------------------------------------------------------------------------------
28--------------------------------------------------------------------------------
29#ifdef PREVIEW_SERVER
29#ifdef PREVIEW_SERVER
30−import qualified Data.Set as S
31−import Hakyll.Core.Identifier
32−import Hakyll.Core.Rules.Internal
33import Hakyll.Preview.Poll
30import Hakyll.Preview.Poll
34import Hakyll.Preview.Server
31import Hakyll.Preview.Server
35#endif
32#endif
@@ -67,15 +64,12 @@ clean conf = do
67preview :: Configuration -> Verbosity -> Rules a -> Int -> IO ()
64preview :: Configuration -> Verbosity -> Rules a -> Int -> IO ()
68#ifdef PREVIEW_SERVER
65#ifdef PREVIEW_SERVER
69preview conf verbosity rules port = do
66preview conf verbosity rules port = do
70− previewPoll conf update
67+ watchUpdates conf update
71 server conf port
68 server conf port
72 where
69 where
73 update = do
70 update = do
74− (exitCode, ruleSet) <- run conf verbosity rules
71+ _ <- run conf verbosity rules
75− case exitCode of
72+ return ()
76− ExitSuccess -> return $ map toFilePath $ S.toList $
77− rulesResources ruleSet
78− _ -> exitWith exitCode
79#else
73#else
80preview _ _ _ _ = previewServerDisabled
74preview _ _ _ _ = previewServerDisabled
81#endif
75#endif
src/Hakyll/Preview/Poll.hs+9−9
@@ -1,9 +1,8 @@
1module Hakyll.Preview.Poll
1module Hakyll.Preview.Poll
2− ( previewPoll
2+ ( watchUpdates
3 ) where
3 ) where
4
4
5--------------------------------------------------------------------------------
5--------------------------------------------------------------------------------
6−import Control.Monad (void)
7import Filesystem.Path.CurrentOS (decodeString, encodeString)
6import Filesystem.Path.CurrentOS (decodeString, encodeString)
8import System.Directory (getCurrentDirectory)
7import System.Directory (getCurrentDirectory)
9import System.FilePath (makeRelative)
8import System.FilePath (makeRelative)
@@ -16,21 +15,21 @@ import Hakyll.Core.Configuration
16
15
17
16
18--------------------------------------------------------------------------------
17--------------------------------------------------------------------------------
19−-- | A preview thread that recompiles the site when files change.
18+-- | A thread that watches for updates in a 'providerDirectory' and recompiles
20−previewPoll :: Configuration -- ^ Configuration
19+-- a site as soon as any changes occur
21− -> IO [FilePath] -- ^ Updating action
20+watchUpdates :: Configuration -> IO () -> IO ()
22− -> IO () -- ^ Can block forever
23−previewPoll conf update = do
21+watchUpdates conf update = do
24 _ <- update
22 _ <- update
25 manager <- startManagerConf (Debounce 0.1)
23 manager <- startManagerConf (Debounce 0.1)
26− wDir <- getCurrentDirectory
24+ workingDirectory <- getCurrentDirectory
27− watchTree manager path (predicate wDir) (\_ -> void update)
25+ watchTree manager path (predicate workingDirectory) $ const update
28 where
26 where
29 path = decodeString $ providerDirectory conf
27 path = decodeString $ providerDirectory conf
30 predicate wDir evt
28 predicate wDir evt
31 | isRemove evt = False
29 | isRemove evt = False
32 | otherwise = not $ shouldIgnoreFile conf (relativeEventPath wDir evt)
30 | otherwise = not $ shouldIgnoreFile conf (relativeEventPath wDir evt)
33
31
32+
34relativeEventPath :: FilePath -> Event -> FilePath
33relativeEventPath :: FilePath -> Event -> FilePath
35relativeEventPath b evt = makeRelative b $ encodeString $ evtPath evt
34relativeEventPath b evt = makeRelative b $ encodeString $ evtPath evt
36 where
35 where
@@ -38,6 +37,7 @@ relativeEventPath b evt = makeRelative b $ encodeString $ evtPath evt
38 evtPath (Modified p _) = p
37 evtPath (Modified p _) = p
39 evtPath (Removed p _) = p
38 evtPath (Removed p _) = p
40
39
40+
41isRemove :: Event -> Bool
41isRemove :: Event -> Bool
42isRemove (Removed _ _) = True
42isRemove (Removed _ _) = True
43isRemove _ = False
43isRemove _ = False