Autocompletion for feedback loops

This commit is contained in:
Tom Sydney Kerckhove 2022-11-13 21:15:54 +01:00
parent ad6c768ee4
commit 6422d4c72c
5 changed files with 33 additions and 22 deletions

2
.envrc
View File

@ -1 +1 @@
use nix use flake

View File

@ -12,3 +12,5 @@
name: "Use record patterns" name: "Use record patterns"
- ignore: - ignore:
name: "Use getChar" name: "Use getChar"
- ignore:
name: "Replace case with maybe"

View File

@ -245,12 +245,14 @@ emptyOutputConfiguration =
} }
getConfiguration :: Flags -> Environment -> IO (Maybe Configuration) getConfiguration :: Flags -> Environment -> IO (Maybe Configuration)
getConfiguration Flags {..} Environment {..} = getConfiguration Flags {..} Environment {..} = do
case flagConfigFile <|> envConfigFile of fp <- case flagConfigFile <|> envConfigFile of
Nothing -> defaultConfigFile >>= readYamlConfigFile Nothing -> defaultConfigFile
Just cf -> do Just cf -> resolveFile' cf
afp <- resolveFile' cf getConfigurationFromFile fp
readYamlConfigFile afp
getConfigurationFromFile :: Path Abs File -> IO (Maybe Configuration)
getConfigurationFromFile = readYamlConfigFile
defaultConfigFile :: IO (Path Abs File) defaultConfigFile :: IO (Path Abs File)
defaultConfigFile = do defaultConfigFile = do
@ -303,8 +305,8 @@ flagsParser =
] ]
data Flags = Flags data Flags = Flags
{ flagConfigFile :: !(Maybe FilePath), { flagCommand :: !String,
flagCommand :: !String, flagConfigFile :: !(Maybe FilePath),
flagOutputFlags :: !OutputFlags, flagOutputFlags :: !OutputFlags,
flagDebug :: Bool flagDebug :: Bool
} }
@ -318,7 +320,8 @@ data OutputFlags = OutputFlags
parseFlags :: OptParse.Parser Flags parseFlags :: OptParse.Parser Flags
parseFlags = parseFlags =
Flags Flags
<$> optional <$> parseCommandFlags
<*> optional
( strOption ( strOption
( mconcat ( mconcat
[ long "config-file", [ long "config-file",
@ -327,7 +330,6 @@ parseFlags =
] ]
) )
) )
<*> parseCommandFlags
<*> parseOutputFlags <*> parseOutputFlags
<*> switch (mconcat [long "debug", help "show debug information"]) <*> switch (mconcat [long "debug", help "show debug information"])
@ -337,7 +339,8 @@ parseCommandFlags =
strArgument strArgument
( mconcat ( mconcat
[ help "The command to run", [ help "The command to run",
metavar "COMMAND" metavar "COMMAND",
completer (listIOCompleter defaultConfigFileCompleter)
] ]
) )
escapeChar = \case escapeChar = \case
@ -349,6 +352,11 @@ parseCommandFlags =
pieceBackTogether = unwords . map quoteIfNecessary pieceBackTogether = unwords . map quoteIfNecessary
in pieceBackTogether <$> many commandArg in pieceBackTogether <$> many commandArg
defaultConfigFileCompleter :: IO [String]
defaultConfigFileCompleter = do
mConfig <- defaultConfigFile >>= getConfigurationFromFile
pure $ M.keys (maybe [] configLoops mConfig)
parseOutputFlags :: OptParse.Parser OutputFlags parseOutputFlags :: OptParse.Parser OutputFlags
parseOutputFlags = parseOutputFlags =
OutputFlags OutputFlags

View File

@ -55,14 +55,22 @@ runFeedbackLoop = do
-- being killed by the user. -- being killed by the user.
mainThreadId <- myThreadId mainThreadId <- myThreadId
-- 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
-- something before parsing the flags.
flags <- getFlags
env <- getEnvironment
let doSingleLoop loopBegin = do let doSingleLoop loopBegin = do
-- We show a 'preparing' chunk before we get the settings because sometimes -- We show a 'preparing' chunk before we get the settings because sometimes
-- getting the settings can take a while, for example in big repositories. -- getting the settings can take a while, for example in big repositories.
putTimedChunks terminalCapabilities loopBegin [indicatorChunk "preparing"] putTimedChunks terminalCapabilities loopBegin [indicatorChunk "preparing"]
-- Get the loop settings within the loop, so that the loop can be -- Get the loop configuration within the loop, so that the loop
-- what is being worked on. -- configuration can be what is being worked on.
loopSettings <- getLoopSettings mConfiguration <- getConfiguration flags env
loopSettings <- combineToSettings flags env mConfiguration
FS.withManagerConf FS.defaultConfig $ \watchManager -> do FS.withManagerConf FS.defaultConfig $ \watchManager -> do
-- Set up watchers for each relevant directory and send the FSNotify -- Set up watchers for each relevant directory and send the FSNotify

View File

@ -17,13 +17,6 @@ import Text.Colour.Term (putChunksLocale)
#endif #endif
import Text.Show.Pretty (pPrint) import Text.Show.Pretty (pPrint)
getLoopSettings :: IO LoopSettings
getLoopSettings = do
flags <- getFlags
env <- getEnvironment
config <- getConfiguration flags env
combineToSettings flags env config
combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO LoopSettings combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO LoopSettings
combineToSettings flags@Flags {..} environment mConf = do combineToSettings flags@Flags {..} environment mConf = do
let loops = maybe M.empty configLoops mConf let loops = maybe M.empty configLoops mConf