diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 3924afa1aa..3dd88fd7e8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -703,17 +703,23 @@ loop e = 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 + 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/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index b3a7f1cc60..044e9f1e5e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -359,6 +359,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 -}) @@ -620,6 +622,8 @@ isFailure o = case o of DisplayDebugCompletions {} -> False DisplayDebugLSPNameCompletions {} -> False DebugDisplayFuzzyOptions {} -> False + DebugFuzzyOptionsIncorrectArgs {} -> True + DebugFuzzyOptionsNoCommand {} -> True DebugFuzzyOptionsNoResolver {} -> True DebugTerm {} -> False DebugDecl {} -> False diff --git a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs index 4741efaab3..7e56f035ae 100644 --- 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 diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 99ac5799d9..28a699592a 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -3,9 +3,13 @@ {-# LANGUAGE ViewPatterns #-} module Unison.CommandLine - ( allow, + ( ParseFailure (..), + ExpansionFailure (..), + FZFResolveFailure (..), + allow, parseInput, prompt, + reportParseFailure, watchFileSystem, ) where @@ -15,19 +19,21 @@ import Control.Lens hiding (aside) import Control.Monad.Except import Control.Monad.Trans.Except import Data.List (isPrefixOf, isSuffixOf) +import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) import Data.Map qualified as Map -import Data.Semialign qualified as Align import Data.Text qualified as Text import Data.Text.IO qualified as Text -import Data.These (These (..)) import Data.Vector qualified as Vector import System.FilePath (takeFileName) +import Text.Numeral (defaultInflection) +import Text.Numeral.Language.ENG qualified as Numeral import Text.Regex.TDFA ((=~)) import Unison.Codebase (Codebase) import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input (Event (..), Input (..)) import Unison.Codebase.Editor.Output (NumberedArgs) +import Unison.Codebase.Editor.StructuredArgument (StructuredArgument) import Unison.Codebase.ProjectPath qualified as PP import Unison.Codebase.Watch qualified as Watch import Unison.CommandLine.FZFResolvers qualified as FZFResolvers @@ -35,12 +41,10 @@ import Unison.CommandLine.FuzzySelect qualified as Fuzzy import Unison.CommandLine.Helpers (warn) import Unison.CommandLine.InputPattern (InputPattern (..)) import Unison.CommandLine.InputPattern qualified as InputPattern -import Unison.CommandLine.InputPatterns qualified as IPs +import Unison.CommandLine.InputPatterns qualified as IP import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.Symbol (Symbol) -import Unison.Util.ColorText qualified as CT -import Unison.Util.Monoid (foldMapM) import Unison.Util.Pretty qualified as P import Unison.Util.TQueue qualified as Q import UnliftIO.STM @@ -60,6 +64,99 @@ watchFileSystem q dir = do atomically . Q.enqueue q $ UnisonFileChanged (Text.pack filePath) text pure (cancel >> killThread t) +data ExpansionFailure + = TooManyArguments (NonEmpty InputPattern.Argument) + | UnexpectedStructuredArgument StructuredArgument + +-- | Expanding numbers is a bit complicated. Each `Parameter` expects either structured or “unstructured” arguments. So +-- we iterate over the parameters, if it doesn’t want structured, we just preserve the string. If it does want +-- structured, we have to expand the argument, which may result in /multiple/ structured arguments. We take the first +-- one for the param and pass the rest along. Now, if the next param wants unstructured, but we’ve already structured +-- it, then we’ve got an error. +expandArguments :: + NumberedArgs -> + InputPattern.Parameters -> + [String] -> + Either ExpansionFailure (InputPattern.Arguments, InputPattern.Parameters) +expandArguments numberedArgs params = + bimap TooManyArguments (first $ reverse) + <=< InputPattern.foldParamsWithM + ( \acc (_, param) arg -> + if InputPattern.isStructured param + then + pure $ + either + ( maybe (arg : acc, []) (maybe (acc, []) (\(h :| t) -> (h : acc, t)) . nonEmpty . fmap pure) + . expandNumber numberedArgs + ) + ((,[]) . (: acc) . pure) + arg + else (,[]) . (: acc) <$> either (pure . Left) (Left . UnexpectedStructuredArgument) arg + ) + [] + params + . fmap Left + +data ParseFailure + = NoCommand + | UnknownCommand String + | ExpansionFailure String InputPattern ExpansionFailure + | FZFResolveFailure InputPattern FZFResolveFailure + | SubParseFailure String InputPattern (P.Pretty P.ColorText) + +-- | +-- +-- __TODO__: Move this closer to `main`, but right now it’s shared by @ucm@ and @transcripts@, so this is the closest +-- we can get without duplicating it. +reportParseFailure :: ParseFailure -> P.Pretty P.ColorText +reportParseFailure = \case + NoCommand -> "" + UnknownCommand command -> + warn . P.wrap $ + "I don't know how to" + <> P.group (fromString command <> ".") + <> "Type" + <> IP.makeExample' IP.help + <> "or `?` to get help." + ExpansionFailure command pat@InputPattern {params} ef -> case ef of + TooManyArguments extraArgs -> + let showNum n = fromMaybe (tShow n) $ Numeral.us_cardinal defaultInflection n + in wrapFailure command pat + . P.text + . maybe + ( "Internal error: fuzzy finder complained that there are " + <> showNum (length extraArgs) + <> " too many arguments provided, but the command apparently allows an unbounded number of arguments." + ) + ( \maxCount -> + let foundCount = showNum $ maxCount + length extraArgs + in case maxCount of + 0 -> "I expected no arguments, but received " <> foundCount <> "." + _ -> "I expected no more than " <> showNum maxCount <> " arguments, but received " <> foundCount <> "." + ) + $ InputPattern.maxArgs params + UnexpectedStructuredArgument _arg -> "Internal error: Expected a String, but got a structured argument instead." + FZFResolveFailure pat frf -> case frf of + NoFZFResolverForArgumentType _argDesc -> InputPattern.help pat + NoFZFOptions argDesc -> + P.callout "⚠️" $ + "Sorry, I was expecting an argument for the " <> P.text argDesc <> ", and I couldn't find any to suggest to you. 😅" + SubParseFailure command pat msg -> wrapFailure command pat msg + where + wrapFailure command pat msg = + P.warnCallout $ + P.lines + [ P.wrap "Sorry, I wasn’t sure how to process your request:", + "", + P.indentN 2 msg, + "", + P.wrap $ + "You can run" + <> IP.makeExample IP.help [fromString command] + <> "for more information on using" + <> IP.makeExampleEOS pat [] + ] + parseInput :: Codebase IO Symbol Ann -> -- | Current location @@ -73,7 +170,7 @@ parseInput :: [String] -> -- Returns either an error message or the fully expanded arguments list and parsed input. -- If the output is `Nothing`, the user cancelled the input (e.g. ctrl-c) - IO (Either (P.Pretty CT.ColorText) (Maybe (InputPattern.Arguments, Input))) + IO (Either ParseFailure (Maybe (InputPattern.Arguments, Input))) parseInput codebase projPath currentProjectRoot numberedArgs patterns segments = runExceptT do let getCurrentBranch0 :: IO (Branch0 IO) getCurrentBranch0 = do @@ -81,60 +178,24 @@ parseInput codebase projPath currentProjectRoot numberedArgs patterns segments = pure . Branch.head $ Branch.getAt' (projPath ^. PP.path_) projRoot case segments of - [] -> throwE "" + [] -> throwE NoCommand command : args -> case Map.lookup command patterns of - Just pat@(InputPattern {parse, help}) -> do - let expandedNumbers :: InputPattern.Arguments - expandedNumbers = - foldMap (\arg -> maybe [Left arg] (fmap pure) $ expandNumber numberedArgs arg) args - lift (fzfResolve codebase projPath getCurrentBranch0 pat expandedNumbers) >>= \case - Left (NoFZFResolverForArgumentType _argDesc) -> throwError help - Left (NoFZFOptions argDesc) -> throwError (noCompletionsMessage argDesc) - Left FZFCancelled -> pure Nothing - Right resolvedArgs -> do - parsedInput <- - except - . first - ( \msg -> - P.warnCallout $ - P.wrap "Sorry, I wasn’t sure how to process your request:" - <> P.newline - <> P.newline - <> P.indentN 2 msg - <> P.newline - <> P.newline - <> P.wrap - ( "You can run" - <> IPs.makeExample IPs.help [fromString command] - <> "for more information on using" - <> IPs.makeExampleEOS pat [] - ) - ) - $ parse resolvedArgs - pure $ Just (Left command : resolvedArgs, parsedInput) - Nothing -> - throwE - . warn - . P.wrap - $ "I don't know how to" - <> P.group (fromString command <> ".") - <> "Type" - <> IPs.makeExample' IPs.help - <> "or `?` to get help." - where - noCompletionsMessage argDesc = - P.callout "⚠️" $ - P.lines - [ ( "Sorry, I was expecting an argument for the " - <> P.text argDesc - <> ", and I couldn't find any to suggest to you. 😅" + Just pat@(InputPattern {params, parse}) -> do + (expandedArgs, remainingParams) <- + except . first (ExpansionFailure command pat) $ expandArguments numberedArgs params args + lift (fzfResolve codebase projPath getCurrentBranch0 remainingParams) + >>= either + (throwE . FZFResolveFailure pat) + ( traverse \resolvedArgs -> + let allArgs = expandedArgs <> resolvedArgs + in except . bimap (SubParseFailure command pat) (Left command : allArgs,) $ parse allArgs ) - ] + Nothing -> throwE $ UnknownCommand command -- Expand a numeric argument like `1` or a range like `3-9` expandNumber :: NumberedArgs -> String -> Maybe NumberedArgs expandNumber numberedArgs s = - (\nums -> [arg | i <- nums, Just arg <- [vargs Vector.!? (i - 1)]]) <$> expandedNumber + catMaybes . fmap ((vargs Vector.!?) . pred) <$> expandedNumber where vargs = Vector.fromList numberedArgs rangeRegex = "([0-9]+)-([0-9]+)" :: String @@ -146,55 +207,47 @@ expandNumber numberedArgs s = Nothing -> -- check for a range case (junk, moreJunk, ns) of - ("", "", [from, to]) -> - (\x y -> [x .. y]) <$> readMay from <*> readMay to - _ -> Nothing + ("", "", [from, to]) -> enumFromTo <$> readMay from <*> readMay to + (_, _, _) -> Nothing data FZFResolveFailure - = NoFZFResolverForArgumentType InputPattern.ArgumentDescription - | NoFZFOptions Text {- argument description -} - | FZFCancelled + = NoFZFResolverForArgumentType InputPattern.ParameterDescription + | NoFZFOptions + -- | argument description + Text -fzfResolve :: Codebase IO Symbol Ann -> PP.ProjectPath -> (IO (Branch0 IO)) -> InputPattern -> InputPattern.Arguments -> IO (Either FZFResolveFailure InputPattern.Arguments) -fzfResolve codebase ppCtx getCurrentBranch pat args = runExceptT do - -- We resolve args in two steps, first we check that all arguments that will require a fzf - -- resolver have one, and only if so do we prompt the user to actually do a fuzzy search. - -- Otherwise, we might ask the user to perform a search only to realize we don't have a resolver - -- for a later arg. - argumentResolvers :: [ExceptT FZFResolveFailure IO InputPattern.Arguments] <- - (Align.align (InputPattern.args pat) args) - & traverse \case - This (argName, opt, InputPattern.ArgumentType {fzfResolver}) - | opt == InputPattern.Required || opt == InputPattern.OnePlus -> - case fzfResolver of - Nothing -> throwError $ NoFZFResolverForArgumentType argName - Just fzfResolver -> pure $ fuzzyFillArg opt argName fzfResolver - | otherwise -> pure $ pure [] - That arg -> pure $ pure [arg] - These _ arg -> pure $ pure [arg] - argumentResolvers & foldMapM id +fzfResolve :: + Codebase IO Symbol Ann -> + PP.ProjectPath -> + (IO (Branch0 IO)) -> + InputPattern.Parameters -> + IO (Either FZFResolveFailure (Maybe InputPattern.Arguments)) +fzfResolve codebase ppCtx getCurrentBranch InputPattern.Parameters {requiredParams, trailingParams} = runExceptT do + -- We build up a list of `ExceptT` inside an outer `ExceptT` to allow us to fail immediately if /any/ required + -- argument is missing a resolver, before we start prompting the user to actually do a fuzzy search. Otherwise, we + -- might ask the user to perform a search only to realize we don't have a resolver for a later arg. + argumentResolvers :: [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty InputPattern.Argument)] <- + liftA2 (<>) (traverse (maybeFillArg False) requiredParams) case trailingParams of + InputPattern.Optional _ _ -> pure mempty + InputPattern.OnePlus p -> pure <$> maybeFillArg True p + runMaybeT $ foldM (\bs -> ((bs <>) . toList <$>)) [] argumentResolvers where - fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO InputPattern.Arguments - fuzzyFillArg opt argDesc InputPattern.FZFResolver {getOptions} = do + maybeFillArg allowMulti (argName, InputPattern.ParameterType {fzfResolver}) = + maybe + (throwError $ NoFZFResolverForArgumentType argName) + (pure . fuzzyFillArg allowMulti argName) + fzfResolver + fuzzyFillArg :: + Bool -> Text -> InputPattern.FZFResolver -> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty InputPattern.Argument) + fuzzyFillArg allowMulti argDesc InputPattern.FZFResolver {getOptions} = MaybeT do currentBranch <- Branch.withoutTransitiveLibs <$> liftIO getCurrentBranch options <- liftIO $ getOptions codebase ppCtx currentBranch - when (null options) $ throwError $ NoFZFOptions argDesc + when (null options) . throwError $ NoFZFOptions argDesc liftIO $ Text.putStrLn (FZFResolvers.fuzzySelectHeader argDesc) - results <- - liftIO (Fuzzy.fuzzySelect Fuzzy.defaultOptions {Fuzzy.allowMultiSelect = multiSelectForOptional opt} id options) - `whenNothingM` throwError FZFCancelled - -- If the user triggered the fuzzy finder, but selected nothing, abort the command rather than continuing execution - -- with no arguments. - if null results - then throwError FZFCancelled - else pure (Left . Text.unpack <$> results) - - multiSelectForOptional :: InputPattern.IsOptional -> Bool - multiSelectForOptional = \case - InputPattern.Required -> False - InputPattern.Optional -> False - InputPattern.OnePlus -> True - InputPattern.ZeroPlus -> True + results <- liftIO (Fuzzy.fuzzySelect Fuzzy.defaultOptions {Fuzzy.allowMultiSelect = allowMulti} id options) + -- If the user triggered the fuzzy finder, but selected nothing, abort the command rather than continuing + -- execution with no arguments. + pure $ fmap (Left . Text.unpack <$>) . nonEmpty =<< results prompt :: String prompt = "> " diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs index 10a838373e..c3920b6ed4 100644 --- a/unison-cli/src/Unison/CommandLine/Completion.hs +++ b/unison-cli/src/Unison/CommandLine/Completion.hs @@ -83,8 +83,8 @@ haskelineTabComplete patterns codebase authedHTTPClient ppCtx = Line.completeWor case words $ reverse prev of h : t -> fromMaybe (pure []) $ do p <- Map.lookup h patterns - argType <- IP.argType p (length t) - pure $ IP.suggestions argType word codebase authedHTTPClient ppCtx + paramType <- IP.paramType (IP.params p) (length t) + pure $ IP.suggestions paramType word codebase authedHTTPClient ppCtx _ -> pure [] -- | Things which we may want to complete for. diff --git a/unison-cli/src/Unison/CommandLine/InputPattern.hs b/unison-cli/src/Unison/CommandLine/InputPattern.hs index cc628559e6..c8e8a35341 100644 --- a/unison-cli/src/Unison/CommandLine/InputPattern.hs +++ b/unison-cli/src/Unison/CommandLine/InputPattern.hs @@ -4,13 +4,17 @@ module Unison.CommandLine.InputPattern ( InputPattern (..), + ParameterDescription, + ParameterType (..), + Parameter, + TrailingParameters (..), + Parameters (..), Argument, - ArgumentType (..), - ArgumentDescription, Arguments, - argType, + noParams, + foldParamsWithM, + paramType, FZFResolver (..), - IsOptional (..), Visibility (..), -- * Currently Unused @@ -23,6 +27,7 @@ where import Control.Lens import Data.List.Extra qualified as List +import Data.List.NonEmpty (NonEmpty (..)) import System.Console.Haskeline qualified as Line import Unison.Auth.HTTPClient (AuthenticatedHttpClient) import Unison.Codebase (Codebase) @@ -35,15 +40,6 @@ import Unison.Util.ColorText qualified as CT import Unison.Util.Monoid (foldMapM) import Unison.Util.Pretty qualified as P --- InputPatterns accept some fixed number of Required arguments of various --- types, followed by a variable number of a single type of argument. -data IsOptional - = Required -- 1, at the start - | Optional -- 0 or 1, at the end - | ZeroPlus -- 0 or more, at the end - | OnePlus -- 1 or more, at the end - deriving (Show, Eq) - data Visibility = Hidden | Visible deriving (Show, Eq, Ord) @@ -55,32 +51,34 @@ type Argument = Either String StructuredArgument type Arguments = [Argument] --- | Argument description --- It should fit grammatically into sentences like "I was expecting an argument for the " --- e.g. "namespace to merge", "definition to delete", "remote target to push to" etc. -type ArgumentDescription = Text +-- | This should fit grammatically into sentences like “I was expecting an argument for the ”. +-- E.g. “namespace to merge”, “definition to delete”, “remote target to push to” etc. +type ParameterDescription = Text data InputPattern = InputPattern { patternName :: String, aliases :: [String], - visibility :: Visibility, -- Allow hiding certain commands when debugging or work-in-progress - args :: [(ArgumentDescription, IsOptional, ArgumentType)], + -- | Allow hiding certain commands when debugging or work-in-progress + visibility :: Visibility, + params :: Parameters, help :: P.Pretty CT.ColorText, -- | Parse the arguments and return either an error message or a command `Input`. -- + -- The input list is always a valid length for the pattern. It may be necessary to have a catch-all case for + -- coverage, but the implementation can assume that, say, a `OnePlus` parameter will always be provided at least + -- one argument. + -- -- __NB__: This function should return `Left` only on failure. For commands (like `help`) that simply produce -- formatted output, use `pure . Input.CreateMessage`. The failure output should be fully formatted (using - -- `wrap`, etc.), but shouldn’t include any general error components like a warninng flag or the full help + -- `wrap`, etc.), but shouldn’t include any general error components like a warning flag or the full help -- message, and shouldn’t plan for the context it is being output to (e.g., don’t `P.indentN` the entire -- message). - parse :: - Arguments -> - Either (P.Pretty CT.ColorText) Input + parse :: Arguments -> Either (P.Pretty CT.ColorText) Input } -data ArgumentType = ArgumentType +data ParameterType = ParameterType { typeName :: String, - -- | Generate completion suggestions for this argument type + -- | Generate completion suggestions for this parameter type suggestions :: forall m v a. (MonadIO m) => @@ -89,75 +87,100 @@ data ArgumentType = ArgumentType AuthenticatedHttpClient -> PP.ProjectPath -> m [Line.Completion], - -- | If an argument is marked as required, but not provided, the fuzzy finder will be triggered if + -- | If a parameter is marked as required, but no argument is provided, the fuzzy finder will be triggered if -- available. - fzfResolver :: Maybe FZFResolver + fzfResolver :: Maybe FZFResolver, + isStructured :: Bool } -instance Show ArgumentType where - show at = "ArgumentType " <> typeName at - --- `argType` gets called when the user tries to autocomplete an `i`th argument (zero-indexed). --- todo: would be nice if we could alert the user if they try to autocomplete --- past the end. It would also be nice if -argInfo :: InputPattern -> Int -> Maybe (ArgumentDescription, ArgumentType) -argInfo InputPattern {args, patternName} i = go (i, args) +type Parameter = (ParameterDescription, ParameterType) + +data TrailingParameters + = -- | Optional args followed by a possibly-empty catch-all + Optional [Parameter] (Maybe Parameter) + | -- | A catch-all that requires at least one value + OnePlus Parameter + +-- | The `Parameters` for an `InputPattern` are roughly +-- +-- > [required …] ([optional …] [catchAll] | NonEmpty catchAll) +data Parameters = Parameters {requiredParams :: [Parameter], trailingParams :: TrailingParameters} + +-- | This is the parameter structure for a pattern that doesn’t accept any arguments. +noParams :: Parameters +noParams = Parameters [] $ Optional [] Nothing + +-- | Applies concrete arguments to a set of `Parameters`. +foldParamsWithM :: + (Monad m) => + -- | Each step needs to return a new incremental result, but can also return additional arguments to apply in later + -- steps. This allows for the expansion of an argument to multiple arguments, as with numbered arg ranges. + (state -> Parameter -> arg -> m (state, [arg])) -> + -- | The initial state. + state -> + Parameters -> + [arg] -> + -- | If too many arguments are provided, it returns `Left`, with the arguments that couldn’t be assigned to a + -- parameter. Otherwise, it returns a tuple of the `Parameters` that could still be applied to additional arguments + -- (e.g., via fuzzy completion) and the final result. If the returned `Parameters` has remaining required arguments, + -- they must either be provided somehow (e.g., another call to this function or fuzzy completion) or result in a + -- “not enough arguments” error. + m (Either (NonEmpty arg) (state, Parameters)) +foldParamsWithM fn z Parameters {requiredParams, trailingParams} = foldRequiredArgs z requiredParams where - -- Strategy: all of these input patterns take some number of arguments. - -- If it takes no arguments, then don't autocomplete. - go :: (Int, [(Text, IsOptional, ArgumentType)]) -> Maybe (ArgumentDescription, ArgumentType) - go (_, []) = Nothing - -- If requesting the 0th of >=1 arguments, return it. - go (0, (argName, _, t) : _) = Just (argName, t) - -- Vararg parameters should appear at the end of the arg list, and work for - -- any later argument number. - go (_, [(argName, ZeroPlus, t)]) = Just (argName, t) - go (_, [(argName, OnePlus, t)]) = Just (argName, t) - -- If requesting a later parameter, decrement and drop one. - go (n, (_argName, o, _) : argTypes) - | o == Optional || o == Required = go (n - 1, argTypes) - -- The argument list spec is invalid if something follows a vararg - go args = - error $ - "Input pattern " - <> show patternName - <> " has an invalid argument list: " - <> show args - --- `argType` gets called when the user tries to autocomplete an `i`th argument (zero-indexed). + foldRequiredArgs res = curry \case + ([], as) -> case trailingParams of + Optional optParams zeroPlus -> foldOptionalArgs res zeroPlus optParams as + OnePlus param -> case as of + [] -> pure $ pure (res, Parameters [] $ OnePlus param) + a : args -> foldCatchallArg res param $ a :| args + (ps, []) -> pure $ pure (res, Parameters ps trailingParams) + (p : ps, a : as) -> do + (res', extraArgs) <- fn res p a + foldRequiredArgs res' ps $ extraArgs <> as + foldOptionalArgs res zp = curry \case + (ps, []) -> pure $ pure (res, Parameters [] $ Optional ps zp) + ([], a : as) -> maybe (pure . Left) (foldCatchallArg res) zp $ a :| as + (p : ps, a : as) -> do + (res', extraArgs) <- fn res p a + foldOptionalArgs res' zp ps $ extraArgs <> as + foldCatchallArg res p = + let collectRemainingArgs prevRes = \case + [] -> pure $ pure (prevRes, Parameters [] . Optional [] $ pure p) + a : args -> do + (res', extraArgs) <- fn prevRes p a + collectRemainingArgs res' $ extraArgs <> args + in collectRemainingArgs res . toList + +paramInfo :: Parameters -> Int -> Maybe (ParameterDescription, ParameterType) +paramInfo Parameters {requiredParams, trailingParams} i = + if i < length requiredParams + then pure $ requiredParams !! i + else case trailingParams of + Optional optParams zeroPlus -> + let rem = i - length requiredParams + in if rem < length optParams + then pure $ optParams !! rem + else zeroPlus + OnePlus arg -> pure arg + +-- | `argType` gets called when the user tries to autocomplete an `i`th argument (zero-indexed). -- todo: would be nice if we could alert the user if they try to autocomplete -- past the end. It would also be nice if -argType :: InputPattern -> Int -> Maybe ArgumentType -argType ip i = snd <$> (argInfo ip i) - -minArgs :: InputPattern -> Int -minArgs (InputPattern {args, patternName}) = - go (args ^.. folded . _2) - where - go [] = 0 - go (Required : argTypes) = 1 + go argTypes - go [_] = 0 - go _ = - error $ - "Invalid args for InputPattern (" - <> show patternName - <> "): " - <> show args - -maxArgs :: InputPattern -> Maybe Int -maxArgs (InputPattern {args, patternName}) = go argTypes - where - argTypes = args ^.. folded . _2 - go [] = Just 0 - go (Required : argTypes) = (1 +) <$> go argTypes - go [Optional] = Just 0 - go [_] = Nothing - go _ = - error $ - "Invalid args for InputPattern (" - <> show patternName - <> "): " - <> show argTypes +paramType :: Parameters -> Int -> Maybe ParameterType +paramType p = fmap snd . paramInfo p + +minArgs :: Parameters -> Int +minArgs Parameters {requiredParams, trailingParams} = + length requiredParams + case trailingParams of + Optional _ _ -> 0 + OnePlus _ -> 1 + +maxArgs :: Parameters -> Maybe Int +maxArgs Parameters {requiredParams, trailingParams} = + case trailingParams of + Optional optParams Nothing -> pure $ length requiredParams + length optParams + _ -> Nothing -- | Union suggestions from all possible completions unionSuggestions :: diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index b003e374a2..0b4d7f8236 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -205,7 +205,14 @@ import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath import Unison.CommandLine.Completion import Unison.CommandLine.FZFResolvers qualified as Resolvers import Unison.CommandLine.Helpers (aside, backtick, tip) -import Unison.CommandLine.InputPattern (ArgumentType (..), InputPattern (InputPattern), IsOptional (..), unionSuggestions) +import Unison.CommandLine.InputPattern + ( InputPattern (InputPattern), + ParameterType (..), + Parameters (..), + TrailingParameters (..), + noParams, + unionSuggestions, + ) import Unison.CommandLine.InputPattern qualified as I import Unison.Core.Project (ProjectBranchName (..)) import Unison.HashQualified qualified as HQ @@ -800,12 +807,11 @@ mergeBuiltins = "builtins.merge" [] I.Hidden - [("namespace", Optional, namespaceArg)] + (Parameters [] $ Optional [("namespace", namespaceArg)] Nothing) "Adds the builtins (excluding `io` and misc) to the specified namespace. Defaults to `builtin.`" \case [] -> pure . Input.MergeBuiltinsI $ Nothing - [p] -> Input.MergeBuiltinsI . Just <$> handlePathArg p - args -> wrongArgsLength "no more than one argument" args + p : _ -> Input.MergeBuiltinsI . Just <$> handlePathArg p mergeIOBuiltins :: InputPattern mergeIOBuiltins = @@ -813,12 +819,11 @@ mergeIOBuiltins = "builtins.mergeio" [] I.Hidden - [("namespace", Optional, namespaceArg)] + (Parameters [] $ Optional [("namespace", namespaceArg)] Nothing) "Adds all the builtins, including `io` and misc., to the specified namespace. Defaults to `builtin.`" \case [] -> pure . Input.MergeIOBuiltinsI $ Nothing - [p] -> Input.MergeIOBuiltinsI . Just <$> handlePathArg p - args -> wrongArgsLength "no more than one argument" args + p : _ -> Input.MergeIOBuiltinsI . Just <$> handlePathArg p updateBuiltins :: InputPattern updateBuiltins = @@ -826,11 +831,12 @@ updateBuiltins = "builtins.update" [] I.Hidden - [] + noParams ( "Adds all the builtins that are missing from this namespace, " <> "and deprecate the ones that don't exist in this version of Unison." ) - (const . pure $ Input.UpdateBuiltinsI) + . const + $ pure Input.UpdateBuiltinsI todo :: InputPattern todo = @@ -838,15 +844,14 @@ todo = "todo" [] I.Visible - [] + noParams ( P.wrap $ makeExample' todo <> "lists the current namespace's outstanding issues, including conflicted names, dependencies with missing" <> "names, and merge precondition violations." ) - \case - [] -> Right Input.TodoI - args -> wrongArgsLength "no arguments" args + . const + $ pure Input.TodoI load :: InputPattern load = @@ -854,7 +859,7 @@ load = "load" [] I.Visible - [("scratch file", Optional, filePathArg)] + (Parameters [] $ Optional [("scratch file", filePathArg)] Nothing) ( P.wrapColumn2 [ ( makeExample' load, "parses, typechecks, and evaluates the most recent scratch file." @@ -866,8 +871,7 @@ load = ) \case [] -> pure $ Input.LoadI Nothing - [file] -> Input.LoadI . Just <$> unsupportedStructuredArgument load "a file name" file - args -> wrongArgsLength "no more than one argument" args + file : _ -> Input.LoadI . Just <$> unsupportedStructuredArgument load "a file name" file clear :: InputPattern clear = @@ -875,16 +879,15 @@ clear = "clear" [] I.Visible - [] + noParams ( P.wrapColumn2 [ ( makeExample' clear, "Clears the screen." ) ] ) - \case - [] -> pure Input.ClearI - args -> wrongArgsLength "no arguments" args + . const + $ pure Input.ClearI add :: InputPattern add = @@ -892,7 +895,7 @@ add = "add" [] I.Visible - [("definition", ZeroPlus, noCompletionsArg)] + (Parameters [] . Optional [] $ Just ("definition", exactDefinitionArg)) ( "`add` adds to the codebase all the definitions from the most recently " <> "typechecked file." ) @@ -904,7 +907,7 @@ previewAdd = "add.preview" [] I.Visible - [("definition", ZeroPlus, noCompletionsArg)] + (Parameters [] . Optional [] $ Just ("definition", exactDefinitionArg)) ( "`add.preview` previews additions to the codebase from the most recently " <> "typechecked file. This command only displays cached typechecking " <> "results. Use `load` to reparse & typecheck the file if the context " @@ -918,16 +921,14 @@ update = { patternName = "update", aliases = [], visibility = I.Visible, - args = [], + params = noParams, help = P.wrap $ "Adds everything in the most recently typechecked file to the namespace," <> "replacing existing definitions having the same name, and attempts to update all the existing dependents accordingly. If the process" <> "can't be completed automatically, the dependents will be added back to the scratch file" <> "for your review.", - parse = \case - [] -> pure Input.Update2I - args -> wrongArgsLength "no arguments" args + parse = const $ pure Input.Update2I } updateOldNoPatch :: InputPattern @@ -936,7 +937,7 @@ updateOldNoPatch = "update.old.nopatch" [] I.Visible - [("definition", ZeroPlus, noCompletionsArg)] + (Parameters [] . Optional [] $ Just ("definition", exactDefinitionArg)) ( P.wrap ( makeExample' updateOldNoPatch <> "works like" @@ -964,7 +965,7 @@ updateOld = "update.old" [] I.Visible - [("patch", Optional, patchArg), ("definition", ZeroPlus, noCompletionsArg)] + (Parameters [] . Optional [("patch", patchArg)] $ Just ("definition", exactDefinitionArg)) ( P.wrap ( makeExample' updateOld <> "works like" @@ -1001,7 +1002,7 @@ previewUpdate = "update.old.preview" [] I.Visible - [("definition", ZeroPlus, noCompletionsArg)] + (Parameters [] . Optional [] $ Just ("definition", exactDefinitionArg)) ( "`update.old.preview` previews updates to the codebase from the most " <> "recently typechecked file. This command only displays cached " <> "typechecking results. Use `load` to reparse & typecheck the file if " @@ -1015,7 +1016,7 @@ view = "view" [] I.Visible - [("definition to view", OnePlus, definitionQueryArg)] + (Parameters [] $ OnePlus ("definition to view", definitionQueryArg)) ( P.lines [ P.wrap $ makeExample view ["foo"] <> "shows definitions named `foo` within your current namespace.", P.wrap $ makeExample view [] <> "without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH.", @@ -1041,7 +1042,7 @@ viewGlobal = "view.global" [] I.Visible - [("definition to view", ZeroPlus, definitionQueryArg)] + (Parameters [] . Optional [] $ Just ("definition to view", definitionQueryArg)) ( P.lines [ "`view.global foo` prints definitions of `foo` within your codebase.", "`view.global` without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH." @@ -1061,7 +1062,7 @@ display = "display" [] I.Visible - [("definition to display", OnePlus, definitionQueryArg)] + (Parameters [] $ OnePlus ("definition to display", definitionQueryArg)) ( P.lines [ "`display foo` prints a rendered version of the term `foo`.", "`display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH." @@ -1078,22 +1079,17 @@ displayTo = "display.to" [] I.Visible - [("destination file name", Required, filePathArg), ("definition to display", OnePlus, definitionQueryArg)] + (Parameters [("destination file name", filePathArg)] $ OnePlus ("definition to display", definitionQueryArg)) ( P.wrap $ makeExample displayTo ["", "foo"] <> "prints a rendered version of the term `foo` to the given file." ) $ \case - file : defs -> - maybe - (wrongArgsLength "at least two arguments" [file]) - ( \defs -> do - file <- unsupportedStructuredArgument displayTo "a file name" file - names <- traverse handleHashQualifiedNameArg defs - pure (Input.DisplayI (Input.FileLocation file Input.AboveFold) names) - ) - $ NE.nonEmpty defs - [] -> wrongArgsLength "at least two arguments" [] + file : def : defs -> do + file <- unsupportedStructuredArgument displayTo "a file name" file + names <- traverse handleHashQualifiedNameArg $ def NE.:| defs + pure (Input.DisplayI (Input.FileLocation file Input.AboveFold) names) + args -> wrongArgsLength "at least two arguments" args docs :: InputPattern docs = @@ -1101,7 +1097,7 @@ docs = "docs" [] I.Visible - [("definition", OnePlus, definitionQueryArg)] + (Parameters [] $ OnePlus ("definition", definitionQueryArg)) ( P.lines [ "`docs foo` shows documentation for the definition `foo`.", "`docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH." @@ -1115,9 +1111,10 @@ api = "api" [] I.Visible - [] + noParams "`api` provides details about the API." - (const $ pure Input.ApiI) + . const + $ pure Input.ApiI ui :: InputPattern ui = @@ -1125,12 +1122,11 @@ ui = { patternName = "ui", aliases = [], visibility = I.Visible, - args = [("definition to load", Optional, namespaceOrDefinitionArg)], + params = Parameters [] $ Optional [("definition to load", namespaceOrDefinitionArg)] Nothing, help = P.wrap "`ui` opens the Local UI in the default browser.", parse = \case [] -> pure $ Input.UiI Path.relativeEmpty' - [path] -> Input.UiI <$> handlePath'Arg path - args -> wrongArgsLength "no more than one argument" args + path : _ -> Input.UiI <$> handlePath'Arg path } undo :: InputPattern @@ -1139,20 +1135,20 @@ undo = "undo" [] I.Visible - [] + noParams "`undo` reverts the most recent change to the codebase." - (const $ pure Input.UndoI) + . const + $ pure Input.UndoI textfind :: Bool -> InputPattern textfind allowLib = - InputPattern cmdName aliases I.Visible [("token", OnePlus, noCompletionsArg)] msg parse + InputPattern cmdName aliases I.Visible (Parameters [] $ OnePlus ("token", noCompletionsArg)) msg parse where (cmdName, aliases, alternate) = if allowLib then ("text.find.all", ["grep.all"], "Use `text.find` to exclude `lib` from search.") else ("text.find", ["grep"], "Use `text.find.all` to include search of `lib`.") parse = \case - [] -> Left (P.text "Please supply at least one token.") words -> pure $ Input.TextFindI allowLib (untokenize $ [e | Left e <- words]) msg = P.lines @@ -1185,10 +1181,16 @@ untokenize words = go (unwords words) sfind :: InputPattern sfind = - InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse + InputPattern + "rewrite.find" + ["sfind"] + I.Visible + (Parameters [("rewrite-rule definition", definitionQueryArg)] $ Optional [] Nothing) + msg + parse where parse = \case - [q] -> Input.StructuredFindI (Input.FindLocal Path.relativeEmpty') <$> handleHashQualifiedNameArg q + q : _ -> Input.StructuredFindI (Input.FindLocal Path.relativeEmpty') <$> handleHashQualifiedNameArg q args -> wrongArgsLength "exactly one argument" args msg = P.lines @@ -1217,9 +1219,15 @@ sfind = sfindReplace :: InputPattern sfindReplace = - InputPattern "rewrite" ["sfind.replace"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse + InputPattern + "rewrite" + ["sfind.replace"] + I.Visible + (Parameters [("rewrite-rule definition", definitionQueryArg)] $ Optional [] Nothing) + msg + parse where - parse [q] = Input.StructuredFindReplaceI <$> handleHashQualifiedNameArg q + parse (q : _) = Input.StructuredFindReplaceI <$> handleHashQualifiedNameArg q parse args = wrongArgsLength "exactly one argument" args msg :: P.Pretty CT.ColorText msg = @@ -1264,7 +1272,7 @@ findIn' cmd mkfscope = cmd [] I.Visible - [("namespace", Required, namespaceArg), ("query", ZeroPlus, exactDefinitionArg)] + (Parameters [("namespace", namespaceArg)] . Optional [] $ Just ("query", exactDefinitionArg)) findHelp \case p : args -> Input.FindI False . mkfscope <$> handlePath'Arg p <*> pure (unifyArgument <$> args) @@ -1312,7 +1320,7 @@ find' cmd fscope = cmd [] I.Visible - [("query", ZeroPlus, exactDefinitionArg)] + (Parameters [] . Optional [] $ Just ("query", exactDefinitionArg)) findHelp (pure . Input.FindI False fscope . fmap unifyArgument) @@ -1322,7 +1330,7 @@ findShallow = "list" ["ls", "dir"] I.Visible - [("namespace", Optional, namespaceArg)] + (Parameters [] $ Optional [("namespace", namespaceArg)] Nothing) ( P.wrapColumn2 [ ("`list`", "lists definitions and namespaces at the current level of the current namespace."), ("`list foo`", "lists the 'foo' namespace."), @@ -1331,8 +1339,7 @@ findShallow = ) ( fmap Input.FindShallowI . \case [] -> pure Path.relativeEmpty' - [path] -> handlePath'Arg path - args -> wrongArgsLength "no more than one argument" args + path : _ -> handlePath'Arg path ) findVerbose :: InputPattern @@ -1341,7 +1348,7 @@ findVerbose = "find.verbose" [] I.Visible - [("query", ZeroPlus, exactDefinitionArg)] + (Parameters [] . Optional [] $ Just ("query", exactDefinitionArg)) ( "`find.verbose` searches for definitions like `find`, but includes hashes " <> "and aliases in the results." ) @@ -1353,7 +1360,7 @@ findVerboseAll = "find.all.verbose" [] I.Visible - [("query", ZeroPlus, exactDefinitionArg)] + (Parameters [] . Optional [] $ Just ("query", exactDefinitionArg)) ( "`find.all.verbose` searches for definitions like `find.all`, but includes hashes " <> "and aliases in the results." ) @@ -1365,12 +1372,12 @@ renameTerm = "move.term" ["rename.term"] I.Visible - [ ("definition to move", Required, exactDefinitionTermQueryArg), - ("new location", Required, newNameArg) - ] + ( Parameters [("definition to move", exactDefinitionTermQueryArg), ("new location", newNameArg)] $ + Optional [] Nothing + ) "`move.term foo bar` renames `foo` to `bar`." \case - [oldName, newName] -> Input.MoveTermI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName + oldName : newName : _ -> Input.MoveTermI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName _ -> Left $ P.wrap "`rename.term` takes two arguments, like `rename.term oldname newname`." moveAll :: InputPattern @@ -1379,12 +1386,10 @@ moveAll = "move" ["rename"] I.Visible - [ ("definition to move", Required, namespaceOrDefinitionArg), - ("new location", Required, newNameArg) - ] + (Parameters [("definition to move", namespaceOrDefinitionArg), ("new location", newNameArg)] $ Optional [] Nothing) "`move foo bar` renames the term, type, and namespace foo to bar." \case - [oldName, newName] -> Input.MoveAllI <$> handlePath'Arg oldName <*> handleNewPath newName + oldName : newName : _ -> Input.MoveAllI <$> handlePath'Arg oldName <*> handleNewPath newName _ -> Left $ P.wrap "`move` takes two arguments, like `move oldname newname`." renameType :: InputPattern @@ -1393,16 +1398,14 @@ renameType = "move.type" ["rename.type"] I.Visible - [ ("type to move", Required, exactDefinitionTypeQueryArg), - ("new location", Required, newNameArg) - ] + (Parameters [("type to move", exactDefinitionTypeQueryArg), ("new location", newNameArg)] $ Optional [] Nothing) "`move.type foo bar` renames `foo` to `bar`." \case - [oldName, newName] -> Input.MoveTypeI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName + oldName : newName : _ -> Input.MoveTypeI <$> handleHashQualifiedSplit'Arg oldName <*> handleNewName newName _ -> Left $ P.wrap "`rename.type` takes two arguments, like `rename.type oldname newname`." -deleteGen :: Maybe String -> ArgumentType -> String -> ([Path.HQSplit'] -> DeleteTarget) -> InputPattern +deleteGen :: Maybe String -> ParameterType -> String -> ([Path.HQSplit'] -> DeleteTarget) -> InputPattern deleteGen suffix queryCompletionArg target mkTarget = let cmd = maybe "delete" ("delete." <>) suffix info = @@ -1426,22 +1429,13 @@ deleteGen suffix queryCompletionArg target mkTarget = "" ) ] - warning = - P.sep - " " - [ backtick (P.string cmd), - "takes an argument, like", - backtick (P.sep " " [P.string cmd, "name"]) <> "." - ] in InputPattern cmd [] I.Visible - [("definition to delete", OnePlus, queryCompletionArg)] + (Parameters [] $ OnePlus ("definition to delete", queryCompletionArg)) info - \case - [] -> Left $ P.wrap warning - queries -> Input.DeleteI . mkTarget <$> traverse handleHashQualifiedSplit'Arg queries + $ fmap (Input.DeleteI . mkTarget) . traverse handleHashQualifiedSplit'Arg delete :: InputPattern delete = deleteGen Nothing exactDefinitionTypeOrTermQueryArg "term or type" (DeleteTarget'TermOrType DeleteOutput'NoDiff) @@ -1467,13 +1461,13 @@ deleteProject = { patternName = "delete.project", aliases = ["project.delete"], visibility = I.Visible, - args = [("project to delete", Required, projectNameArg)], + params = Parameters [("project to delete", projectNameArg)] $ Optional [] Nothing, help = P.wrapColumn2 [ ("`delete.project foo`", "deletes the local project `foo`") ], parse = \case - [name] -> Input.DeleteI . DeleteTarget'Project <$> handleProjectArg name + name : _ -> Input.DeleteI . DeleteTarget'Project <$> handleProjectArg name args -> wrongArgsLength "exactly one argument" args } @@ -1483,14 +1477,14 @@ deleteBranch = { patternName = "delete.branch", aliases = ["branch.delete"], visibility = I.Visible, - args = [("branch to delete", Required, projectBranchNameArg suggestionsConfig)], + params = Parameters [("branch to delete", projectBranchNameArg suggestionsConfig)] $ Optional [] Nothing, help = P.wrapColumn2 [ ("`delete.branch foo/bar`", "deletes the branch `bar` in the project `foo`"), ("`delete.branch /bar`", "deletes the branch `bar` in the current project") ], parse = \case - [name] -> Input.DeleteI . DeleteTarget'ProjectBranch <$> handleMaybeProjectBranchArg name + name : _ -> Input.DeleteI . DeleteTarget'ProjectBranch <$> handleMaybeProjectBranchArg name args -> wrongArgsLength "exactly one argument" args } where @@ -1507,10 +1501,11 @@ aliasTerm = { patternName = "alias.term", aliases = [], visibility = I.Visible, - args = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)], + params = + Parameters [("term to alias", exactDefinitionTermQueryArg), ("alias name", newNameArg)] $ Optional [] Nothing, help = "`alias.term foo bar` introduces `bar` with the same definition as `foo`.", parse = \case - [oldName, newName] -> Input.AliasTermI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + oldName : newName : _ -> Input.AliasTermI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName _ -> Left $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." } @@ -1520,10 +1515,11 @@ debugAliasTermForce = { patternName = "debug.alias.term.force", aliases = [], visibility = I.Hidden, - args = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)], + params = + Parameters [("term to alias", exactDefinitionTermQueryArg), ("alias name", newNameArg)] $ Optional [] Nothing, help = "`debug.alias.term.force foo bar` introduces `bar` with the same definition as `foo`.", parse = \case - [oldName, newName] -> Input.AliasTermI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + oldName : newName : _ -> Input.AliasTermI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName _ -> Left $ P.wrap "`debug.alias.term.force` takes two arguments, like `debug.alias.term.force oldname newname`." @@ -1535,10 +1531,10 @@ aliasType = "alias.type" [] I.Visible - [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)] + (Parameters [("type to alias", exactDefinitionTypeQueryArg), ("alias name", newNameArg)] $ Optional [] Nothing) "`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`." \case - [oldName, newName] -> Input.AliasTypeI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + oldName : newName : _ -> Input.AliasTypeI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName _ -> Left $ P.wrap "`alias.type` takes two arguments, like `alias.type oldname newname`." debugAliasTypeForce :: InputPattern @@ -1547,7 +1543,8 @@ debugAliasTypeForce = { patternName = "debug.alias.type.force", aliases = [], visibility = I.Hidden, - args = [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)], + params = + Parameters [("type to alias", exactDefinitionTypeQueryArg), ("alias name", newNameArg)] $ Optional [] Nothing, help = "`debug.alias.type.force Foo Bar` introduces `Bar` with the same definition as `Foo`.", parse = \case [oldName, newName] -> Input.AliasTypeI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName @@ -1562,7 +1559,7 @@ aliasMany = "alias.many" ["copy"] I.Visible - [("definition to alias", Required, definitionQueryArg), ("alias names", OnePlus, exactDefinitionArg)] + (Parameters [("definition to alias", definitionQueryArg)] $ OnePlus ("alias names", exactDefinitionArg)) ( P.group . P.lines $ [ P.wrap $ P.group (makeExample aliasMany ["", "[relative2...]", ""]) @@ -1583,11 +1580,10 @@ up = "deprecated.up" [] I.Hidden - [] + noParams (P.wrapColumn2 [(makeExample up [], "move current path up one level (deprecated)")]) - \case - [] -> Right Input.UpI - args -> wrongArgsLength "no arguments" args + . const + $ pure Input.UpI cd :: InputPattern cd = @@ -1595,7 +1591,7 @@ cd = "deprecated.cd" ["deprecated.namespace"] I.Visible - [("namespace", Required, namespaceArg)] + (Parameters [("namespace", namespaceArg)] $ Optional [] Nothing) ( P.lines [ "Moves your perspective to a different namespace. Deprecated for now because too many important things depend on your perspective selection.", "", @@ -1626,16 +1622,15 @@ back = "back" ["popd"] I.Visible - [] + noParams ( P.wrapColumn2 [ ( makeExample back [], "undoes the last" <> makeExample' projectSwitch <> "command." ) ] ) - \case - [] -> pure Input.PopBranchI - args -> wrongArgsLength "no arguments" args + . const + $ pure Input.PopBranchI deleteNamespace :: InputPattern deleteNamespace = @@ -1643,7 +1638,7 @@ deleteNamespace = "delete.namespace" [] I.Visible - [("namespace to delete", Required, namespaceArg)] + (Parameters [("namespace to delete", namespaceArg)] $ Optional [] Nothing) "`delete.namespace ` deletes the namespace `foo`" (deleteNamespaceParser Input.Try) @@ -1653,7 +1648,7 @@ deleteNamespaceForce = "delete.namespace.force" [] I.Visible - [("namespace to delete", Required, namespaceArg)] + (Parameters [("namespace to delete", namespaceArg)] $ Optional [] Nothing) ( "`delete.namespace.force ` deletes the namespace `foo`," <> "deletion will proceed even if other code depends on definitions in foo." ) @@ -1671,7 +1666,7 @@ renameBranch = "move.namespace" ["rename.namespace"] I.Visible - [("namespace to move", Required, namespaceArg), ("new location", Required, newNameArg)] + (Parameters [("namespace to move", namespaceArg), ("new location", newNameArg)] $ Optional [] Nothing) "`move.namespace foo bar` renames the path `foo` to `bar`." \case [src, dest] -> Input.MoveBranchI <$> handlePath'Arg src <*> handlePath'Arg dest @@ -1683,7 +1678,7 @@ history = "history" [] I.Visible - [("namespace", Optional, namespaceArg)] + (Parameters [] $ Optional [("namespace", namespaceArg)] Nothing) ( P.wrapColumn2 [ (makeExample history [], "Shows the history of the current path."), (makeExample history [".foo"], "Shows history of the path .foo."), @@ -1694,9 +1689,8 @@ history = ] ) \case - [src] -> Input.HistoryI (Just 10) (Just 10) <$> handleBranchIdArg src [] -> pure $ Input.HistoryI (Just 10) (Just 10) (BranchAtPath Path.currentPath) - args -> wrongArgsLength "no more than one argument" args + src : _ -> Input.HistoryI (Just 10) (Just 10) <$> handleBranchIdArg src forkLocal :: InputPattern forkLocal = @@ -1704,9 +1698,9 @@ forkLocal = "fork" ["copy.namespace"] I.Visible - [ ("source location", Required, branchRelativePathArg), - ("dest location", Required, branchRelativePathArg) - ] + ( Parameters [("source location", branchRelativePathArg), ("dest location", branchRelativePathArg)] $ + Optional [] Nothing + ) ( P.wrapColumn2 [ ( makeExample forkLocal ["src", "dest"], "creates the namespace `dest` as a copy of `src`." @@ -1729,7 +1723,7 @@ libInstallInputPattern = { patternName = "lib.install", aliases = ["install.lib"], visibility = I.Visible, - args = [], + params = Parameters [("library name", noCompletionsArg)] $ Optional [] Nothing, help = P.lines [ P.wrap $ @@ -1760,9 +1754,9 @@ reset = "reset" [] I.Visible - [ ("namespace, hash, or branch to reset to", Required, namespaceOrProjectBranchArg config), - ("namespace to be reset", Optional, namespaceOrProjectBranchArg config) - ] + ( Parameters [("namespace, hash, or branch to reset to", namespaceOrProjectBranchArg config)] $ + Optional [("namespace to be reset", namespaceOrProjectBranchArg config)] Nothing + ) ( P.lines [ P.wrapColumn2 [ ("`reset #pvfd222s8n`", "reset the current namespace to the hash `#pvfd222s8n`"), @@ -1806,18 +1800,20 @@ pullImpl name aliases pullMode addendum = do { patternName = name, aliases = aliases, visibility = I.Visible, - args = - [ ("remote namespace to pull", Optional, remoteNamespaceArg), - ( "destination branch", - Optional, - projectBranchNameArg - ProjectBranchSuggestionsConfig - { showProjectCompletions = False, - projectInclusion = AllProjects, - branchInclusion = AllBranches - } - ) - ], + params = + Parameters [] $ + Optional + [ ("remote namespace to pull", remoteNamespaceArg), + ( "destination branch", + projectBranchNameArg + ProjectBranchSuggestionsConfig + { showProjectCompletions = False, + projectInclusion = AllProjects, + branchInclusion = AllBranches + } + ) + ] + Nothing, help = P.lines [ P.wrap $ @@ -1846,7 +1842,7 @@ pullImpl name aliases pullMode addendum = do [sourceArg] -> do source <- handlePullSourceArg sourceArg pure (Input.PullI (Input.PullSourceTarget1 source) pullMode) - [sourceArg, targetArg] -> + sourceArg : targetArg : _ -> -- You used to be able to pull into a path, so this arg parser is a little complicated, because -- we want to provide helpful suggestions if you are doing a deprecated or invalid thing. case ( handlePullSourceArg sourceArg, @@ -1899,7 +1895,6 @@ pullImpl name aliases pullMode addendum = do <> " namespace, but the " <> makeExample' pull <> " command only supports merging into the top level of a local project branch." - args -> wrongArgsLength "no more than two arguments" args } debugTabCompletion :: InputPattern @@ -1908,7 +1903,7 @@ debugTabCompletion = "debug.tab-complete" [] I.Hidden - [("command arguments", ZeroPlus, noCompletionsArg)] + (Parameters [] . Optional [] $ Just ("command arguments", noCompletionsArg)) ( P.lines [ P.wrap $ "This command can be used to test and debug ucm's tab-completion within transcripts.", P.wrap $ "Completions which are finished are prefixed with a * represent finished completions." @@ -1922,7 +1917,7 @@ debugLspNameCompletion = "debug.lsp-name-completion" [] I.Hidden - [("Completion prefix", OnePlus, noCompletionsArg)] + (Parameters [] $ OnePlus ("Completion prefix", noCompletionsArg)) ( P.lines [ P.wrap $ "This command can be used to test and debug ucm's LSP name-completion within transcripts." ] @@ -1937,7 +1932,7 @@ debugFuzzyOptions = "debug.fuzzy-options" [] I.Hidden - [("command arguments", OnePlus, noCompletionsArg)] + (Parameters [("command", commandNameArg)] . Optional [] $ Just ("arguments", noCompletionsArg)) ( P.lines [ P.wrap $ "This command can be used to test and debug ucm's fuzzy-options within transcripts.", P.wrap $ "Write a command invocation with _ for any args you'd like to see completion options for.", @@ -1947,7 +1942,7 @@ debugFuzzyOptions = ] ) \case - (cmd : args) -> + cmd : args -> Input.DebugFuzzyOptionsI <$> unsupportedStructuredArgument debugFuzzyOptions "a command" cmd <*> traverse (unsupportedStructuredArgument debugFuzzyOptions "text") args @@ -1959,16 +1954,14 @@ debugFormat = "debug.format" [] I.Hidden - [("source-file", Optional, filePathArg)] + (Parameters [] $ Optional [("source-file", filePathArg)] Nothing) ( P.lines [ P.wrap $ "This command can be used to test ucm's file formatter on the latest typechecked file.", makeExample' debugFormat ] ) - ( \case - [] -> Right Input.DebugFormatI - args -> wrongArgsLength "no arguments" args - ) + . const + $ pure Input.DebugFormatI push :: InputPattern push = @@ -1976,7 +1969,11 @@ push = "push" [] I.Visible - [("remote destination", Optional, remoteNamespaceArg), ("local target", Optional, namespaceOrProjectBranchArg suggestionsConfig)] + ( Parameters [] $ + Optional + [("remote destination", remoteNamespaceArg), ("local target", namespaceOrProjectBranchArg suggestionsConfig)] + Nothing + ) ( P.lines [ P.wrap "The `push` command merges a local project or namespace into a remote project or namespace.", @@ -2012,9 +2009,8 @@ push = . \case [] -> pure Input.PushSourceTarget0 [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr - [targetStr, sourceStr] -> + targetStr : sourceStr : _ -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -2029,10 +2025,13 @@ pushCreate = "push.create" [] I.Visible - [("remote destination", Optional, remoteNamespaceArg), ("local target", Optional, namespaceOrProjectBranchArg suggestionsConfig)] + ( Parameters [] $ + Optional + [("remote destination", remoteNamespaceArg), ("local target", namespaceOrProjectBranchArg suggestionsConfig)] + Nothing + ) ( P.lines - [ P.wrap - "The `push.create` command pushes a local namespace to an empty remote namespace.", + [ P.wrap "The `push.create` command pushes a local namespace to an empty remote namespace.", "", P.wrapColumn2 [ ( "`push.create remote local`", @@ -2063,9 +2062,8 @@ pushCreate = . \case [] -> pure Input.PushSourceTarget0 [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr - [targetStr, sourceStr] -> + targetStr : sourceStr : _ -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -2080,7 +2078,11 @@ pushForce = "unsafe.force-push" ["push.unsafe-force"] I.Visible - [("remote destination", Optional, remoteNamespaceArg), ("local source", Optional, namespaceOrProjectBranchArg suggestionsConfig)] + ( Parameters [] $ + Optional + [("remote destination", remoteNamespaceArg), ("local source", namespaceOrProjectBranchArg suggestionsConfig)] + Nothing + ) (P.wrap "Like `push`, but forcibly overwrites the remote namespace.") $ fmap ( \sourceTarget -> @@ -2093,9 +2095,8 @@ pushForce = . \case [] -> pure Input.PushSourceTarget0 [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr - [targetStr, sourceStr] -> + targetStr : sourceStr : _ -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -2110,7 +2111,11 @@ pushExhaustive = "debug.push-exhaustive" [] I.Hidden - [("remote destination", Optional, remoteNamespaceArg), ("local target", Optional, namespaceOrProjectBranchArg suggestionsConfig)] + ( Parameters [] $ + Optional + [("remote destination", remoteNamespaceArg), ("local target", namespaceOrProjectBranchArg suggestionsConfig)] + Nothing + ) ( P.lines [ P.wrap $ "The " @@ -2133,9 +2138,8 @@ pushExhaustive = . \case [] -> pure Input.PushSourceTarget0 [targetStr] -> Input.PushSourceTarget1 <$> handlePushTargetArg targetStr - [targetStr, sourceStr] -> + targetStr : sourceStr : _ -> Input.PushSourceTarget2 <$> handlePushSourceArg sourceStr <*> handlePushTargetArg targetStr - args -> wrongArgsLength "no more than two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -2150,7 +2154,9 @@ syncToFile = { patternName = "sync.to-file", aliases = [], visibility = I.Hidden, - args = [("file-path", Required, filePathArg), ("branch", Optional, projectAndBranchNamesArg suggestionsConfig)], + params = + Parameters [("file-path", filePathArg)] $ + Optional [("branch", projectAndBranchNamesArg suggestionsConfig)] Nothing, help = ( P.wrapColumn2 [ ( makeExample syncToFile ["./branch.usync"], @@ -2180,7 +2186,9 @@ syncFromFile = { patternName = "sync.from-file", aliases = [], visibility = I.Hidden, - args = [("file-path", Required, filePathArg), ("destination branch", Required, projectAndBranchNamesArg suggestionsConfig)], + params = + Parameters [("file-path", filePathArg), ("destination branch", projectAndBranchNamesArg suggestionsConfig)] $ + Optional [] Nothing, help = ( P.wrapColumn2 [ ( makeExample syncFromFile ["./feature.usync", "/feature"], @@ -2190,7 +2198,7 @@ syncFromFile = ), parse = \case [filePath, branch] -> Input.SyncFromFileI <$> unsupportedStructuredArgument makeStandalone "a file name" filePath <*> handleBranchWithOptionalProject branch - args -> wrongArgsLength "one or two arguments" args + args -> wrongArgsLength "exactly two arguments" args } where suggestionsConfig = @@ -2206,7 +2214,13 @@ syncFromCodebase = { patternName = "sync.from-codebase", aliases = [], visibility = I.Hidden, - args = [("codebase-location", Required, filePathArg), ("branch-to-sync", Required, projectAndBranchNamesArg suggestionsConfig), ("destination-branch", Optional, projectAndBranchNamesArg suggestionsConfig)], + params = + Parameters + [ ("codebase-location", filePathArg), + ("branch-to-sync", projectAndBranchNamesArg suggestionsConfig), + ("destination-branch", projectAndBranchNamesArg suggestionsConfig) + ] + $ Optional [] Nothing, help = ( P.wrapColumn2 [ ( makeExample syncFromCodebase ["./codebase", "srcProject/main", "destProject/main"], @@ -2216,7 +2230,7 @@ syncFromCodebase = ), parse = \case [codebaseLocation, srcBranch, destinationBranch] -> Input.SyncFromCodebaseI <$> unsupportedStructuredArgument makeStandalone "a file name" codebaseLocation <*> handleBranchWithProject srcBranch <*> handleBranchWithOptionalProject destinationBranch - args -> wrongArgsLength "three arguments" args + args -> wrongArgsLength "exactly three arguments" args } where suggestionsConfig = @@ -2232,10 +2246,12 @@ mergeOldSquashInputPattern = { patternName = "merge.old.squash", aliases = ["squash.old"], visibility = I.Hidden, - args = - [ ("namespace or branch to be squashed", Required, namespaceOrProjectBranchArg suggestionsConfig), - ("merge destination", Required, namespaceOrProjectBranchArg suggestionsConfig) - ], + params = + Parameters + [ ("namespace or branch to be squashed", namespaceOrProjectBranchArg suggestionsConfig), + ("merge destination", namespaceOrProjectBranchArg suggestionsConfig) + ] + $ Optional [] Nothing, help = P.wrap $ makeExample mergeOldSquashInputPattern ["src", "dest"] @@ -2270,9 +2286,9 @@ mergeOldInputPattern = "merge.old" [] I.Hidden - [ ("branch or namespace to merge", Required, namespaceOrProjectBranchArg config), - ("merge destination", Optional, namespaceOrProjectBranchArg config) - ] + ( Parameters [("branch or namespace to merge", namespaceOrProjectBranchArg config)] $ + Optional [("merge destination", namespaceOrProjectBranchArg config)] Nothing + ) ( P.column2 [ ( makeExample mergeOldInputPattern ["foo/bar", "baz/qux"], "merges the `foo/bar` branch into the `baz/qux` branch" @@ -2315,17 +2331,18 @@ mergeInputPattern = { patternName = "merge", aliases = [], visibility = I.Visible, - args = - [ ( "branch to merge", - Required, - projectBranchNameArg - ProjectBranchSuggestionsConfig - { showProjectCompletions = True, - projectInclusion = AllProjects, - branchInclusion = ExcludeCurrentBranch - } - ) - ], + params = + Parameters + [ ( "branch to merge", + projectBranchNameArg + ProjectBranchSuggestionsConfig + { showProjectCompletions = True, + projectInclusion = AllProjects, + branchInclusion = ExcludeCurrentBranch + } + ) + ] + $ Optional [] Nothing, help = P.wrap $ makeExample mergeInputPattern ["/branch"] <> "merges `branch` into the current branch", parse = \case @@ -2339,7 +2356,7 @@ mergeCommitInputPattern = { patternName = "merge.commit", aliases = ["commit.merge"], visibility = I.Visible, - args = [], + params = noParams, help = let mainBranch = UnsafeProjectBranchName "main" tempBranch = UnsafeProjectBranchName "merge-topic-into-main" @@ -2370,9 +2387,7 @@ mergeCommitInputPattern = makeExampleNoBackticks deleteBranch [prettySlashProjectBranchName tempBranch] ] ), - parse = \case - [] -> Right Input.MergeCommitI - args -> wrongArgsLength "no arguments" args + parse = const $ pure Input.MergeCommitI } diffNamespace :: InputPattern @@ -2381,7 +2396,9 @@ diffNamespace = "diff.namespace" [] I.Visible - [("before namespace", Required, namespaceOrProjectBranchArg suggestionsConfig), ("after namespace", Optional, namespaceOrProjectBranchArg suggestionsConfig)] + ( Parameters [("before namespace", namespaceOrProjectBranchArg suggestionsConfig)] $ + Optional [("after namespace", namespaceOrProjectBranchArg suggestionsConfig)] Nothing + ) ( P.column2 [ ( "`diff.namespace before after`", P.wrap "shows how the namespace `after` differs from the namespace `before`" @@ -2391,11 +2408,10 @@ diffNamespace = ) ] ) - ( \case - [before, after] -> Input.DiffNamespaceI <$> handleBranchId2Arg before <*> handleBranchId2Arg after - [before] -> Input.DiffNamespaceI <$> handleBranchId2Arg before <*> pure (Right . UnqualifiedPath $ Path.currentPath) - args -> wrongArgsLength "one or two arguments" args - ) + \case + [before, after] -> Input.DiffNamespaceI <$> handleBranchId2Arg before <*> handleBranchId2Arg after + [before] -> Input.DiffNamespaceI <$> handleBranchId2Arg before <*> pure (Right . UnqualifiedPath $ Path.currentPath) + args -> wrongArgsLength "one or two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -2410,7 +2426,9 @@ mergeOldPreviewInputPattern = "merge.old.preview" [] I.Hidden - [("branch or namespace to merge", Required, namespaceOrProjectBranchArg suggestionsConfig), ("merge destination", Optional, namespaceOrProjectBranchArg suggestionsConfig)] + ( Parameters [("branch or namespace to merge", namespaceOrProjectBranchArg suggestionsConfig)] $ + Optional [("merge destination", namespaceOrProjectBranchArg suggestionsConfig)] Nothing + ) ( P.column2 [ ( makeExample mergeOldPreviewInputPattern ["src"], "shows how the current namespace will change after a " <> makeExample mergeOldInputPattern ["src"] @@ -2420,12 +2438,11 @@ mergeOldPreviewInputPattern = ) ] ) - ( \case - [src] -> Input.PreviewMergeLocalBranchI <$> handleBranchRelativePathArg src <*> pure Nothing - [src, dest] -> - Input.PreviewMergeLocalBranchI <$> handleBranchRelativePathArg src <*> (Just <$> handleBranchRelativePathArg dest) - args -> wrongArgsLength "one or two arguments" args - ) + \case + [src] -> Input.PreviewMergeLocalBranchI <$> handleBranchRelativePathArg src <*> pure Nothing + [src, dest] -> + Input.PreviewMergeLocalBranchI <$> handleBranchRelativePathArg src <*> (Just <$> handleBranchRelativePathArg dest) + args -> wrongArgsLength "one or two arguments" args where suggestionsConfig = ProjectBranchSuggestionsConfig @@ -2440,17 +2457,13 @@ deprecatedViewRootReflog = "deprecated.root-reflog" [] I.Visible - [] + noParams ( "`deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of " <> makeExample branchReflog [] <> " which shows the reflog for the current project." ) - ( \case - [] -> pure Input.ShowRootReflogI - _ -> - Left . P.string $ - I.patternName deprecatedViewRootReflog ++ " doesn't take any arguments." - ) + . const + $ pure Input.ShowRootReflogI branchReflog :: InputPattern branchReflog = @@ -2458,17 +2471,15 @@ branchReflog = "reflog" ["reflog.branch", "branch.reflog"] I.Visible - [] + (Parameters [] $ Optional [("branch name", noCompletionsArg)] Nothing) ( P.lines [ "`reflog` lists all the changes that have affected the current branch.", "`reflog /mybranch` lists all the changes that have affected /mybranch." ] ) - ( \case - [] -> pure $ Input.ShowProjectBranchReflogI Nothing - [branchRef] -> Input.ShowProjectBranchReflogI <$> (Just <$> handleMaybeProjectBranchArg branchRef) - _ -> Left (I.help branchReflog) - ) + \case + [] -> pure $ Input.ShowProjectBranchReflogI Nothing + branchRef : _ -> Input.ShowProjectBranchReflogI <$> (Just <$> handleMaybeProjectBranchArg branchRef) projectReflog :: InputPattern projectReflog = @@ -2476,17 +2487,15 @@ projectReflog = "project.reflog" ["reflog.project"] I.Visible - [] + (Parameters [] $ Optional [("project name", noCompletionsArg)] Nothing) ( P.lines [ "`project.reflog` lists all the changes that have affected any branches in the current project.", "`project.reflog myproject` lists all the changes that have affected any branches in myproject." ] ) - ( \case - [] -> pure $ Input.ShowProjectReflogI Nothing - [projectRef] -> Input.ShowProjectReflogI <$> (Just <$> handleProjectArg projectRef) - _ -> Left (I.help projectReflog) - ) + \case + [] -> pure $ Input.ShowProjectReflogI Nothing + projectRef : _ -> Input.ShowProjectReflogI <$> (Just <$> handleProjectArg projectRef) globalReflog :: InputPattern globalReflog = @@ -2494,15 +2503,13 @@ globalReflog = "reflog.global" [] I.Visible - [] + noParams ( P.lines [ "`reflog.global` lists all recent changes across all projects and branches." ] ) - ( \case - [] -> pure $ Input.ShowGlobalReflogI - _ -> Left (I.help globalReflog) - ) + . const + $ pure Input.ShowGlobalReflogI edit :: InputPattern edit = @@ -2510,7 +2517,7 @@ edit = { patternName = "edit", aliases = [], visibility = I.Visible, - args = [("definition to edit", OnePlus, definitionQueryArg)], + params = Parameters [] $ OnePlus ("definition to edit", definitionQueryArg), help = P.lines [ "`edit foo` prepends the definition of `foo` to the top of the most " @@ -2532,7 +2539,7 @@ editNew = { patternName = "edit.new", aliases = [], visibility = I.Visible, - args = [("definition to edit", OnePlus, definitionQueryArg)], + params = Parameters [] $ OnePlus ("definition to edit", definitionQueryArg), help = "Like `edit`, but adds a new fold line below the definitions.", parse = maybe @@ -2549,7 +2556,7 @@ editDependents = { patternName = "edit.dependents", aliases = [], visibility = I.Visible, - args = [("definition to edit", Required, definitionQueryArg)], + params = Parameters [("definition to edit", definitionQueryArg)] $ Optional [] Nothing, help = "Like `edit`, but also includes all transitive dependents in the current project.", parse = \case [name] -> Input.EditDependentsI <$> handleHashQualifiedNameArg name @@ -2562,7 +2569,7 @@ editNamespace = { patternName = "edit.namespace", aliases = [], visibility = I.Visible, - args = [("namespace to load definitions from", ZeroPlus, namespaceArg)], + params = Parameters [] . Optional [] $ Just ("namespace to load definitions from", namespaceArg), help = P.lines [ "`edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries.", @@ -2571,13 +2578,23 @@ editNamespace = parse = fmap Input.EditNamespaceI . traverse handlePathArg } -topicNameArg :: ArgumentType +newBranchNameArg :: ParameterType +newBranchNameArg = + ParameterType + { typeName = "new-branch", + suggestions = \_ _ _ _ -> pure [], + fzfResolver = Nothing, + isStructured = False + } + +topicNameArg :: ParameterType topicNameArg = let topics = Map.keys helpTopicsMap - in ArgumentType + in ParameterType { typeName = "topic", suggestions = \q _ _ _ -> pure (exactComplete q topics), - fzfResolver = Just $ Resolvers.fuzzySelectFromList (Text.pack <$> topics) + fzfResolver = Just $ Resolvers.fuzzySelectFromList (Text.pack <$> topics), + isStructured = False } helpTopics :: InputPattern @@ -2586,17 +2603,15 @@ helpTopics = "help-topics" ["help-topic"] I.Visible - [("topic", Optional, topicNameArg)] + (Parameters [] $ Optional [("topic", topicNameArg)] Nothing) ("`help-topics` lists all topics and `help-topics ` shows an explanation of that topic.") - ( \case - [] -> Right $ Input.CreateMessage topics - [topic] -> do - topic <- unsupportedStructuredArgument helpTopics "a help topic" topic - case Map.lookup topic helpTopicsMap of - Nothing -> Left $ "I don't know of that topic. Try `help-topics`." - Just t -> Right $ Input.CreateMessage t - _ -> Left $ "Use `help-topics ` or `help-topics`." - ) + \case + [] -> Right $ Input.CreateMessage topics + topic : _ -> do + topic <- unsupportedStructuredArgument helpTopics "a help topic" topic + case Map.lookup topic helpTopicsMap of + Nothing -> Left $ "I don't know of that topic. Try `help-topics`." + Just t -> Right $ Input.CreateMessage t where topics = P.callout "🌻" $ @@ -2770,16 +2785,11 @@ help = "help" ["?"] I.Visible - [("command", Optional, commandNameArg)] + (Parameters [] $ Optional [("command", commandNameArg)] Nothing) "`help` shows general help and `help ` shows help for one command." $ \case - [] -> - Right . Input.CreateMessage $ - intercalateMap - "\n\n" - showPatternHelp - visibleInputs - [cmd] -> do + [] -> Right . Input.CreateMessage $ intercalateMap "\n\n" showPatternHelp visibleInputs + cmd : _ -> do cmd <- unsupportedStructuredArgument help "a command" cmd case (Map.lookup cmd commandsByName, isHelp cmd) of (Nothing, Just msg) -> Right $ Input.CreateMessage msg @@ -2798,7 +2808,6 @@ help = <> "use" <> makeExample helpTopics [P.string cmd] ) - _ -> Left "Use `help ` or `help`." where commandsByName = Map.fromList $ do @@ -2813,11 +2822,10 @@ quit = "quit" ["exit", ":q"] I.Visible - [] + noParams "Exits the Unison command line interface." - \case - [] -> pure Input.QuitI - _ -> Left "Use `quit`, `exit`, or to quit." + . const + $ pure Input.QuitI names :: Input.IsGlobal -> InputPattern names isGlobal = @@ -2825,7 +2833,7 @@ names isGlobal = cmdName [] I.Visible - [("name or hash", OnePlus, definitionQueryArg)] + (Parameters [] $ OnePlus ("name or hash", definitionQueryArg)) description $ \case [] -> wrongArgsLength "at least one argument" [] @@ -2856,9 +2864,9 @@ dependents = "dependents" [] I.Visible - [("definition", Required, definitionQueryArg)] + (Parameters [("definition", definitionQueryArg)] $ Optional [] Nothing) "List the named dependents of the specified definition." - $ \case + \case [thing] -> Input.ListDependentsI <$> handleHashQualifiedNameArg thing args -> wrongArgsLength "exactly one argument" args dependencies = @@ -2866,9 +2874,9 @@ dependencies = "dependencies" [] I.Visible - [("definition", Required, definitionQueryArg)] + (Parameters [("definition", definitionQueryArg)] $ Optional [] Nothing) "List the dependencies of the specified definition." - $ \case + \case [thing] -> Input.ListDependenciesI <$> handleHashQualifiedNameArg thing args -> wrongArgsLength "exactly one argument" args @@ -2878,12 +2886,11 @@ namespaceDependencies = "namespace.dependencies" [] I.Visible - [("namespace", Optional, namespaceArg)] + (Parameters [] $ Optional [("namespace", namespaceArg)] Nothing) "List the external dependencies of the specified namespace." - $ \case - [p] -> Input.NamespaceDependenciesI . pure <$> handlePath'Arg p + \case [] -> pure (Input.NamespaceDependenciesI Nothing) - args -> wrongArgsLength "no more than one argument" args + p : _ -> Input.NamespaceDependenciesI . pure <$> handlePath'Arg p debugNumberedArgs :: InputPattern debugNumberedArgs = @@ -2891,9 +2898,10 @@ debugNumberedArgs = "debug.numberedArgs" [] I.Visible - [] + noParams "Dump the contents of the numbered args state." - (const $ Right Input.DebugNumberedArgsI) + . const + $ pure Input.DebugNumberedArgsI debugFileHashes :: InputPattern debugFileHashes = @@ -2901,9 +2909,10 @@ debugFileHashes = "debug.file" [] I.Visible - [] + noParams "View details about the most recent successfully typechecked file." - (const $ Right Input.DebugTypecheckedUnisonFileI) + . const + $ pure Input.DebugTypecheckedUnisonFileI debugDumpNamespace :: InputPattern debugDumpNamespace = @@ -2911,9 +2920,10 @@ debugDumpNamespace = "debug.dump-namespace" [] I.Visible - [] + noParams "Dump the namespace to a text file" - (const $ Right Input.DebugDumpNamespacesI) + . const + $ pure Input.DebugDumpNamespacesI debugDumpNamespaceSimple :: InputPattern debugDumpNamespaceSimple = @@ -2921,9 +2931,10 @@ debugDumpNamespaceSimple = "debug.dump-namespace-simple" [] I.Visible - [] + noParams "Dump the namespace to a text file" - (const $ Right Input.DebugDumpNamespaceSimpleI) + . const + $ pure Input.DebugDumpNamespaceSimpleI debugTerm :: InputPattern debugTerm = @@ -2931,12 +2942,11 @@ debugTerm = "debug.term.abt" [] I.Hidden - [("term", Required, exactDefinitionTermQueryArg)] + (Parameters [("term", exactDefinitionTermQueryArg)] $ Optional [] Nothing) "View debugging information for a given term." - ( \case - [thing] -> Input.DebugTermI False <$> handleHashQualifiedNameArg thing - args -> wrongArgsLength "exactly one argument" args - ) + \case + [thing] -> Input.DebugTermI False <$> handleHashQualifiedNameArg thing + args -> wrongArgsLength "exactly one argument" args debugTermVerbose :: InputPattern debugTermVerbose = @@ -2944,12 +2954,11 @@ debugTermVerbose = "debug.term.abt.verbose" [] I.Hidden - [("term", Required, exactDefinitionTermQueryArg)] + (Parameters [("term", exactDefinitionTermQueryArg)] $ Optional [] Nothing) "View verbose debugging information for a given term." - ( \case - [thing] -> Input.DebugTermI True <$> handleHashQualifiedNameArg thing - args -> wrongArgsLength "exactly one argument" args - ) + \case + [thing] -> Input.DebugTermI True <$> handleHashQualifiedNameArg thing + args -> wrongArgsLength "exactly one argument" args debugType :: InputPattern debugType = @@ -2957,12 +2966,11 @@ debugType = "debug.type.abt" [] I.Hidden - [("type", Required, exactDefinitionTypeQueryArg)] + (Parameters [("type", exactDefinitionTypeQueryArg)] $ Optional [] Nothing) "View debugging information for a given type." - ( \case - [thing] -> Input.DebugTypeI <$> handleHashQualifiedNameArg thing - args -> wrongArgsLength "exactly one argument" args - ) + \case + [thing] -> Input.DebugTypeI <$> handleHashQualifiedNameArg thing + args -> wrongArgsLength "exactly one argument" args debugLSPFoldRanges :: InputPattern debugLSPFoldRanges = @@ -2970,9 +2978,10 @@ debugLSPFoldRanges = "debug.lsp.fold-ranges" [] I.Hidden - [] + noParams "Output the source from the most recently parsed file, but annotated with the computed fold ranges." - (const $ Right Input.DebugLSPFoldRangesI) + . const + $ pure Input.DebugLSPFoldRangesI debugClearWatchCache :: InputPattern debugClearWatchCache = @@ -2980,9 +2989,10 @@ debugClearWatchCache = "debug.clear-cache" [] I.Visible - [] + noParams "Clear the watch expression cache" - (const $ Right Input.DebugClearWatchI) + . const + $ pure Input.DebugClearWatchI debugDoctor :: InputPattern debugDoctor = @@ -2990,13 +3000,10 @@ debugDoctor = "debug.doctor" [] I.Visible - [] - ( P.wrap "Analyze your codebase for errors and inconsistencies." - ) - ( \case - [] -> Right $ Input.DebugDoctorI - args -> wrongArgsLength "no arguments" args - ) + noParams + (P.wrap "Analyze your codebase for errors and inconsistencies.") + . const + $ pure Input.DebugDoctorI debugNameDiff :: InputPattern debugNameDiff = @@ -3004,7 +3011,7 @@ debugNameDiff = { patternName = "debug.name-diff", aliases = [], visibility = I.Hidden, - args = [("before namespace", Required, namespaceArg), ("after namespace", Required, namespaceArg)], + params = Parameters [("before namespace", namespaceArg), ("after namespace", namespaceArg)] $ Optional [] Nothing, help = P.wrap "List all name changes between two causal hashes. Does not detect patch changes.", parse = \case [from, to] -> Input.DebugNameDiffI <$> handleShortCausalHashArg from <*> handleShortCausalHashArg to @@ -3017,7 +3024,7 @@ test = { patternName = "test", aliases = [], visibility = I.Visible, - args = [("namespace", Optional, namespaceArg)], + params = Parameters [] $ Optional [("namespace", namespaceArg)] Nothing, help = P.wrapColumn2 [ ("`test`", "runs unit tests for the current branch"), @@ -3037,8 +3044,7 @@ test = ) . \case [] -> pure Path.empty - [pathString] -> handlePathArg pathString - args -> wrongArgsLength "no more than one argument" args + pathString : _ -> handlePathArg pathString } testNative :: InputPattern @@ -3047,7 +3053,7 @@ testNative = { patternName = "test.native", aliases = [], visibility = I.Hidden, - args = [("namespace", Optional, namespaceArg)], + params = Parameters [] $ Optional [("namespace", namespaceArg)] Nothing, help = P.wrapColumn2 [ ( "`test.native`", @@ -3069,8 +3075,7 @@ testNative = ) . \case [] -> pure Path.empty - [pathString] -> handlePathArg pathString - args -> wrongArgsLength "no more than one argument" args + pathString : _ -> handlePathArg pathString } testAll :: InputPattern @@ -3079,19 +3084,18 @@ testAll = "test.all" [] I.Visible - [] + noParams "`test.all` runs unit tests for the current branch (including the `lib` namespace)." - ( const $ - pure $ - Input.TestI - False - Input.TestInput - { includeLibNamespace = True, - path = Path.empty, - showFailures = True, - showSuccesses = True - } - ) + . const + . pure + $ Input.TestI + False + Input.TestInput + { includeLibNamespace = True, + path = Path.empty, + showFailures = True, + showSuccesses = True + } testAllNative :: InputPattern testAllNative = @@ -3099,19 +3103,18 @@ testAllNative = "test.native.all" ["test.all.native"] I.Hidden - [] + noParams "`test.native.all` runs unit tests for the current branch (including the `lib` namespace) on the native runtime." - ( const $ - pure $ - Input.TestI - True - Input.TestInput - { includeLibNamespace = True, - path = Path.empty, - showFailures = True, - showSuccesses = True - } - ) + . const + . pure + $ Input.TestI + True + Input.TestInput + { includeLibNamespace = True, + path = Path.empty, + showFailures = True, + showSuccesses = True + } docsToHtml :: InputPattern docsToHtml = @@ -3119,7 +3122,7 @@ docsToHtml = "docs.to-html" [] I.Visible - [("namespace", Required, branchRelativePathArg), ("", Required, filePathArg)] + (Parameters [("namespace", branchRelativePathArg), ("output directory", filePathArg)] $ Optional [] Nothing) ( P.wrapColumn2 [ ( makeExample docsToHtml [".path.to.ns", "doc-dir"], "Render all docs contained within the namespace `.path.to.ns`, no matter how deep, to html files in `doc-dir` in the directory UCM was run from." @@ -3142,7 +3145,7 @@ docToMarkdown = "debug.doc-to-markdown" [] I.Visible - [("doc to render", Required, exactDefinitionTermQueryArg)] + (Parameters [("doc to render", exactDefinitionTermQueryArg)] $ Optional [] Nothing) ( P.wrapColumn2 [ ( "`debug.doc-to-markdown term.doc`", "Render a doc to markdown." @@ -3159,7 +3162,7 @@ execute = "run" [] I.Visible - [("definition to execute", Required, exactDefinitionTermQueryArg), ("argument", ZeroPlus, noCompletionsArg)] + (Parameters [("definition to execute", exactDefinitionTermQueryArg)] . Optional [] $ Just ("argument", noCompletionsArg)) ( P.wrapColumn2 [ ( "`run mymain args...`", "Runs `!mymain`, where `mymain` is searched for in the most recent" @@ -3169,7 +3172,7 @@ execute = ) ] ) - $ \case + \case main : args -> Input.ExecuteI <$> handleHashQualifiedNameArg main @@ -3182,11 +3185,11 @@ saveExecuteResult = "add.run" [] I.Visible - [("new name", Required, newNameArg)] + (Parameters [("new name", newNameArg)] $ Optional [] Nothing) ( "`add.run name` adds to the codebase the result of the most recent `run` command" <> " as `name`." ) - $ \case + \case [w] -> Input.SaveExecuteResultI <$> handleNameArg w args -> wrongArgsLength "exactly one argument" args @@ -3196,7 +3199,7 @@ ioTest = { patternName = "io.test", aliases = ["test.io"], visibility = I.Visible, - args = [("test to run", Required, exactDefinitionTermQueryArg)], + params = Parameters [("test to run", exactDefinitionTermQueryArg)] $ Optional [] Nothing, help = P.wrapColumn2 [ ( "`io.test mytest`", @@ -3214,7 +3217,7 @@ ioTestNative = { patternName = "io.test.native", aliases = ["test.io.native", "test.native.io"], visibility = I.Hidden, - args = [("test to run", Required, exactDefinitionTermQueryArg)], + params = Parameters [("test to run", exactDefinitionTermQueryArg)] $ Optional [] Nothing, help = P.wrapColumn2 [ ( "`io.test.native mytest`", @@ -3234,16 +3237,14 @@ ioTestAll = { patternName = "io.test.all", aliases = ["test.io.all"], visibility = I.Visible, - args = [], + params = noParams, help = P.wrapColumn2 [ ( "`io.test.all`", "runs unit tests for the current branch that use IO" ) ], - parse = \case - [] -> Right (Input.IOTestAllI False) - args -> wrongArgsLength "no arguments" args + parse = const . pure $ Input.IOTestAllI False } ioTestAllNative :: InputPattern @@ -3252,16 +3253,14 @@ ioTestAllNative = { patternName = "io.test.native.all", aliases = ["test.io.native.all", "test.native.io.all"], visibility = I.Hidden, - args = [], + params = noParams, help = P.wrapColumn2 [ ( "`io.test.native.all`", "runs unit tests for the current branch that use IO" ) ], - parse = \case - [] -> Right (Input.IOTestAllI True) - args -> wrongArgsLength "no arguments" args + parse = const . pure $ Input.IOTestAllI True } makeStandalone :: InputPattern @@ -3270,7 +3269,9 @@ makeStandalone = "compile" ["compile.output"] I.Visible - [("definition to compile", Required, exactDefinitionTermQueryArg), ("output file", Required, filePathArg)] + ( Parameters [("definition to compile", exactDefinitionTermQueryArg), ("output file", filePathArg)] $ + Optional [] Nothing + ) ( P.wrapColumn2 [ ( "`compile main file`", "Outputs a stand alone file that can be directly loaded and" @@ -3279,7 +3280,7 @@ makeStandalone = ) ] ) - $ \case + \case [main, file] -> Input.MakeStandaloneI <$> unsupportedStructuredArgument makeStandalone "a file name" file @@ -3292,14 +3293,16 @@ runScheme = "run.native" [] I.Visible - [("definition to run", Required, exactDefinitionTermQueryArg), ("arguments", ZeroPlus, noCompletionsArg)] + ( Parameters [("definition to run", exactDefinitionTermQueryArg)] . Optional [] $ + Just ("arguments", noCompletionsArg) + ) ( P.wrapColumn2 [ ( makeExample runScheme ["main", "args"], "Executes !main using native compilation via scheme." ) ] ) - $ \case + \case main : args -> Input.ExecuteSchemeI <$> handleHashQualifiedNameArg main @@ -3312,10 +3315,9 @@ compileScheme = "compile.native" [] I.Hidden - [ ("definition to compile", Required, exactDefinitionTermQueryArg), - ("output file", Required, filePathArg), - ("profile", Optional, profileArg) - ] + ( Parameters [("definition to compile", exactDefinitionTermQueryArg), ("output file", filePathArg)] $ + Optional [("profile", profileArg)] Nothing + ) ( P.wrapColumn2 [ ( makeExample compileScheme ["main", "file", "profile"], "Creates stand alone executable via compilation to" @@ -3325,7 +3327,7 @@ compileScheme = ) ] ) - $ \case + \case [main, file] -> mkCompileScheme False file main [main, file, prof] -> do unsupportedStructuredArgument compileScheme "profile" prof @@ -3350,7 +3352,7 @@ createAuthor = "create.author" [] I.Visible - [("definition name", Required, noCompletionsArg), ("author name", Required, noCompletionsArg)] + (Parameters [("definition name", noCompletionsArg)] $ OnePlus ("author name", noCompletionsArg)) ( makeExample createAuthor ["alicecoder", "\"Alice McGee\""] <> " " <> P.wrap @@ -3384,17 +3386,14 @@ authLogin = "auth.login" [] I.Visible - [] + noParams ( P.lines [ P.wrap "Obtain an authentication session with Unison Share.", - makeExample authLogin [] - <> "authenticates ucm with Unison Share." + makeExample authLogin [] <> "authenticates ucm with Unison Share." ] ) - ( \case - [] -> Right $ Input.AuthLoginI - args -> wrongArgsLength "no arguments" args - ) + . const + $ pure Input.AuthLoginI printVersion :: InputPattern printVersion = @@ -3402,13 +3401,10 @@ printVersion = "version" [] I.Visible - [] - ( P.wrap "Print the version of unison you're running" - ) - ( \case - [] -> Right $ Input.VersionI - args -> wrongArgsLength "no arguments" args - ) + noParams + (P.wrap "Print the version of unison you're running") + . const + $ pure Input.VersionI projectCreate :: InputPattern projectCreate = @@ -3416,7 +3412,7 @@ projectCreate = { patternName = "project.create", aliases = ["create.project"], visibility = I.Visible, - args = [], + params = Parameters [] $ Optional [("project name", noCompletionsArg)] Nothing, help = P.wrapColumn2 [ ("`project.create`", "creates a project with a random name"), @@ -3424,8 +3420,7 @@ projectCreate = ], parse = \case [] -> pure $ Input.ProjectCreateI True Nothing - [name] -> Input.ProjectCreateI True . pure <$> handleProjectArg name - args -> wrongArgsLength "no more than one argument" args + name : _ -> Input.ProjectCreateI True . pure <$> handleProjectArg name } projectCreateEmptyInputPattern :: InputPattern @@ -3434,7 +3429,7 @@ projectCreateEmptyInputPattern = { patternName = "project.create-empty", aliases = ["create.empty-project"], visibility = I.Hidden, - args = [], + params = Parameters [] $ Optional [("project name", noCompletionsArg)] Nothing, help = P.wrapColumn2 [ ("`project.create-empty`", "creates an empty project with a random name"), @@ -3442,8 +3437,7 @@ projectCreateEmptyInputPattern = ], parse = \case [] -> pure $ Input.ProjectCreateI False Nothing - [name] -> Input.ProjectCreateI False . pure <$> handleProjectArg name - args -> wrongArgsLength "no more than one argument" args + name : _ -> Input.ProjectCreateI False . pure <$> handleProjectArg name } projectRenameInputPattern :: InputPattern @@ -3452,7 +3446,7 @@ projectRenameInputPattern = { patternName = "project.rename", aliases = ["rename.project"], visibility = I.Visible, - args = [("new name", Required, projectNameArg)], + params = Parameters [("new name", projectNameArg)] $ Optional [] Nothing, help = P.wrapColumn2 [ ("`project.rename foo`", "renames the current project to `foo`") @@ -3468,7 +3462,9 @@ projectSwitch = { patternName = "switch", aliases = [], visibility = I.Visible, - args = [("project or branch to switch to", Required, projectAndBranchNamesArg suggestionsConfig)], + params = + Parameters [("project or branch to switch to", projectAndBranchNamesArg suggestionsConfig)] $ + Optional [] Nothing, help = P.wrapColumn2 [ ("`switch`", "opens an interactive selector to pick a project and branch"), @@ -3494,9 +3490,9 @@ projectsInputPattern = { patternName = "projects", aliases = ["list.project", "ls.project", "project.list"], visibility = I.Visible, - args = [], + params = noParams, help = P.wrap "List projects.", - parse = \_ -> Right Input.ProjectsI + parse = const $ pure Input.ProjectsI } branchesInputPattern :: InputPattern @@ -3505,7 +3501,7 @@ branchesInputPattern = { patternName = "branches", aliases = ["list.branch", "ls.branch", "branch.list"], visibility = I.Visible, - args = [("project", Optional, projectNameArg)], + params = Parameters [] $ Optional [("project", projectNameArg)] Nothing, help = P.wrapColumn2 [ ("`branches`", "lists all branches in the current project"), @@ -3513,8 +3509,7 @@ branchesInputPattern = ], parse = \case [] -> Right (Input.BranchesI Nothing) - [nameString] -> Input.BranchesI . pure <$> handleProjectArg nameString - args -> wrongArgsLength "no more than one argument" args + nameString : _ -> Input.BranchesI . pure <$> handleProjectArg nameString } branchInputPattern :: InputPattern @@ -3523,10 +3518,9 @@ branchInputPattern = { patternName = "branch", aliases = ["branch.create", "create.branch"], visibility = I.Visible, - args = - [ ("branch", Required, projectBranchNameArg suggestionsConfig), - ("branch", Optional, newBranchNameArg) - ], + params = + Parameters [("branch", projectBranchNameArg suggestionsConfig)] $ + Optional [("branch", newBranchNameArg)] Nothing, help = P.wrapColumn2 [ ("`branch foo`", "forks the current project branch to a new branch `foo`"), @@ -3541,12 +3535,6 @@ branchInputPattern = args -> wrongArgsLength "one or two arguments" args } where - newBranchNameArg = - ArgumentType - { typeName = "new-branch", - suggestions = \_ _ _ _ -> pure [], - fzfResolver = Nothing - } suggestionsConfig = ProjectBranchSuggestionsConfig { showProjectCompletions = False, @@ -3560,7 +3548,7 @@ branchEmptyInputPattern = { patternName = "branch.empty", aliases = ["branch.create-empty", "create.empty-branch"], visibility = I.Visible, - args = [], + params = Parameters [("branch", newBranchNameArg)] $ Optional [] Nothing, help = P.wrap "Create a new empty branch.", parse = \case [name] -> @@ -3575,7 +3563,7 @@ branchRenameInputPattern = { patternName = "branch.rename", aliases = ["rename.branch"], visibility = I.Visible, - args = [], + params = Parameters [("branch", newBranchNameArg)] $ Optional [] Nothing, help = P.wrapColumn2 [("`branch.rename foo`", "renames the current branch to `foo`")], @@ -3590,7 +3578,9 @@ clone = { patternName = "clone", aliases = [], visibility = I.Visible, - args = [], + params = + Parameters [("source branch", projectAndBranchNamesArg suggestionsConfig)] $ + Optional [("target branch", newBranchNameArg)] Nothing, help = P.wrapColumn2 [ ( "`clone @unison/json/topic json/my-topic`", @@ -3621,6 +3611,13 @@ clone = <*> fmap pure (handleProjectAndBranchNamesArg localNames) args -> wrongArgsLength "one or two arguments" args } + where + suggestionsConfig = + ProjectBranchSuggestionsConfig + { showProjectCompletions = True, + projectInclusion = AllProjects, + branchInclusion = ExcludeCurrentBranch + } releaseDraft :: InputPattern releaseDraft = @@ -3628,7 +3625,7 @@ releaseDraft = { patternName = "release.draft", aliases = ["draft.release"], visibility = I.Visible, - args = [], + params = Parameters [("version", noCompletionsArg)] $ Optional [] Nothing, help = P.wrap "Draft a release.", parse = \case [semverString] -> @@ -3645,7 +3642,9 @@ upgrade = { patternName = "upgrade", aliases = [], visibility = I.Visible, - args = [("dependency to upgrade", Required, dependencyArg), ("dependency to upgrade to", Required, dependencyArg)], + params = + Parameters [("dependency to upgrade", dependencyArg), ("dependency to upgrade to", dependencyArg)] $ + Optional [] Nothing, help = P.wrap $ "`upgrade old new` upgrades library dependency `lib.old` to `lib.new`, and, if successful, deletes `lib.old`.", @@ -3661,7 +3660,7 @@ upgradeCommitInputPattern = { patternName = "upgrade.commit", aliases = ["commit.upgrade"], visibility = I.Visible, - args = [], + params = noParams, help = let mainBranch = UnsafeProjectBranchName "main" tempBranch = UnsafeProjectBranchName "upgrade-foo-to-bar" @@ -3692,9 +3691,7 @@ upgradeCommitInputPattern = makeExampleNoBackticks deleteBranch [prettySlashProjectBranchName tempBranch] ] ), - parse = \case - [] -> Right Input.UpgradeCommitI - args -> wrongArgsLength "no arguments" args + parse = const $ pure Input.UpgradeCommitI } debugSynhashTermInputPattern :: InputPattern @@ -3703,7 +3700,7 @@ debugSynhashTermInputPattern = { patternName = "debug.synhash.term", aliases = [], visibility = I.Hidden, - args = [("term", Required, exactDefinitionTermQueryArg)], + params = Parameters [("term", exactDefinitionTermQueryArg)] $ Optional [] Nothing, help = mempty, parse = \case [arg] -> Input.DebugSynhashTermI <$> handleNameArg arg @@ -3865,70 +3862,77 @@ visibleInputs = filter ((== I.Visible) . I.visibility) validInputs commandNames :: [String] commandNames = visibleInputs >>= \i -> I.patternName i : I.aliases i -commandNameArg :: ArgumentType +commandNameArg :: ParameterType commandNameArg = let options = commandNames <> Map.keys helpTopicsMap - in ArgumentType + in ParameterType { typeName = "command", suggestions = \q _ _ _ -> pure (exactComplete q options), - fzfResolver = Just $ Resolvers.fuzzySelectFromList (Text.pack <$> options) + fzfResolver = Just $ Resolvers.fuzzySelectFromList (Text.pack <$> options), + isStructured = False } -exactDefinitionArg :: ArgumentType +exactDefinitionArg :: ParameterType exactDefinitionArg = - ArgumentType + ParameterType { typeName = "definition", suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteTermOrType q p), - fzfResolver = Just Resolvers.definitionResolver + fzfResolver = Just Resolvers.definitionResolver, + isStructured = True } -definitionQueryArg :: ArgumentType +definitionQueryArg :: ParameterType definitionQueryArg = exactDefinitionArg {typeName = "definition query"} -exactDefinitionTypeQueryArg :: ArgumentType +exactDefinitionTypeQueryArg :: ParameterType exactDefinitionTypeQueryArg = - ArgumentType + ParameterType { typeName = "type definition query", suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteType q p), - fzfResolver = Just Resolvers.typeDefinitionResolver + fzfResolver = Just Resolvers.typeDefinitionResolver, + isStructured = True } -exactDefinitionTypeOrTermQueryArg :: ArgumentType +exactDefinitionTypeOrTermQueryArg :: ParameterType exactDefinitionTypeOrTermQueryArg = - ArgumentType + ParameterType { typeName = "type or term definition query", suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteTermOrType q p), - fzfResolver = Just Resolvers.definitionResolver + fzfResolver = Just Resolvers.definitionResolver, + isStructured = True } -exactDefinitionTermQueryArg :: ArgumentType +exactDefinitionTermQueryArg :: ParameterType exactDefinitionTermQueryArg = - ArgumentType + ParameterType { typeName = "term definition query", suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteTerm q p), - fzfResolver = Just Resolvers.termDefinitionResolver + fzfResolver = Just Resolvers.termDefinitionResolver, + isStructured = True } -patchArg :: ArgumentType +patchArg :: ParameterType patchArg = - ArgumentType + ParameterType { typeName = "patch", suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompletePatch q p), - fzfResolver = Nothing + fzfResolver = Nothing, + isStructured = True } -namespaceArg :: ArgumentType +namespaceArg :: ParameterType namespaceArg = - ArgumentType + ParameterType { typeName = "namespace", suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteNamespace q p), - fzfResolver = Just Resolvers.namespaceResolver + fzfResolver = Just Resolvers.namespaceResolver, + isStructured = True } -- | Usually you'll want one or the other, but some commands support both right now. -namespaceOrProjectBranchArg :: ProjectBranchSuggestionsConfig -> ArgumentType +namespaceOrProjectBranchArg :: ProjectBranchSuggestionsConfig -> ParameterType namespaceOrProjectBranchArg config = - ArgumentType + ParameterType { typeName = "namespace or branch", suggestions = let namespaceSuggestions = \q cb _http pp -> Codebase.runTransaction cb (prefixCompleteNamespace q pp) @@ -3936,72 +3940,80 @@ namespaceOrProjectBranchArg config = [ projectAndOrBranchSuggestions config, namespaceSuggestions ], - fzfResolver = Just Resolvers.projectOrBranchResolver + fzfResolver = Just Resolvers.projectOrBranchResolver, + isStructured = True } -namespaceOrDefinitionArg :: ArgumentType +namespaceOrDefinitionArg :: ParameterType namespaceOrDefinitionArg = - ArgumentType + ParameterType { typeName = "term, type, or namespace", suggestions = \q cb _http p -> Codebase.runTransaction cb do namespaces <- prefixCompleteNamespace q p termsTypes <- prefixCompleteTermOrType q p pure (List.nubOrd $ namespaces <> termsTypes), fzfResolver = - Just Resolvers.namespaceOrDefinitionResolver + Just Resolvers.namespaceOrDefinitionResolver, + isStructured = True } -- | A dependency name. E.g. if your project has `lib.base`, `base` would be a dependency -- name. -dependencyArg :: ArgumentType +dependencyArg :: ParameterType dependencyArg = - ArgumentType + ParameterType { typeName = "project dependency", suggestions = \q cb _http pp -> Codebase.runTransaction cb do prefixCompleteNamespace q (pp & PP.path_ .~ Path.singleton NameSegment.libSegment), - fzfResolver = Just Resolvers.projectDependencyResolver + fzfResolver = Just Resolvers.projectDependencyResolver, + isStructured = True } -newNameArg :: ArgumentType +newNameArg :: ParameterType newNameArg = - ArgumentType + ParameterType { typeName = "new-name", suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteNamespace q p), - fzfResolver = Nothing + fzfResolver = Nothing, + isStructured = True } -noCompletionsArg :: ArgumentType +noCompletionsArg :: ParameterType noCompletionsArg = - ArgumentType + ParameterType { typeName = "word", suggestions = noCompletions, - fzfResolver = Nothing + fzfResolver = Nothing, + isStructured = False } -filePathArg :: ArgumentType +filePathArg :: ParameterType filePathArg = - ArgumentType + ParameterType { typeName = "file-path", suggestions = noCompletions, - fzfResolver = Nothing + fzfResolver = Nothing, + isStructured = False } -- | Refers to a namespace on some remote code host. -remoteNamespaceArg :: ArgumentType +remoteNamespaceArg :: ParameterType remoteNamespaceArg = - ArgumentType + ParameterType { typeName = "remote-namespace", suggestions = \input _cb http _p -> sharePathCompletion http input, - fzfResolver = Nothing + fzfResolver = Nothing, + isStructured = True } -profileArg :: ArgumentType +profileArg :: ParameterType profileArg = - ArgumentType + ParameterType { typeName = "profile", suggestions = \_input _cb _http _p -> pure [Line.simpleCompletion "profile"], - fzfResolver = Nothing + fzfResolver = Nothing, + isStructured = False } data ProjectInclusion = OnlyWithinCurrentProject | OnlyOutsideCurrentProject | AllProjects @@ -4315,29 +4327,32 @@ branchRelativePathSuggestions config inputStr codebase _httpClient pp = do branchPathSep = ":" -- | A project name, branch name, or both. -projectAndBranchNamesArg :: ProjectBranchSuggestionsConfig -> ArgumentType +projectAndBranchNamesArg :: ProjectBranchSuggestionsConfig -> ParameterType projectAndBranchNamesArg config = - ArgumentType + ParameterType { typeName = "project-and-branch-names", suggestions = projectAndOrBranchSuggestions config, - fzfResolver = Just Resolvers.projectAndOrBranchArg + fzfResolver = Just Resolvers.projectAndOrBranchArg, + isStructured = True } -- | A project branch name. -projectBranchNameArg :: ProjectBranchSuggestionsConfig -> ArgumentType +projectBranchNameArg :: ProjectBranchSuggestionsConfig -> ParameterType projectBranchNameArg config = - ArgumentType + ParameterType { typeName = "project-branch-name", suggestions = projectAndOrBranchSuggestions config, - fzfResolver = Just Resolvers.projectBranchResolver + fzfResolver = Just Resolvers.projectBranchResolver, + isStructured = True } -branchRelativePathArg :: ArgumentType +branchRelativePathArg :: ParameterType branchRelativePathArg = - ArgumentType + ParameterType { typeName = "branch-relative-path", suggestions = branchRelativePathSuggestions config, - fzfResolver = Nothing + fzfResolver = Nothing, + isStructured = True } where config = @@ -4348,12 +4363,13 @@ branchRelativePathArg = } -- | A project name. -projectNameArg :: ArgumentType +projectNameArg :: ParameterType projectNameArg = - ArgumentType + ParameterType { typeName = "project-name", suggestions = \input codebase _httpClient _path -> projectNameSuggestions NoSlash input codebase, - fzfResolver = Just $ Resolvers.multiResolver [Resolvers.projectNameOptions] + fzfResolver = Just $ Resolvers.multiResolver [Resolvers.projectNameOptions], + isStructured = True } data OptionalSlash diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 97af0ba88e..61fe87e3a1 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -81,7 +81,11 @@ getUserInput codebase authHTTPClient pp currentProjectRoot numberedArgs = codeserverPrompt :: String codeserverPrompt = if isCustomCodeserver Codeserver.defaultCodeserver - then "🌐" <> Codeserver.codeserverRegName Codeserver.defaultCodeserver <> maybe "" (":" <>) (show <$> Codeserver.codeserverPort Codeserver.defaultCodeserver) <> "\n" + then + "🌐" + <> Codeserver.codeserverRegName Codeserver.defaultCodeserver + <> maybe "" (":" <>) (show <$> Codeserver.codeserverPort Codeserver.defaultCodeserver) + <> "\n" else "" go :: Line.InputT IO Input @@ -95,11 +99,11 @@ getUserInput codebase authHTTPClient pp currentProjectRoot numberedArgs = [] -> go ws -> do liftIO (parseInput codebase pp currentProjectRoot numberedArgs IP.patternMap ws) >>= \case - Left msg -> do + Left failure -> do -- We still add history that failed to parse so the user can easily reload -- the input and fix it. - Line.modifyHistory $ Line.addHistoryUnlessConsecutiveDupe $ l - liftIO $ putPrettyLn msg + Line.modifyHistory $ Line.addHistoryUnlessConsecutiveDupe l + liftIO . putPrettyLn $ reportParseFailure failure go Right Nothing -> do -- Ctrl-c or some input cancel, re-run the prompt @@ -109,7 +113,7 @@ getUserInput codebase authHTTPClient pp currentProjectRoot numberedArgs = expandedArgsStr = unwords expandedArgs' when (expandedArgs' /= ws) $ do liftIO . putStrLn $ fullPrompt <> expandedArgsStr - Line.modifyHistory $ Line.addHistoryUnlessConsecutiveDupe $ expandedArgsStr + Line.modifyHistory $ Line.addHistoryUnlessConsecutiveDupe expandedArgsStr pure i settings :: Line.Settings IO settings = diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index c94dff1803..c5cfc6e093 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1581,6 +1581,8 @@ notifyUser dir = \case pure $ P.lines [P.text (FZFResolvers.fuzzySelectHeader argDesc), P.indentN 2 $ P.bulleted (P.string <$> fuzzyOptions)] + DebugFuzzyOptionsIncorrectArgs _ -> pure $ P.string "Too many arguments were provided." + DebugFuzzyOptionsNoCommand command -> pure $ "The command “" <> P.string command <> "” doesn’t exist." DebugFuzzyOptionsNoResolver -> pure "No resolver found for fuzzy options in this slot." ClearScreen -> do ANSI.clearScreen diff --git a/unison-src/transcripts-using-base/all-base-hashes.output.md b/unison-src/transcripts-using-base/all-base-hashes.output.md index d60d5ae872..c736299cb4 100644 --- a/unison-src/transcripts-using-base/all-base-hashes.output.md +++ b/unison-src/transcripts-using-base/all-base-hashes.output.md @@ -2743,243 +2743,252 @@ scratch/main> find.verbose 779. -- #13fpchr37ua0pr38ssr7j22pudmseuedf490aok18upagh0f00kg40guj9pgl916v9qurqrvu53f3lpsvi0s82hg3dtjacanrpjvs38 fromHex : Text -> Bytes - 780. -- #od69b4q2upcvsdjhb7ra8unq1r8t7924mra5j5s8f7n173bmslp8dprhgt1mjdj49qj10h2gj91eflke1avj0qlecus1mdevufm3hho + 780. -- #b5ljjbncgukq958frsqtuebv9b1ack0blhqcue5km6k15gotubesaj6bv3ii61f676qcfq5rimmjtrihio7pnk8r9noe3s3v7lk4i5o + getArgs : '{IO, Exception} [Text] + + 781. -- #od69b4q2upcvsdjhb7ra8unq1r8t7924mra5j5s8f7n173bmslp8dprhgt1mjdj49qj10h2gj91eflke1avj0qlecus1mdevufm3hho getBuffering : Handle ->{IO, Exception} BufferMode - 781. -- #fupr0p6pmt834qep0jp18h9jhf4uadmtrsndpfac3kpkf4q4foqnqi6dmc6u4mgs9aubl8issknu89taqhi1mvaeg1ctbt3uf2lidh8 + 782. -- #fupr0p6pmt834qep0jp18h9jhf4uadmtrsndpfac3kpkf4q4foqnqi6dmc6u4mgs9aubl8issknu89taqhi1mvaeg1ctbt3uf2lidh8 getBytes : Handle -> Nat ->{IO, Exception} Bytes - 782. -- #qgocu5n2e7urg44ch4m8upn24efh6jk4cmp8bjsvhnenhahq8nniauav0ihpqa31p57v8fhqdep4fh5dj7nj1uul7596us04dr6dqng + 783. -- #qgocu5n2e7urg44ch4m8upn24efh6jk4cmp8bjsvhnenhahq8nniauav0ihpqa31p57v8fhqdep4fh5dj7nj1uul7596us04dr6dqng getChar : Handle ->{IO, Exception} Char - 783. -- #t92if409jh848oifd8v6bbu6o0hd0916rc3rbdlj4vf46oll2tradqrilk6r28mmm19dao5sh8l349qrhc59qopv4u1hba3ndfiitq8 + 784. -- #t92if409jh848oifd8v6bbu6o0hd0916rc3rbdlj4vf46oll2tradqrilk6r28mmm19dao5sh8l349qrhc59qopv4u1hba3ndfiitq8 getEcho : Handle ->{IO, Exception} Boolean - 784. -- #5nc47o8abjut8sab84ltouhiv3mtid9poipn2b53q3bpceebdimb4sb1e7lkrmu3bn3ivgcqe568upqqh5clrqgkhfdsji58kcdrt4g + 785. -- #5nc47o8abjut8sab84ltouhiv3mtid9poipn2b53q3bpceebdimb4sb1e7lkrmu3bn3ivgcqe568upqqh5clrqgkhfdsji58kcdrt4g getLine : Handle ->{IO, Exception} Text - 785. -- #l9pfqiqb3u9o8qo7jnaajph1qh0jbodih4vtuqti53vjmtp4diddidt8r2qa826918bt7b1cf873oo511tkivfkg35fo5o4kh5j35r0 + 786. -- #l9pfqiqb3u9o8qo7jnaajph1qh0jbodih4vtuqti53vjmtp4diddidt8r2qa826918bt7b1cf873oo511tkivfkg35fo5o4kh5j35r0 getSomeBytes : Handle -> Nat ->{IO, Exception} Bytes - 786. -- #mdhva408l4fji5h23okmhk5t4dakt1lokuie28nsdspal45lbhe06vkmcu8hf8jplse56o576ogn72j7k5nbph06nl36o957qn25tvo + 787. -- #mdhva408l4fji5h23okmhk5t4dakt1lokuie28nsdspal45lbhe06vkmcu8hf8jplse56o576ogn72j7k5nbph06nl36o957qn25tvo getTempDirectory : '{IO, Exception} Text - 787. -- #vniqolukf0296u5dc6d68ngfvi9quuuklcsjodnfm0tm8atslq19sidso2uqnbf4g6h23qck69dpd0oceb9539ufoo12rhdcdd934lo + 788. -- #vniqolukf0296u5dc6d68ngfvi9quuuklcsjodnfm0tm8atslq19sidso2uqnbf4g6h23qck69dpd0oceb9539ufoo12rhdcdd934lo handlePosition : Handle ->{IO, Exception} Nat - 788. -- #85s6gvfbpv8lhgq8m36h7ebvan4lljiu2ffehbgese5c11h3vpqlcssts8svi2qo2c5d68oeke092puta1ng84982hiid972hss9m40 + 789. -- #85s6gvfbpv8lhgq8m36h7ebvan4lljiu2ffehbgese5c11h3vpqlcssts8svi2qo2c5d68oeke092puta1ng84982hiid972hss9m40 handshake : Tls ->{IO, Exception} () - 789. -- #128490j1tmitiu3vesv97sqspmefobg1am38vos9p0vt4s1bhki87l7kj4cctquffkp40eanmr9ummfglj9i7s25jrpb32ob5sf2tio + 790. -- #128490j1tmitiu3vesv97sqspmefobg1am38vos9p0vt4s1bhki87l7kj4cctquffkp40eanmr9ummfglj9i7s25jrpb32ob5sf2tio hex : Bytes -> Text - 790. -- #ttjui80dbufvf3vgaddmcr065dpgl0rtp68i5cdht6tq4t2vk3i2vg60hi77rug368qijgijf8oui27te7o5oq0t0osm6dg65c080i0 + 791. -- #ttjui80dbufvf3vgaddmcr065dpgl0rtp68i5cdht6tq4t2vk3i2vg60hi77rug368qijgijf8oui27te7o5oq0t0osm6dg65c080i0 id : a -> a - 791. -- #0lj5fufff9ocn6lfgc3sv23aup971joh61ei6llu7djblug7tmv2avijc91ing6jmm42hu3akdefl1ttdvepk69sc8jslih1g80npg8 + 792. -- #0lj5fufff9ocn6lfgc3sv23aup971joh61ei6llu7djblug7tmv2avijc91ing6jmm42hu3akdefl1ttdvepk69sc8jslih1g80npg8 isDirectory : Text ->{IO, Exception} Boolean - 792. -- #flakrb6iks7vgijtm8dhipj14v57tk96nq5uj3uluplpoamb1etufn7rsjrelaj3letaa0e2aivq95794nv2b8a8vqbqdumd6i0fvpo + 793. -- #flakrb6iks7vgijtm8dhipj14v57tk96nq5uj3uluplpoamb1etufn7rsjrelaj3letaa0e2aivq95794nv2b8a8vqbqdumd6i0fvpo isFileEOF : Handle ->{IO, Exception} Boolean - 793. -- #5qan8ssedn9pouru70v1a06tkivapiv0es8k6v3hjpmkmboekktnh30ia7asmevglf4pu8ujb0t9vsctjsjtam160o9bn9g02uciui8 + 794. -- #5qan8ssedn9pouru70v1a06tkivapiv0es8k6v3hjpmkmboekktnh30ia7asmevglf4pu8ujb0t9vsctjsjtam160o9bn9g02uciui8 isFileOpen : Handle ->{IO, Exception} Boolean - 794. -- #2a11371klrv2i8726knma0l3g14on4m2ucihpg65cjj9k930aefg65ovvg0ak4uv3i9evtnu0a5249q3i8ugheqd65cnmgquc1a88n0 + 795. -- #2a11371klrv2i8726knma0l3g14on4m2ucihpg65cjj9k930aefg65ovvg0ak4uv3i9evtnu0a5249q3i8ugheqd65cnmgquc1a88n0 isNone : Optional a -> Boolean - 795. -- #jsqdsol9g3qnkub2f2ogertbiieldlkqh859vn5qovub6halelfmpv1tc50u1n23kotgd9nnejnn0n6foef8aqfcp615ashd0cfi3j8 + 796. -- #jsqdsol9g3qnkub2f2ogertbiieldlkqh859vn5qovub6halelfmpv1tc50u1n23kotgd9nnejnn0n6foef8aqfcp615ashd0cfi3j8 isSeekable : Handle ->{IO, Exception} Boolean - 796. -- #gop2v9s6l24ii1v6bf1nks2h0h18pato0vbsf4u3el18s7mp1jfnp4c7fesdf9sunnlv5f5a9fjr1s952pte87mf63l1iqki9bp0mio + 797. -- #gop2v9s6l24ii1v6bf1nks2h0h18pato0vbsf4u3el18s7mp1jfnp4c7fesdf9sunnlv5f5a9fjr1s952pte87mf63l1iqki9bp0mio List.all : (a ->{ε} Boolean) -> [a] ->{ε} Boolean - 797. -- #thvdk6pgdi019on95nttjhg3rbqo7aq5lv9fqgehg00657utkitc1k5r9bfl7soqdrqd82tjmesn5ocb6d30ire6vkl0ad6rcppg5vo + 798. -- #thvdk6pgdi019on95nttjhg3rbqo7aq5lv9fqgehg00657utkitc1k5r9bfl7soqdrqd82tjmesn5ocb6d30ire6vkl0ad6rcppg5vo List.filter : (a ->{g} Boolean) -> [a] ->{g} [a] - 798. -- #ca71f74kmn16u76lch7ropsgou2t3lbtc5hr06858l97qkhk0b4ado1pnii4hqfannelbgv4qruv4f1iqn43kgkbsq8lpjmo3mnrp38 + 799. -- #ca71f74kmn16u76lch7ropsgou2t3lbtc5hr06858l97qkhk0b4ado1pnii4hqfannelbgv4qruv4f1iqn43kgkbsq8lpjmo3mnrp38 List.foldLeft : (b ->{g} a ->{g} b) -> b -> [a] ->{g} b - 799. -- #o1gssqn32qvl4pa79a0lko5ksvbn0rtv8u5g9jpd73ig94om2r4nlbcqa4nd968q74ios37eg0ol36776praolimpch8jsbohg47j2o + 800. -- #o1gssqn32qvl4pa79a0lko5ksvbn0rtv8u5g9jpd73ig94om2r4nlbcqa4nd968q74ios37eg0ol36776praolimpch8jsbohg47j2o List.forEach : [a] -> (a ->{e} ()) ->{e} () - 800. -- #atruig2897q7u699k1u4ruou8epfb9qsok7ojkm5om67fhhaqgdi597jr7dvr09h9qndupc49obo4cccir98ei1grfehrcd5qhnkcq0 + 801. -- #ol837rn3935jnul9r2ri4i7gqonu2jp9maqmbr072mmk35tl0kq19s4ltuche8seihf8d246a6upgpdlvs6ocdbsgdm7k88bonhgmn8 + List.head : [t] -> Optional t + + 802. -- #atruig2897q7u699k1u4ruou8epfb9qsok7ojkm5om67fhhaqgdi597jr7dvr09h9qndupc49obo4cccir98ei1grfehrcd5qhnkcq0 List.range : Nat -> Nat -> [Nat] - 801. -- #marlqbcbculvqjfro3iidf899g2ncob2f8ld3gosg7kas5t9hlh341d49uh57ff5litvrt0hlb2ms7tj0mkfqs9do67cm4msodt8dng + 803. -- #marlqbcbculvqjfro3iidf899g2ncob2f8ld3gosg7kas5t9hlh341d49uh57ff5litvrt0hlb2ms7tj0mkfqs9do67cm4msodt8dng List.reverse : [a] -> [a] - 802. -- #30hfqasco93u0oipi7irfoabh5uofuu2aeplo2c87p4dg0386si6gvv715dbr21s4ftfquev4baj5ost3h17mt8fajn64mbffp6c8c0 + 804. -- #30hfqasco93u0oipi7irfoabh5uofuu2aeplo2c87p4dg0386si6gvv715dbr21s4ftfquev4baj5ost3h17mt8fajn64mbffp6c8c0 List.unzip : [(a, b)] -> ([a], [b]) - 803. -- #s8l7maltpsr01naqadvs5ssttg7eim4ca2096lbo3f3he1i1b11kk95ahtgb5ukb8cjr6kg4r4c1qrvshk9e8dp5fkq87254gc1pk48 + 805. -- #s8l7maltpsr01naqadvs5ssttg7eim4ca2096lbo3f3he1i1b11kk95ahtgb5ukb8cjr6kg4r4c1qrvshk9e8dp5fkq87254gc1pk48 List.zip : [a] -> [b] -> [(a, b)] - 804. -- #g6g6lhj9upe46032doaeo0ndu8lh1krfkc56gvupeg4a16me5vghhi6bthphnsvgtve9ogl73qab6d69ju6uorpj029g97pjg3p2k2o + 806. -- #g6g6lhj9upe46032doaeo0ndu8lh1krfkc56gvupeg4a16me5vghhi6bthphnsvgtve9ogl73qab6d69ju6uorpj029g97pjg3p2k2o listen : Socket ->{IO, Exception} () - 805. -- #ilva5f9uoaia9l8suc3hl9kh2bg1lah1k7uvm8mlq3mt0b9krdh15kurbhb9pu7a8irmvk6m2lpulg75a5alf0a95u0rp0v0n9folmg + 807. -- #ilva5f9uoaia9l8suc3hl9kh2bg1lah1k7uvm8mlq3mt0b9krdh15kurbhb9pu7a8irmvk6m2lpulg75a5alf0a95u0rp0v0n9folmg loadCodeBytes : Bytes ->{Exception} Code - 806. -- #tjj9c7fbprd57jlnndl8huslhvfbhi1bt1mr45v1fvvr2b3bguhnjtll3lbsbnqqjb290tm9cnuafpbtlfev1csbtjjog0r2kfv0e50 + 808. -- #tjj9c7fbprd57jlnndl8huslhvfbhi1bt1mr45v1fvvr2b3bguhnjtll3lbsbnqqjb290tm9cnuafpbtlfev1csbtjjog0r2kfv0e50 loadSelfContained : Text ->{IO, Exception} a - 807. -- #1pkgu9vbcdl57d9pn9ses1htmfokjq6212ed5oo9jscjkf8t2s407j71287hd9nr1shgsjmn0eunm5e7h262id4hh3t4op6barrvc70 + 809. -- #1pkgu9vbcdl57d9pn9ses1htmfokjq6212ed5oo9jscjkf8t2s407j71287hd9nr1shgsjmn0eunm5e7h262id4hh3t4op6barrvc70 loadValueBytes : Bytes ->{IO, Exception} ([(Link.Term, Code)], Value) - 808. -- #nqodnhhovq1ilb5fstpc61l8omfto62r8s0qq8s4ij39ulorqpgtinef64mullq0ns4914gck6obeuu6so1hds09hh5o1ptpt4k909g + 810. -- #nqodnhhovq1ilb5fstpc61l8omfto62r8s0qq8s4ij39ulorqpgtinef64mullq0ns4914gck6obeuu6so1hds09hh5o1ptpt4k909g MVar.put : MVar i -> i ->{IO, Exception} () - 809. -- #4ck8hqiu4m7478q5p7osqd1g9piie53g2v6j89en9s90f3cnhb9jr2515f35605e18ohiod7nb93t03765cil0lecob3hcsht9870g0 + 811. -- #4ck8hqiu4m7478q5p7osqd1g9piie53g2v6j89en9s90f3cnhb9jr2515f35605e18ohiod7nb93t03765cil0lecob3hcsht9870g0 MVar.read : MVar o ->{IO, Exception} o - 810. -- #tchse01rs4t1e6bk9br5ofad23ahlb9eanlv9nqqlk5eh7rv7qtpd5jmdjrcksm1q3uji64kqblrqq0vgap9tmak3urkr3ok4kg2ci0 + 812. -- #tchse01rs4t1e6bk9br5ofad23ahlb9eanlv9nqqlk5eh7rv7qtpd5jmdjrcksm1q3uji64kqblrqq0vgap9tmak3urkr3ok4kg2ci0 MVar.swap : MVar o -> o ->{IO, Exception} o - 811. -- #23nq5mshk51uktsg3su3mnkr9s4fe3sktf4q388bpsluiik64l8h060qptgfv48r25fcskecmc9t4gdsm8im9fhjf70i1klp34epksg + 813. -- #23nq5mshk51uktsg3su3mnkr9s4fe3sktf4q388bpsluiik64l8h060qptgfv48r25fcskecmc9t4gdsm8im9fhjf70i1klp34epksg MVar.take : MVar o ->{IO, Exception} o - 812. -- #18pqussken2f5u9vuall7ds58cf4fajoc4trf7p93vk4640ia88vsh2lgq9kgu8fvpr86518443ecvn7eo5tessq2hmgs55aiftui8g + 814. -- #18pqussken2f5u9vuall7ds58cf4fajoc4trf7p93vk4640ia88vsh2lgq9kgu8fvpr86518443ecvn7eo5tessq2hmgs55aiftui8g newClient : ClientConfig -> Socket ->{IO, Exception} Tls - 813. -- #mmoj281h8bimgcfqfpfg6mfriu8cta5vva4ppo41ioc6phegdfii26ic2s5sh0lf5tc6o15o7v79ui8eeh2mbicup07tl6hkrq9q34o + 815. -- #mmoj281h8bimgcfqfpfg6mfriu8cta5vva4ppo41ioc6phegdfii26ic2s5sh0lf5tc6o15o7v79ui8eeh2mbicup07tl6hkrq9q34o newServer : ServerConfig -> Socket ->{IO, Exception} Tls - 814. -- #r6l6s6ni7ut1b9le2d84el9dkhqjcjhodhd0l1qsksahm4cbgdk0odjck9jnku08v0pn909kabe2v88p43jisavkariomtgmtrrtbu8 + 816. -- #r6l6s6ni7ut1b9le2d84el9dkhqjcjhodhd0l1qsksahm4cbgdk0odjck9jnku08v0pn909kabe2v88p43jisavkariomtgmtrrtbu8 openFile : Text -> FileMode ->{IO, Exception} Handle - 815. -- #c58qbcgd90d965dokk7bu82uehegkbe8jttm7lv4j0ohgi2qm3e3p4v1qfr8vc2dlsmsl9tv0v71kco8c18mneule0ntrhte4ks1090 + 817. -- #de42pjerlsm688s7llh6obrno8j5kq8rf5k931a5nq94o4475qi6ed0c5paqhem6aqi1e6th058qank01j7csc2sp7au9prhkjk31c8 + Optional.getOrBug : msg -> Optional a -> a + + 818. -- #c58qbcgd90d965dokk7bu82uehegkbe8jttm7lv4j0ohgi2qm3e3p4v1qfr8vc2dlsmsl9tv0v71kco8c18mneule0ntrhte4ks1090 printLine : Text ->{IO, Exception} () - 816. -- #dck7pb7qv05ol3b0o76l88a22bc7enl781ton5qbs2umvgsua3p16n22il02m29592oohsnbt3cr7hnlumpdhv2ibjp6iji9te4iot0 + 819. -- #dck7pb7qv05ol3b0o76l88a22bc7enl781ton5qbs2umvgsua3p16n22il02m29592oohsnbt3cr7hnlumpdhv2ibjp6iji9te4iot0 printText : Text ->{IO} Either Failure () - 817. -- #5si7baedo99eap6jgd9krvt7q4ak8s98t4ushnno8mgjp7u9li137ferm3dn11g4k3mds1m8n33sbuodrohstbm9hcqm1937tfj7iq8 + 820. -- #5si7baedo99eap6jgd9krvt7q4ak8s98t4ushnno8mgjp7u9li137ferm3dn11g4k3mds1m8n33sbuodrohstbm9hcqm1937tfj7iq8 putBytes : Handle -> Bytes ->{IO, Exception} () - 818. -- #gkd4pi7uossfe12b19s0mrr0a04v5vvhnfmq3qer3cu7jr24m5v4e1qu59mktrornbrrqgihsvkj1f29je971oqimpngiqgebkr9i58 + 821. -- #gkd4pi7uossfe12b19s0mrr0a04v5vvhnfmq3qer3cu7jr24m5v4e1qu59mktrornbrrqgihsvkj1f29je971oqimpngiqgebkr9i58 readFile : Text ->{IO, Exception} Bytes - 819. -- #ak95mrmd6jhaiikkr42qsvd5lu7au0mpveqm1e347mkr7s4f846apqhh203ei1p3pqi18dcuhuotf53l8p2ivsjs8octc1eenjdqb48 + 822. -- #ak95mrmd6jhaiikkr42qsvd5lu7au0mpveqm1e347mkr7s4f846apqhh203ei1p3pqi18dcuhuotf53l8p2ivsjs8octc1eenjdqb48 ready : Handle ->{IO, Exception} Boolean - 820. -- #gpogpcuoc1dsktoh5t50ofl6dc4vulm0fsqoeevuuoivbrin87ah166b8k8vq3s3977ha0p7np5mn198gglqkjj1gh7nbv31eb7dbqo + 823. -- #gpogpcuoc1dsktoh5t50ofl6dc4vulm0fsqoeevuuoivbrin87ah166b8k8vq3s3977ha0p7np5mn198gglqkjj1gh7nbv31eb7dbqo receive : Tls ->{IO, Exception} Bytes - 821. -- #7rctbhido3s7lm9tjb6dit94cg2jofasr6div31976q840e5va5j6tu6p0pugkt106mcjrtiqndimaknakrnssdo6ul0jef6a9nf1qo + 824. -- #7rctbhido3s7lm9tjb6dit94cg2jofasr6div31976q840e5va5j6tu6p0pugkt106mcjrtiqndimaknakrnssdo6ul0jef6a9nf1qo removeDirectory : Text ->{IO, Exception} () - 822. -- #710k006oln987ch4k1c986sb0jfqtpusp0a235te6cejhns51um6umr311ltgfiv80kt0s8sb8r0ic63gj2nvgbi66vq10s4ilkk5ng + 825. -- #710k006oln987ch4k1c986sb0jfqtpusp0a235te6cejhns51um6umr311ltgfiv80kt0s8sb8r0ic63gj2nvgbi66vq10s4ilkk5ng renameDirectory : Text -> Text ->{IO, Exception} () - 823. -- #vb50tjb967ic3mr4brs0pro9819ftcj4q48eoeal8gmk02f05isuqhn0accbi7rv07g3i4hjgntu2b2r8b9bn15mjc59v10u9c3gjdo + 826. -- #vb50tjb967ic3mr4brs0pro9819ftcj4q48eoeal8gmk02f05isuqhn0accbi7rv07g3i4hjgntu2b2r8b9bn15mjc59v10u9c3gjdo runTest : '{IO, TempDirs, Exception, Stream Result} a ->{IO} [Result] - 824. -- #ub9vp3rs8gh7kj9ksq0dbpoj22r61iq179co8tpgsj9m52n36qha52rm5hlht4hesgqfb8917cp1tk8jhgcft6sufgis6bgemmd57ag + 827. -- #ub9vp3rs8gh7kj9ksq0dbpoj22r61iq179co8tpgsj9m52n36qha52rm5hlht4hesgqfb8917cp1tk8jhgcft6sufgis6bgemmd57ag saveSelfContained : a -> Text ->{IO, Exception} () - 825. -- #6jriif58nb7gbb576kcabft4k4qaa74prd4dpsomokbqceust7p0gu0jlpar4o70qt987lkki2sj1pknkr0ggoif8fcvu2jg2uenqe8 + 828. -- #6jriif58nb7gbb576kcabft4k4qaa74prd4dpsomokbqceust7p0gu0jlpar4o70qt987lkki2sj1pknkr0ggoif8fcvu2jg2uenqe8 saveTestCase : Text -> Text -> (a -> Text) -> a ->{IO, Exception} () - 826. -- #uq87p0r1djq5clhkbimp3fc325e5kp3bv33dc8fpphotdqp95a0ps2c2ch8d2ftdpdualpq2oo9dmnka6kvnc9kvugs2538q62up4t0 + 829. -- #uq87p0r1djq5clhkbimp3fc325e5kp3bv33dc8fpphotdqp95a0ps2c2ch8d2ftdpdualpq2oo9dmnka6kvnc9kvugs2538q62up4t0 seekHandle : Handle -> SeekMode -> Int ->{IO, Exception} () - 827. -- #ftkuro0u0et9ahigdr1k38tl2sl7i0plm7cv5nciccdd71t6a64icla66ss0ufu7llfuj7cuvg3ms4ieel6penfi8gkahb9tm3sfhjo + 830. -- #ftkuro0u0et9ahigdr1k38tl2sl7i0plm7cv5nciccdd71t6a64icla66ss0ufu7llfuj7cuvg3ms4ieel6penfi8gkahb9tm3sfhjo send : Tls -> Bytes ->{IO, Exception} () - 828. -- #k6gmcn3qg50h49gealh8o7j7tp74rvhgn040kftsavd2cldqopcv9945olnooe04cqitgpvekpcbr5ccqjosg7r9gb1lagju5v9ln0o + 831. -- #k6gmcn3qg50h49gealh8o7j7tp74rvhgn040kftsavd2cldqopcv9945olnooe04cqitgpvekpcbr5ccqjosg7r9gb1lagju5v9ln0o serverSocket : Optional Text -> Text ->{IO, Exception} Socket - 829. -- #umje4ibrfv3c6vsjrdkbne1u7c8hg4ll9185m3frqr2rsr8738hp5fq12kepa28h63u9qi23stsegjp1hv0incr5djbl7ulp2s12d8g + 832. -- #umje4ibrfv3c6vsjrdkbne1u7c8hg4ll9185m3frqr2rsr8738hp5fq12kepa28h63u9qi23stsegjp1hv0incr5djbl7ulp2s12d8g setBuffering : Handle -> BufferMode ->{IO, Exception} () - 830. -- #je6s0pdkrg3mvphpg535pubchjd40mepki6ipum7498sma7pll9l89h6de65063bufihf2jb5ihepth2jahir8rs757ggfrnpp7fs7o + 833. -- #je6s0pdkrg3mvphpg535pubchjd40mepki6ipum7498sma7pll9l89h6de65063bufihf2jb5ihepth2jahir8rs757ggfrnpp7fs7o setEcho : Handle -> Boolean ->{IO, Exception} () - 831. -- #in06o7cfgnlmm6pvdtv0jv9hniahcli0fvh27o01ork1p77ro2v51rc05ts1h6p9mtffqld4ufs8klcc4bse1tsj93cu0na0bbiuqb0 + 834. -- #in06o7cfgnlmm6pvdtv0jv9hniahcli0fvh27o01ork1p77ro2v51rc05ts1h6p9mtffqld4ufs8klcc4bse1tsj93cu0na0bbiuqb0 snd : (a1, a) -> a - 832. -- #km3cpkvcnvcos0isfbnb7pb3s45ri5q42n74jmm9c4v1bcu8nlk63353u4ohfr7av4k00s4s180ddnqbam6a01thhlt2tie1hm5a9bo + 835. -- #km3cpkvcnvcos0isfbnb7pb3s45ri5q42n74jmm9c4v1bcu8nlk63353u4ohfr7av4k00s4s180ddnqbam6a01thhlt2tie1hm5a9bo socketAccept : Socket ->{IO, Exception} Socket - 833. -- #ubteu6e7h7om7o40e8mm1rcmp8uur7qn7p5d92gtp3q92rtr459nn3rff4i9q46o2o60tmh77i9vgu0pub768s9kvn9egtcds30nk88 + 836. -- #ubteu6e7h7om7o40e8mm1rcmp8uur7qn7p5d92gtp3q92rtr459nn3rff4i9q46o2o60tmh77i9vgu0pub768s9kvn9egtcds30nk88 socketPort : Socket ->{IO, Exception} Nat - 834. -- #3rp8h0dt7g60nrjdehuhqga9dmomti5rdqho7r1rm5rg5moet7kt3ieempo7c9urur752njachq6k48ggbic4ugbbv75jl2mfbk57a0 + 837. -- #3rp8h0dt7g60nrjdehuhqga9dmomti5rdqho7r1rm5rg5moet7kt3ieempo7c9urur752njachq6k48ggbic4ugbbv75jl2mfbk57a0 startsWith : Text -> Text -> Boolean - 835. -- #elsab3sc7p4c6bj73pgvklv0j7qu268rn5isv6micfp7ib8grjoustpqdq0pkd4a379mr5ijb8duu2q0n040osfurppp8pt8vaue2fo + 838. -- #elsab3sc7p4c6bj73pgvklv0j7qu268rn5isv6micfp7ib8grjoustpqdq0pkd4a379mr5ijb8duu2q0n040osfurppp8pt8vaue2fo stdout : Handle - 836. -- #rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8 + 839. -- #rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8 structural ability Stream a - 837. -- #s76vfp9t00khf3bvrg01h9u7gnqj5m62sere8ac97un79ojd82b71q2e0cllj002jn4r2g3qhjft40gkqotgor74v0iogkt3lfftlug + 840. -- #s76vfp9t00khf3bvrg01h9u7gnqj5m62sere8ac97un79ojd82b71q2e0cllj002jn4r2g3qhjft40gkqotgor74v0iogkt3lfftlug Stream.collect : '{e, Stream a} r ->{e} ([a], r) - 838. -- #abc5m7k74em3fk9et4lrj0ee2lsbvp8vp826josen26l1g3lh9ansb47b68efe1vhhi8f6l6kaircd5t4ihlbt0pq4nlipgde9rq8v8 + 841. -- #abc5m7k74em3fk9et4lrj0ee2lsbvp8vp826josen26l1g3lh9ansb47b68efe1vhhi8f6l6kaircd5t4ihlbt0pq4nlipgde9rq8v8 Stream.collect.handler : Request {Stream a} r -> ([a], r) - 839. -- #rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8#0 + 842. -- #rfi1v9429f9qluv533l2iba77aadttilrpmnhljfapfnfa6sru2nr8ibpqvib9nc4s4nb9s1as45upsfqfqe6ivqi2p82b2vd866it8#0 Stream.emit : a ->{Stream a} () - 840. -- #mrhqdu5he7p8adejmvt4ss09apkbnu8jn66g4lpf0uas9dvm8goa6g65bo2u7s0175hrrofd6uqg7ogmduf928knfpkd12042k6o860 + 843. -- #mrhqdu5he7p8adejmvt4ss09apkbnu8jn66g4lpf0uas9dvm8goa6g65bo2u7s0175hrrofd6uqg7ogmduf928knfpkd12042k6o860 Stream.toList : '{Stream a} r -> [a] - 841. -- #t3klufmrq2bk8gg0o4lukenlmu0dkkcssq9l80m4p3dm6rqesrt51nrebfujfgco9h47f4e5nplmj7rvc3salvs65labd7nvj2fkne8 + 844. -- #t3klufmrq2bk8gg0o4lukenlmu0dkkcssq9l80m4p3dm6rqesrt51nrebfujfgco9h47f4e5nplmj7rvc3salvs65labd7nvj2fkne8 Stream.toList.handler : Request {Stream a} r -> [a] - 842. -- #pus3urtj4e1bhv5p5l16d7vnv4g2hso78pcfussnufkt3d53j7oaqde1ajvijr1g6f0cv2c4ice34g8g8n17hd7hql6hvl8sgcgu6s8 + 845. -- #pus3urtj4e1bhv5p5l16d7vnv4g2hso78pcfussnufkt3d53j7oaqde1ajvijr1g6f0cv2c4ice34g8g8n17hd7hql6hvl8sgcgu6s8 systemTime : '{IO, Exception} Nat - 843. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18 + 846. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18 structural ability TempDirs - 844. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18#0 + 847. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18#0 TempDirs.newTempDir : Text ->{TempDirs} Text - 845. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18#1 + 848. -- #11mhfqj6rts8lm3im7saf44tn3km5bboqtu1td0udnaiit4qqg6ar1ecmccosl6gufsnp6sug3vcmgapsc58sgj7dh7rg8msq2qkj18#1 TempDirs.removeDir : Text ->{TempDirs} () - 846. -- #ibj0sc16l6bd7r6ptft93jeocitrjod98g210beogdk30t3tb127fbe33vau29j0j4gt8mbs2asfs5rslgk0fl3o4did2t9oa8o5kf8 + 849. -- #ibj0sc16l6bd7r6ptft93jeocitrjod98g210beogdk30t3tb127fbe33vau29j0j4gt8mbs2asfs5rslgk0fl3o4did2t9oa8o5kf8 terminate : Tls ->{IO, Exception} () - 847. -- #iis8ph5ljlq8ijd9jsdlsga91fh1354fii7955l4v52mnvn71cd76maculs0eathrmtfjqh0knbc600kmvq6abj4k2ntnbh5ee10m2o + 850. -- #iis8ph5ljlq8ijd9jsdlsga91fh1354fii7955l4v52mnvn71cd76maculs0eathrmtfjqh0knbc600kmvq6abj4k2ntnbh5ee10m2o testAutoClean : '{IO} [Result] - 848. -- #k1prgid1t9d4fu6f60rct978khcuinkpq49ps95aqaimt2tfoa77fc0c8i3pmc8toeth1s98al3nosaa1mhbh2j2k2nvqivm0ks963o + 851. -- #k1prgid1t9d4fu6f60rct978khcuinkpq49ps95aqaimt2tfoa77fc0c8i3pmc8toeth1s98al3nosaa1mhbh2j2k2nvqivm0ks963o Text.fromUtf8 : Bytes ->{Exception} Text - 849. -- #32q9jqhmi8f08pec3hj0je4u7k52f9f1hdfsmn9ncg2kpki5da9dabigplvdcot3a00k7s5npc4n78psd6ojaumqjla259e9pqd4ov8 + 852. -- #32q9jqhmi8f08pec3hj0je4u7k52f9f1hdfsmn9ncg2kpki5da9dabigplvdcot3a00k7s5npc4n78psd6ojaumqjla259e9pqd4ov8 structural ability Throw e - 850. -- #32q9jqhmi8f08pec3hj0je4u7k52f9f1hdfsmn9ncg2kpki5da9dabigplvdcot3a00k7s5npc4n78psd6ojaumqjla259e9pqd4ov8#0 + 853. -- #32q9jqhmi8f08pec3hj0je4u7k52f9f1hdfsmn9ncg2kpki5da9dabigplvdcot3a00k7s5npc4n78psd6ojaumqjla259e9pqd4ov8#0 Throw.throw : e ->{Throw e} a - 851. -- #f6pkvs6ukf8ngh2j8lm935p1bqadso76o7e3t0j1ukupjh1rg0m1rhtp7u492sq17p3bkbintbnjehc1cqs33qlhnfkoihf5uee4ug0 + 854. -- #f6pkvs6ukf8ngh2j8lm935p1bqadso76o7e3t0j1ukupjh1rg0m1rhtp7u492sq17p3bkbintbnjehc1cqs33qlhnfkoihf5uee4ug0 uncurry : (i1 ->{g1} i ->{g} o) -> (i1, i) ->{g1, g} o - 852. -- #u1o44hd0cdlfa8racf458sahdmgea409k8baajgc5k7bqukf2ak5ggs2ped0u3h85v99pgefgb9r7ct2dv4nn9eihjghnqf30p4l57g + 855. -- #u1o44hd0cdlfa8racf458sahdmgea409k8baajgc5k7bqukf2ak5ggs2ped0u3h85v99pgefgb9r7ct2dv4nn9eihjghnqf30p4l57g Value.transitiveDeps : Value ->{IO} [(Link.Term, Code)] - 853. -- #o5bg5el7ckak28ib98j5b6rt26bqbprpddd1brrg3s18qahhbbe3uohufjjnt5eenvtjg0hrvnvpra95jmdppqrovvmcfm1ih2k7guo + 856. -- #o5bg5el7ckak28ib98j5b6rt26bqbprpddd1brrg3s18qahhbbe3uohufjjnt5eenvtjg0hrvnvpra95jmdppqrovvmcfm1ih2k7guo void : x -> () - 854. -- #b4pssu6mf30r4irqj43vvgbc6geq8pp7eg4o2erl948qp3nskp6io5damjj54o2eq9q76mrhsijr1q1d0bna4soed3oggddfvdajaj8 + 857. -- #b4pssu6mf30r4irqj43vvgbc6geq8pp7eg4o2erl948qp3nskp6io5damjj54o2eq9q76mrhsijr1q1d0bna4soed3oggddfvdajaj8 writeFile : Text -> Bytes ->{IO, Exception} () - 855. -- #lcmj2envm11lrflvvcl290lplhvbccv82utoej0lg0eomhmsf2vrv8af17k6if7ff98fp1b13rkseng3fng4stlr495c8dn3gn4k400 + 858. -- #lcmj2envm11lrflvvcl290lplhvbccv82utoej0lg0eomhmsf2vrv8af17k6if7ff98fp1b13rkseng3fng4stlr495c8dn3gn4k400 |> : a -> (a ->{g} t) ->{g} t ``` diff --git a/unison-src/transcripts-using-base/base.u b/unison-src/transcripts-using-base/base.u index b1023f558a..f525dae034 100644 --- a/unison-src/transcripts-using-base/base.u +++ b/unison-src/transcripts-using-base/base.u @@ -1,4 +1,3 @@ - a |> f = f a f <| a = f a @@ -97,6 +96,10 @@ List.forEach l f = [] -> () go l +List.head = cases + [] -> None + a +: _ -> Some a + List.zip : [a] -> [b] -> [(a,b)] List.zip = cases [], _ -> [] @@ -118,6 +121,10 @@ List.reverse = x +: xs -> loop (x +: acc) xs loop [] +Optional.getOrBug msg = cases + None -> bug msg + Some a -> a + first : (a -> b) -> (a,c) -> (b,c) first f = cases (x,y) -> (f x, y) @@ -215,6 +222,9 @@ autoCleaned.handler _ = autoCleaned: '{io2.IO, TempDirs} r -> r autoCleaned comp = handle !comp with !autoCleaned.handler +getArgs : '{IO, Exception} [Text] +getArgs _ = Exception.reraise getArgs.impl() + stdout = IO.stdHandle StdOut printText : Text -> {io2.IO} Either Failure () printText t = putBytes.impl stdout (toUtf8 t) diff --git a/unison-src/transcripts-using-base/fix-2805.md b/unison-src/transcripts-using-base/fix-2805.md new file mode 100644 index 0000000000..80e8198b3c --- /dev/null +++ b/unison-src/transcripts-using-base/fix-2805.md @@ -0,0 +1,20 @@ +When running a main function in `ucm` a numeric argument is replaced by the potential last result of a find command: + +``` unison +main : '{IO, Exception} () +main _ = + printLine ("Hello " ++ Optional.getOrBug "definitely passed an arg" (List.head !getArgs) ++ "!") +``` + +First we run it with no numbered results in the history, so if number expansion is applied, it should end up calling `main` with zero args, whereas without number expansion, we get a single argument, “1”, passed to it. + +``` ucm +scratch/main> run main 1 +``` + +Now we set it up so there _are_ numbered results in the history. If number expansion is applied here, we will get an error “`run` can’t accept a numbered argument […]”, and otherwise our expected "1". + +``` ucm +scratch/main> find.all isLeft +scratch/main> run main 1 +``` diff --git a/unison-src/transcripts-using-base/fix-2805.output.md b/unison-src/transcripts-using-base/fix-2805.output.md new file mode 100644 index 0000000000..fddc6702d9 --- /dev/null +++ b/unison-src/transcripts-using-base/fix-2805.output.md @@ -0,0 +1,39 @@ +When running a main function in `ucm` a numeric argument is replaced by the potential last result of a find command: + +``` unison +main : '{IO, Exception} () +main _ = + printLine ("Hello " ++ Optional.getOrBug "definitely passed an arg" (List.head !getArgs) ++ "!") +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + main : '{IO, Exception} () +``` + +First we run it with no numbered results in the history, so if number expansion is applied, it should end up calling `main` with zero args, whereas without number expansion, we get a single argument, “1”, passed to it. + +``` ucm +scratch/main> run main 1 + + () +``` + +Now we set it up so there *are* numbered results in the history. If number expansion is applied here, we will get an error “`run` can’t accept a numbered argument \[…\]”, and otherwise our expected "1". + +``` ucm +scratch/main> find.all isLeft + + 1. Either.isLeft : Either a b -> Boolean + +scratch/main> run main 1 + + () +```