{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune #-}
module Core.Program.Notify
(
waitForChange
) where
import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)
import qualified Data.ByteString.Char8 as C (ByteString, pack)
import Data.Foldable (foldr, foldrM)
import System.FilePath.Posix (dropFileName)
import System.INotify (EventVariety(..), Event(..), withINotify
, addWatch, removeWatch)
import Core.Data.Structures
import Core.Program.Execute
import Core.Program.Logging
import Core.Program.Unlift
waitForChange :: [FilePath] -> Program τ ()
waitForChange files =
let
f :: FilePath -> Set C.ByteString -> Set C.ByteString
f path acc = insertElement (C.pack path) acc
g :: FilePath -> Set C.ByteString -> Set C.ByteString
g path acc = insertElement (C.pack (dropFileName path)) acc
in do
event "Watching for changes"
let paths = foldr f emptySet files
let dirs = foldr g emptySet files
withContext $ \runProgram -> do
block <- newEmptyMVar
withINotify $ \notify -> do
watches <- foldrM (\dir acc -> do
runProgram (debugS "watching" dir)
watch <- addWatch notify [CloseWrite] dir (\trigger ->
case trigger of
Closed _ (Just file) _ -> do
let path = if dir == "./"
then file
else dir <> file
runProgram (debugS "changed" path)
if containsElement path paths
then do
runProgram (debugS "trigger" path)
putMVar block False
else
return ()
_ -> return ())
return (watch:acc)) [] dirs
_ <- readMVar block
mapM_ removeWatch watches
sleep 0.1