{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Simple.UUAGC.Parser(parserAG,
                                        parserAG',
                                        scanner,
                                        parseIOAction,
                                        parseClassAG,
                                        parseOptionAG) where

import UU.Parsing
import UU.Scanner
import Distribution.Simple.UUAGC.AbsSyn
import Options
import System.Console.GetOpt
import System.IO.Unsafe(unsafeInterleaveIO)
import System.IO(hPutStr,stderr)
import Control.Monad.Error.Class

data ParserError = DefParserError String
                 deriving (Int -> ParserError -> ShowS
[ParserError] -> ShowS
ParserError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ParserError] -> ShowS
$cshowList :: [ParserError] -> ShowS
show :: ParserError -> [Char]
$cshow :: ParserError -> [Char]
showsPrec :: Int -> ParserError -> ShowS
$cshowsPrec :: Int -> ParserError -> ShowS
Show, ParserError -> ParserError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParserError -> ParserError -> Bool
$c/= :: ParserError -> ParserError -> Bool
== :: ParserError -> ParserError -> Bool
$c== :: ParserError -> ParserError -> Bool
Eq, ReadPrec [ParserError]
ReadPrec ParserError
Int -> ReadS ParserError
ReadS [ParserError]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParserError]
$creadListPrec :: ReadPrec [ParserError]
readPrec :: ReadPrec ParserError
$creadPrec :: ReadPrec ParserError
readList :: ReadS [ParserError]
$creadList :: ReadS [ParserError]
readsPrec :: Int -> ReadS ParserError
$creadsPrec :: Int -> ReadS ParserError
Read)

instance Error ParserError where
    strMsg :: [Char] -> ParserError
strMsg [Char]
x = [Char] -> ParserError
DefParserError [Char]
x

uFlags :: [String]
uFlags :: [[Char]]
uFlags = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Char]]
x | Option [Char]
_ [[Char]]
x ArgDescr (Options -> Options)
_ [Char]
_ <- [OptDescr (Options -> Options)]
options]

kwtxt :: [[Char]]
kwtxt = [[Char]]
uFlags forall a. [a] -> [a] -> [a]
++ [[Char]
"file", [Char]
"options", [Char]
"class", [Char]
"with"]
kwotxt :: [[Char]]
kwotxt = [[Char]
"=",[Char]
":",[Char]
"..",[Char]
"."]
sctxt :: [Char]
sctxt  = [Char]
"..,"
octxt :: [Char]
octxt = [Char]
"=:.,"

posTxt :: Pos
posTxt :: Pos
posTxt = Int -> Int -> [Char] -> Pos
Pos Int
0 Int
0 [Char]
""

puFlag :: OptDescr (Options -> Options) -> Parser Token (Options -> Options)
puFlag :: OptDescr (Options -> Options) -> Parser Token (Options -> Options)
puFlag (Option [Char]
_ []  ArgDescr (Options -> Options)
_            [Char]
_) = forall (p :: * -> *) s a. IsParser p s => p a
pFail
puFlag (Option [Char]
_ [[Char]]
kws (NoArg Options -> Options
f)    [Char]
_) = forall (p :: * -> *) s a a1.
IsParser p s =>
(a -> p a1) -> [a] -> p a1
pAny (\[Char]
kw -> forall a b. a -> b -> a
const Options -> Options
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
kw) [[Char]]
kws
puFlag (Option [Char]
_ [[Char]]
kws (ReqArg [Char] -> Options -> Options
f [Char]
_) [Char]
_) = forall (p :: * -> *) s a a1.
IsParser p s =>
(a -> p a1) -> [a] -> p a1
pAny (\[Char]
kw -> [Char] -> Options -> Options
f forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
kw forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> *). IsParser p Token => p [Char]
pString) [[Char]]
kws
puFlag (Option [Char]
_ [[Char]]
kws (OptArg Maybe [Char] -> Options -> Options
f [Char]
_) [Char]
_) = forall (p :: * -> *) s a a1.
IsParser p s =>
(a -> p a1) -> [a] -> p a1
pAny (\[Char]
kw -> forall a b. a -> b -> a
const (Maybe [Char] -> Options -> Options
f forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
kw
                                                    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Char] -> Options -> Options
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
kw forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (p :: * -> *). IsParser p Token => p [Char]
pString) [[Char]]
kws

