Watcher.hs

{-# LANGUAGE DeriveDataTypeable,RecordWildCards #-}

module Spy.Watcher
(
 spy
,Format
,plainFormat
,Spy(..)
,skipEvent
,matchesFile
,containsHiddenPathElement
) where

import System.FSNotify (withManager, watchTree, Event(..))
import System.Console.CmdArgs
import System.Cmd
import System.Exit
import System.IO (stderr, hPrint)
import System.FilePath.GlobPattern
import System.FilePath (splitDirectories, takeFileName)
import Filesystem.Path.CurrentOS
  (encodeString, decodeString, commonPrefix, stripPrefix)
import Data.Time.Clock(UTCTime)
import Data.Maybe (fromMaybe, maybeToList, fromJust)
import Text.JSON
import Spy.Daemon

-- | The output format when Spy prints out changes to STDOUT
data Format = Json | Plain deriving (Show, Eq, Data, Typeable)

-- | Spy run modes.
data Spy = Watch {
     dir                :: FilePath
    ,glob               :: Maybe GlobPattern
    ,format             :: Maybe Format
    ,hidden             :: Bool
} | Run {
     dir                :: FilePath
    ,command            :: String
    ,glob               :: Maybe GlobPattern
    ,hidden             :: Bool
    ,notifyOnly         :: Bool
} deriving (Data,Typeable,Show,Eq)

-- | Return the Plain format.
plainFormat :: Format
plainFormat = Plain

-- | Register for FS events using the given Spy config.
spy :: Spy -> IO b -> IO ()
spy config after = withManager $ \wm ->
    runIndefinitely
      (watchTree wm (decodeString $ dir config)
                  (not . skipEvent config . eventPath)
                  (handleEvent config)) 
      (const after)

-- | Handle the FS event based on the current Spy run configuration
handleEvent :: Spy -> Event -> IO ()
handleEvent Run{..} event =
        runCommand command pathAsArg >>=
            \exit -> case exit of
                ExitSuccess     -> return ()
                ExitFailure i   -> hPrint stderr $ "Failed to execute " ++ command ++ " - exit code: " ++ show i
        where pathAsArg = if notifyOnly then
                            Nothing
                            else Just (eventPath event)

handleEvent Watch{..} event =
        putStrLn $ (outputHandler $ fromMaybe Plain format) event

-- =================================================================================

runCommand :: Command -> Maybe FilePath -> IO ExitCode
runCommand cmd maybePath = rawSystem p $ mergeArgs args'
    where (p, args')            = case words cmd of
                                    (x:xs) -> (x, xs)
                                    _      -> ("", [])
          mergeArgs defaultArgs = defaultArgs ++ maybeToList maybePath

-- =================================================================================

type Printer = (Event -> String)
type Command = String

outputHandler :: Format -> Printer
outputHandler Json  = \event -> encode $ makeObj [
    ("path", showJSON $ eventPath event),
    ("flag", showJSON $ eventType event),
    ("time", showJSON . show $ eventTime event)]
outputHandler Plain = eventPath


-- | Skip events based on the configuration given
skipEvent :: Spy -> FilePath -> Bool
skipEvent config path = skipHidden || skipNonMatchingGlob
    where skipHidden            = let includeHiddenfiles = hidden config
                                  in not includeHiddenfiles && containsHiddenPathElement relPath
          skipNonMatchingGlob   = maybe False (not . matchesFile path) $ glob config
          relPath = encodeString . fromJust $ stripPrefix prefix (decodeString path)
          prefix = commonPrefix (map decodeString [dir config, path])

eventTime :: Event -> UTCTime
eventTime (Added _ t) = t
eventTime (Modified _ t) = t
eventTime (Removed _ t) = t

eventPath :: Event -> FilePath
eventPath (Added fp _) = encodeString fp
eventPath (Modified fp _) = encodeString fp
eventPath (Removed fp _) = encodeString fp

eventType :: Event -> FilePath
eventType (Added _ _) = "Added"
eventType (Modified _ _) = "Modified"
eventType (Removed _ _) = "Removed"

matchesFile :: FilePath -> GlobPattern -> Bool
matchesFile path glob' = takeFileName path ~~ glob'

containsHiddenPathElement :: FilePath -> Bool
containsHiddenPathElement path = any isHidden paths
                where paths = splitDirectories path
                      isHidden name' = case name' of
                                            (x:_)   -> x == '.'
                                            _       -> False