Add structure to UCM command args

unison-cli-integration/integration-tests/IntegrationTests/transcript.md

@@ -2,7 +2,7 @@
 
 ``` ucm :hide
 scratch/main> builtins.mergeio lib.builtins
-scratch/main> load ./unison-src/transcripts-using-base/base.u
+scratch/main> load "./unison-src/transcripts-using-base/base.u"
 scratch/main> add
 ```
 

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -712,18 +712,31 @@ loop e = do
             DebugFuzzyOptionsI command args -> do
               Cli.Env {codebase} <- ask
               currentBranch <- Branch.withoutTransitiveLibs <$> Cli.getCurrentBranch0
-              case Map.lookup command InputPatterns.patternMap of
-                Just (IP.InputPattern {args = argTypes}) -> do
-                  zip argTypes args & Monoid.foldMapM \case
-                    ((argName, _, IP.ArgumentType {fzfResolver = Just IP.FZFResolver {getOptions}}), "_") -> do
-                      pp <- Cli.getCurrentProjectPath
-                      results <- liftIO $ getOptions codebase pp currentBranch
-                      Cli.respond (DebugDisplayFuzzyOptions argName (Text.unpack <$> results))
-                    ((_, _, IP.ArgumentType {fzfResolver = Nothing}), "_") -> do
-                      Cli.respond DebugFuzzyOptionsNoResolver
-                    _ -> pure ()
-                Nothing -> do
-                  Cli.respond DebugFuzzyOptionsNoResolver
+              maybe
+                (Cli.respond $ DebugFuzzyOptionsNoCommand command)
+                ( \IP.InputPattern {params} ->
+                    either (Cli.respond . DebugFuzzyOptionsIncorrectArgs) snd $
+                      IP.foldArgs
+                        ( \(paramName, IP.ParameterType {fzfResolver}) arg ->
+                            ( *>
+                                if arg == "_"
+                                  then
+                                    maybe
+                                      (Cli.respond DebugFuzzyOptionsNoResolver)
+                                      ( \IP.FZFResolver {getOptions} -> do
+                                          pp <- Cli.getCurrentProjectPath
+                                          results <- liftIO $ getOptions codebase pp currentBranch
+                                          Cli.respond (DebugDisplayFuzzyOptions paramName (Text.unpack <$> results))
+                                      )
+                                      fzfResolver
+                                  else pure ()
+                            )
+                        )
+                        (pure ())
+                        params
+                        args
+                )
+                $ Map.lookup command InputPatterns.patternMap
             DebugFormatI -> do
               env <- ask
               void $ runMaybeT do

unison-cli/src/Unison/Codebase/Editor/Output.hs

@@ -355,6 +355,8 @@ data Output
   | DisplayDebugCompletions [Completion.Completion]
   | DisplayDebugLSPNameCompletions [(Text, Name, LabeledDependency)]
   | DebugDisplayFuzzyOptions Text [String {- arg description, options -}]
+  | DebugFuzzyOptionsIncorrectArgs (NonEmpty String)
+  | DebugFuzzyOptionsNoCommand String
   | DebugFuzzyOptionsNoResolver
   | DebugTerm (Bool {- verbose mode -}) (Either (Text {- A builtin hash -}) (Term Symbol Ann))
   | DebugDecl (Either (Text {- A builtin hash -}) (DD.Decl Symbol Ann)) (Maybe ConstructorId {- If 'Just' we're debugging a constructor of the given decl -})
@@ -624,6 +626,8 @@ isFailure o = case o of
   DisplayDebugCompletions {} -> False
   DisplayDebugLSPNameCompletions {} -> False
   DebugDisplayFuzzyOptions {} -> False
+  DebugFuzzyOptionsIncorrectArgs {} -> True
+  DebugFuzzyOptionsNoCommand {} -> True
   DebugFuzzyOptionsNoResolver {} -> True
   DebugTerm {} -> False
   DebugDecl {} -> False

unison-cli/src/Unison/Codebase/Transcript/Runner.hs

@@ -297,27 +297,24 @@ run isTest verbosity dir codebase runtime sbRuntime nRuntime ucmVersion baseURL
                 atomically . Q.undequeue cmdQueue $ Just p
                 pure $ Right switchCommand
               Nothing -> do
-                case words . Text.unpack $ lineTxt of
-                  [] -> Cli.returnEarlyWithoutOutput
-                  args -> do
-                    liftIO $ outputUcmLine p
-                    numberedArgs <- use #numberedArgs
-                    PP.ProjectAndBranch projId branchId <-
-                      PP.toProjectAndBranch . NonEmpty.head <$> use #projectPathStack
-                    let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId
-                    liftIO (parseInput codebase curPath getProjectRoot numberedArgs patternMap args)
-                      >>= either
-                        -- invalid command is treated as a failure
-                        ( \msg -> do
-                            liftIO $ writeIORef hasErrors True
-                            liftIO (readIORef allowErrors) >>= \case
-                              True -> do
-                                liftIO $ outputUcmResult msg
-                                Cli.returnEarlyWithoutOutput
-                              False -> liftIO . dieWithMsg $ Pretty.toPlain terminalWidth msg
-                        )
-                        -- No input received from this line, try again.
-                        (maybe Cli.returnEarlyWithoutOutput $ pure . Right . snd)
+                liftIO $ outputUcmLine p
+                numberedArgs <- use #numberedArgs
+                PP.ProjectAndBranch projId branchId <-
+                  PP.toProjectAndBranch . NonEmpty.head <$> use #projectPathStack
+                let getProjectRoot = liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId
+                liftIO (parseInput codebase curPath getProjectRoot numberedArgs patternMap $ Text.unpack lineTxt)
+                  >>= either
+                    -- invalid command is treated as a failure
+                    ( \msg -> do
+                        liftIO $ writeIORef hasErrors True
+                        liftIO (readIORef allowErrors) >>= \case
+                          True -> do
+                            liftIO $ outputUcmResult msg
+                            Cli.returnEarlyWithoutOutput
+                          False -> liftIO . dieWithMsg $ Pretty.toPlain terminalWidth msg
+                    )
+                    -- No input received from this line, try again.
+                    (maybe Cli.returnEarlyWithoutOutput $ pure . Right . (\(_, _, input) -> input))
 
       startProcessedBlock block = case block of
         Unison infoTags txt -> do