{-# LANGUAGE OverloadedStrings #-}
module ShellWords
( parse
, parseText
) where
import Data.Bifunctor (first)
import Data.Char
import Data.Maybe (fromMaybe)
import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void (Void)
import Text.Megaparsec hiding (parse)
import qualified Text.Megaparsec as Megaparsec
import Text.Megaparsec.Char
type Parser = Parsec Void String
parse :: String -> Either String [String]
parse = first parseErrorPretty . Megaparsec.parse parser "<input>"
parseText :: Text -> Either String [Text]
parseText = fmap (map T.pack) . parse . T.unpack
parser :: Parser [String]
parser = shellword `sepBy` space1
shellword :: Parser String
shellword = choice [quoted, shelloption, value]
quoted :: Parser String
quoted = do
q <- oneOf ['\'', '\"']
manyTill (try (escaped q) <|> anyToken) (char q)
shelloption :: Parser String
shelloption = (<>) <$> flag <*> (fromMaybe "" <$> optional argument)
flag :: Parser String
flag =
(<>)
<$> (string "--" <|> string "-")
<*> (quoted <|> many (noneOf ['=', ' ']))
argument :: Parser String
argument = (:) <$> char '=' <*> (quoted <|> value)
value :: Parser String
value = many (try (escaped ' ') <|> nonSpace)
escaped :: Char -> Parser Char
escaped c = c <$ string ("\\" <> [c])
anyToken :: Parser Char
anyToken = satisfy $ const True
nonSpace :: Parser Char
nonSpace = satisfy $ not . isSpace