hakyll/src/Hakyll/Web/Preview/Poll.hs

44 lines
1.2 KiB
Haskell
Raw Normal View History

2011-05-28 10:41:37 +00:00
-- | Interval-based implementation of preview polling
2011-02-21 12:35:20 +00:00
--
2012-09-24 09:05:49 +00:00
{-# LANGUAGE CPP #-}
2011-02-23 09:11:55 +00:00
module Hakyll.Web.Preview.Poll
2011-02-21 12:35:20 +00:00
( previewPoll
) where
import Control.Applicative ((<$>))
import Control.Concurrent (threadDelay)
2011-05-27 19:00:59 +00:00
import Control.Monad (filterM)
2012-09-24 09:05:49 +00:00
#if MIN_VERSION_directory(1,2,0)
import Data.Time (getCurrentTime)
#else
2011-02-21 12:35:20 +00:00
import System.Time (getClockTime)
2012-09-24 09:05:49 +00:00
#endif
import System.Directory (getModificationTime, doesFileExist)
2011-02-21 12:35:20 +00:00
import Hakyll.Core.Configuration
-- | A preview thread that periodically recompiles the site.
--
previewPoll :: HakyllConfiguration -- ^ Configuration
2011-05-27 19:00:59 +00:00
-> IO [FilePath] -- ^ Updating action
2011-02-21 12:35:20 +00:00
-> IO () -- ^ Can block forever
2011-05-27 19:00:59 +00:00
previewPoll _ update = do
2012-09-24 09:05:49 +00:00
#if MIN_VERSION_directory(1,2,0)
time <- getCurrentTime
#else
2011-02-21 12:35:20 +00:00
time <- getClockTime
2012-09-24 09:05:49 +00:00
#endif
2011-05-27 19:00:59 +00:00
loop time =<< update
2011-02-21 12:35:20 +00:00
where
delay = 1000000
2011-05-27 19:00:59 +00:00
loop time files = do
2011-02-21 12:35:20 +00:00
threadDelay delay
files' <- filterM doesFileExist files
2011-05-27 19:00:59 +00:00
filesTime <- case files' of
[] -> return time
_ -> maximum <$> mapM getModificationTime files'
if filesTime > time || files' /= files
then loop filesTime =<< update
else loop time files'