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 [])   -- comment
  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)