diff options
| -rw-r--r-- | src/Hakyll/Core/Run.hs | 3 | ||||
| -rw-r--r-- | src/Hakyll/Main.hs | 16 | ||||
| -rw-r--r-- | src/Hakyll/Web/Preview/INotify.hs | 60 |
3 files changed, 74 insertions, 5 deletions
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 17a5f79..407a2b1 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -25,7 +25,6 @@ import Hakyll.Core.ResourceProvider import Hakyll.Core.ResourceProvider.FileResourceProvider import Hakyll.Core.Rules import Hakyll.Core.DirectedGraph -import Hakyll.Core.DirectedGraph.Dot import Hakyll.Core.DirectedGraph.DependencySolver import Hakyll.Core.Writable import Hakyll.Core.Store @@ -114,8 +113,6 @@ addNewCompilers oldCompilers newCompilers = Runtime $ do -- complete graph completeGraph <- mappend currentGraph . hakyllGraph <$> get - liftIO $ writeDot "dependencies.dot" show completeGraph - -- Check which items are up-to-date. This only needs to happen for the new -- compilers oldModified <- hakyllModified <$> get diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs index 1d60e47..64800c2 100644 --- a/src/Hakyll/Main.hs +++ b/src/Hakyll/Main.hs @@ -5,6 +5,7 @@ module Hakyll.Main , hakyllWith ) where +import Control.Concurrent (forkIO) import Control.Monad (when) import System.Environment (getProgName, getArgs) import System.Directory (doesDirectoryExist, removeDirectoryRecursive) @@ -12,6 +13,7 @@ import System.Directory (doesDirectoryExist, removeDirectoryRecursive) import Hakyll.Core.Configuration import Hakyll.Core.Run import Hakyll.Core.Rules +import Hakyll.Web.Preview.INotify import Hakyll.Web.Preview.Server -- | This usualy is the function with which the user runs the hakyll compiler @@ -29,8 +31,8 @@ hakyllWith configuration rules = do ["build"] -> build configuration rules ["clean"] -> clean configuration ["help"] -> help - ["preview"] -> putStrLn "Not implemented" - ["preview", p] -> putStrLn "Not implemented" + ["preview"] -> preview configuration rules 8000 + ["preview", p] -> preview configuration rules (read p) ["rebuild"] -> rebuild configuration rules ["server"] -> server configuration 8000 ["server", p] -> server configuration (read p) @@ -74,6 +76,16 @@ help = do , name ++ " server [port] Run a local test server" ] +-- | Preview the site +-- +preview :: HakyllConfiguration -> Rules -> Int -> IO () +preview configuration rules port = do + -- Fork a thread polling for changes + _ <- forkIO $ previewPoll configuration "." $ build configuration rules + + -- Run the server in the main thread + server configuration port + -- | Rebuild the site -- rebuild :: HakyllConfiguration -> Rules -> IO () diff --git a/src/Hakyll/Web/Preview/INotify.hs b/src/Hakyll/Web/Preview/INotify.hs new file mode 100644 index 0000000..fb3a7de --- /dev/null +++ b/src/Hakyll/Web/Preview/INotify.hs @@ -0,0 +1,60 @@ +-- | Filesystem polling with an inotify backend. Works only on linux. +-- +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 System.INotify + +import Hakyll.Core.Util.File +import Hakyll.Core.Configuration + +-- | Calls the given callback when the directory tree changes +-- +previewPoll :: HakyllConfiguration -- ^ Configuration + -> FilePath -- ^ Root directory + -> IO () -- ^ Action called when something changes + -> IO () -- ^ Can block forever +previewPoll conf directory 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 + +-- | 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 + 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 |