summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Main.hs12
-rw-r--r--src/Hakyll/Web/Preview/INotify.hs68
2 files changed, 35 insertions, 45 deletions
diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs
index 74097f7..8cec42e 100644
--- a/src/Hakyll/Main.hs
+++ b/src/Hakyll/Main.hs
@@ -6,10 +6,9 @@ module Hakyll.Main
) where
import Control.Concurrent (forkIO)
-import Control.Monad (when, forM_)
+import Control.Monad (when)
import System.Environment (getProgName, getArgs)
import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
-import qualified Data.Set as S
import Hakyll.Core.Configuration
import Hakyll.Core.Run
@@ -87,16 +86,15 @@ preview configuration rules port = do
-- Build once, keep the rule set
ruleSet <- run configuration rules
- -- Debug: show the resources used
- forM_ (S.toList $ rulesResources ruleSet) $ putStrLn . show
+ -- Get the resource list and a callback for the preview poll
+ let resources = rulesResources ruleSet
+ callback = build configuration rules
- {-
-- Fork a thread polling for changes
- _ <- forkIO $ previewPoll configuration "." $ build configuration rules
+ _ <- forkIO $ previewPoll configuration resources callback
-- Run the server in the main thread
server configuration port
- -}
-- | Rebuild the site
--
diff --git a/src/Hakyll/Web/Preview/INotify.hs b/src/Hakyll/Web/Preview/INotify.hs
index fb3a7de..5bee981 100644
--- a/src/Hakyll/Web/Preview/INotify.hs
+++ b/src/Hakyll/Web/Preview/INotify.hs
@@ -4,57 +4,49 @@ module Hakyll.Web.Preview.INotify
( previewPoll
) where
-import Control.Monad (forM_, when, unless)
-import System.Directory (doesDirectoryExist)
-import System.FilePath ((</>))
-import Data.List (isPrefixOf)
+import Control.Monad (forM_, when)
+import Data.Set (Set)
+import qualified Data.Set as S
+import System.FilePath (takeDirectory)
import System.INotify
-import Hakyll.Core.Util.File
import Hakyll.Core.Configuration
+import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Identifier
-- | Calls the given callback when the directory tree changes
--
previewPoll :: HakyllConfiguration -- ^ Configuration
- -> FilePath -- ^ Root directory
+ -> Set Resource -- ^ Resources to watch
-> IO () -- ^ Action called when something changes
-> IO () -- ^ Can block forever
-previewPoll conf directory callback = do
+previewPoll _ resources callback = do
-- Initialize inotify
inotify <- initINotify
- -- Start by watching all directories
- contents <- getRecursiveContents True directory
- forM_ contents $ \file -> do
- isDir <- doesDirectoryExist file
- when isDir $ watchDirectory conf inotify file callback
+ let -- A set of file paths
+ paths = S.map (toFilePath . unResource) resources
--- | Start watching a directory recursively: when another directory is created
--- inside this directory, start watching that one as well...
---
-watchDirectory :: HakyllConfiguration -- ^ Configuration
- -> INotify -- ^ INotify handle
- -> FilePath -- ^ Directory to watch
- -> IO () -- ^ Callback
- -> IO () -- ^ No result
-watchDirectory conf inotify path callback =
- unless (isFileInternal conf path) $ do
- _ <- addWatch inotify interesting path $ \event -> do
- putStrLn $ "Triggered: " ++ show event
- callback' inotify path event
+ -- A list of directories
+ directories = S.toList $ S.map (notEmpty . takeDirectory) paths
+
+ -- Make sure a directory name is not empty
+ notEmpty "" = "."
+ notEmpty x = x
+
+ -- Execute the callback when path is known
+ ifResource path = when (path `S.member` paths) $ do
+ putStrLn $ "Changed: " ++ path
+ callback
+
+ -- Add a watcher for every directory
+ forM_ directories $ \directory -> do
+ putStrLn $ "Adding watch for " ++ directory
+ _ <- addWatch inotify interesting directory $ \e -> case e of
+ (Modified _ (Just p)) -> ifResource p
+ _ -> return ()
return ()
where
- callback' i p (Created True n) = watchDirectory conf i (p </> n) callback
- callback' _ _ (Created _ p) = whenProper $ Just p
- callback' _ _ (Modified _ p) = whenProper p
- callback' _ _ (MovedOut _ p _) = whenProper $ Just p
- callback' _ _ (MovedIn _ p _) = whenProper $ Just p
- callback' _ _ (Deleted _ p) = whenProper $ Just p
- callback' _ _ _ = return ()
-
- interesting = [Modify, Create, Move, Delete]
-
- -- Call the callback only for proper files
- whenProper Nothing = return ()
- whenProper (Just f) = unless ("." `isPrefixOf` f) callback
+ -- Interesting events
+ interesting = [Modify]