diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,8 @@ -## [*Unreleased*](https://github.com/pbrisbin/hs-shellwords/compare/v0.1.3.2...main) +## [*Unreleased*](https://github.com/pbrisbin/hs-shellwords/compare/v0.1.4.0...main) + +## [v0.1.4.0](https://github.com/pbrisbin/hs-shellwords/compare/v0.1.3.2...v0.1.4.0) + +- Add `quote` and `join` ([@999years](https://github.com/pbrisbin/hs-shellwords/pull/11)) ## [v0.1.3.2](https://github.com/pbrisbin/hs-shellwords/compare/v0.1.3.1...v0.1.3.2) diff --git a/shellwords.cabal b/shellwords.cabal --- a/shellwords.cabal +++ b/shellwords.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: shellwords -version: 0.1.3.2 +version: 0.1.4.0 license: MIT license-file: LICENSE copyright: 2018 Patrick Brisbin @@ -23,6 +23,8 @@ library exposed-modules: ShellWords + ShellWords.Parse + ShellWords.Quote Text.Megaparsec.Compat hs-source-dirs: src @@ -52,7 +54,8 @@ main-is: Spec.hs hs-source-dirs: test other-modules: - ShellWordsSpec + ShellWords.ParseSpec + ShellWords.QuoteSpec Paths_shellwords default-language: Haskell2010 diff --git a/src/ShellWords.hs b/src/ShellWords.hs --- a/src/ShellWords.hs +++ b/src/ShellWords.hs @@ -1,77 +1,26 @@ -{-# LANGUAGE OverloadedStrings #-} - module ShellWords - ( parse + ( -- * Splitting shell words + parse , parseText + -- * Quoting for shells + , quote + , join + -- * Low-level parser , Parser , runParser , parser ) where -import Prelude - -import Data.Bifunctor (first) -import Data.Char -import Data.Text (Text, pack, unpack) -import Data.Void (Void) -import qualified Text.Megaparsec as Megaparsec -import Text.Megaparsec.Char -import Text.Megaparsec.Compat hiding (parse, runParser) - -type Parser = Parsec Void String - -parse :: String -> Either String [String] -parse = runParser parser - -runParser :: Parser a -> String -> Either String a -runParser p = first errorBundlePretty . Megaparsec.parse (p <* eof) "" - --- | Parse and return @'Text'@ values -parseText :: Text -> Either String [Text] -parseText = fmap (map pack) . parse . unpack - -parser :: Parser [String] -parser = space *> shellword `sepEndBy1` space1 <* space - -shellword :: Parser String -shellword = fmap concat $ some $ bare <|> quoted - --- | A plain value, here till an (unescaped) space or quote -bare :: Parser String -bare = some go - where - go = - escaped '\\' - <|> escapedSpace - <|> escapedAnyOf (reserved <> quotes) - <|> satisfy ((&&) <$> not . isSpace <*> (`notElem` (reserved <> quotes))) - "non white space / non reserved character / non quote" - --- | A balanced, single- or double-quoted string -quoted :: Parser String -quoted = do - q <- oneOf quotes - manyTill (escaped '\\' <|> escaped q <|> anyToken) $ char q - -escaped :: Char -> Parser Char -escaped c = c <$ (escapedSatisfy (== c) "escaped" <> show c) - -escapedSpace :: Parser Char -escapedSpace = escapedSatisfy isSpace "escaped white space" - -escapedAnyOf :: [Char] -> Parser Char -escapedAnyOf cs = escapedSatisfy (`elem` cs) "escaped one of " <> cs - -escapedSatisfy :: (Char -> Bool) -> Parser Char -escapedSatisfy p = try $ string "\\" *> satisfy p - -anyToken :: Parser Char -anyToken = satisfy $ const True - -reserved :: [Char] -reserved = "();" - -quotes :: [Char] -quotes = "\'\"" +import ShellWords.Parse + ( Parser + , parse + , parseText + , parser + , runParser + ) +import ShellWords.Quote + ( join + , quote + ) diff --git a/src/ShellWords/Parse.hs b/src/ShellWords/Parse.hs new file mode 100644 --- /dev/null +++ b/src/ShellWords/Parse.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ShellWords.Parse + ( -- * Splitting shell words + parse + , parseText + + -- * Low-level parser + , Parser + , runParser + , parser + ) where + +import Prelude + +import Data.Bifunctor (first) +import Data.Char +import Data.Text (Text, pack, unpack) +import Data.Void (Void) +import qualified Text.Megaparsec as Megaparsec +import Text.Megaparsec.Char +import Text.Megaparsec.Compat hiding (parse, runParser) + +type Parser = Parsec Void String + +parse :: String -> Either String [String] +parse = runParser parser + +runParser :: Parser a -> String -> Either String a +runParser p = first errorBundlePretty . Megaparsec.parse (p <* eof) "" + +-- | Parse and return @'Text'@ values +parseText :: Text -> Either String [Text] +parseText = fmap (map pack) . parse . unpack + +parser :: Parser [String] +parser = space *> shellword `sepEndBy1` space1 <* space + +shellword :: Parser String +shellword = fmap concat $ some $ bare <|> quoted + +-- | A plain value, here till an (unescaped) space or quote +bare :: Parser String +bare = some go + where + go = + escaped '\\' + <|> escapedSpace + <|> escapedAnyOf (reserved <> quotes) + <|> satisfy ((&&) <$> not . isSpace <*> (`notElem` (reserved <> quotes))) + "non white space / non reserved character / non quote" + +-- | A balanced, single- or double-quoted string +quoted :: Parser String +quoted = do + q <- oneOf quotes + manyTill (escaped '\\' <|> escaped q <|> anyToken) $ char q + +escaped :: Char -> Parser Char +escaped c = c <$ (escapedSatisfy (== c) "escaped" <> show c) + +escapedSpace :: Parser Char +escapedSpace = escapedSatisfy isSpace "escaped white space" + +escapedAnyOf :: [Char] -> Parser Char +escapedAnyOf cs = escapedSatisfy (`elem` cs) "escaped one of " <> cs + +escapedSatisfy :: (Char -> Bool) -> Parser Char +escapedSatisfy p = try $ string "\\" *> satisfy p + +anyToken :: Parser Char +anyToken = satisfy $ const True + +reserved :: [Char] +reserved = "();" + +quotes :: [Char] +quotes = "\'\"" diff --git a/src/ShellWords/Quote.hs b/src/ShellWords/Quote.hs new file mode 100644 --- /dev/null +++ b/src/ShellWords/Quote.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE NamedFieldPuns #-} + +module ShellWords.Quote + ( -- * Quoting for shells + quote + , join + ) where + +import Prelude + +-- | How to escape a `String` for @sh(1)@. +data EscapeStyle + = -- | No escaping. + NoEscaping + | -- | Wrapped in single quotes. + SingleQuoted + | -- | Wrapped in single quotes + Mixed + +-- | Internal state for `escapeStyle`. +data EscapeStyleState + = EscapeStyleState + { hasSpecial :: Bool + , hasNewline :: Bool + , hasSingleQuote :: Bool + } + +-- | Determine how to escape a `String`. +escapeStyle :: String -> EscapeStyle +escapeStyle "" = SingleQuoted +escapeStyle str = + let + isOtherSpecial :: Char -> Bool + isOtherSpecial c = c `elem` ("|&;<>()$`\\\" \t*?[#~=%" :: String) + + helper :: EscapeStyleState -> String -> EscapeStyle + helper state (c : s) + | c == '\n' = helper state {hasNewline = True, hasSpecial = True} s + | c == '\'' = helper state {hasSingleQuote = True, hasSpecial = True} s + | isOtherSpecial c = helper state {hasSpecial = True} s + | otherwise = helper state s + helper EscapeStyleState {hasSpecial, hasNewline, hasSingleQuote} [] + | not hasSpecial = NoEscaping + | hasNewline && not hasSingleQuote = SingleQuoted + | otherwise = Mixed + in + helper + EscapeStyleState + { hasSpecial = False + , hasNewline = False + , hasSingleQuote = False + } + str + +-- | Escape special characters in a string, so that it will retain its literal +-- meaning when used as a part of command in a Unix shell. +-- +-- It tries to avoid introducing any unnecessary quotes or escape characters, +-- but specifics regarding quoting style are left unspecified. +quote :: String -> String +quote str = + case escapeStyle str of + NoEscaping -> str + SingleQuoted -> "'" <> str <> "'" + Mixed -> + let + quoteMixed :: String -> String + quoteMixed [] = [] + quoteMixed ('\'' : s) = "'\\''" <> quoteMixed s + quoteMixed (c : s) = c : quoteMixed s + in + "'" <> quoteMixed str <> "'" + +-- | Joins arguments into a single command line suitable for execution in a Unix shell. +-- +-- Each argument is quoted using `quote` to preserve its literal meaning when +-- parsed by Unix shell. +-- +-- Note: This function is essentially an (infallible) inverse of `parse`. +join :: [String] -> String +join = unwords . map quote diff --git a/test/ShellWords/ParseSpec.hs b/test/ShellWords/ParseSpec.hs new file mode 100644 --- /dev/null +++ b/test/ShellWords/ParseSpec.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- +-- Case-for-case port from Python: +-- +-- +module ShellWords.ParseSpec + ( spec + ) where + +import Prelude hiding (truncate) + +import Data.Foldable (for_, traverse_) +import ShellWords.Parse (parser, runParser) +import Test.Hspec +import Text.Megaparsec.Char (string) +import Text.Megaparsec.Compat (between) + +testCases :: [(String, [String])] +testCases = + [ ("var --bar=baz", ["var", "--bar=baz"]) + , ("var --bar=\"baz\"", ["var", "--bar=baz"]) + , ("var \"--bar=baz\"", ["var", "--bar=baz"]) + , ("var \"--bar='baz'\"", ["var", "--bar='baz'"]) + , ("var --bar=`baz`", ["var", "--bar=`baz`"]) + , ("var \"--bar=\\\"baz'\"", ["var", "--bar=\"baz'"]) + , ("var \"--bar=\\'baz\\'\"", ["var", "--bar=\\'baz\\'"]) + , ("var \"--bar baz\"", ["var", "--bar baz"]) + , ("var --\"bar baz\"", ["var", "--bar baz"]) + , ("var --\"bar baz\"", ["var", "--bar baz"]) + , -- Additional test cases for whitespace + ("var --bar=baz ", ["var", "--bar=baz"]) + , (" var --bar=baz ", ["var", "--bar=baz"]) + , (" var --bar=baz ", ["var", "--bar=baz"]) + , -- Additional test cases for escaped spaces + ("var --bar\\ baz", ["var", "--bar baz"]) + , ("var --bar=baz\\ bat", ["var", "--bar=baz bat"]) + , ("var --bar baz\\ bat", ["var", "--bar", "baz bat"]) + , -- N.B. sh preserves escapes in quoted values, python-shellwords does not. + -- we behave like sh in this regard. + ("var --bar 'baz\\ bat'", ["var", "--bar", "baz\\ bat"]) + , ("var --bar \"baz\\ bat\"", ["var", "--bar", "baz\\ bat"]) + , ("var \"--bar=\\\\'baz\\\\'\"", ["var", "--bar=\\'baz\\'"]) + , ("var --bar='\\\\'", ["var", "--bar=\\"]) + ] + +errorCases :: [String] +errorCases = + [ "foo '" + , "foo \"" + -- + -- Doesn't need to error since we don't have parse_backtick either. + -- + -- , "foo `" + ] + +runTestCase :: HasCallStack => String -> [String] -> Spec +runTestCase input expected = + it ("parses |" <> truncate 50 input <> "| correctly") $ do + runParser parser input `shouldBeParsed` expected + where + truncate n x + | length x > n = take n x <> "..." + | otherwise = x + +spec :: Spec +spec = describe "parser" $ do + traverse_ (uncurry runTestCase) testCases + + for_ errorCases $ \input -> do + it ("errors on |" <> input <> "|") $ do + expectParseError $ runParser parser input + + context "Issue #3" $ do + runTestCase + "-LC:/Users/Vitor\\ Coimbra/AppData/Local/Programs/stack/x86_64-windows/msys2-20150512/mingw64/lib -ltag\n" + [ "-LC:/Users/Vitor Coimbra/AppData/Local/Programs/stack/x86_64-windows/msys2-20150512/mingw64/lib" + , "-ltag" + ] + + context "Issue #7" $ do + runTestCase "foo=123 bar" ["foo=123", "bar"] + runTestCase "foo bar=123 cow" ["foo", "bar=123", "cow"] + runTestCase "foo bar'();='bar cow" ["foo", "bar();=bar", "cow"] + runTestCase "foo 'ba'\"r\" cow" ["foo", "bar", "cow"] + + context "As part of a larger Parser" $ do + let parseDelimited input = + runParser (between (string "FOO=$(") (string ")") parser) $ + "FOO=$(" + <> input + <> ")" + + it "parses within delimiters" $ do + parseDelimited "echo \"hi\"" `shouldBeParsed` ["echo", "hi"] + + it "handles quoted delimiter" $ do + parseDelimited "echo \"hi (quietly)\"" + `shouldBeParsed` ["echo", "hi (quietly)"] + + it "works with white space" $ do + parseDelimited " echo \n\"hi\" " `shouldBeParsed` ["echo", "hi"] + + it "works with newlines" $ do + parseDelimited "echo \n\"hi\"" `shouldBeParsed` ["echo", "hi"] + + it "works with final newline" $ do + parseDelimited "echo \n\"hi\"\n" `shouldBeParsed` ["echo", "hi"] + +expectParseError :: (Show a, HasCallStack) => Either String a -> Expectation +expectParseError = \case + Left {} -> pure () + Right a' -> expectationFailure $ "Expected parse error, got:" <> show a' + +shouldBeParsed + :: (Show a, Eq a, HasCallStack) + => Either String a + -> a + -> Expectation +a `shouldBeParsed` b = case a of + Left e -> expectationFailure e + Right a' -> a' `shouldBe` b + +{- Features I'm not sure I'll be porting, certainly not yet. + +def test_backtick(): + goversion, err = shell_run("go version") + assert not err + + s = ShellWords(parse_backtick=True) + args = s.parse("echo `go version`") + + expected = ["echo", goversion.strip('\n')] + assert args == expected + +def test_backtick_error(): + s = ShellWords(parse_backtick=True) + try: + s.parse("echo `go Version`") + except: + pass + else: + raise Exception("Should be an error") + +def test_env(): + os.environ["FOO"] = "bar" + + s = ShellWords(parse_env=True) + args = s.parse("echo $FOO") + + expected = ["echo", "bar"] + assert args == expected + +def test_no_env(): + s = ShellWords(parse_env=True) + args = s.parse("echo $BAR") + + expected = ["echo", ""] + assert args == expected + +def test_dup_env(): + os.environ["FOO"] = "bar" + os.environ["FOO_BAR"] = "baz" + + s = ShellWords(parse_env=True) + args = s.parse("echo $$FOO$") + expected = ["echo", "$bar$"] + assert args == expected + + args = s.parse("echo $${FOO_BAR}$") + expected = ["echo", "$baz$"] + assert args == expected +-} diff --git a/test/ShellWords/QuoteSpec.hs b/test/ShellWords/QuoteSpec.hs new file mode 100644 --- /dev/null +++ b/test/ShellWords/QuoteSpec.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- +-- Some test cases ported from Rust: +-- +-- +module ShellWords.QuoteSpec + ( spec + ) where + +import Prelude hiding (truncate) + +import ShellWords.Quote (join, quote) +import Test.Hspec + +spec :: Spec +spec = do + describe "quote" $ do + it "single-quotes the empty string" $ do + quote "" `shouldBe` "''" + + it "escapes a single quote" $ do + quote "'" `shouldBe` "''\\'''" + + it "leaves un-special characters alone" $ do + quote "abc" `shouldBe` "abc" + + it "quotes newlines" $ do + quote "a \n b" `shouldBe` "'a \n b'" + + it "quotes newlines and escapes single-quotes" $ do + quote "X'\nY" `shouldBe` "'X'\\''\nY'" + + it "quotes tildes correctly" $ do + quote "~root" `shouldBe` "'~root'" + + describe "join" $ do + it "joins arguments" $ do + join ["a", "b", "c"] `shouldBe` "a b c" + + it "quotes arguments" $ do + join [" ", "$", "\n"] `shouldBe` "' ' '$' '\n'" diff --git a/test/ShellWordsSpec.hs b/test/ShellWordsSpec.hs deleted file mode 100644 --- a/test/ShellWordsSpec.hs +++ /dev/null @@ -1,175 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - --- | --- --- Case-for-case port from Python: --- --- -module ShellWordsSpec - ( spec - ) where - -import Prelude hiding (truncate) - -import Data.Foldable (for_, traverse_) -import ShellWords -import Test.Hspec -import Text.Megaparsec.Char (string) -import Text.Megaparsec.Compat (between) - -testCases :: [(String, [String])] -testCases = - [ ("var --bar=baz", ["var", "--bar=baz"]) - , ("var --bar=\"baz\"", ["var", "--bar=baz"]) - , ("var \"--bar=baz\"", ["var", "--bar=baz"]) - , ("var \"--bar='baz'\"", ["var", "--bar='baz'"]) - , ("var --bar=`baz`", ["var", "--bar=`baz`"]) - , ("var \"--bar=\\\"baz'\"", ["var", "--bar=\"baz'"]) - , ("var \"--bar=\\'baz\\'\"", ["var", "--bar=\\'baz\\'"]) - , ("var \"--bar baz\"", ["var", "--bar baz"]) - , ("var --\"bar baz\"", ["var", "--bar baz"]) - , ("var --\"bar baz\"", ["var", "--bar baz"]) - , -- Additional test cases for whitespace - ("var --bar=baz ", ["var", "--bar=baz"]) - , (" var --bar=baz ", ["var", "--bar=baz"]) - , (" var --bar=baz ", ["var", "--bar=baz"]) - , -- Additional test cases for escaped spaces - ("var --bar\\ baz", ["var", "--bar baz"]) - , ("var --bar=baz\\ bat", ["var", "--bar=baz bat"]) - , ("var --bar baz\\ bat", ["var", "--bar", "baz bat"]) - , -- N.B. sh preserves escapes in quoted values, python-shellwords does not. - -- we behave like sh in this regard. - ("var --bar 'baz\\ bat'", ["var", "--bar", "baz\\ bat"]) - , ("var --bar \"baz\\ bat\"", ["var", "--bar", "baz\\ bat"]) - , ("var \"--bar=\\\\'baz\\\\'\"", ["var", "--bar=\\'baz\\'"]) - , ("var --bar='\\\\'", ["var", "--bar=\\"]) - ] - -errorCases :: [String] -errorCases = - [ "foo '" - , "foo \"" - -- - -- Doesn't need to error since we don't have parse_backtick either. - -- - -- , "foo `" - ] - -runTestCase :: HasCallStack => String -> [String] -> Spec -runTestCase input expected = - it ("parses |" <> truncate 50 input <> "| correctly") $ do - runParser parser input `shouldBeParsed` expected - where - truncate n x - | length x > n = take n x <> "..." - | otherwise = x - -spec :: Spec -spec = describe "parser" $ do - traverse_ (uncurry runTestCase) testCases - - for_ errorCases $ \input -> do - it ("errors on |" <> input <> "|") $ do - expectParseError $ runParser parser input - - context "Issue #3" $ do - runTestCase - "-LC:/Users/Vitor\\ Coimbra/AppData/Local/Programs/stack/x86_64-windows/msys2-20150512/mingw64/lib -ltag\n" - [ "-LC:/Users/Vitor Coimbra/AppData/Local/Programs/stack/x86_64-windows/msys2-20150512/mingw64/lib" - , "-ltag" - ] - - context "Issue #7" $ do - runTestCase "foo=123 bar" ["foo=123", "bar"] - runTestCase "foo bar=123 cow" ["foo", "bar=123", "cow"] - runTestCase "foo bar'();='bar cow" ["foo", "bar();=bar", "cow"] - runTestCase "foo 'ba'\"r\" cow" ["foo", "bar", "cow"] - - context "As part of a larger Parser" $ do - let parseDelimited input = - runParser (between (string "FOO=$(") (string ")") parser) $ - "FOO=$(" - <> input - <> ")" - - it "parses within delimiters" $ do - parseDelimited "echo \"hi\"" `shouldBeParsed` ["echo", "hi"] - - it "handles quoted delimiter" $ do - parseDelimited "echo \"hi (quietly)\"" - `shouldBeParsed` ["echo", "hi (quietly)"] - - it "works with white space" $ do - parseDelimited " echo \n\"hi\" " `shouldBeParsed` ["echo", "hi"] - - it "works with newlines" $ do - parseDelimited "echo \n\"hi\"" `shouldBeParsed` ["echo", "hi"] - - it "works with final newline" $ do - parseDelimited "echo \n\"hi\"\n" `shouldBeParsed` ["echo", "hi"] - -expectParseError :: (Show a, HasCallStack) => Either String a -> Expectation -expectParseError = \case - Left {} -> pure () - Right a' -> expectationFailure $ "Expected parse error, got:" <> show a' - -shouldBeParsed - :: (Show a, Eq a, HasCallStack) - => Either String a - -> a - -> Expectation -a `shouldBeParsed` b = case a of - Left e -> expectationFailure e - Right a' -> a' `shouldBe` b - -{- Features I'm not sure I'll be porting, certainly not yet. - -def test_backtick(): - goversion, err = shell_run("go version") - assert not err - - s = ShellWords(parse_backtick=True) - args = s.parse("echo `go version`") - - expected = ["echo", goversion.strip('\n')] - assert args == expected - -def test_backtick_error(): - s = ShellWords(parse_backtick=True) - try: - s.parse("echo `go Version`") - except: - pass - else: - raise Exception("Should be an error") - -def test_env(): - os.environ["FOO"] = "bar" - - s = ShellWords(parse_env=True) - args = s.parse("echo $FOO") - - expected = ["echo", "bar"] - assert args == expected - -def test_no_env(): - s = ShellWords(parse_env=True) - args = s.parse("echo $BAR") - - expected = ["echo", ""] - assert args == expected - -def test_dup_env(): - os.environ["FOO"] = "bar" - os.environ["FOO_BAR"] = "baz" - - s = ShellWords(parse_env=True) - args = s.parse("echo $$FOO$") - expected = ["echo", "$bar$"] - assert args == expected - - args = s.parse("echo $${FOO_BAR}$") - expected = ["echo", "$baz$"] - assert args == expected --}