steeloverseer-2.0: app/Main.hs

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Job
import Rule
import Sos
import Template

import Control.Monad
import Data.ByteString     (ByteString)
import Data.Function
import Data.Monoid
import Data.Yaml           (decodeFileEither, prettyPrintParseException)
import Prelude             hiding (FilePath)
import Options.Applicative
import System.Directory
import System.Exit
import System.FilePath
import System.FSNotify
import Text.Regex.TDFA

import qualified Data.ByteString.Char8 as BS
import qualified Data.List.NonEmpty    as NE

version :: String
version = "Steel Overseer 2.0"

data Options = Options
    { optTarget   :: FilePath
    , optCommands :: [ByteString]
    , optPatterns :: [ByteString]
    } deriving Show

main :: IO ()
main = execParser opts >>= main'
  where
    opts = info (helper <*> optsParser)
        ( fullDesc
       <> progDesc "A file watcher and development tool."
       <> header version )

    optsParser :: Parser Options
    optsParser = Options
        <$> strArgument
            ( help "File or directory to watch for changes."
           <> metavar "TARGET"
           <> value "."
           <> showDefault )
        <*> many (fmap BS.pack (strOption
            ( long "command"
           <> short 'c'
           <> help "Add command to run on file event."
           <> metavar "COMMAND" )))
        <*> many (fmap BS.pack (strOption
            ( long "pattern"
           <> short 'p'
           <> help "Add pattern to match on file path. Only relevant if the target is a directory. (default: .*)"
           <> metavar "PATTERN" )))

main' :: Options -> IO ()
main' Options{..} = do
    -- Parse .sosrc rules.
    rc_rules <- parseSosrc

    -- Parse cli rules, where one rule is created per pattern that executes each
    -- of commands sequentially.
    cli_rules <- do
        let patterns =
                case (rc_rules, optPatterns) of
                    -- If there are no commands in .sosrc, and no patterns
                    -- specified on the command line, default to ".*"
                    ([], []) -> [".*"]
                    _ -> optPatterns
        runSos (mapM (\pattern -> buildRule pattern optCommands) patterns)

    (target, rules) <- do
        is_dir  <- doesDirectoryExist optTarget
        is_file <- doesFileExist optTarget
        case (is_dir, is_file) of
            (True, _) -> pure (optTarget, cli_rules ++ rc_rules)
            -- If the target is a single file, completely ignore the .sosrc
            -- commands and the cli commands.
            (_, True) -> do
                rule <- runSos (buildRule (BS.pack optTarget) optCommands)
                pure (takeDirectory optTarget, [rule])
            _ -> do
                putStrLn ("Target " ++ optTarget ++ " is not a file or directory.")
                exitFailure

    putStrLn "Hit Ctrl+C to quit."

    withManager $ \wm -> do
        job_queue <- newJobQueue
        spawnFileWatcherThread wm job_queue target rules
        forever (dequeueJob job_queue >>= runJob job_queue)

spawnFileWatcherThread :: WatchManager -> JobQueue -> FilePath -> [Rule] -> IO ()
spawnFileWatcherThread wm job_queue target rules = do
    cwd <- getCurrentDirectory

    let eventRelPath :: Event -> FilePath
        eventRelPath event = makeRelative cwd (eventPath event)

        predicate :: Event -> Bool
        predicate event = any (\rule -> match (ruleRegex rule) (eventRelPath event)) rules

    _ <- watchTree wm target predicate $ \event -> do
        let path = BS.pack (eventRelPath event)

        commands <- concat <$> mapM (instantiateTemplates path) rules
        when (commands /= [])
            (enqueueJob (showEvent event cwd) (NE.fromList commands) job_queue)

    pure ()
  where
    instantiateTemplates :: ByteString -> Rule -> IO [ShellCommand]
    instantiateTemplates path Rule{..} =
        case match ruleRegex path of
            [] -> pure []
            (captures:_) -> runSos (mapM (instantiateTemplate captures) ruleTemplates)

--------------------------------------------------------------------------------

-- Parse a list of rules from .sosrc.
parseSosrc :: IO [Rule]
parseSosrc = do
    exists <- doesFileExist ".sosrc"
    if exists
        then
            decodeFileEither ".sosrc" >>= \case
                Left err -> do
                    putStrLn ("Error parsing .sosrc:\n" ++ prettyPrintParseException err)
                    exitFailure
                Right (raw_rules :: [RawRule]) -> do
                    rules <- runSos (mapM buildRawRule raw_rules)
                    putStrLn (case length raw_rules of
                                  1 -> "Found 1 rule in .sosrc"
                                  n -> "Found " ++ show n ++ " rules in .sosrc")
                    pure (concat rules)
        else pure []

--------------------------------------------------------------------------------

showEvent :: Event -> FilePath -> String
showEvent (Added fp _)    cwd = "Added: "    ++ makeRelative cwd fp
showEvent (Modified fp _) cwd = "Modified: " ++ makeRelative cwd fp
showEvent (Removed fp _)  cwd = "Removed: "  ++ makeRelative cwd fp