From 06125ee07f546d67f2f8ba25c24f3b3b6857da33 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 27 May 2011 21:00:59 +0200 Subject: Fix issue regarding preview server --- src-interval/Hakyll/Web/Preview/Poll.hs | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) (limited to 'src-interval/Hakyll/Web') diff --git a/src-interval/Hakyll/Web/Preview/Poll.hs b/src-interval/Hakyll/Web/Preview/Poll.hs index 0c9f771..68ea8d4 100644 --- a/src-interval/Hakyll/Web/Preview/Poll.hs +++ b/src-interval/Hakyll/Web/Preview/Poll.hs @@ -7,30 +7,29 @@ module Hakyll.Web.Preview.Poll import Control.Applicative ((<$>)) import Control.Concurrent (threadDelay) -import Control.Monad (when, filterM) +import Control.Monad (filterM) import System.Time (getClockTime) -import Data.Set (Set) -import qualified Data.Set as S import System.Directory (getModificationTime, doesFileExist) import Hakyll.Core.Configuration -import Hakyll.Core.Resource -- | A preview thread that periodically recompiles the site. -- previewPoll :: HakyllConfiguration -- ^ Configuration - -> Set Resource -- ^ Resources to watch - -> IO () -- ^ Action called when something changes + -> IO [FilePath] -- ^ Updating action -> IO () -- ^ Can block forever -previewPoll _ resources callback = do - let files = map unResource $ S.toList resources +previewPoll _ update = do time <- getClockTime - loop files time + loop time =<< update where delay = 1000000 - loop files time = do + loop time files = do threadDelay delay files' <- filterM doesFileExist files - modified <- any (time <) <$> mapM getModificationTime files' - when (modified || files' /= files) callback - loop files' =<< getClockTime + filesTime <- case files' of + [] -> return time + _ -> maximum <$> mapM getModificationTime files' + + if filesTime > time || files' /= files + then loop filesTime =<< update + else loop time files' -- cgit v1.2.3