summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Core/Run.hs3
-rw-r--r--src/Hakyll/Main.hs16
-rw-r--r--src/Hakyll/Web/Preview/INotify.hs60
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