pugFlags :: [Parser Token (Options -> Options)]
pugFlags :: [Parser Token (Options -> Options)]
pugFlags = forall a b. (a -> b) -> [a] -> [b]
map OptDescr (Options -> Options) -> Parser Token (Options -> Options)
puFlag [OptDescr (Options -> Options)]
options

pAnyFlag :: Parser Token (Options -> Options)
pAnyFlag = forall (p :: * -> *) s a a1.
IsParser p s =>
(a -> p a1) -> [a] -> p a1
pAny forall a. a -> a
id [Parser Token (Options -> Options)]
pugFlags

pSep :: Parser Token String
pSep :: Parser Token [Char]
pSep = forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
":" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"="

pFileClasses :: Parser Token [String]
pFileClasses :: Parser Token [[Char]]
pFileClasses = forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"with" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (p :: * -> *) a. IsParser p Token => p a -> p [a]
pCommas forall (p :: * -> *). IsParser p Token => p [Char]
pString)
             forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (p :: * -> *) s a. IsParser p s => a -> p a
pSucceed []

pAGFileOption :: Parser Token AGFileOption
pAGFileOption :: Parser Token AGFileOption
pAGFileOption = (\[Char]
f [[Char]]
cl [Options -> Options]
opt -> [Char] -> [[Char]] -> Options -> AGFileOption
AGFileOption [Char]
f [[Char]]
cl ([Options -> Options] -> Options
constructOptions [Options -> Options]
opt))
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"file" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Token [Char]
pSep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (p :: * -> *). IsParser p Token => p [Char]
pString)
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Token [[Char]]
pFileClasses
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"options" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Token [Char]
pSep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (p :: * -> *) a. IsParser p Token => p a -> p [a]
pCommas Parser Token (Options -> Options)
pAnyFlag)

pAGOptionsClass :: Parser Token AGOptionsClass
pAGOptionsClass :: Parser Token AGOptionsClass
pAGOptionsClass = (\[Char]
c [Options -> Options]
opt -> [Char] -> Options -> AGOptionsClass
AGOptionsClass [Char]
c ([Options -> Options] -> Options
constructOptions [Options -> Options]
opt))
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"class" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Token [Char]
pSep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (p :: * -> *). IsParser p Token => p [Char]
pString)
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"options" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Token [Char]
pSep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (p :: * -> *) a. IsParser p Token => p a -> p [a]
pCommas Parser Token (Options -> Options)
pAnyFlag)

pAGFileOptions :: Parser Token AGFileOptions
pAGFileOptions :: Parser Token AGFileOptions
pAGFileOptions = forall (p :: * -> *) s a. IsParser p s => p a -> p [a]
pList Parser Token AGFileOption
pAGFileOption

parserAG :: FilePath -> IO AGFileOptions
parserAG :: [Char] -> IO AGFileOptions
parserAG [Char]
fp = do [Char]
s <- [Char] -> IO [Char]
readFile [Char]
fp
                 forall s inp p a.
(Symbol s, InputState inp s p) =>
(Message s p -> IO ()) -> AnaParser inp Pair s p a -> inp -> IO a
parseIOAction forall s p. (Eq s, Show s, Show p) => Message s p -> IO ()
action Parser Token AGFileOptions
pAGFileOptions ([Char] -> [Char] -> [Token]
scanner [Char]
fp [Char]
s)

parserAG' :: FilePath -> IO (Either ParserError AGFileOptions)
parserAG' :: [Char] -> IO (Either ParserError AGFileOptions)
parserAG' [Char]
fp = do [Char]
s <- [Char] -> IO [Char]
readFile [Char]
fp
                  let steps :: Steps (Pair AGFileOptions (Pair [Token] ())) Token (Maybe Token)
steps = forall s inp pos a.
(Symbol s, InputState inp s pos) =>
AnaParser inp Pair s pos a
-> inp -> Steps (Pair a (Pair inp ())) s pos
parse Parser Token AGFileOptions
pAGFileOptions ([Char] -> [Char] -> [Token]
scanner [Char]
fp [Char]
s)
                  let (Pair AGFileOptions
res Pair [Token] ()
_, [Message Token (Maybe Token)]
mesg) = forall s p a.
(Eq s, Show s, Show p) =>
Steps a s p -> (a, [Message s p])
evalStepsMessages Steps (Pair AGFileOptions (Pair [Token] ())) Token (Maybe Token)
steps
                  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message Token (Maybe Token)]
