diff options
Diffstat (limited to 'src/Hakyll')
-rw-r--r-- | src/Hakyll/Main.hs | 12 | ||||
-rw-r--r-- | src/Hakyll/Web/Preview/INotify.hs | 68 |
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] |