Untitled diff

Created Diff never expires
6 removals
48 lines
54 additions
80 lines
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 ()