feedback 0.1.0.1 → 0.1.0.2
raw patch · 7 files changed
+267/−147 lines, 7 files
Files
- feedback.cabal +3/−3
- src/Feedback/Common/OptParse.hs +114/−47
- src/Feedback/Common/Output.hs +12/−17
- src/Feedback/Common/Process.hs +6/−5
- src/Feedback/Loop.hs +128/−73
- src/Feedback/Loop/Filter.hs +3/−1
- src/Feedback/Loop/OptParse.hs +1/−1
feedback.cabal view
@@ -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
src/Feedback/Common/OptParse.hs view
@@ -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)
src/Feedback/Common/Output.hs view
@@ -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 ]
src/Feedback/Common/Process.hs view
@@ -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
src/Feedback/Loop.hs view
@@ -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
src/Feedback/Loop/Filter.hs view
@@ -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
src/Feedback/Loop/OptParse.hs view
@@ -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