steeloverseer 2.0.0.1 → 2.0.1.0

raw patch · 19 files changed

+944/−623 lines, 19 filesdep +hfseventsdep +hspecdep +resourcetdep −megaparsecdep −microlensdep ~basedep ~filepathdep ~fsnotifyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hfsevents, hspec, resourcet, streaming

Dependencies removed: megaparsec, microlens

Dependency ranges changed: base, filepath, fsnotify

API changes (from Hackage documentation)

Files

• README.md +34/−23
• app/Main.hs +147/−115
• src/ANSI.hs +0/−13
• src/Job.hs +0/−190
• src/Rule.hs +0/−110
• src/Sos.hs +66/−36
• src/Sos/Exception.hs +37/−0
• src/Sos/FileEvent.hs +17/−0
• src/Sos/Job.hs +106/−0
• src/Sos/JobQueue.hs +104/−0
• src/Sos/Rule.hs +113/−0
• src/Sos/Template.hs +98/−0
• src/Sos/Utils.hs +36/−0
• src/System/FSNotify/Streaming.hs +28/−0
• src/Template.hs +0/−78
• steeloverseer.cabal +100/−58
• test/Sos/JobQueueSpec.hs +23/−0
• test/Sos/TemplateSpec.hs +34/−0
• test/Spec.hs +1/−0

@@ -20,19 +20,23 @@  See `sos --help` to get started: -    Steel Overseer 2.0+    Steel Overseer 2.0.1 -    Usage: sos [TARGET] [-c|--command COMMAND] [-p|--pattern PATTERN]+    Usage: sos [TARGET] [--rcfile ARG] [-c|--command COMMAND] [-p|--pattern PATTERN]       A file watcher and development tool.      Available options:       -h,--help                Show this help text-      TARGET                   File or directory to watch for+      TARGET                   Optional file or directory to watch for                                changes. (default: ".")+      --rcfile ARG             Optional rcfile to read patterns and commands+                               from. (default: ".sosrc")       -c,--command COMMAND     Add command to run on file event.       -p,--pattern PATTERN     Add pattern to match on file path. Only relevant if                                the target is a directory. (default: .*) +Patterns and Commands+------------------- Capture groups can be created with `(` `)` and captured variables can be referred to with `\1`, `\2`, etc. (`\0` contains the entire match). @@ -43,8 +47,10 @@  Commands are run left-to-right, and one failed command will halt the entire pipeline. -As a shortcut, we may want to write the above only once and save it in `.sosrc`, which is-an alternative to the command-line interface (yaml syntax):+The RCFile+----------+As a shortcut, we may want to write the above only once and save it in `.sosrc`,+which is an alternative to the command-line interface (yaml syntax):  ```yaml - pattern: src/(.*)\.c@@ -53,29 +59,17 @@   - make test --filter=test/\1_test.c ``` -Then, we only need to run+Then, we only need to run:      sos -to start watching the current directory.--Pipelines of commands are immediately canceled and re-run if a subsequent-filesystem event triggers the *same* list of commands. Otherwise, commands are-are enqueued and run sequentially to keep the terminal output clean and readable.--For example, we may wish to run `hlint` on any modified `.hs` file:--```yaml-- pattern: .*\.hs-  command: hlint \0-```+to start watching the current directory. If you'd like to use multiple rcfiles,+or just don't like the name `.sosrc` you can specify the rcfile on the command+line like so: -We can modify `foo.hs` and trigger `hlint foo.hs` to run. During its execution,-modifying `bar.hs` will *enqueue* `hlint bar.hs`, while modifying `foo.hs` again-will *re-run* `hlint foo.hs`.+    sos --rcfile my-rcfile -.sosrc grammar-==============+### Grammar      sosrc            := [entry]     entry            := { "pattern" | "patterns" : value | [value]@@ -89,3 +83,20 @@ The .sosrc grammar is somewhat flexible with respect to the command specifications. Both singular and plural keys are allowed, and both strings and lists of strings are allowed for values.++Pipelining Explaned+-------------------+Pipelines of commands are immediately canceled and re-run if a subsequent+filesystem event triggers the *same* list of commands. Otherwise, commands are+are enqueued and run sequentially to keep the terminal output clean and readable.++For example, we may wish to run `hlint` on any modified `.hs` file:++```yaml+- pattern: .*\.hs+  command: hlint \0+```++We can modify `foo.hs` and trigger `hlint foo.hs` to run. During its execution,+modifying `bar.hs` will *enqueue* `hlint bar.hs`, while modifying `foo.hs` again+will *re-run* `hlint foo.hs`.

