Add structured arg checking to ParameterType

This allows us to incrementally expand numbered arguments, only doing so when we want a Unison value and not unstructured text. Fixes #2805.
unisonweb · Jan 17, 2025 · 99d56f0 · 99d56f0
1 parent 88cf6b3
commit 99d56f0
Show file tree

Hide file tree

Showing 8 changed files with 273 additions and 230 deletions.
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -714,31 +714,24 @@ loop e = do
             DebugFuzzyOptionsI command args -> do
               Cli.Env {codebase} <- ask
               currentBranch <- Branch.withoutTransitiveLibs <$> Cli.getCurrentBranch0
-              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
+              case Map.lookup command InputPatterns.patternMap of
+                Just IP.InputPattern {params} ->
+                  either (Cli.respond . DebugFuzzyOptionsIncorrectArgs) (pure . fst)
+                    =<< IP.foldParamsWithM
+                      ( \_ (paramName, IP.ParameterType {fzfResolver}) arg ->
+                          if arg == "_"
+                            then case fzfResolver of
+                              Just IP.FZFResolver {getOptions} -> do
+                                pp <- Cli.getCurrentProjectPath
+                                results <- liftIO $ getOptions codebase pp currentBranch
+                                (,[]) <$> Cli.respond (DebugDisplayFuzzyOptions paramName (Text.unpack <$> results))
+                              Nothing -> (,[]) <$> Cli.respond DebugFuzzyOptionsNoResolver
+                            else pure ((), [])
+                      )
+                      ()
+                      params
+                      args
+                Nothing -> Cli.respond $ DebugFuzzyOptionsNoCommand command
             DebugFormatI -> do
               env <- ask
               void $ runMaybeT do

diff --git a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs
@@ -48,8 +48,8 @@ import Unison.Codebase.Transcript.Parser qualified as Transcript
 import Unison.Codebase.Verbosity (Verbosity, isSilent)
 import Unison.Codebase.Verbosity qualified as Verbosity
 import Unison.CommandLine
-import Unison.CommandLine.InputPattern (InputPattern (aliases, patternName))
-import Unison.CommandLine.InputPatterns (validInputs)
+import Unison.CommandLine.InputPattern (aliases, patternName)
+import Unison.CommandLine.InputPatterns qualified as IP
 import Unison.CommandLine.OutputMessages (notifyNumbered, notifyUser)
 import Unison.CommandLine.Welcome (asciiartUnison)
 import Unison.Parser.Ann (Ann)
@@ -174,7 +174,7 @@ run isTest verbosity dir codebase runtime sbRuntime nRuntime ucmVersion baseURL
   expectFailure <- newIORef False
   hasErrors <- newIORef False
   mBlock <- newIORef Nothing
-  let patternMap = Map.fromList $ (\p -> (patternName p, p) : ((,p) <$> aliases p)) =<< validInputs
+  let patternMap = Map.fromList $ (\p -> (patternName p, p) : ((,p) <$> aliases p)) =<< IP.validInputs
   let output' :: Bool -> Stanza -> IO ()
       output' inputEcho msg = do
         hide <- hideOutput inputEcho
@@ -326,7 +326,8 @@ run isTest verbosity dir codebase runtime sbRuntime nRuntime ucmVersion baseURL
                     liftIO (parseInput codebase curPath getProjectRoot numberedArgs patternMap args)
                       >>= either
                         -- invalid command is treated as a failure
-                        ( \msg -> do
+                        ( \failure -> do
+                            let msg = reportParseFailure failure
                             liftIO $ outputUcmResult msg
                             liftIO $ maybeDieWithMsg msg
                             Cli.returnEarlyWithoutOutput