mesg
                     then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right AGFileOptions
res
                     else do let err :: [Char]
err = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. [a] -> [a] -> [a]
(++) [] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Message Token (Maybe Token) -> [Char]
message2error [Message Token (Maybe Token)]
mesg
                             forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char] -> ParserError
DefParserError [Char]
err)

message2error :: Message Token (Maybe Token) -> String
message2error :: Message Token (Maybe Token) -> [Char]
message2error (Msg Expecting Token
e Maybe Token
p Action Token
a) = [Char]
"Expecting: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> [Char]
show Expecting Token
e) forall a. [a] -> [a] -> [a]
++ [Char]
" at " forall a. [a] -> [a] -> [a]
++ [Char]
action
    where action :: [Char]
action = case Action Token
a of
                     Insert Token
s -> [Char]
" Inserting: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> [Char]
show Token
s)
                     Delete Token
s -> [Char]
" Deleting: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> [Char]
show Token
s)
                     Other [Char]
s  -> [Char]
s

liftParse :: AnaParser [Token] Pair Token (Maybe Token) a -> [Char] -> IO a
liftParse AnaParser [Token] Pair Token (Maybe Token) a
p [Char]
text = forall s inp p a.
(Symbol s, InputState inp s p) =>
(Message s p -> IO ()) -> AnaParser inp Pair s p a -> inp -> IO a
parseIOAction forall s p. (Eq s, Show s, Show p) => Message s p -> IO ()
action AnaParser [Token] Pair Token (Maybe Token) a
p ([Char] -> [Char] -> [Token]
scanner [Char]
text [Char]
text)

parseOptionAG :: String -> IO AGFileOption
parseOptionAG :: [Char] -> IO AGFileOption
parseOptionAG = forall {a}.
AnaParser [Token] Pair Token (Maybe Token) a -> [Char] -> IO a
liftParse Parser Token AGFileOption
pAGFileOption

parseClassAG :: String -> IO AGOptionsClass
parseClassAG :: [Char] -> IO AGOptionsClass
parseClassAG = forall {a}.
AnaParser [Token] Pair Token (Maybe Token) a -> [Char] -> IO a
liftParse Parser Token AGOptionsClass
pAGOptionsClass

scanner     :: String -> String -> [Token]
scanner :: [Char] -> [Char] -> [Token]
scanner [Char]
fn [Char]
s = [[Char]]
-> [[Char]] -> [Char] -> [Char] -> Pos -> [Char] -> [Token]
scan [[Char]]
kwtxt [[Char]]
kwotxt [Char]
sctxt [Char]
octxt (Int -> Int -> [Char] -> Pos
Pos Int
0 Int
0 [Char]
fn) [Char]
s

action :: (Eq s, Show s, Show p) => Message s p -> IO ()
action :: forall s p. (Eq s, Show s, Show p) => Message s p -> IO ()
action Message s p
m = Handle -> [Char] -> IO ()
hPutStr Handle
stderr (forall a. Show a => a -> [Char]
show Message s p
m)

test :: (Show a) => Parser Token a -> [Token] -> IO ()
test :: forall a. Show a => Parser Token a -> [Token] -> IO ()
test Parser Token a
p [Token]
inp = do a
r <- forall s inp p a.
(Symbol s, InputState inp s p) =>
(Message s p -> IO ()) -> AnaParser inp Pair s p a -> inp -> IO a
parseIOAction forall s p. (Eq s, Show s, Show p) => Message s p -> IO ()
action Parser Token a
p [Token]
inp
                forall a. Show a => a -> IO ()
print a
r

parseIOAction :: (Symbol s, InputState inp s p)
               => (Message s p -> IO ())
               -> AnaParser inp Pair s p a
               -> inp
               -> IO a