@@ -1,152 +1,184 @@-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE RecordWildCards     #-}-{-# LANGUAGE ScopedTypeVariables #-}- module Main where -import Job-import Rule import Sos-import Template+import Sos.Utils +import qualified System.FSNotify.Streaming as FSNotify++import Control.Concurrent.Async import Control.Monad-import Data.ByteString     (ByteString)-import Data.Function+import Control.Monad.Except+import Data.ByteString        (ByteString)+import Data.List.NonEmpty     (NonEmpty(..)) import Data.Monoid-import Data.Yaml           (decodeFileEither, prettyPrintParseException)-import Prelude             hiding (FilePath)+import Data.Yaml              (decodeFileEither, prettyPrintParseException) import Options.Applicative+import Streaming import System.Directory import System.Exit import System.FilePath-import System.FSNotify-import Text.Regex.TDFA+import System.IO -import qualified Data.ByteString.Char8 as BS-import qualified Data.List.NonEmpty    as NE+import qualified Data.Foldable     as Foldable+import qualified Streaming.Prelude as S + version :: String-version = "Steel Overseer 2.0"+version = "Steel Overseer 2.0.1.0"  data Options = Options-    { optTarget   :: FilePath-    , optCommands :: [ByteString]-    , optPatterns :: [ByteString]-    } deriving Show+  { optTarget   :: FilePath+  , optRCFile   :: FilePath+  , optCommands :: [RawTemplate]+  , optPatterns :: [RawPattern]+  } deriving Show  main :: IO () main = execParser opts >>= main'-  where-    opts = info (helper <*> optsParser)-        ( fullDesc-       <> progDesc "A file watcher and development tool."-       <> header version )+ 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" )))+  optsParser :: Parser Options+  optsParser = Options+    <$> strArgument+     ( help "Optional file or directory to watch for changes."+       <> metavar "TARGET"+       <> value "."+       <> showDefault )+    <*> strOption+     ( help "Optional rcfile to read patterns and commands from."+       <> long "rcfile"+       <> value ".sosrc"+       <> showDefault )+    <*> many (fmap packBS (strOption+      ( long "command"+        <> short 'c'+        <> help "Add command to run on file event."+        <> metavar "COMMAND" )))+    <*> many (fmap packBS (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 .sosrc rules.+  rc_rules <- parseSosrc optRCFile -    -- 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)+  -- Parse cli rules, where one rule is created per pattern that executes+  -- each of @optCommands@ sequentially.+  cli_rules <- do+    let patterns :: [RawPattern]+        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 (`buildRule` 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+  (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 (packBS optTarget) optCommands)+        pure (takeDirectory optTarget, [rule])+      _ -> do+        putStrLn ("Target " ++ optTarget ++ " is not a file or directory.")+        exitFailure -    putStrLn "Hit Ctrl+C to quit."+  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)+  job_queue <- newJobQueue -spawnFileWatcherThread :: WatchManager -> JobQueue -> FilePath -> [Rule] -> IO ()-spawnFileWatcherThread wm job_queue target rules = do-    cwd <- getCurrentDirectory+  let enqueue_thread :: IO a+      enqueue_thread =+        runSos (sosEnqueueJobs rules (watchTree target) job_queue) -    let eventRelPath :: Event -> FilePath-        eventRelPath event = makeRelative cwd (eventPath event)+      -- Run jobs forever, only stopping to prompt whether or not to run+      -- enqueued jobs when a job fails. This way, the failing job's output+      -- will not be lost by subsequent jobs' outputs without the user's+      -- consent.+      dequeue_thread :: IO a+      dequeue_thread = forever $ do+        dequeueJob job_queue >>= \case+          JobSuccess -> pure ()+          JobFailure -> do+            jobQueueLength job_queue >>= \case+              0 -> pure ()+              n -> do+                putStrLn (yellow (show n ++ " job(s) still pending.")) -        predicate :: Event -> Bool-        predicate event = any (\rule -> match (ruleRegex rule) (eventRelPath event)) rules+                hSetBuffering stdin NoBuffering+                continue <- fix (\prompt -> do+                  putStr (yellow "Press 'c' to continue, 'p' to print, or 'a' to abort: ")+                  hFlush stdout+                  (getChar <* putStrLn "") >>= \case+                    'c' -> pure True+                    'a' -> pure False+                    'p' -> do+                      jobs <- jobQueueJobs job_queue+                      Foldable.forM_ (jobCommands <$> jobs) $+                        (\(c:|cs) -> do+                          putStrLn ("- " ++ c)+                          mapM_ (putStrLn . ("  " ++)) cs)+                      prompt+                    _ -> prompt)+                hSetBuffering stdin LineBuffering -    _ <- watchTree wm target predicate $ \event -> do-        let path = BS.pack (eventRelPath event)+                unless continue $ do+                  n' <- jobQueueLength job_queue+                  clearJobQueue job_queue+                  putStrLn (red ("Aborted " ++ show n' ++ " job(s).")) -        commands <- concat <$> mapM (instantiateTemplates path) rules-        when (commands /= [])-            (enqueueJob (showEvent event cwd) (NE.fromList commands) job_queue)+  race_ enqueue_thread dequeue_thread -    pure ()-  where-    instantiateTemplates :: ByteString -> Rule -> IO [ShellCommand]-    instantiateTemplates path Rule{..} =-        case match ruleRegex path of-            [] -> pure []-            (captures:_) -> runSos (mapM (instantiateTemplate captures) ruleTemplates)+watchTree+  :: forall m a.+     MonadResource m+  => FilePath -> Stream (Of FileEvent) m a+watchTree target = do+  cwd <- liftIO getCurrentDirectory ---------------------------------------------------------------------------------+  let config :: FSNotify.WatchConfig+      config = FSNotify.defaultConfig+        { FSNotify.confDebounce = FSNotify.Debounce 0.1 } --- 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 []+      stream :: Stream (Of FSNotify.Event) m a+      stream = FSNotify.watchTree config target (const True) +  S.for stream (\case+    FSNotify.Added    path _ -> S.yield (FileAdded    (go cwd path))+    FSNotify.Modified path _ -> S.yield (FileModified (go cwd path))+    FSNotify.Removed  _    _ -> pure ())+ where+  go :: FilePath -> FilePath -> ByteString+  go cwd path = packBS (makeRelative cwd path)+ -------------------------------------------------------------------------------- -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+-- Parse a list of rules from an rcfile.+parseSosrc :: FilePath -> IO [Rule]+parseSosrc sosrc = do+  exists <- doesFileExist sosrc+  if exists+    then+      decodeFileEither sosrc >>= \case+        Left err -> do+          putStrLn ("Error parsing " ++ show 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 " ++ show sosrc+                      n -> "Found " ++ show n ++ " rules in " ++ show sosrc)+          pure (concat rules)+    else pure []

@@ -1,13 +0,0 @@-module ANSI where--import Data.Monoid-import System.Console.ANSI--colored :: Color -> String -> String-colored c s = color c <> s <> reset--color :: Color -> String-color c = setSGRCode [SetColor Foreground Dull c]--reset :: String-reset = setSGRCode [Reset]

