{-# Language MultiWayIf #-} module System.Touched ( module System.Touched.Procedure , onChangeAny , onChangeAll , onChangeFile ) where import Control.Concurrent import Data.Time.Clock import System.Directory import System.Touched.Procedure import System.Touched.OnlyOne import Control.Applicative ((<$>), (<*>)) import Data.Maybe (isNothing, fromJust, isJust) -- | An enum for deciding how to determine if a proc should be restarted -- Any - If *any* of the files have changed, restart -- All - If *every* file has changed, restart -- First - If the first file has changed, restart. Useful only in 'onChangeFile' data Take = Any | All | First -- | Turns a 'Take' enumeration into a selection function for comparing to the -- last modified time toFn :: Take -> [UTCTime] -> UTCTime toFn All = minimum toFn Any = maximum toFn First = head -- | Ignore (frequently heavy) hidden files and directories during filesystem -- recursion. -- TODO: Make this optional ignoreHidden :: [String] -> [String] ignoreHidden = filter (not . (=='.') . head) -- | Gets the last modified date for a file type. Directories are processed recursively. modified :: File -> IO [Maybe UTCTime] modified (File path) = (:[]) . Just <$> getModificationTime path modified (Dir path) = getDirectoryContents path >>= mapM (liftF . (path++) . ('/':)) . ignoreHidden >>= concatMapM modified modified _ = return [Nothing] -- | Enumerate the type of file found at a path -- File - a file -- Dir - a file-system directory or folder -- NotFound - marks that the OS does not know the path data File = File FilePath | Dir FilePath | NotFound FilePath deriving (Show, Eq) -- | Treat directories as files. -- Makes monitoring a folder only trigger a change if the folder itself has -- changed (disabling recursion). forceFile :: File -> File forceFile (Dir x) = File x forceFile x = x -- | Take a file path and lift it to a tagged File type. liftF :: FilePath -> IO File liftF path = do f <- doesFileExist path if f then return $ File path else do d <- doesDirectoryExist path if d then return $ Dir path else return $ NotFound path -- | Same as 'liftF', but disables recursion. liftF' :: FilePath -> IO File liftF' = fmap forceFile . liftF -- TODO: Move to utils concatMapM f = fmap concat . mapM f justs = map fromJust . filter isJust -- | Internal onChange function onChange :: Take -> [File] -> OnlyOne a b -> IO () onChange sel files ot = do threadDelay 100000 times <- concatMapM modified files case map fst $ filter (isNothing . snd) (zip files times) of [] -> restartOld ot (toFn sel $ justs times) >>= onChange sel files _ -> putStrLn "Missing files: " -- | Generalized onChange function onChange' :: Take -> Bool -> [FilePath] -> Procedure a b -> IO () onChange' sel recursive files procfn = do files' <- sequence $ if recursive then map liftF files else map liftF' files onChange sel files' (Inactive procfn) -- | Launches a procedure if any specified file has changed onChangeAny :: Bool -> [FilePath] -> Procedure a b -> IO () onChangeAny = onChange' Any -- | Launches a procedure if every specified file has changed onChangeAll :: Bool -> [FilePath] -> Procedure a b -> IO () onChangeAll = onChange' All -- | Takes a single file and launches a procedure when it changes onChangeFile :: Bool -> FilePath -> Procedure a b -> IO () onChangeFile recursive file = onChange' First recursive [file]