48 lines
-6 Removals
80 lines
+54 Additions
import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import System.Directory
import System.Directory
import System.Environment (getArgs)
import System.Environment (getArgs)
import System.INotify
import System.INotify
import System.IO
import System.IO
data Config =
Config
{ confCabalFile :: FilePath
, confWorking :: Bool
} deriving (Show,Read)
main = do
main = do
args <- getArgs
args <- getArgs
let dir = head args
let dir = head args
putStrLn $ "Watching directory: " ++ dir
putStrLn $ "Watching directory: " ++ dir
contents <- getDirectoryContents dir
let contents' = filter filterCabal contents
case contents' of
(x:_) -> runThread x dir
[] -> do
putStrLn "No cabal file found!"
putStrLn "Exiting"
runThread cabal dir = do
config <- newTVarIO $ Config cabal False
n <- initINotify
n <- initINotify
putStrLn "Press <Enter> to exit"
putStrLn "Press <Enter> to exit"
print n
print n
wd <- addWatch n
wd <- addWatch n
[ Modify, CloseWrite, Create, Delete, MoveIn, MoveOut ]
[ Modify, CloseWrite, Create, Delete, MoveIn, MoveOut ]
dir
dir
eventHandler
(eventHandler config)
print wd
print wd
getLine
getLine
removeWatch wd
removeWatch wd
killINotify n
killINotify n
eventHandler :: Event -> IO ()
eventHandler :: TVar Config -> Event -> IO ()
eventHandler x@(Modified _ (Just fp)) = handleFilteredFile x fp
eventHandler conf x@(Modified _ (Just fp)) = handleFilteredFile conf x fp
eventHandler x@(MovedIn _ fp _) = handleFilteredFile x fp
eventHandler conf x@(MovedIn _ fp _) = handleFilteredFile conf x fp
eventHandler x@(MovedOut _ fp _) = handleFilteredFile x fp
eventHandler conf x@(MovedOut _ fp _) = handleFilteredFile conf x fp
eventHandler x@(Created _ fp) = handleFilteredFile x fp
eventHandler conf x@(Created _ fp) = handleFilteredFile conf x fp
eventHandler x@(Deleted _ fp) = handleFilteredFile x fp
eventHandler conf x@(Deleted _ fp) = handleFilteredFile conf x fp
eventHandler _ = return ()
eventHandler _ _ = return ()
handleFilteredFile evt fp = do
handleFilteredFile conf evt fp = do
if filterHS fp
if filterHS fp
then print evt >> doWork fp
then print evt >> doWork conf fp
else return ()
else return ()
filterHS fp = (== "hs")
filterHS fp = fileExt fp == "hs"
$ reverse
filterCabal fp = fileExt fp == "cabal"
$ takeWhile (/= '.')
$ reverse fp
doWork :: FilePath -> IO ()
fileExt = reverse
doWork fp = return ()
. takeWhile (/= '.')
. reverse
doWork :: TVar Config -> FilePath -> IO ()
doWork conf fp = do
config <- readTVarIO conf
if confWorking config
then do
print "Already working!"
return ()
else do
print "New work available!"
atomically $ writeTVar conf (config { confWorking = True })
return ()