From c03607e08751c3ce0e7c4cb70f9168f7f0237663 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Thu, 10 Feb 2011 20:05:50 +0100
Subject: Add prototype inotify backend

---
 src/Hakyll/Core/Run.hs            |  3 --
 src/Hakyll/Main.hs                | 16 +++++++++--
 src/Hakyll/Web/Preview/INotify.hs | 60 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 74 insertions(+), 5 deletions(-)
 create mode 100644 src/Hakyll/Web/Preview/INotify.hs

(limited to 'src')

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
-- 
cgit v1.2.3