Watcher.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards    #-}

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

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

-- | The output format when Spy prints out changes to STDOUT
data Format = Json | Color | 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 (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
outputHandler Color = \event -> case event of
                        (Added fp _)      -> printf "%s %s" (added "+|") fp
                        (Modified fp _)   -> printf "%s %s" (updated "~|") fp
                        (Removed fp _)    -> printf "%s %s" (removed "-|") (ansi Foreground DarkGray fp)
                        where
                              added    = ansi Foreground Black . ansi Background LightGreen
                              updated  = ansi Foreground Black . ansi Background Yellow
                              removed  = ansi Foreground Black . ansi Background LightRed

-- | 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 _) = fp
eventPath (Modified fp _) = fp
eventPath (Removed fp _) = 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