parseIOAction :: forall s inp p a.
(Symbol s, InputState inp s p) =>
(Message s p -> IO ()) -> AnaParser inp Pair s p a -> inp -> IO a
parseIOAction  Message s p -> IO ()
showMessage AnaParser inp Pair s p a
p inp
inp
 = do  (Pair a
v Pair inp ()
final) <- forall s p b. (Message s p -> IO ()) -> Steps b s p -> IO b
evalStepsIOAction Message s p -> IO ()
showMessage (forall s inp pos a.
(Symbol s, InputState inp s pos) =>
AnaParser inp Pair s pos a
-> inp -> Steps (Pair a (Pair inp ())) s pos
parse AnaParser inp Pair s p a
p inp
inp)
       Pair inp ()
final seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return a
v -- in order to force the trailing error messages to be printed

evalStepsIOAction :: (Message s p -> IO ())
                  ->  Steps b s p
                  -> IO b
evalStepsIOAction :: forall s p b. (Message s p -> IO ()) -> Steps b s p -> IO b
evalStepsIOAction Message s p -> IO ()
showMessage = forall s p b. (Message s p -> IO ()) -> Int -> Steps b s p -> IO b
evalStepsIOAction' Message s p -> IO ()
showMessage (-Int
1)


evalStepsIOAction' :: (Message s p -> IO ())
                   -> Int
                   ->  Steps b s p
                   -> IO b
evalStepsIOAction' :: forall s p b. (Message s p -> IO ()) -> Int -> Steps b s p -> IO b
evalStepsIOAction' Message s p -> IO ()
showMessage Int
n (Steps b s p
steps :: Steps b s p) = forall a. Int -> Steps a s p -> IO a
eval Int
n Steps b s p
steps
  where eval                      :: Int -> Steps a s p -> IO a
        eval :: forall a. Int -> Steps a s p -> IO a
eval Int
0 Steps a s p
steps               = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a s p. Steps a s p -> a
evalSteps Steps a s p
steps)
        eval Int
n Steps a s p
steps = case Steps a s p
steps of
          OkVal a -> a
v        Steps a s p
rest -> do a
arg <- forall a. IO a -> IO a
unsafeInterleaveIO (forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest)
                                    forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
v a
arg)
          Ok             Steps a s p
rest -> forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest
          Cost  Int#
_        Steps a s p
rest -> forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest
          StRepair Int#
_ Message s p
msg Steps a s p
rest -> do Message s p -> IO ()
showMessage Message s p
msg
                                    forall a. Int -> Steps a s p -> IO a
eval (Int
nforall a. Num a => a -> a -> a
-Int
1) Steps a s p
rest
          Best Steps a s p
_   Steps a s p
rest   Steps a s p
_   -> forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest
          NoMoreSteps a
v       -> forall (m :: * -> *) a. Monad m => a -> m a
return a
v


evalStepsMessages :: (Eq s, Show s, Show p) => Steps a s p -> (a,[Message s p])
evalStepsMessages :: forall s p a.
(Eq s, Show s, Show p) =>
Steps a s p -> (a, [Message s p])
evalStepsMessages Steps a s p
steps = case Steps a s p
steps of
     OkVal a -> a
v             Steps a s p
rest -> let (a
arg, [Message s p]
ms) = forall s p a.
(Eq s, Show s, Show p) =>
Steps a s p -> (a, [Message s p])
evalStepsMessages Steps a s p
rest
                                 in (a -> a
v a
arg, [Message s p]
ms)
     Ok                  Steps a s p
rest -> forall s p a.
(Eq s, Show s, Show p) =>
Steps a s p -> (a, [Message s p])
evalStepsMessages Steps a s p
rest
     Cost Int#
_              Steps a s p
rest -> forall s p a.
(Eq s, Show s, Show p) =>
Steps a s p -> (a, [Message s p])
evalStepsMessages Steps a s p
rest
     StRepair Int#
_    Message s p
msg   Steps a s p
rest -> let (a
v, [Message s p]
ms) = forall s p a.
(Eq s, Show s, Show p) =>
Steps a s p -> (a, [Message s p])
evalStepsMessages Steps a s p
rest
                                 in (a
v, Message s p
msgforall a. a -> [a] -> [a]
:[Message s p]
ms)
     Best Steps a s p
_        Steps a s p
rest  Steps a s p
_    -> forall s p a.
(Eq s, Show s, Show p) =>
Steps a s p -> (a, [Message s p])
evalStepsMessages Steps a s p
rest
     NoMoreSteps a
v            -> (a
v,[])