From 259190e30bb9136aef5b06546d47306edc2ad3ee Mon Sep 17 00:00:00 2001
From: Simonas Kazlauskas <git@kazlauskas.me>
Date: Sun, 31 Mar 2013 14:47:47 +0300
Subject: Refine code

This patch includes several smaller changes, namely:
1. We don't use result of `update` function and likely never will, so
   don't bother generating it.
2. Rename watch function to better reflect what it does.
3. Never exit preview server in case of failed update.
---
 src/Hakyll/Commands.hs     | 14 ++++----------
 src/Hakyll/Preview/Poll.hs | 18 +++++++++---------
 2 files changed, 13 insertions(+), 19 deletions(-)

(limited to 'src')

diff --git a/src/Hakyll/Commands.hs b/src/Hakyll/Commands.hs
index 140e0d9..700dda5 100644
--- a/src/Hakyll/Commands.hs
+++ b/src/Hakyll/Commands.hs
@@ -13,7 +13,7 @@ module Hakyll.Commands
 
 
 --------------------------------------------------------------------------------
-import           System.Exit                (ExitCode (ExitSuccess), exitWith)
+import           System.Exit                (exitWith)
 
 
 --------------------------------------------------------------------------------
@@ -27,9 +27,6 @@ import           Hakyll.Core.Util.File
 
 --------------------------------------------------------------------------------
 #ifdef PREVIEW_SERVER
-import qualified Data.Set                   as S
-import           Hakyll.Core.Identifier
-import           Hakyll.Core.Rules.Internal
 import           Hakyll.Preview.Poll
 import           Hakyll.Preview.Server
 #endif
@@ -67,15 +64,12 @@ clean conf = do
 preview :: Configuration -> Verbosity -> Rules a -> Int -> IO ()
 #ifdef PREVIEW_SERVER
 preview conf verbosity rules port = do
-    previewPoll conf update
+    watchUpdates conf update
     server conf port
   where
     update = do
-        (exitCode, ruleSet) <- run conf verbosity rules
-        case exitCode of
-            ExitSuccess -> return $ map toFilePath $ S.toList $
-                rulesResources ruleSet
-            _           -> exitWith exitCode
+        _ <- run conf verbosity rules
+        return ()
 #else
 preview _ _ _ _ = previewServerDisabled
 #endif
diff --git a/src/Hakyll/Preview/Poll.hs b/src/Hakyll/Preview/Poll.hs
index 9f7a505..65021db 100644
--- a/src/Hakyll/Preview/Poll.hs
+++ b/src/Hakyll/Preview/Poll.hs
@@ -1,9 +1,8 @@
 module Hakyll.Preview.Poll
-    ( previewPoll
+    ( watchUpdates
     ) where
 
 --------------------------------------------------------------------------------
-import           Control.Monad             (void)
 import           Filesystem.Path.CurrentOS (decodeString, encodeString)
 import           System.Directory          (getCurrentDirectory)
 import           System.FilePath           (makeRelative)
@@ -16,21 +15,21 @@ import           Hakyll.Core.Configuration
 
 
 --------------------------------------------------------------------------------
--- | A preview thread that recompiles the site when files change.
-previewPoll :: Configuration  -- ^ Configuration
-            -> IO [FilePath]  -- ^ Updating action
-            -> IO ()          -- ^ Can block forever
-previewPoll conf update = do
+-- | A thread that watches for updates in a 'providerDirectory' and recompiles
+-- a site as soon as any changes occur
+watchUpdates :: Configuration -> IO () -> IO ()
+watchUpdates conf update = do
     _ <- update
     manager <- startManagerConf (Debounce 0.1)
-    wDir <- getCurrentDirectory
-    watchTree manager path (predicate wDir) (\_ -> void update)
+    workingDirectory <- getCurrentDirectory
+    watchTree manager path (predicate workingDirectory) $ const update
   where
     path = decodeString $ providerDirectory conf
     predicate wDir evt
         | isRemove evt = False
         | otherwise = not $ shouldIgnoreFile conf (relativeEventPath wDir evt)
 
+
 relativeEventPath :: FilePath -> Event -> FilePath
 relativeEventPath b evt = makeRelative b $ encodeString $ evtPath evt
   where
@@ -38,6 +37,7 @@ relativeEventPath b evt = makeRelative b $ encodeString $ evtPath evt
     evtPath (Modified p _) = p
     evtPath (Removed p _) = p
 
+
 isRemove :: Event -> Bool
 isRemove (Removed _ _) = True
 isRemove _ = False
-- 
cgit v1.2.3