@@ -1,190 +0,0 @@-{-# LANGUAGE LambdaCase   #-}-{-# LANGUAGE ViewPatterns #-}--module Job-    ( Job-    , JobQueue-    , ShellCommand-    , newJobQueue-    , enqueueJob-    , dequeueJob-    , runJob-    ) where--import ANSI--import Control.Applicative-import Control.Concurrent.Async-import Control.Concurrent.STM-import Control.Exception-import Control.Monad-import Control.Monad.STM-import Data.Function                (fix)-import Data.List.NonEmpty           (NonEmpty(..))-import Data.Monoid-import Data.Sequence                (Seq, ViewL(..), (|>), viewl)-import Lens.Micro            hiding (to)-import System.Console.ANSI-import System.Exit-import System.IO-import System.Process-import Text.Printf--import qualified Data.List.NonEmpty as NE--type ShellCommand = String--data Job = Job-    { jobHeader   :: String-    , jobCommands :: NonEmpty ShellCommand-    , jobTMVar    :: TMVar ()-    }--makeJob :: String -> NonEmpty ShellCommand -> STM Job-makeJob header cmds = do-    tmvar <- newEmptyTMVar-    pure (Job header cmds tmvar)--jobEquals :: NonEmpty ShellCommand -> Job -> Bool-jobEquals cmds job = cmds == jobCommands job--data JobQueue-    = JobQueue-        (TVar (Maybe Job)) -- Currently running job-        (TVar (Seq Job))   -- Queue of jobs to run--newJobQueue :: IO JobQueue-newJobQueue = JobQueue <$> newTVarIO Nothing <*> newTVarIO mempty--enqueueJob :: String -> NonEmpty ShellCommand -> JobQueue -> IO ()-enqueueJob header cmds (JobQueue running_tv queue_tv) = atomically $-    readTVar running_tv >>= \case-        Just job | cmds `jobEquals` job ->-            restartJob job-        _ -> do-            queue <- readTVar queue_tv-            unless (seqContains jobEquals cmds queue) $ do-                new_job <- makeJob header cmds-                modifyTVar' queue_tv (|> new_job)---- | Dequeue a Job from a JobQueue. This assumes that there is no currently--- running job, but does not actually check.-dequeueJob :: JobQueue -> IO Job-dequeueJob (JobQueue running_tv queue_tv) = atomically $ do-    queue <- readTVar queue_tv-    case viewl queue of-        EmptyL -> retry-        (job :< jobs) -> do-            writeTVar running_tv (Just job)-            writeTVar queue_tv jobs-            pure job--runJob :: JobQueue -> Job -> IO ()-runJob job_queue@(JobQueue running_tv queue_tv)-       job@(Job header cmds tmvar) = do--    putStrLn ("\n" <> colored Cyan header)--    a <- async (runShellCommands (NE.toList cmds))--    let lhs :: STM (Either SomeException JobResult)-        lhs = waitCatchSTM a <* writeTVar running_tv Nothing--        rhs :: STM ()-        rhs = takeTMVar tmvar--    atomically (lhs <|||> rhs) >>= \case-        -- Job threw an exception - a ThreadKilled we are-        -- okay with, but anything else we should print to the-        -- console.-        Left (Left ex) ->-            case fromException ex of-                Just ThreadKilled -> pure ()-                _ -> putStrLn (colored Red ("Exception: " ++ show ex))--        -- Commands finished successfully.-        Left (Right JobSuccess) -> pure ()--        -- A command failed - if there is another enqueued list-        -- of commands to run, prompt the user to continue or-        -- abort.-        Left (Right JobFailure) -> do-            queue <- atomically (readTVar queue_tv)-            case length queue of-                0 -> pure ()-                n -> do-                    putStrLn (colored Yellow (show n ++ " job(s) still pending."))--                    hSetBuffering stdin NoBuffering-                    continue <- fix (\prompt -> do-                        putStr (colored Yellow "Press 'c' to continue, 'p' to print, or 'a' to abort: ")-                        hFlush stdout-                        (getChar <* putStrLn "") >>= \case-                            'c' -> pure True-                            'a' -> pure False-                            'p' -> do-                                mapM_ (\(c:|cs) -> do-                                          putStrLn ("- " ++ c)-                                          mapM_ (putStrLn . ("  " ++)) cs)-                                      (queue^..traversed.to jobCommands)-                                prompt-                            _ -> prompt)-                    hSetBuffering stdin LineBuffering--                    -- Here, it's possible we've reported that-                    -- `n` jobs were enqueued, but by the time-                    -- the user decides to abort them, more-                    -- were added. Oh well, delete them all.-                    unless continue $ do-                        n' <- atomically (length <$> swapTVar queue_tv mempty)-                        putStrLn (colored Red ("Aborted " ++ show n' ++ " job(s)."))--        -- Another filesystem event triggered this list of commands-        -- to be run again - cancel the previous run and start over.-        Right () -> do-            cancel a-            _ <- waitCatch a-            runJob job_queue job--restartJob :: Job -> STM ()-restartJob job = void (tryPutTMVar (jobTMVar job) ())--data JobResult = JobSuccess | JobFailure---- Run a list of shell commands sequentially. If a command returns ExitFailure,--- don't run the rest. Return whether or not all commands completed--- successfully.-runShellCommands :: [ShellCommand] -> IO JobResult-runShellCommands cmds0 = go 1 cmds0-  where-    go :: Int -> [ShellCommand] -> IO JobResult-    go _ [] = pure JobSuccess-    go n (cmd:cmds) = do-        putStrLn (colored Magenta (printf "[%d/%d] " n (length cmds0)) <> cmd)--        let create = (\(_, _, _, ph) -> ph) <$> createProcess (shell cmd)-            teardown ph = do-                putStrLn (colored Yellow ("Canceling: " ++ cmd))-                terminateProcess ph-        bracketOnError create teardown waitForProcess >>= \case-            ExitSuccess -> do-                putStrLn (colored Green "Success ✓")-                go (n+1) cmds-            _ -> do-                putStrLn (colored Red "Failure ✗")-                pure JobFailure---seqContains :: (a -> b -> Bool) -> a -> Seq b -> Bool-seqContains _ _ (viewl -> EmptyL) = False-seqContains p x (viewl -> y :< ys)-    | p x y     = True-    | otherwise = seqContains p x ys------------------------------------------------------------------------------------to :: (s -> a) -> (a -> Const r a) -> s -> Const r s-to f g s = Const (getConst (g (f s)))--(<|||>) :: Alternative f => f a -> f b -> f (Either a b)-fa <|||> fb = Left <$> fa <|> Right <$> fb

@@ -1,110 +0,0 @@-{-# LANGUAGE DeriveFunctor       #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Rule-    ( Rule(..)-    , RawRule(..)-    , buildRule-    , buildRawRule-    ) where--import Sos-import Template--import Control.Applicative-import Control.Monad.Except-import Data.Aeson.Types-import Data.ByteString            (ByteString)-import Data.Either-import Data.Text                  (Text)-import Text.Regex.TDFA-import Text.Regex.TDFA.ByteString (compile)--import qualified Data.Text.Encoding as T----- A Rule is a regex paired with a list of templates to execute on files--- that match the regex. Any mismatching of captured variables with the--- associated templates will be caught at runtime.------ For example, this definition from a .sosrc yaml file is incorrect:------     - pattern: .*.c---     - commands:---       - gcc -c {1}------ because there is only one capture variable, and it has with index 0.----data Rule = Rule-    { rulePattern   :: ByteString -- Text from which the regex was compiled.-    , ruleRegex     :: Regex      -- Compiled regex of command pattern.-    , ruleTemplates :: [Template] -- Command template.-    }---- Build a Rule from a RawRule by compiling the regex and parsing each Template.-buildRule :: forall m. MonadError SosException m => ByteString -> [ByteString] -> m Rule-buildRule pattern templates0 = do-    templates <- mapM parseTemplate templates0--    -- Improve performance for patterns with no capture groups.-    let (comp_opt, exec_opt) =-            case concatMap lefts templates of-                [] -> ( CompOption-                            { caseSensitive  = True-                            , multiline      = False-                            , rightAssoc     = True-                            , newSyntax      = True-                            , lastStarGreedy = True-                            }-                      , ExecOption-                            { captureGroups = False }-                      )-                _ -> (defaultCompOpt, defaultExecOpt)--    regex <--        case compile comp_opt exec_opt pattern of-            Left err -> throwError (SosRegexException pattern err)-            Right x  -> pure x--    pure (Rule pattern regex templates)---- A "raw" Rule that is post-processed after being parsed from a yaml--- file. Namely, the regex is compiled and the commands are parsed into--- templates.-data RawRule-    = RawRule-        [ByteString] -- patterns-        [ByteString] -- commands--instance FromJSON RawRule where-    parseJSON (Object o) = RawRule <$> parsePatterns <*> parseCommands-      where-        parsePatterns = fmap go (o .: "pattern" <|> o .: "patterns")-        parseCommands = fmap go (o .: "command" <|> o .: "commands")--        go :: OneOrList Text -> [ByteString]-        go = map T.encodeUtf8 . listify-    parseJSON v = typeMismatch "command" v--buildRawRule :: forall m. MonadError SosException m => RawRule -> m [Rule]-buildRawRule (RawRule patterns templates) =-    mapM (\pattern -> buildRule pattern templates) patterns------------------------------------------------------------------------------------data OneOrList a-    = One a-    | List [a]-    deriving Functor--instance FromJSON a => FromJSON (OneOrList a) where-    parseJSON v@(String _) = One  <$> parseJSON v-    parseJSON v@(Array _)  = List <$> parseJSON v-    parseJSON v = typeMismatch "element or list of elements" v--listify :: OneOrList a -> [a]-listify (One x)   = [x]-listify (List xs) = xs-

@@ -1,46 +1,76 @@-{-# LANGUAGE LambdaCase #-}+module Sos+  ( Sos+  , runSos+  , sosEnqueueJobs+  , module Sos.Exception+  , module Sos.FileEvent+  , module Sos.Job+  , module Sos.JobQueue+  , module Sos.Rule+  , module Sos.Template+  ) where -module Sos where+import Sos.Exception+import Sos.FileEvent+import Sos.Job+import Sos.JobQueue+import Sos.Rule+import Sos.Template +import Control.Applicative import Control.Monad.Except-import Data.ByteString      (ByteString)+import Control.Monad.Trans.Resource+import Data.List.NonEmpty           (NonEmpty(..))+import Streaming import System.Exit-import Text.Megaparsec      (ParseError)+import Text.Regex.TDFA              (match) -import qualified Data.ByteString.Char8 as BS+import qualified Streaming.Prelude as S -data SosException-    -- Error compiling the given regex.-    = SosRegexException-          ByteString -- pattern-          String     -- string reason for failure-    -- Error parsing a command template.-    | SosCommandParseException-          ByteString -- template-          ParseError -- failure-    -- Error applying a list of captured variables to a command template.-    | SosCommandApplyException-          [Either Int ByteString] -- template-          [ByteString]            -- captured variables-          String                  -- string reason for failure -instance Show SosException where-    show (SosRegexException pattern err) = "Error compiling regex '" ++ BS.unpack pattern ++ "': " ++ err-    show (SosCommandParseException template err) = "Error parsing command '" ++ BS.unpack template ++ "': " ++ show err-    show (SosCommandApplyException template vars err) = "Error applying template '" ++ reconstruct template ++ "' to " ++ show vars ++ ": " ++ err-      where-        reconstruct :: [Either Int ByteString] -> String-        reconstruct = concatMap-            (\case-                Left n   -> '\\' : show n-                Right bs -> BS.unpack bs)--type Sos a = ExceptT SosException IO a+type Sos a = ResourceT (ExceptT SosException IO) a +-- | Run an 'Sos' action in IO, exiting if any 'SosException's are thrown. runSos :: Sos a -> IO a runSos act =-    runExceptT act >>= \case-        Left err -> do-            print err-            exitFailure-        Right x -> pure x+  runExceptT (runResourceT act) >>= \case+    Left err -> do+      print err+      exitFailure+    Right x -> return x++-- | Enqueue jobs on the given job queue resulting from to apply the given+-- rules to each emitted file event from the given stream. This function+-- returns when the stream is exhausted.+sosEnqueueJobs+  :: (Applicative m, MonadError SosException m, MonadResource m)+  => [Rule]+  -> Stream (Of FileEvent) m a+  -> JobQueue+  -> m a+sosEnqueueJobs rules events queue =+  S.mapM_+    (\(event, cmds) -> liftIO (enqueueJob event cmds queue))+    (jobStream rules events)++jobStream+  :: forall m a.+     (Applicative m, MonadError SosException m)+  => [Rule]+  -> Stream (Of FileEvent) m a+  -> Stream (Of (FileEvent, NonEmpty ShellCommand)) m a+jobStream rules events =+  S.for events+    (\event ->+      lift (commands event) >>= \case+        []     -> pure ()+        (c:cs) -> S.yield (event, c :| cs))+ where+  commands :: FileEvent -> m [ShellCommand]+  commands event = concat <$> mapM go rules+   where+    go :: Rule -> m [ShellCommand]+    go rule =+      case match (ruleRegex rule) (fileEventPath event) of+        []     -> pure []+        (xs:_) -> mapM (instantiateTemplate xs) (ruleTemplates rule)

@@ -0,0 +1,37 @@+module Sos.Exception+  ( SosException(..)+  ) where++import Sos.Utils++import Data.ByteString (ByteString)+++data SosException+  -- Error compiling the given regex.+  = SosRegexException+      ByteString -- pattern+      String     -- string reason for failure+  -- Error parsing a command template.+  | SosCommandParseException+      ByteString -- template+  -- Error applying a list of captured variables to a command template.+  | SosCommandApplyException+      [Either Int ByteString] -- template+      [ByteString]            -- captured variables+      String                  -- string reason for failure+  deriving Eq++instance Show SosException where+  show (SosRegexException pattrn err) =+    "Error compiling regex '" ++ unpackBS pattrn ++ "': " ++ err+  show (SosCommandParseException template) =+    "Error parsing command '" ++ unpackBS template ++ "'"+  show (SosCommandApplyException template vars err) =+    "Error applying template '" ++ reconstruct template ++ "' to " ++   show vars ++ ": " ++ err+   where+    reconstruct :: [Either Int ByteString] -> String+    reconstruct = concatMap+      (\case+        Left n   -> '\\' : show n+        Right bs -> unpackBS bs)

@@ -0,0 +1,17 @@+{-# LANGUAGE LambdaCase #-}++module Sos.FileEvent+  ( FileEvent(..)+  , fileEventPath+  ) where++import Data.ByteString (ByteString)++data FileEvent+  = FileAdded    ByteString+  | FileModified ByteString++fileEventPath :: FileEvent -> ByteString+fileEventPath = \case+  FileAdded    path -> path+  FileModified path -> path

@@ -0,0 +1,106 @@+module Sos.Job+  ( Job(jobEvent, jobCommands)+  , JobResult(..)+  , ShellCommand+  , newJob+  , runJob+  , restartJob+  , unrestartJob+  , shouldRestartJob+  ) where++import Sos.FileEvent+import Sos.Utils++import Control.Applicative+import Control.Concurrent.STM+import Control.Exception+import Control.Monad+import Data.List.NonEmpty     (NonEmpty)+import Data.Monoid+import System.Exit+import System.Process+import Text.Printf++import qualified Data.List.NonEmpty as NonEmpty+++type ShellCommand = String+++data JobResult = JobSuccess | JobFailure+++-- | A 'Job' is an interruptible list of shell commands to run.+data Job = Job+  { jobEvent    :: FileEvent+    -- ^ Event that triggered this job.+  , jobCommands :: NonEmpty ShellCommand+    -- ^ The list of shell commands to run.+  , jobRestart  :: TMVar ()+    -- ^ A TMVar that, when written to, indicates this job should be+    -- immediately canceled and restarted.+  }++newJob :: FileEvent -> NonEmpty ShellCommand -> STM Job+newJob event cmds = do+  tmvar <- newEmptyTMVar+  pure (Job event cmds tmvar)++restartJob :: Job -> STM ()+restartJob job = void (tryPutTMVar (jobRestart job) ())++-- | Clear any previous restart "ping"s that were sent to this job while it was+-- sitting in the job queue (not at the front).+unrestartJob :: Job -> STM ()+unrestartJob = void . tryTakeTMVar . jobRestart++-- | An STM action that returns when this job should be restarted, and retries+-- otherwise.+shouldRestartJob :: Job -> STM ()+shouldRestartJob = readTMVar . jobRestart++-- | Run a Job's list of shell commands sequentially. If a command returns+-- ExitFailure, or an exception is thrown, don't run the rest (but also don't+-- propagate the exception). Return whether or not all commands completed+-- successfully.+runJob :: Job -> IO JobResult+runJob (NonEmpty.toList . jobCommands -> cmds0) = go 1 cmds0+ where+  go :: Int -> [ShellCommand] -> IO JobResult+  go _ [] = pure JobSuccess+  go n (cmd:cmds) = do+    putStrLn (magenta (printf "[%d/%d] " n (length cmds0)) <> cmd)++    let acquire :: IO ProcessHandle+        acquire = do+          (_, _, _, ph) <- createProcess (shell cmd)+          pure ph++    try (bracket acquire terminateProcess waitForProcess) >>= \case+      Left (ex :: SomeException) -> do+          -- We expect to get ThreadKilled exceptions when we get canceled and+          -- restarted. Any other exception would be bizarre; just print it and+          -- move on.+          case fromException ex of+            Just ThreadKilled ->+              case length cmds0 of+                -- If this was a one-command job, just print that it's been+                -- canceled. Otherwise, print a little graphic showing how much+                -- of the job was completed before being restarted+                1 -> putStrLn (yellow ("Restarting job: " ++ cmd))+                _ -> do+                  let (xs, ys) = splitAt (n-1) cmds0+                  putStrLn (yellow "Restarting job:")+                  mapM_ (putStrLn . yellow . printf "[✓] %s") xs+                  mapM_ (putStrLn . yellow . printf "[ ] %s") ys+            _ -> putStrLn (red ("Exception: " ++ show ex))+          pure JobFailure++      Right ExitSuccess -> do+        putStrLn (green "Success ✓")+        go (n+1) cmds++      Right (ExitFailure c) -> do+        putStrLn (red (printf "Failure ✗ (%d)" c))+        pure JobFailure

@@ -0,0 +1,104 @@+module Sos.JobQueue+  ( JobQueue+  , newJobQueue+  , clearJobQueue+  , jobQueueLength+  , jobQueueJobs+  , enqueueJob+  , dequeueJob+  ) where++import Sos.FileEvent+import Sos.Job+import Sos.Utils++import Control.Applicative+import Control.Concurrent.Async+import Control.Concurrent.STM+import Data.Foldable            (find)+import Data.List.NonEmpty       (NonEmpty(..))+import Data.Monoid+import Data.Sequence            (Seq, ViewL(..), (|>), viewl)++import qualified Data.Sequence as Sequence++-- | A 'JobQueue' is a mutable linked list of jobs. The job at the head of the+-- list is assumed to be currently running, however, it is left in the list so+-- it can be interrupted and restarted.+newtype JobQueue = JobQueue (TVar (Seq Job))++newJobQueue :: IO JobQueue+newJobQueue = JobQueue <$> newTVarIO mempty++clearJobQueue :: JobQueue -> IO ()+clearJobQueue (JobQueue queue) = atomically (writeTVar queue mempty)++jobQueueLength :: JobQueue -> IO Int+jobQueueLength queue = Sequence.length <$> jobQueueJobs queue++jobQueueJobs :: JobQueue -> IO (Seq Job)+jobQueueJobs (JobQueue queue_tv) = atomically (readTVar queue_tv)++enqueueJob :: FileEvent -> NonEmpty ShellCommand -> JobQueue -> IO ()+enqueueJob event cmds (JobQueue queue_tv) = atomically $ do+  queue <- readTVar queue_tv++  case find (\j -> jobCommands j == cmds) queue of+    -- If the job is not already enqueued, enqueue it.+    Nothing -> do+      job <- newJob event cmds+      writeTVar queue_tv (queue |> job)+    -- Otherwise, if it's already been enqueued, put into its reset var.+    -- This should only have an effect on the currently running job.+    Just job -> restartJob job++-- | Run the first job in the job queue, restarting it if signaled to do so.+-- When this function returns, the job is popped off the job queue, and its+-- result is returned.+dequeueJob :: JobQueue -> IO JobResult+dequeueJob (JobQueue queue_tv) = do+  -- Read the first job, but don't actually pop it off of the queue+  job <- atomically $ do+    queue <- readTVar queue_tv+    case viewl queue of+      j :< _ -> do+        unrestartJob j+        pure j+      _ -> retry++  putStrLn ("\n" <> cyan (showFileEvent (jobEvent job)))++  a <- async (runJob job)++  let doRunJob :: STM JobResult+      doRunJob = do+        r <- waitSTM a+        -- seqTail is safe here because this is the only function that pops+        -- jobs off of the job queue, and we already saw one job in the queue+        -- above.+        modifyTVar' queue_tv seqTail+        pure r++  atomically (doRunJob <|||> shouldRestartJob job) >>= \case+    -- Commands finished either successfully or unsuccessfully.+    Left result -> pure result++    -- Another filesystem event triggered this list of commands+    -- to be run again - cancel the previous run and start over.+    Right () -> do+      cancel a+      _ <- waitCatch a+      dequeueJob (JobQueue queue_tv)++--------------------------------------------------------------------------------++seqTail :: Seq a -> Seq a+seqTail s =+  case viewl s of+    _ :< xs -> xs+    _       -> error "seqTail: empty sequence"++showFileEvent :: FileEvent -> String+showFileEvent = \case+  FileAdded    path -> unpackBS ("Added: "    <> path)+  FileModified path -> unpackBS ("Modified: " <> path)

@@ -0,0 +1,113 @@+module Sos.Rule+  ( Rule(..)+  , RawRule(..)+  , RawPattern+  , buildRule+  , buildRawRule+  ) where++import Sos.Exception+import Sos.Template++import Control.Applicative+import Control.Monad.Except+import Data.Aeson.Types+import Data.ByteString            (ByteString)+import Data.Either+import Data.Text                  (Text)+import Text.Regex.TDFA+import Text.Regex.TDFA.ByteString (compile)++import qualified Data.Text.Encoding as Text+++-- | A 'ByteString' representing a pattern, e.g. "foo\.hs" or ".*\.c"+type RawPattern = ByteString+++-- A Rule is a regex paired with a list of templates to execute on files+-- that match the regex. Any mismatching of captured variables with the+-- associated templates will be caught at runtime.+--+-- For example, this definition from a .sosrc yaml file is incorrect:+--+--     - pattern: .*.c+--     - commands:+--       - gcc -c \1+--+-- because there is only one capture variable, and it has with index 0.+--+data Rule = Rule+  { ruleRegex     :: Regex      -- Compiled regex of command pattern.+  , ruleTemplates :: [Template] -- Command template.+  }++-- Build a 'Rule' from a 'RawPattern' and a list of 'RawTemplate' by compiling+-- the pattern regex and parsing each template.+buildRule+  :: forall m. MonadError SosException m+  => RawPattern+  -> [RawTemplate]+  -> m Rule+buildRule pattrn templates0 = do+  templates <- mapM parseTemplate templates0++  -- Improve performance for patterns with no capture groups.+  let (comp_opt, exec_opt) =+        case concatMap lefts templates of+          [] -> ( CompOption+                    { caseSensitive  = True+                    , multiline      = False+                    , rightAssoc     = True+                    , newSyntax      = True+                    , lastStarGreedy = True+                    }+                , ExecOption+                    { captureGroups = False }+                )+          _ -> (defaultCompOpt, defaultExecOpt)++  regex <-+    case compile comp_opt exec_opt pattrn of+      Left err -> throwError (SosRegexException pattrn err)+      Right x  -> return x++  return (Rule regex templates)++-- A "raw" Rule that is post-processed after being parsed from a yaml+-- file. Namely, the regex is compiled and the commands are parsed into+-- templates.+data RawRule = RawRule [RawPattern] [RawTemplate]++instance FromJSON RawRule where+  parseJSON (Object o) = RawRule <$> parsePatterns <*> parseCommands+   where+    parsePatterns :: Parser [RawPattern]+    parsePatterns = fmap go (o .: "pattern" <|> o .: "patterns")++    parseCommands :: Parser [RawTemplate]+    parseCommands = fmap go (o .: "command" <|> o .: "commands")++    go :: OneOrList Text -> [ByteString]+    go = map Text.encodeUtf8 . listify+  parseJSON v = typeMismatch "command" v++buildRawRule :: forall m. MonadError SosException m => RawRule -> m [Rule]+buildRawRule (RawRule patterns templates) =+  mapM (\pattrn -> buildRule pattrn templates) patterns++--------------------------------------------------------------------------------++data OneOrList a+  = One a+  | List [a]+  deriving Functor++instance FromJSON a => FromJSON (OneOrList a) where+  parseJSON v@(String _) = One  <$> parseJSON v+  parseJSON v@(Array _)  = List <$> parseJSON v+  parseJSON v = typeMismatch "element or list of elements" v++listify :: OneOrList a -> [a]+listify (One x)   = [x]+listify (List xs) = xs

@@ -0,0 +1,98 @@+module Sos.Template+  ( RawTemplate+  , Template+  , parseTemplate+  , instantiateTemplate+  ) where++import Sos.Exception+import Sos.Job       (ShellCommand)+import Sos.Utils++import Control.Applicative+import Control.Monad.Except+import Data.ByteString              (ByteString)+import Data.Monoid+import Text.ParserCombinators.ReadP++import qualified Data.Text.Encoding     as Text+import qualified Data.Text.Lazy         as LText+import qualified Data.Text.Lazy.Builder as LText+++-- | A 'RawTemplate' represents a shell command, possibly containing capture+-- groups, e.g. "ghc \0"+type RawTemplate = ByteString++-- A 'Template' is a parsed 'RawTemplate' that replaces all capture groups with+-- Lefts.+--+-- For example, the raw template+--+--    "gcc -c \1.c -o \1.c"+--+-- will become+--+--    [Right "gcc -c ", Left 1, Right ".c -o ", Left 1, Right ".c"]+--+type Template = [Either Int ByteString]+++parseTemplate :: MonadError SosException m => RawTemplate -> m Template+parseTemplate raw_template =+  case readP_to_S parser (unpackBS raw_template) of+    [(template, "")] -> return template+    _ -> throwError (SosCommandParseException raw_template)+ where+  parser :: ReadP Template+  parser = some (capturePart <|||> textPart) <* eof+   where+    capturePart :: ReadP Int+    capturePart = read <$> (char '\\' *> munch1 digit)+     where+      digit :: Char -> Bool+      digit c = c >= '0' && c <= '9'++    textPart :: ReadP ByteString+    textPart = packBS <$> munch1 (/= '\\')++-- Instantiate a template with a list of captured variables, per their indices.+--+-- For example,+--+--    instantiateTemplate ["ONE", "TWO"] [Right "foo", Left 0, Right "bar", Left 1] == "fooONEbarTWO"+--+instantiateTemplate+  :: forall m. MonadError SosException m+  => [ByteString]+  -> Template+  -> m ShellCommand+instantiateTemplate vars0 template0 = go 0 vars0 template0+ where+  go :: Int -> [ByteString] -> Template -> m ShellCommand+  go _ [] template =+    case flattenTemplate template of+      Left n ->+        let err = "uninstantiated template variable: \\" ++ show n+        in throwError (SosCommandApplyException template0 vars0 err)+      Right x -> return x+  go n (t:ts) template = go (n+1) ts (map f template)+   where+    f :: Either Int ByteString -> Either Int ByteString+    f (Left n')+        | n == n'   = Right t+        | otherwise = Left n'+    f x = x++-- Attempt to flatten a list of Rights to a single string.+flattenTemplate :: Template -> Either Int ShellCommand+flattenTemplate = go mempty+ where+  go :: LText.Builder -> Template -> Either Int ShellCommand+  go !acc [] = Right (LText.unpack (LText.toLazyText acc))+  go !acc (x:xs) =+    case x of+      Right s ->+        let acc' = acc <> LText.fromText (Text.decodeUtf8 s)+        in go acc' xs+      Left n -> Left n

@@ -0,0 +1,36 @@+module Sos.Utils where++import Control.Applicative+import Data.Monoid+import Data.ByteString     (ByteString)+import System.Console.ANSI++import qualified Data.Text          as Text+import qualified Data.Text.Encoding as Text++(<|||>) :: Alternative f => f a -> f b -> f (Either a b)+fa <|||> fb = Left <$> fa <|> Right <$> fb++-- The proper way to make a ByteString from a String - Data.ByteString.Char8+-- will snip each Char to 8 bits.+packBS :: String -> ByteString+packBS = Text.encodeUtf8 . Text.pack++unpackBS :: ByteString -> String+unpackBS = Text.unpack . Text.decodeUtf8++colored :: Color -> String -> String+colored c s = color c <> s <> reset++color :: Color -> String+color c = setSGRCode [SetColor Foreground Dull c]++reset :: String+reset = setSGRCode [Reset]++cyan, green, magenta, red, yellow :: String -> String+cyan    = colored Cyan+green   = colored Green+magenta = colored Magenta+red     = colored Red+yellow  = colored Yellow

@@ -0,0 +1,28 @@+-- | A streaming wrapper around System.FSNotify.++module System.FSNotify.Streaming+  ( System.FSNotify.Streaming.watchTree+    -- * Re-exports+  , Event(..)+  , WatchManager+  , WatchConfig(..)+  , Debounce(..)+  , defaultConfig+  ) where++import Control.Concurrent.Chan+import Control.Monad+import Control.Monad.Trans.Resource+import Streaming+import Streaming.Prelude (yield)+import System.FSNotify++watchTree+  :: MonadResource m+  => WatchConfig -> FilePath -> (Event -> Bool) -> Stream (Of Event) m a+watchTree config path predicate = do+  chan         <- liftIO newChan+  (_, manager) <- allocate (startManagerConf config) stopManager+  _            <- allocate (watchTreeChan manager path predicate chan) id++  forever (liftIO (readChan chan) >>= yield)

@@ -1,78 +0,0 @@-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Template-    ( Template-    , parseTemplate-    , instantiateTemplate-    ) where--import Sos--import Control.Monad.Except-import Data.ByteString (ByteString)-import Data.Monoid-import Text.Megaparsec--import qualified Data.ByteString.Char8      as BS-import qualified Data.ByteString.Lazy.Char8 as BSL-import qualified Data.ByteString.Builder    as BS---- A template is a string that may contain anti-quoted capture groups.--- For example,------    "gcc -c \1.c -o \1.c"------ will become------    [Right "gcc -c ", Left 1, Right ".c -o ", Left 1, Right ".c"]-type Template-    = [Either Int ByteString]--parseTemplate :: MonadError SosException m => ByteString -> m Template-parseTemplate template =-    case runParser parser "" template of-        Left err -> throwError (SosCommandParseException template err)-        Right x  -> pure x-  where-    parser :: Parsec ByteString Template-    parser = some (Right <$> textPart-          <|> Left  <$> capturePart)-      where-        textPart :: Parsec ByteString ByteString-        textPart = BS.pack <$> some (satisfy (/= '\\'))--        capturePart :: Parsec ByteString Int-        capturePart = read <$> (char '\\' *> some digitChar)---- Instantiate a template with a list of captured variables, per their indices.------ For example,------    instantiateTemplate ["ONE", "TWO"] [Right "foo", Left 0, Right "bar", Left 1] == "fooONEbarTWO"----instantiateTemplate :: forall m. MonadError SosException m => [ByteString] -> Template -> m String-instantiateTemplate vars0 template0 = go 0 vars0 template0-  where-    go :: Int -> [ByteString] -> Template -> m String-    go _ [] template =-        case flattenTemplate template of-            Left err -> throwError (SosCommandApplyException template0 vars0 err)-            Right x  -> pure x-    go n (t:ts) template = go (n+1) ts (map f template)-      where-        f :: Either Int ByteString -> Either Int ByteString-        f (Left n')-            | n == n'   = Right t-            | otherwise = Left n'-        f x = x---- Attempt to flatten a list of Rights to a single string.-flattenTemplate :: Template -> Either String String-flattenTemplate = go mempty-  where-    go :: BS.Builder -> Template -> Either String String-    go acc [] = Right (BSL.unpack (BS.toLazyByteString acc))-    go acc (Right x : xs) = go (acc <> BS.byteString x) xs-    go _   (Left n : _) = Left ("uninstantiated template variable \\" <> show n)-

@@ -1,73 +1,115 @@-name: steeloverseer--- The package version.  See the Haskell package versioning policy (PVP)--- for standards guiding when and how versions should be incremented.--- http://www.haskell.org/haskellwiki/Package_versioning_policy---       +-+------- breaking API changes---       | | +----- non-breaking API additions---       | | | +--- code changes with no API change-version: 2.0.0.1-cabal-version: >=1.8-build-type: Simple-license: BSD3-license-file: LICENSE-maintainer: schell.scivally@synapsegrop.com-stability: stable-homepage: https://github.com/schell/steeloverseer-bug-reports: https://github.com/schell/steeloverseer/issues-synopsis: A file watcher and development tool.-description:-    A command line tool that responds to filesystem events.-    Allows the user to automatically execute commands after-    files are added or updated. Watches files using regular-    expressions.-category: Development-author: Schell Scivally, Mitchell Rosen+-- This file has been generated from package.yaml by hpack version 0.14.1.+--+-- see: https://github.com/sol/hpack++name:           steeloverseer+version:        2.0.1.0+cabal-version:  >= 1.10+build-type:     Simple+license:        BSD3+license-file:   LICENSE+maintainer:     efsubenovex@gmail.com+stability:      stable+homepage:       https://github.com/schell/steeloverseer#readme+bug-reports:    https://github.com/schell/steeloverseer/issues+synopsis:       A file watcher and development tool.+description:    A command line tool that responds to filesystem events. Allows the user to automatically execute commands after files are added or updated. Watches files using regular expressions.+category:       Development+author:         Schell Scivally,+                Mitchell Rosen+ extra-source-files:-    README.md+      README.md  source-repository head     type: git-    location: git://github.com/schell/steeloverseer.git+    location: https://github.com/schell/steeloverseer  library     exposed-modules:-        ANSI-        Job-        Rule-        Sos-        Template+          Sos+          Sos.Exception+          Sos.FileEvent+          Sos.Job+          Sos.JobQueue+          Sos.Rule+          Sos.Template+          Sos.Utils+          System.FSNotify.Streaming+    default-language: Haskell2010     build-depends:-        base >= 4.0 && < 6.0-      , aeson >= 0.8-      , ansi-terminal >= 0.6.2-      , async >= 2.0-      , bytestring >= 0.10-      , containers >= 0.5-      , megaparsec >= 4.2 && < 5.0-      , microlens >= 0.2-      , mtl >= 2.2-      , process >= 1.2-      , semigroups >= 0.16-      , regex-tdfa >= 1.2-      , stm >= 2.4-      , text >= 1.2-      , yaml >= 0.8-    hs-source-dirs: src+          async      >= 2.0+        , base       >= 4.0 && < 5.0+        , bytestring >= 0.10+        , fsnotify   >= 0.2+        , mtl        >= 2.2+        , regex-tdfa >= 1.2+        , resourcet  >= 1.0+        , semigroups >= 0.16+        , stm        >= 2.4+        , streaming  >= 0.1.0 && < 0.1.5+        , text       >= 1.2+        , yaml       >= 0.8+        , aeson         >= 0.8+        , ansi-terminal >= 0.6.2+        , containers    >= 0.5+        , process       >= 1.2+    hs-source-dirs:+          src+    default-extensions: BangPatterns DeriveFunctor FlexibleContexts LambdaCase OverloadedStrings RecordWildCards ScopedTypeVariables ViewPatterns     ghc-options: -Wall  executable sos     main-is: Main.hs     build-depends:-        base >= 4.0 && < 6.0-      , steeloverseer-      , bytestring >= 0.10-      , directory >= 1.2-      , fsnotify >= 0.2-      , filepath >= 1.4-      , optparse-applicative >= 0.11-      , regex-tdfa >= 1.2-      , semigroups >= 0.16-      , yaml >= 0.8-    hs-source-dirs: app+          async      >= 2.0+        , base       >= 4.0 && < 5.0+        , bytestring >= 0.10+        , fsnotify   >= 0.2+        , mtl        >= 2.2+        , regex-tdfa >= 1.2+        , resourcet  >= 1.0+        , semigroups >= 0.16+        , stm        >= 2.4+        , streaming  >= 0.1.0 && < 0.1.5+        , text       >= 1.2+        , yaml       >= 0.8+        , steeloverseer+        , directory >= 1.2+        , filepath >= 1.3+        , optparse-applicative >= 0.11+    if os(darwin)+        build-depends:+              hfsevents >= 0.1.3+    default-language: Haskell2010+    hs-source-dirs:+          app+    default-extensions: BangPatterns DeriveFunctor FlexibleContexts LambdaCase OverloadedStrings RecordWildCards ScopedTypeVariables ViewPatterns     ghc-options: -Wall -threaded +test-suite spec+    type: exitcode-stdio-1.0+    main-is: Spec.hs+    hs-source-dirs:+          test+    default-extensions: BangPatterns DeriveFunctor FlexibleContexts LambdaCase OverloadedStrings RecordWildCards ScopedTypeVariables ViewPatterns+    ghc-options: -Wall+    build-depends:+          async      >= 2.0+        , base       >= 4.0 && < 5.0+        , bytestring >= 0.10+        , fsnotify   >= 0.2+        , mtl        >= 2.2+        , regex-tdfa >= 1.2+        , resourcet  >= 1.0+        , semigroups >= 0.16+        , stm        >= 2.4+        , streaming  >= 0.1.0 && < 0.1.5+        , text       >= 1.2+        , yaml       >= 0.8+        , steeloverseer+        , hspec+    other-modules:+          Sos.JobQueueSpec+          Sos.TemplateSpec+    default-language: Haskell2010

@@ -0,0 +1,23 @@+module Sos.JobQueueSpec where++import Sos.FileEvent+import Sos.JobQueue++import Test.Hspec++import qualified Data.List.NonEmpty as NonEmpty++spec :: Spec+spec =+  describe "enqueueJob" $ do+    it "enqueues jobs" $ do+      queue <- newJobQueue+      enqueueJob (FileAdded "foo.txt") (NonEmpty.fromList ["a","b","c"]) queue+      enqueueJob (FileAdded "bar.txt") (NonEmpty.fromList ["d","e","f"]) queue+      jobQueueLength queue `shouldReturn` 2++    it "does not double-enqueue" $ do+      queue <- newJobQueue+      enqueueJob (FileAdded "foo.txt") (NonEmpty.fromList ["a","b","c"]) queue+      enqueueJob (FileAdded "bar.txt") (NonEmpty.fromList ["a","b","c"]) queue+      jobQueueLength queue `shouldReturn` 1

@@ -0,0 +1,34 @@+module Sos.TemplateSpec where++import Sos.Template++import Test.Hspec++spec :: Spec+spec = do+  describe "parseTemplate" $ do+    it "fails on the empty string" $+      parseTemplate "" `shouldSatisfy` isLeft++    it "parses templates" $ do+      parseTemplate "hi"      `shouldBe` Right [Right "hi"]+      parseTemplate "foo bar" `shouldBe` Right [Right "foo bar"]+      parseTemplate "\\25"    `shouldBe` Right [Left 25]+      parseTemplate "gcc \\0" `shouldBe` Right [Right "gcc ", Left 0]++  describe "instantiateTemplate" $ do+    it "ignores capture groups in templates with no captures" $ do+      instantiateTemplate []            [Right "z"] `shouldBe` Right "z"+      instantiateTemplate ["a"]         [Right "z"] `shouldBe` Right "z"+      instantiateTemplate ["a","b","c"] [Right "z"] `shouldBe` Right "z"++    it "substitutes capture groups" $ do+      instantiateTemplate ["a","b","c"] [Left 2, Left 1, Left 0] `shouldBe` Right "cba"++    it "errors when there are not enough capture groups" $ do+      instantiateTemplate []    [Left 0] `shouldSatisfy` isLeft+      instantiateTemplate ["a"] [Left 1] `shouldSatisfy` isLeft++isLeft :: Either a b -> Bool+isLeft (Left _) = True+isLeft _ = False

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}