module GF.Command.Parse(readCommandLine, pCommand) where
import PGF(pExpr,pIdent)
import GF.Grammar.Parser(runPartial,pTerm)
import GF.Command.Abstract
import Data.Char(isDigit,isSpace)
import Control.Monad(liftM2)
import Text.ParserCombinators.ReadP
readCommandLine :: String -> Maybe CommandLine
readCommandLine :: String -> Maybe CommandLine
readCommandLine String
s =
case [CommandLine
x | (CommandLine
x,String
cs) <- ReadP CommandLine -> ReadS CommandLine
forall a. ReadP a -> ReadS a
readP_to_S ReadP CommandLine
pCommandLine String
s, (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
cs] of
[CommandLine
x] -> CommandLine -> Maybe CommandLine
forall a. a -> Maybe a
Just CommandLine
x
[CommandLine]
_ -> Maybe CommandLine
forall a. Maybe a
Nothing
pCommandLine :: ReadP CommandLine
pCommandLine =
(ReadP ()
skipSpaces ReadP () -> ReadP Char -> ReadP Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP Char -> ReadP Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP String
pTheRest ReadP String -> ReadP CommandLine -> ReadP CommandLine
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CommandLine -> ReadP CommandLine
forall (m :: * -> *) a. Monad m => a -> m a
return [])
ReadP CommandLine -> ReadP CommandLine -> ReadP CommandLine
forall a. ReadP a -> ReadP a -> ReadP a
<++
(ReadP [Command] -> ReadP Char -> ReadP CommandLine
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
sepBy (ReadP ()
skipSpaces ReadP () -> ReadP [Command] -> ReadP [Command]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP [Command]
pPipe) (ReadP ()
skipSpaces ReadP () -> ReadP Char -> ReadP Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
char Char
';'))
pPipe :: ReadP [Command]
pPipe = ReadP Command -> ReadP Char -> ReadP [Command]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
sepBy1 (ReadP ()
skipSpaces ReadP () -> ReadP Command -> ReadP Command
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Command
pCommand) (ReadP ()
skipSpaces ReadP () -> ReadP Char -> ReadP Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
char Char
'|')
pCommand :: ReadP Command
pCommand = (do
String
cmd <- ReadP String
pIdent ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++ (Char -> ReadP Char
char Char
'%' ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> String) -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char
'%'Char -> String -> String
forall a. a -> [a] -> [a]
:) ReadP String
pIdent)
ReadP ()
skipSpaces
[Option]
opts <- ReadP Option -> ReadP () -> ReadP [Option]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
sepBy ReadP Option
pOption ReadP ()
skipSpaces
Argument
arg <- if String -> String
getCommandOp String
cmd String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cc" then ReadP Argument
pArgTerm else ReadP Argument
pArgument
Command -> ReadP Command
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [Option] -> Argument -> Command
Command String
cmd [Option]
opts Argument
arg)
)
ReadP Command -> ReadP Command -> ReadP Command
forall a. ReadP a -> ReadP a -> ReadP a
<++ (do
Char -> ReadP Char
char Char
'?'
ReadP ()
skipSpaces
String
c <- ReadP String
pSystemCommand
Command -> ReadP Command
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [Option] -> Argument -> Command
Command String
"sp" [String -> Value -> Option
OFlag String
"command" (String -> Value
VStr String
c)] Argument
ANoArg)
)
pOption :: ReadP Option
pOption = do
Char -> ReadP Char
char Char
'-'
String
flg <- ReadP String
pIdent
Option -> ReadP Option -> ReadP Option
forall a. a -> ReadP a -> ReadP a
option (String -> Option
OOpt String
flg) ((Value -> Option) -> ReadP Value -> ReadP Option
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Value -> Option
OFlag String
flg) (Char -> ReadP Char
char Char
'=' ReadP Char -> ReadP Value -> ReadP Value
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Value
pValue))
pValue :: ReadP Value
pValue = do
(Int -> Value) -> ReadP Int -> ReadP Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Value
VInt (ReadS Int -> ReadP Int
forall a. ReadS a -> ReadP a
readS_to_P ReadS Int
forall a. Read a => ReadS a
reads)
ReadP Value -> ReadP Value -> ReadP Value
forall a. ReadP a -> ReadP a -> ReadP a
<++
(String -> Value) -> ReadP String -> ReadP Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Value
VStr (ReadS String -> ReadP String
forall a. ReadS a -> ReadP a
readS_to_P ReadS String
forall a. Read a => ReadS a
reads)
ReadP Value -> ReadP Value -> ReadP Value
forall a. ReadP a -> ReadP a -> ReadP a
<++
(String -> Value) -> ReadP String -> ReadP Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Value
VId ReadP String
pFilename
pFilename :: ReadP String
pFilename = (Char -> String -> String)
-> ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isFileFirst) ((Char -> Bool) -> ReadP String
munch (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) where
isFileFirst :: Char -> Bool
isFileFirst Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isDigit Char
c)
pArgument :: ReadP Argument
pArgument =
Argument -> ReadP Argument -> ReadP Argument
forall a. a -> ReadP a -> ReadP a
option Argument
ANoArg
((Expr -> Argument) -> ReadP Expr -> ReadP Argument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr -> Argument
AExpr ReadP Expr
pExpr
ReadP Argument -> ReadP Argument -> ReadP Argument
forall a. ReadP a -> ReadP a -> ReadP a
<++
(ReadP ()
skipSpaces ReadP () -> ReadP Char -> ReadP Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
char Char
'%' ReadP Char -> ReadP Argument -> ReadP Argument
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> Argument) -> ReadP String -> ReadP Argument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Argument
AMacro ReadP String
pIdent))
pArgTerm :: ReadP Argument
pArgTerm = Term -> Argument
ATerm (Term -> Argument) -> ReadP Term -> ReadP Argument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReadS Term -> ReadP Term
forall a. ReadS a -> ReadP a
readS_to_P ReadS Term
sTerm
where
sTerm :: ReadS Term
sTerm String
s = case P Term -> String -> Either (Posn, String) (String, Term)
forall b. P b -> String -> Either (Posn, String) (String, b)
runPartial P Term
pTerm String
s of
Right (String
s,Term
t) -> [(Term
t,String
s)]
Either (Posn, String) (String, Term)
_ -> []
pSystemCommand :: ReadP String
pSystemCommand =
(Char -> ReadP Char
char Char
'"' ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReadP Char -> ReadP Char -> ReadP String
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
manyTill (ReadP Char
pEsc ReadP Char -> ReadP Char -> ReadP Char
forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP Char
get) (Char -> ReadP Char
char Char
'"')))
ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++
ReadP String
pTheRest
where
pEsc :: ReadP Char
pEsc = Char -> ReadP Char
char Char
'\\' ReadP Char -> ReadP Char -> ReadP Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Char
get
pTheRest :: ReadP String
pTheRest = (Char -> Bool) -> ReadP String
munch (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)