diff --git a/feedback.cabal b/feedback.cabal --- a/feedback.cabal +++ b/feedback.cabal @@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.34.7. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: feedback -version: 0.1.0.1 +version: 0.1.0.2 synopsis: Declarative feedback loop manager homepage: https://github.com/NorfairKing/feedback#readme bug-reports: https://github.com/NorfairKing/feedback/issues @@ -56,13 +56,13 @@ , unix , unliftio , yaml + default-language: Haskell2010 if os(windows) build-depends: Win32 >=2.13.2 else build-depends: safe-coloured-text-terminfo - default-language: Haskell2010 executable feedback main-is: Loop.hs diff --git a/src/Feedback/Common/OptParse.hs b/src/Feedback/Common/OptParse.hs --- a/src/Feedback/Common/OptParse.hs +++ b/src/Feedback/Common/OptParse.hs @@ -28,7 +28,8 @@ data LoopSettings = LoopSettings { loopSettingRunSettings :: !RunSettings, loopSettingFilterSettings :: !FilterSettings, - loopSettingOutputSettings :: !OutputSettings + loopSettingOutputSettings :: !OutputSettings, + loopSettingHooksSettings :: !HooksSettings } deriving (Show, Eq, Generic) @@ -39,6 +40,7 @@ let outputConfig = maybe loopConfigOutputConfiguration (<> loopConfigOutputConfiguration) mDefaultOutputConfig let loopSettingOutputSettings = combineToOutputSettings flagOutputFlags outputConfig + loopSettingHooksSettings <- combineToHooksSettings loopConfigHooksConfiguration pure LoopSettings {..} data RunSettings = RunSettings @@ -55,11 +57,6 @@ runSettingWorkingDir <- mapM resolveDir' runConfigWorkingDir pure RunSettings {..} -data OutputSettings = OutputSettings - { outputSettingClear :: !Clear - } - deriving (Show, Eq, Generic) - data FilterSettings = FilterSettings { filterSettingGitignore :: !Bool, filterSettingFind :: !(Maybe String) @@ -72,6 +69,11 @@ filterSettingFind = filterConfigFind in FilterSettings {..} +data OutputSettings = OutputSettings + { outputSettingClear :: !Clear + } + deriving (Show, Eq, Generic) + combineToOutputSettings :: OutputFlags -> OutputConfiguration -> OutputSettings combineToOutputSettings OutputFlags {..} mConf = let outputSettingClear = @@ -79,6 +81,18 @@ outputFlagClear <|> outputConfigClear mConf in OutputSettings {..} +data HooksSettings = HooksSettings + { hooksSettingBeforeAll :: Maybe RunSettings, + hooksSettingAfterFirst :: Maybe RunSettings + } + deriving (Show, Eq, Generic) + +combineToHooksSettings :: HooksConfiguration -> IO HooksSettings +combineToHooksSettings HooksConfiguration {..} = do + hooksSettingBeforeAll <- mapM combineToRunSettings hooksConfigurationBeforeAll + hooksSettingAfterFirst <- mapM combineToRunSettings hooksConfigurationAfterFirst + pure HooksSettings {..} + data Configuration = Configuration { configLoops :: !(Map String LoopConfiguration), configOutputConfiguration :: !(Maybe OutputConfiguration) @@ -90,14 +104,24 @@ codec = object "Configuration" $ Configuration - <$> optionalFieldWithOmittedDefault' "loops" M.empty .= configLoops - <*> optionalField "output" "default output configuration" .= configOutputConfiguration + <$> optionalFieldWithOmittedDefault' "loops" M.empty + .= configLoops + <*> optionalField "output" "default output configuration" + .= configOutputConfiguration +emptyConfiguration :: Configuration +emptyConfiguration = + Configuration + { configLoops = mempty, + configOutputConfiguration = mempty + } + data LoopConfiguration = LoopConfiguration { loopConfigDescription :: !(Maybe String), loopConfigRunConfiguration :: !RunConfiguration, loopConfigFilterConfiguration :: !FilterConfiguration, - loopConfigOutputConfiguration :: !OutputConfiguration + loopConfigOutputConfiguration :: !OutputConfiguration, + loopConfigHooksConfiguration :: !HooksConfiguration } deriving stock (Show, Eq, Generic) deriving (FromJSON, ToJSON) via (Autodocodec LoopConfiguration) @@ -115,25 +139,27 @@ loopConfigDocs = [ "A LoopConfiguration specifies an entire feedback loop.", "", - "It consists of three parts:", + "It consists of four parts:", "* Filter Configuration: Which files to watch", "* Run Configuration: What to do when those files change", - "* Output Configuration: What to see" + "* Output Configuration: What to see", + "* Hooks configuration: What to around commands" ] f = \case - Left s -> makeLoopConfiguration (CommandArgs s) + Left s -> makeLoopConfiguration (CommandScript s) Right loopConfig -> loopConfig g loopConfig = let runConfig = loopConfigRunConfiguration loopConfig c = runConfigCommand runConfig in case c of - CommandArgs cmd | loopConfig == makeLoopConfiguration c -> Left cmd + CommandScript cmd | loopConfig == makeLoopConfiguration c -> Left cmd _ -> Right loopConfig loopConfigurationObjectCodec :: JSONObjectCodec LoopConfiguration loopConfigurationObjectCodec = LoopConfiguration - <$> optionalField "description" "description of when to use this feedback loop" .= loopConfigDescription + <$> optionalField "description" "description of when to use this feedback loop" + .= loopConfigDescription <*> parseAlternative (requiredField "run" "run configuration for this loop") runConfigurationObjectCodec @@ -146,6 +172,10 @@ (requiredField "output" "output configuration for this loop") outputConfigurationObjectCodec .= loopConfigOutputConfiguration + <*> parseAlternative + (requiredField "hooks" "hooks configuration for this loop") + hooksConfigurationObjectCodec + .= loopConfigHooksConfiguration makeLoopConfiguration :: Command -> LoopConfiguration makeLoopConfiguration c = @@ -153,7 +183,8 @@ { loopConfigDescription = Nothing, loopConfigRunConfiguration = makeRunConfiguration c, loopConfigFilterConfiguration = emptyFilterConfiguration, - loopConfigOutputConfiguration = emptyOutputConfiguration + loopConfigOutputConfiguration = emptyOutputConfiguration, + loopConfigHooksConfiguration = emptyHooksConfiguration } data RunConfiguration = RunConfiguration @@ -167,14 +198,29 @@ instance HasCodec RunConfiguration where codec = named "RunConfiguration" $ - object "RunConfiguration" runConfigurationObjectCodec + dimapCodec f g $ + eitherCodec + (codec "A bare command without any extra configuration") + (object "RunConfiguration" runConfigurationObjectCodec) + where + f = \case + Left s -> makeRunConfiguration (CommandScript s) + Right loopConfig -> loopConfig + g runConfig = + let c = runConfigCommand runConfig + in case c of + CommandScript cmd | runConfig == makeRunConfiguration c -> Left cmd + _ -> Right runConfig runConfigurationObjectCodec :: JSONObjectCodec RunConfiguration runConfigurationObjectCodec = RunConfiguration - <$> commandObjectCodec .= runConfigCommand - <*> optionalFieldWithOmittedDefault "env" M.empty "extra environment variables to set" .= runConfigExtraEnv - <*> optionalField "working-dir" "where the process will be run" .= runConfigWorkingDir + <$> commandObjectCodec + .= runConfigCommand + <*> optionalFieldWithOmittedDefault "env" M.empty "extra environment variables to set" + .= runConfigExtraEnv + <*> optionalField "working-dir" "where the process will be run" + .= runConfigWorkingDir makeRunConfiguration :: Command -> RunConfiguration makeRunConfiguration c = @@ -208,8 +254,10 @@ filterConfigurationObjectCodec :: JSONObjectCodec FilterConfiguration filterConfigurationObjectCodec = FilterConfiguration - <$> optionalField "git" "whether to ignore files that are not in the git repo\nConcretely, this uses `git ls-files` to find files that are in the repo, so files that have been added but are also ignored by .gitignore will still be watched." .= filterConfigGitignore - <*> optionalField "find" "arguments for the 'find' command to find files to be notified about" .= filterConfigFind + <$> optionalField "git" "whether to ignore files that are not in the git repo\nConcretely, this uses `git ls-files` to find files that are in the repo, so files that have been added but are also ignored by .gitignore will still be watched." + .= filterConfigGitignore + <*> optionalField "find" "arguments for the 'find' command to find files to be notified about" + .= filterConfigFind emptyFilterConfiguration :: FilterConfiguration emptyFilterConfiguration = @@ -232,7 +280,8 @@ outputConfigurationObjectCodec :: JSONObjectCodec OutputConfiguration outputConfigurationObjectCodec = OutputConfiguration - <$> optionalField "clear" "whether to clear the screen runs" .= outputConfigClear + <$> optionalField "clear" "whether to clear the screen runs" + .= outputConfigClear instance Semigroup OutputConfiguration where (<>) oc1 oc2 = @@ -246,6 +295,32 @@ { outputConfigClear = Nothing } +data HooksConfiguration = HooksConfiguration + { hooksConfigurationBeforeAll :: !(Maybe RunConfiguration), + hooksConfigurationAfterFirst :: !(Maybe RunConfiguration) + } + deriving (Show, Eq, Generic) + +instance HasCodec HooksConfiguration where + codec = + named "HooksConfiguration" $ + object "HooksConfiguration" hooksConfigurationObjectCodec + +hooksConfigurationObjectCodec :: JSONObjectCodec HooksConfiguration +hooksConfigurationObjectCodec = + HooksConfiguration + <$> optionalField "before-all" "The hook to run before the first run" + .= hooksConfigurationBeforeAll + <*> optionalField "after-first" "The hook to run after the first run" + .= hooksConfigurationAfterFirst + +emptyHooksConfiguration :: HooksConfiguration +emptyHooksConfiguration = + HooksConfiguration + { hooksConfigurationBeforeAll = Nothing, + hooksConfigurationAfterFirst = Nothing + } + getConfiguration :: Flags -> Environment -> IO (Maybe Configuration) getConfiguration Flags {..} Environment {..} = do fp <- case flagConfigFile <|> envConfigFile of @@ -326,7 +401,8 @@ <*> optional ( strOption ( mconcat - [ long "config-file", + [ short 'c', + long "config-file", help "Path to an altenative config file", metavar "FILEPATH" ] @@ -344,15 +420,7 @@ completer (listIOCompleter defaultConfigFileCompleter) ] ) - escapeChar = \case - '"' -> "\\\"" - '\'' -> "\\\'" - c -> [c] - quote = ("\"" <>) . (<> "\"") . concatMap escapeChar - quoteIfNecessary "" = quote "" - quoteIfNecessary s = if ' ' `elem` s then quote s else s - pieceBackTogether = unwords . map quoteIfNecessary - in pieceBackTogether <$> many commandArg + in unwords <$> many commandArg defaultConfigFileCompleter :: IO [String] defaultConfigFileCompleter = do @@ -363,26 +431,25 @@ parseOutputFlags = OutputFlags <$> parseClearFlag - <*> switch (mconcat [long "debug", help "show debug information"]) + <*> switch + ( mconcat + [ short 'd', + long "debug", + help "show debug information" + ] + ) -data Command - = CommandArgs !String - | CommandScript !String +newtype Command = CommandScript {unScript :: String} deriving (Show, Eq, Generic) +instance HasCodec Command where + codec = dimapCodec CommandScript unScript codec + commandObjectCodec :: JSONObjectCodec Command commandObjectCodec = - dimapCodec f g $ - eitherCodec - (requiredField "command" "the command to run on change") - (requiredField "script" "the script to run on change") - where - f = \case - Left c -> CommandArgs c - Right s -> CommandScript s - g = \case - CommandArgs c -> Left c - CommandScript s -> Right s + parseAlternative + (requiredField "script" "the script to run on change") + (requiredField "command" "the command to run on change (alias for 'script' for backward compatibility)") data Clear = ClearScreen | DoNotClearScreen deriving (Show, Eq, Generic) diff --git a/src/Feedback/Common/Output.hs b/src/Feedback/Common/Output.hs --- a/src/Feedback/Common/Output.hs +++ b/src/Feedback/Common/Output.hs @@ -45,12 +45,6 @@ let RunSettings _ _ _ = undefined in concat [ case runSettingCommand of - CommandArgs command -> - [ [ indicatorChunk "starting", - " ", - commandChunk command - ] - ] CommandScript script -> [ [ indicatorChunk "starting script\n", chunk $ T.pack script @@ -65,16 +59,16 @@ if null runSettingExtraEnv then [] else - [indicatorChunk "extra env:"] : - map - ( \(k, v) -> - [ " ", - fore blue $ chunk (T.pack k), - ": ", - fore blue $ chunk (T.pack v) - ] - ) - (M.toList runSettingExtraEnv) + [indicatorChunk "extra env:"] + : map + ( \(k, v) -> + [ " ", + fore blue $ chunk (T.pack k), + ": ", + fore blue $ chunk (T.pack v) + ] + ) + (M.toList runSettingExtraEnv) ] exitCodeChunks :: ExitCode -> [Chunk] @@ -95,5 +89,6 @@ in [ indicatorChunk "took", " ", chunk $ - T.pack $ printf "%4.2fs" diffTime + T.pack $ + printf "%4.2fs" diffTime ] diff --git a/src/Feedback/Common/Process.hs b/src/Feedback/Common/Process.hs --- a/src/Feedback/Common/Process.hs +++ b/src/Feedback/Common/Process.hs @@ -42,11 +42,12 @@ let envForProcess = M.toList $ M.union runSettingExtraEnv (M.fromList env) -- Set up the command commandString <- case runSettingCommand of - CommandArgs c -> pure c CommandScript s -> do -- Write the script to a file systemTempDir <- getTempDir - scriptFile <- resolveFile systemTempDir "feedback-script.sh" + ensureDir systemTempDir + tempDir <- createTempDir systemTempDir "feedback" + scriptFile <- resolveFile tempDir "feedback-script.sh" writeBinaryFileDurableAtomic (fromAbsFile scriptFile) (TE.encodeUtf8 (T.pack s)) -- Make the script executable oldPermissions <- getPermissions scriptFile @@ -55,13 +56,13 @@ pure $ fromAbsFile scriptFile - pure $ - setStdout inherit + pure + $ setStdout inherit . setStderr inherit . setStdin nullStream -- TODO make this configurable? . setEnv envForProcess . maybe id (setWorkingDir . fromAbsDir) runSettingWorkingDir - $ shell commandString + $ shell commandString stopProcessHandle :: ProcessHandle -> IO () stopProcessHandle ProcessHandle {..} = do diff --git a/src/Feedback/Loop.hs b/src/Feedback/Loop.hs --- a/src/Feedback/Loop.hs +++ b/src/Feedback/Loop.hs @@ -25,17 +25,17 @@ import System.IO (hGetChar) import System.Mem (performGC) import System.Posix.Signals as Signal +import Text.Colour +import UnliftIO #ifdef MIN_VERSION_Win32 import System.Win32.MinTTY (isMinTTYHandle) import System.Win32.Types (withHandleToHANDLE) #endif -import Text.Colour #ifdef MIN_VERSION_safe_coloured_text_terminfo import Text.Colour.Capabilities.FromEnv (getTerminalCapabilitiesFromEnv) #else import Text.Colour.Capabilities (TerminalCapabilities(..)) #endif -import UnliftIO runFeedbackLoop :: IO () runFeedbackLoop = do @@ -55,6 +55,10 @@ -- being killed by the user. mainThreadId <- myThreadId + -- Make sure the user knows what's happening. + firstBegin <- getZonedTime + putTimedChunks terminalCapabilities firstBegin [indicatorChunk "preparing for first run"] + -- Get the flags and the environment up front, because they don't change -- anyway. -- This is also important because autocompletion won't work if we output @@ -62,16 +66,19 @@ flags <- getFlags env <- getEnvironment - let doSingleLoop loopBegin = do - -- We show a 'preparing' chunk before we get the settings because sometimes - -- getting the settings can take a while, for example in big repositories. - putTimedChunks terminalCapabilities loopBegin [indicatorChunk "preparing"] + -- Get the initial configuration so that we know if we need to run a hook after the first run. + mInitialConfiguration <- getConfiguration flags env + initialSettings <- combineToSettings flags env mInitialConfiguration - -- Get the loop configuration within the loop, so that the loop - -- configuration can be what is being worked on. - mConfiguration <- getConfiguration flags env - loopSettings <- combineToSettings flags env mConfiguration + -- If a before-all hook is defined, run it now. + forM_ (hooksSettingBeforeAll (loopSettingHooksSettings initialSettings)) $ \beforeAllRunSettings -> do + putTimedChunks terminalCapabilities firstBegin [indicatorChunk "starting before-all hook"] + runHook terminalCapabilities firstBegin beforeAllRunSettings + -- Define how to run a single loop with given settings in a let binding so we + -- don't have to pass in args like 'here', 'stdinFilter' and + -- 'terminalCapabilities'. + let doSingleLoopWithSettings firstLoop loopBegin loopSettings = do FS.withManagerConf FS.defaultConfig $ \watchManager -> do -- Set up watchers for each relevant directory and send the FSNotify -- events down this event channel. @@ -87,9 +94,26 @@ eventChan -- Start the process and put output. - worker mainThreadId loopSettings terminalCapabilities loopBegin eventChan + worker mainThreadId firstLoop loopSettings terminalCapabilities loopBegin eventChan `finally` stopListeningAction + -- Do the first loop outside the 'forever' so we can run commands before and + -- after the first loop. + doSingleLoopWithSettings True firstBegin initialSettings + `finally` putDone terminalCapabilities firstBegin + + let doSingleLoop loopBegin = do + -- We show a 'preparing' chunk before we get the settings because sometimes + -- getting the settings can take a while, for example in big repositories. + putTimedChunks terminalCapabilities loopBegin [indicatorChunk "preparing"] + + -- Get the loop configuration within the loop, so that the loop + -- configuration can be what is being worked on. + mConfiguration <- getConfiguration flags env + loopSettings <- combineToSettings flags env mConfiguration + + doSingleLoopWithSettings False loopBegin loopSettings + let singleIteration = do -- Record when the loop began so we can show relative times nicely. loopBegin <- getZonedTime @@ -97,6 +121,13 @@ forever singleIteration +runHook :: TerminalCapabilities -> ZonedTime -> RunSettings -> IO () +runHook terminalCapabilities begin runSettings = do + mapM_ (putTimedChunks terminalCapabilities begin) (startingLines runSettings) + _ <- startProcessHandle runSettings + -- We want this process to keep running, so we don't wait for it. + pure () + startWatching :: Path Abs Dir -> Filter -> @@ -142,66 +173,89 @@ | StdinEvent !Char deriving (Show, Eq) -worker :: ThreadId -> LoopSettings -> TerminalCapabilities -> ZonedTime -> Chan FS.Event -> IO () -worker mainThreadId LoopSettings {..} terminalCapabilities loopBegin eventChan = do - let sendOutput :: Output -> IO () - sendOutput = putOutput loopSettingOutputSettings terminalCapabilities loopBegin +worker :: + ThreadId -> + Bool -> + LoopSettings -> + TerminalCapabilities -> + ZonedTime -> + Chan FS.Event -> + IO () +worker + mainThreadId + thisIsTheFirstLoop + LoopSettings {..} + terminalCapabilities + loopBegin + eventChan = do + let sendOutput :: Output -> IO () + sendOutput = putOutput loopSettingOutputSettings terminalCapabilities loopBegin - -- Record starting time of the process. - -- This is different from 'loopBegin' because preparing the watchers may take - -- a nontrivial amount of time. - start <- getMonotonicTimeNSec + -- Record starting time of the process. + -- This is different from 'loopBegin' because preparing the watchers may take + -- a nontrivial amount of time. + start <- getMonotonicTimeNSec - -- Start the process process - processHandle <- startProcessHandle loopSettingRunSettings - sendOutput $ OutputProcessStarted loopSettingRunSettings + -- Start the process process + processHandle <- startProcessHandle loopSettingRunSettings + sendOutput $ OutputProcessStarted loopSettingRunSettings - -- Perform GC after the process has started, because that's when we're - -- waiting anyway, so that we don't need idle gc. - performGC + -- Perform GC after the process has started, because that's when we're + -- waiting anyway, so that we don't need idle gc. + performGC - -- Make sure we kill the process and wait for it to exit if a user presses - -- C-c. - installKillHandler mainThreadId processHandle + -- Make sure we kill the process and wait for it to exit if a user presses + -- C-c. + installKillHandler mainThreadId processHandle - -- From here on we will wait for either: - -- 1. A change to a file that we are watching, or - -- 2. The process to finish. + let runAfterFirstHookIfNecessary = do + -- If this is the first run AND a after-first hook is defined, run it now. + when thisIsTheFirstLoop $ + forM_ (hooksSettingAfterFirst loopSettingHooksSettings) $ \afterFirstRunSettings -> do + putTimedChunks terminalCapabilities loopBegin [indicatorChunk "starting after-first hook"] + runHook terminalCapabilities loopBegin afterFirstRunSettings + -- From here on we will wait for either: + -- 1. A change to a file that we are watching, or + -- 2. The process to finish. - -- 1. If An event happened first, output it and kill the process. - let handleEventHappened event = do - -- Output the event that has fired - sendOutput $ OutputEvent event - -- Output that killing will start - sendOutput OutputKilling - -- Kill the process - stopProcessHandle processHandle - -- Output that the process has been killed - sendOutput OutputKilled - -- Wait for the process to finish (should have by now) - ec <- waitProcessHandle processHandle - -- Record the end time - end <- getMonotonicTimeNSec - -- Output that the process has finished - sendOutput $ OutputProcessExited ec (end - start) + -- 1. If An event happened first, output it and kill the process. + let handleEventHappened event = do + -- Output the event that has fired + sendOutput $ OutputEvent event + -- Output that killing will start + sendOutput OutputKilling + -- Kill the process + stopProcessHandle processHandle + -- Output that the process has been killed + sendOutput OutputKilled + -- Wait for the process to finish (should have by now) + ec <- waitProcessHandle processHandle + -- Record the end time + end <- getMonotonicTimeNSec + -- Output that the process has finished + sendOutput $ OutputProcessExited ec (end - start) + -- Process is done, run the after-first hook if necessary + runAfterFirstHookIfNecessary - -- 2. If the process finished first, show the result and wait for an event anyway - let handleProcessDone ec = do - end <- getMonotonicTimeNSec - sendOutput $ OutputProcessExited ec (end - start) - -- Output the event that made the rerun happen - event <- waitForEvent eventChan - sendOutput $ OutputEvent event + -- 2. If the process finished first, show the result and wait for an event anyway + let handleProcessDone ec = do + end <- getMonotonicTimeNSec + sendOutput $ OutputProcessExited ec (end - start) + -- Process is done, run the after-first hook if necessary + runAfterFirstHookIfNecessary + -- Output the event that made the rerun happen + event <- waitForEvent eventChan + sendOutput $ OutputEvent event - -- Either wait for it to finish or wait for an event - eventOrDone <- - race - (waitForEvent eventChan) - (waitProcessHandle processHandle) + -- Either wait for it to finish or wait for an event + eventOrDone <- + race + (waitForEvent eventChan) + (waitProcessHandle processHandle) - case eventOrDone of - Left event -> handleEventHappened event - Right ec -> handleProcessDone ec + case eventOrDone of + Left event -> handleEventHappened event + Right ec -> handleProcessDone ec installKillHandler :: ThreadId -> ProcessHandle -> IO () installKillHandler mainThreadId processHandle = do @@ -250,17 +304,18 @@ OutputWatching -> put [indicatorChunk "watching"] OutputEvent restartEvent -> do put $ - indicatorChunk "event:" : - " " : case restartEvent of - FSEvent fsEvent -> - [ case fsEvent of - Added {} -> fore green " added " - Modified {} -> fore yellow " modified " - Removed {} -> fore red " removed " - Unknown {} -> " unknown ", - chunk $ T.pack $ eventPath fsEvent - ] - StdinEvent c -> [fore magenta "manual restart: ", chunk $ T.pack $ show c] + indicatorChunk "event:" + : " " + : case restartEvent of + FSEvent fsEvent -> + [ case fsEvent of + Added {} -> fore green " added " + Modified {} -> fore yellow " modified " + Removed {} -> fore red " removed " + Unknown {} -> " unknown ", + chunk $ T.pack $ eventPath fsEvent + ] + StdinEvent c -> [fore magenta "manual restart: ", chunk $ T.pack $ show c] OutputKilling -> put [indicatorChunk "killing"] OutputKilled -> put [indicatorChunk "killed"] OutputProcessStarted runSettings -> do diff --git a/src/Feedback/Loop/Filter.hs b/src/Feedback/Loop/Filter.hs --- a/src/Feedback/Loop/Filter.hs +++ b/src/Feedback/Loop/Filter.hs @@ -92,7 +92,9 @@ gitLsFiles :: Path Abs Dir -> IO (Maybe (Set (Path Abs File))) gitLsFiles here = do - let processConfig = shell "git ls-files" + -- If there is no git directory, we'll get a 'fatal' message on stderr. + -- We don't need the user to see this, so we setStderr nullStream. + let processConfig = setStderr nullStream $ shell "git ls-files" (ec, out) <- readProcessStdout processConfig set <- bytesFileSet here out pure $ case ec of diff --git a/src/Feedback/Loop/OptParse.hs b/src/Feedback/Loop/OptParse.hs --- a/src/Feedback/Loop/OptParse.hs +++ b/src/Feedback/Loop/OptParse.hs @@ -32,7 +32,7 @@ show flagCommand <> ",", "interpreting it as a standalone command." ] - pure $ makeLoopConfiguration $ CommandArgs flagCommand + pure $ makeLoopConfiguration $ CommandScript flagCommand Just config -> do putStrLn $ unwords