diff --git a/unison-cli/src/Unison/Codebase/TranscriptParser.hs b/unison-cli/src/Unison/Codebase/TranscriptParser.hs index b281d67e5e..9edb5f39c8 100644 --- a/unison-cli/src/Unison/Codebase/TranscriptParser.hs +++ b/unison-cli/src/Unison/Codebase/TranscriptParser.hs @@ -23,6 +23,7 @@ import Crypto.Random qualified as Random import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as BL +import Data.Char (isSpace) import Data.Char qualified as Char import Data.Configurator qualified as Configurator import Data.Configurator.Types (Config) @@ -346,14 +347,14 @@ run dir stanzas codebase runtime sbRuntime config ucmVersion baseURL = UnliftIO. atomically $ Q.undequeue cmdQueue (Just p) pure (Right switchCommand) Nothing -> do - case words . Text.unpack $ lineTxt of - [] -> awaitInput - args -> do + case break isSpace $ dropWhile isSpace . Text.unpack $ lineTxt of + ("", _) -> awaitInput + (command, argsString) -> do liftIO (output ("\n" <> show p <> "\n")) rootVar <- use #root numberedArgs <- use #numberedArgs let getRoot = fmap Branch.head . atomically $ readTMVar rootVar - liftIO (parseInput getRoot curPath numberedArgs patternMap args) >>= \case + liftIO (parseInput getRoot curPath numberedArgs patternMap command argsString) >>= \case -- invalid command is treated as a failure Left msg -> liftIO (dieWithMsg $ Pretty.toPlain terminalWidth msg) Right input -> pure $ Right input diff --git a/unison-cli/src/Unison/CommandLine.hs b/unison-cli/src/Unison/CommandLine.hs index 61e39f0351..d1750ec518 100644 --- a/unison-cli/src/Unison/CommandLine.hs +++ b/unison-cli/src/Unison/CommandLine.hs @@ -28,6 +28,7 @@ where import Control.Concurrent (forkIO, killThread) import Control.Lens (ifor) import Control.Monad.Trans.Except +import Data.Char (isSpace) import Data.Configurator (autoConfig, autoReload) import Data.Configurator qualified as Config import Data.Configurator.Types (Config, Worth (..)) @@ -114,37 +115,54 @@ parseInput :: [String] -> -- | Input Pattern Map Map String InputPattern -> - -- | command:arguments - [String] -> + -- | command + String -> + -- | arguments string + String -> IO (Either (P.Pretty CT.ColorText) Input) -parseInput getRoot currentPath numberedArgs patterns segments = runExceptT do - case segments of - [] -> throwE "" - command : args -> case Map.lookup command patterns of - Just pat@(InputPattern {parse}) -> do - let expandedNumbers :: [String] - expandedNumbers = foldMap (expandNumber numberedArgs) args - expandedGlobs <- ifor expandedNumbers $ \i arg -> do - if Globbing.containsGlob arg - then do - rootBranch <- liftIO getRoot - let targets = case InputPattern.argType pat i of - Just argT -> InputPattern.globTargets argT - Nothing -> mempty - case Globbing.expandGlobs targets rootBranch currentPath arg of - -- No globs encountered - Nothing -> pure [arg] - Just [] -> throwE $ "No matches for: " <> fromString arg - Just matches -> pure matches - else pure [arg] - except $ parse (concat expandedGlobs) - Nothing -> - throwE - . warn - . P.wrap - $ "I don't know how to " - <> P.group (fromString command <> ".") - <> "Type `help` or `?` to get help." +parseInput getRoot currentPath numberedArgs patterns command args = runExceptT do + case Map.lookup command patterns of + Just pat@(InputPattern {parse}) -> do + let expandedNumbers :: [String] + expandedNumbers = foldMap (expandNumber numberedArgs) $ words' args + expandedGlobs <- ifor expandedNumbers $ \i arg -> do + if Globbing.containsGlob arg + then do + rootBranch <- liftIO getRoot + let targets = case InputPattern.argType pat i of + Just argT -> InputPattern.globTargets argT + Nothing -> mempty + case Globbing.expandGlobs targets rootBranch currentPath arg of + -- No globs encountered + Nothing -> pure [arg] + Just [] -> throwE $ "No matches for: " <> fromString arg + Just matches -> pure matches + else pure [arg] + except $ parse (concat expandedGlobs) + Nothing -> + throwE + . warn + . P.wrap + $ "I don't know how to " + <> P.group (fromString command <> ".") + <> "Type `help` or `?` to get help." + +-- | A version of 'words' that treats sequences enclosed in double quotes as +-- single words and that does not break on backslash-escaped spaces. +-- E.g., 'words\' "\"lorem ipsum\" dolor"' and 'words\' "lorem\\ ipsum dolor"' +-- yield '["lorem ipsum", "dolor"]'. +-- https://github.com/ghc/ghc/blob/73d07c6e1986bd2b3516d4f009cc1e30ba804f06/ghc/GHCi/UI.hs#L2499 +words' :: String -> [String] +words' s = case dropWhile isSpace s of + "" -> [] + s'@('\"' : _) | [(w, s'')] <- reads s' -> w : words' s'' + s' -> go id s' + where + go acc [] = [acc []] + go acc ('\\' : c : cs) | isSpace c = go (acc . (c :)) cs + go acc (c : cs) + | isSpace c = acc [] : words' cs + | otherwise = go (acc . (c :)) cs -- Expand a numeric argument like `1` or a range like `3-9` expandNumber :: [String] -> String -> [String] diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 2adf8f38b9..d635d0d377 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/unison-cli/src/Unison/CommandLine/Main.hs @@ -9,6 +9,7 @@ import Control.Exception (catch, finally, mask) import Control.Lens (preview, (?~), (^.)) import Control.Monad.Catch (MonadMask) import Crypto.Random qualified as Random +import Data.Char (isSpace) import Data.Configurator.Types (Config) import Data.IORef import Data.Text qualified as Text @@ -100,10 +101,10 @@ getUserInput codebase authHTTPClient getRoot currentPath numberedArgs = line <- Line.getInputLine (P.toANSI 80 (promptString <> fromString prompt)) case line of Nothing -> pure QuitI - Just l -> case words l of - [] -> go - ws -> do - liftIO (parseInput (Branch.head <$> getRoot) currentPath numberedArgs IP.patternMap ws) >>= \case + Just l -> case break isSpace $ dropWhile isSpace l of + ("", _) -> go + (command, argsString) -> do + liftIO (parseInput (Branch.head <$> getRoot) currentPath numberedArgs IP.patternMap command argsString) >>= \case Left msg -> do liftIO $ putPrettyLn msg go diff --git a/unison-cli/unison/ArgParse.hs b/unison-cli/unison/ArgParse.hs index e5ed427778..2a2aa4c211 100644 --- a/unison-cli/unison/ArgParse.hs +++ b/unison-cli/unison/ArgParse.hs @@ -201,7 +201,7 @@ runFileCommand = where help = "Execute a definition from a file, passing on the provided arguments. " - <> " To pass flags to your program, use `run.file -- --my-flag`" + <> " To pass flags to your program, use `run.file -- --my-flag`" runPipeCommand :: Mod CommandFields Command runPipeCommand =