forked from GitHub/gf-core
Fix issue 61: GF shell cannot parse a system command ending with a space
Trailing spaces caused the command line parse to be ambiguous, and ambiguous parses were rejected by function readCommandLine, causing the cryptic error message "command not parsed".
This commit is contained in:
@@ -1,63 +1,65 @@
|
||||
module GF.Command.Parse(readCommandLine, pCommand) where
|
||||
|
||||
import PGF
|
||||
import PGF(pExpr,pIdent)
|
||||
import GF.Command.Abstract
|
||||
|
||||
import Data.Char
|
||||
import Control.Monad
|
||||
import qualified Text.ParserCombinators.ReadP as RP
|
||||
import Data.Char(isDigit,isSpace)
|
||||
import Control.Monad(liftM2)
|
||||
import Text.ParserCombinators.ReadP
|
||||
|
||||
readCommandLine :: String -> Maybe CommandLine
|
||||
readCommandLine s = case [x | (x,cs) <- RP.readP_to_S pCommandLine s, all isSpace cs] of
|
||||
[x] -> Just x
|
||||
_ -> Nothing
|
||||
readCommandLine s =
|
||||
case [x | (x,cs) <- readP_to_S pCommandLine s, all isSpace cs] of
|
||||
[x] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
pCommandLine =
|
||||
(RP.skipSpaces >> RP.char '-' >> RP.char '-' >> RP.skipMany (RP.satisfy (const True)) >> return []) -- comment
|
||||
RP.<++
|
||||
(RP.sepBy (RP.skipSpaces >> pPipe) (RP.skipSpaces >> RP.char ';'))
|
||||
(skipSpaces >> char '-' >> char '-' >> pTheRest >> return []) -- comment
|
||||
<++
|
||||
(sepBy (skipSpaces >> pPipe) (skipSpaces >> char ';'))
|
||||
|
||||
pPipe = RP.sepBy1 (RP.skipSpaces >> pCommand) (RP.skipSpaces >> RP.char '|')
|
||||
pPipe = sepBy1 (skipSpaces >> pCommand) (skipSpaces >> char '|')
|
||||
|
||||
pCommand = (do
|
||||
cmd <- pIdent RP.<++ (RP.char '%' >> pIdent >>= return . ('%':))
|
||||
RP.skipSpaces
|
||||
opts <- RP.sepBy pOption RP.skipSpaces
|
||||
cmd <- pIdent <++ (char '%' >> pIdent >>= return . ('%':))
|
||||
skipSpaces
|
||||
opts <- sepBy pOption skipSpaces
|
||||
arg <- pArgument
|
||||
return (Command cmd opts arg)
|
||||
)
|
||||
RP.<++ (do
|
||||
RP.char '?'
|
||||
c <- pSystemCommand
|
||||
<++ (do
|
||||
char '?'
|
||||
skipSpaces
|
||||
c <- pSystemCommand
|
||||
return (Command "sp" [OFlag "command" (VStr c)] ANoArg)
|
||||
)
|
||||
)
|
||||
|
||||
pOption = do
|
||||
RP.char '-'
|
||||
char '-'
|
||||
flg <- pIdent
|
||||
RP.option (OOpt flg) (fmap (OFlag flg) (RP.char '=' >> pValue))
|
||||
option (OOpt flg) (fmap (OFlag flg) (char '=' >> pValue))
|
||||
|
||||
pValue = do
|
||||
fmap VInt (RP.readS_to_P reads)
|
||||
RP.<++
|
||||
fmap VStr (RP.readS_to_P reads)
|
||||
RP.<++
|
||||
fmap VInt (readS_to_P reads)
|
||||
<++
|
||||
fmap VStr (readS_to_P reads)
|
||||
<++
|
||||
fmap VId pFilename
|
||||
|
||||
pFilename = liftM2 (:) (RP.satisfy isFileFirst) (RP.munch (not . isSpace)) where
|
||||
pFilename = liftM2 (:) (satisfy isFileFirst) (munch (not . isSpace)) where
|
||||
isFileFirst c = not (isSpace c) && not (isDigit c)
|
||||
|
||||
pArgument =
|
||||
RP.option ANoArg
|
||||
pArgument =
|
||||
option ANoArg
|
||||
(fmap AExpr pExpr
|
||||
RP.<++
|
||||
(RP.munch isSpace >> RP.char '%' >> fmap AMacro pIdent))
|
||||
<++
|
||||
(skipSpaces >> char '%' >> fmap AMacro pIdent))
|
||||
|
||||
pSystemCommand =
|
||||
RP.munch isSpace >> (
|
||||
(RP.char '"' >> (RP.manyTill (pEsc RP.<++ RP.get) (RP.char '"')))
|
||||
RP.<++
|
||||
RP.many RP.get
|
||||
)
|
||||
where
|
||||
pEsc = RP.char '\\' >> RP.get
|
||||
pSystemCommand =
|
||||
(char '"' >> (manyTill (pEsc <++ get) (char '"')))
|
||||
<++
|
||||
pTheRest
|
||||
where
|
||||
pEsc = char '\\' >> get
|
||||
|
||||
pTheRest = munch (const True)
|
||||
|
||||
Reference in New Issue
Block a user