{-# LANGUAGE OverloadedStrings #-}
module ShellWords
( parse
, parseText
, Parser
, runParser
, parser
) where
import Prelude
import Data.Bifunctor (first)
import Data.Char
import Data.List (dropWhileEnd)
import Data.Maybe (fromMaybe)
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 :: String -> Either String [String]
parse = Parser [String] -> String -> Either String [String]
forall a. Parser a -> String -> Either String a
runParser Parser [String]
parser
runParser :: Parser a -> String -> Either String a
runParser :: Parser a -> String -> Either String a
runParser Parser a
p = (ParseErrorBundle String Void -> String)
-> Either (ParseErrorBundle String Void) a -> Either String a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle String Void) a -> Either String a)
-> (String -> Either (ParseErrorBundle String Void) a)
-> String
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a
-> String -> String -> Either (ParseErrorBundle String Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.parse Parser a
p String
"<input>"
parseText :: Text -> Either String [Text]
parseText :: Text -> Either String [Text]
parseText = ([String] -> [Text])
-> Either String [String] -> Either String [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
pack) (Either String [String] -> Either String [Text])
-> (Text -> Either String [String]) -> Text -> Either String [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String [String]
parse (String -> Either String [String])
-> (Text -> String) -> Text -> Either String [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
parser :: Parser [String]
parser :: Parser [String]
parser = ([String] -> [String]) -> Parser [String] -> Parser [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Parser [String] -> Parser [String])
-> Parser [String] -> Parser [String]
forall a b. (a -> b) -> a -> b
$ ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void String Identity ()
-> Parser [String] -> Parser [String]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
shellword Parser String -> ParsecT Void String Identity () -> Parser [String]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy1` ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
shellword :: Parser String
shellword :: Parser String
shellword =
[Parser String] -> Parser String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ Parser String
quoted Parser String -> String -> Parser String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"quoted string"
, Parser String
shelloption Parser String -> String -> Parser String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"shell option"
, Parser String
value Parser String -> String -> Parser String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"bare value"
]
Parser String -> String -> Parser String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"shell word"
quoted :: Parser String
quoted :: Parser String
quoted = do
Char
q <- [Token String] -> ParsecT Void String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'\'', Char
'\"']
ParsecT Void String Identity Char
-> ParsecT Void String Identity Char -> Parser String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (Char -> ParsecT Void String Identity Char
escaped Char
q ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity Char
anyToken) (ParsecT Void String Identity Char -> Parser String)
-> ParsecT Void String Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
q
shelloption :: Parser String
shelloption :: Parser String
shelloption = String -> String -> String
forall a. Semigroup a => a -> a -> a
(<>) (String -> String -> String)
-> Parser String -> ParsecT Void String Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
flag ParsecT Void String Identity (String -> String)
-> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> ParsecT Void String Identity (Maybe String) -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String
argument)
flag :: Parser String
flag :: Parser String
flag =
String -> String -> String
forall a. Semigroup a => a -> a -> a
(<>)
(String -> String -> String)
-> Parser String -> ParsecT Void String Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"--" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"-")
ParsecT Void String Identity (String -> String)
-> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser String
quoted Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser String
value)
argument :: Parser String
argument :: Parser String
argument = (:) (Char -> String -> String)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'=' ParsecT Void String Identity (String -> String)
-> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser String
quoted Parser String -> Parser String -> Parser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser String
value)
value :: Parser String
value :: Parser String
value = ParsecT Void String Identity Char -> Parser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void String Identity Char
nonSpaceNonReserved
escaped :: Char -> Parser Char
escaped :: Char -> ParsecT Void String Identity Char
escaped Char
c = Char
c Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ((Char -> Bool) -> ParsecT Void String Identity Char
escapedSatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) ParsecT Void String Identity Char
-> String -> ParsecT Void String Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"escaped" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c)
escapedSpace :: Parser Char
escapedSpace :: ParsecT Void String Identity Char
escapedSpace = (Char -> Bool) -> ParsecT Void String Identity Char
escapedSatisfy Char -> Bool
isSpace ParsecT Void String Identity Char
-> String -> ParsecT Void String Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"escaped white space"
escapedAnyOf :: [Char] -> Parser Char
escapedAnyOf :: String -> ParsecT Void String Identity Char
escapedAnyOf String
cs = (Char -> Bool) -> ParsecT Void String Identity Char
escapedSatisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
cs) ParsecT Void String Identity Char
-> String -> ParsecT Void String Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"escaped one of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
cs
escapedSatisfy :: (Char -> Bool) -> Parser Char
escapedSatisfy :: (Char -> Bool) -> ParsecT Void String Identity Char
escapedSatisfy Char -> Bool
p = ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity Char
-> ParsecT Void String Identity Char)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall a b. (a -> b) -> a -> b
$ Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"\\" Parser String
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token String -> Bool
p
anyToken :: Parser Char
anyToken :: ParsecT Void String Identity Char
anyToken = (Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Token String -> Bool)
-> ParsecT Void String Identity (Token String))
-> (Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall a b. (a -> b) -> a -> b
$ Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True
nonSpaceNonReserved :: Parser Char
nonSpaceNonReserved :: ParsecT Void String Identity Char
nonSpaceNonReserved =
ParsecT Void String Identity Char
escapedSpace
ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT Void String Identity Char
escapedAnyOf String
reserved
ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token String -> Bool)
-> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token String
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSpace Char
Token String
c Bool -> Bool -> Bool
|| Char -> Bool
isReserved Char
Token String
c)
ParsecT Void String Identity Char
-> String -> ParsecT Void String Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"non white space / non reserved character"
isReserved :: Char -> Bool
isReserved :: Char -> Bool
isReserved = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
reserved)
reserved :: [Char]
reserved :: String
reserved = String
"();="