lit-0.1.0.5: src/Poll.hs

module Poll 
( watch ) where

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 :: (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 :: (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 ()

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