Poll is triggered by the --watch
flag to lit
. It applies the lit
command every time one of the files changes. Poll implements simple file polling and does not attempt to interface with the underlying event system. Afterall, lit
is a simple utility.
An overview of the file:
<< * >>=
<< define Poll module >>
<< import modules >>
<< watch a file >>
<< apply a fun if the file changed >>
<< retry if timing error >>
Poll exposes only the watch functionality
<< define Poll module >>=
module Poll
( watch ) where
<< import modules >>=
import System.Directory
import Data.Time.Clock
import Data.Time.Calendar
import Control.Monad (forever)
import qualified Control.Concurrent as C
import System.IO.Error
watch
takes a function which operates on a file and performs an IO action indefinitely. In lit
,
fun
is all the file processing (writing Html, writing Code, etc) necessary for one file. watch
does not actually apply the transform but makes a request to onChange
defined below.
<< watch a file >>=
watch :: (String -> IO ()) -> [String] -> IO ()
watch fun fs =
let
wait = C.threadDelay 1000000
in do
putStrLn "starting.."
mapM_ fun fs
forever $ (wait >> mapM_ (onChange fun) fs)
onChange
handles a function and a file. It checks to see if the file was saved recently. If so,
the function needs to be reapplied to the file. Otherwise, the function was previously applied, and
nothing needs to be done.
<< apply a fun if the file changed >>=
onChange :: (String -> IO ()) -> String -> IO ()
onChange fun file = do
modified <- retryAtMost 10 (getModificationTime file)
curTime <- getCurrentTime
let diff = (diffUTCTime curTime modified)
if diff < 2 then fun file else return ()
Occasionally, a timing error occurs when the program tries to read the modification time. If the
file is in the process of being saved, it becomes unavailable. During which, the program returns
the error that the file does not exist. retryAtMost n action
will ignore the error n times before
actually throwing the error.
<< retry if timing error >>=
retryAtMost 1 action = catchIOError action (\e -> ioError e)
retryAtMost times action =
let
handle e = if isDoesNotExistError e
then C.threadDelay 50000 >> retryAtMost (times - 1) action
else ioError e
in
catchIOError action handle