Autocompletion for feedback loops

.envrc

@@ -1 +1 @@
-use nix
+use flake

.hlint.yaml

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

feedback/src/Feedback/Common/OptParse.hs

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

feedback/src/Feedback/Loop.hs

@@ -55,14 +55,22 @@ runFeedbackLoop = do
   -- being killed by the user.
   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
         -- 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 settings within the loop, so that the loop can be
-        -- what is being worked on.
-        loopSettings <- getLoopSettings
+        -- 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
 
         FS.withManagerConf FS.defaultConfig $ \watchManager -> do
           -- Set up watchers for each relevant directory and send the FSNotify

feedback/src/Feedback/Loop/OptParse.hs

@@ -17,13 +17,6 @@ import Text.Colour.Term (putChunksLocale)
 #endif
 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@Flags {..} environment mConf = do
   let loops = maybe M.empty configLoops mConf