{-# 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)

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

uFlags :: [String]
uFlags :: [[Char]]
uFlags = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
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 [[Char]] -> [[Char]] -> [[Char]]
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]
_) = Parser Token (Options -> Options)
forall a. AnaParser [Token] Pair Token (Maybe Token) a
forall (p :: * -> *) s a. IsParser p s => p a
pFail
puFlag (Option [Char]
_ [[Char]]
kws (NoArg Options -> Options
f)    [Char]
_) = ([Char] -> Parser Token (Options -> Options))
-> [[Char]] -> Parser Token (Options -> Options)
forall (p :: * -> *) s a a1.
IsParser p s =>
(a -> p a1) -> [a] -> p a1
pAny (\[Char]
kw -> (Options -> Options) -> [Char] -> Options -> Options
forall a b. a -> b -> a
const Options -> Options
f ([Char] -> Options -> Options)
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> Parser Token (Options -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> AnaParser [Token] Pair Token (Maybe Token) [Char]
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]
_) = ([Char] -> Parser Token (Options -> Options))
-> [[Char]] -> Parser Token (Options -> Options)
forall (p :: * -> *) s a a1.
IsParser p s =>
(a -> p a1) -> [a] -> p a1
pAny (\[Char]
kw -> [Char] -> Options -> Options
f ([Char] -> Options -> Options)
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser
     [Token] Pair Token (Maybe Token) ([Char] -> Options -> Options)
forall a b.
a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
kw AnaParser
  [Token] Pair Token (Maybe Token) ([Char] -> Options -> Options)
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> Parser Token (Options -> Options)
forall a b.
AnaParser [Token] Pair Token (Maybe Token) (a -> b)
-> AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => p [Char]
pString) [[Char]]
kws
puFlag (Option [Char]
_ [[Char]]
kws (OptArg Maybe [Char] -> Options -> Options
f [Char]
_) [Char]
_) = ([Char] -> Parser Token (Options -> Options))
-> [[Char]] -> Parser Token (Options -> Options)
forall (p :: * -> *) s a a1.
IsParser p s =>
(a -> p a1) -> [a] -> p a1
pAny (\[Char]
kw -> (Options -> Options) -> [Char] -> Options -> Options
forall a b. a -> b -> a
const (Maybe [Char] -> Options -> Options
f Maybe [Char]
forall a. Maybe a
Nothing) ([Char] -> Options -> Options)
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> Parser Token (Options -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
kw
                                                    Parser Token (Options -> Options)
-> Parser Token (Options -> Options)
-> Parser Token (Options -> Options)
forall a.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Char] -> Options -> Options
f (Maybe [Char] -> Options -> Options)
-> ([Char] -> Maybe [Char]) -> [Char] -> Options -> Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Options -> Options)
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser
     [Token] Pair Token (Maybe Token) ([Char] -> Options -> Options)
forall a b.
a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
kw AnaParser
  [Token] Pair Token (Maybe Token) ([Char] -> Options -> Options)
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> Parser Token (Options -> Options)
forall a b.
AnaParser [Token] Pair Token (Maybe Token) (a -> b)
-> AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => p [Char]
pString) [[Char]]
kws

pugFlags :: [Parser Token (Options -> Options)]
pugFlags :: [Parser Token (Options -> Options)]
pugFlags = (OptDescr (Options -> Options)
 -> Parser Token (Options -> Options))
-> [OptDescr (Options -> Options)]
-> [Parser Token (Options -> Options)]
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 = (Parser Token (Options -> Options)
 -> Parser Token (Options -> Options))
-> [Parser Token (Options -> Options)]
-> Parser Token (Options -> Options)
forall (p :: * -> *) s a a1.
IsParser p s =>
(a -> p a1) -> [a] -> p a1
pAny Parser Token (Options -> Options)
-> Parser Token (Options -> Options)
forall a. a -> a
id [Parser Token (Options -> Options)]
pugFlags

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

pFileClasses :: Parser Token [String]
pFileClasses :: Parser Token [[Char]]
pFileClasses = [Char] -> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"with" AnaParser [Token] Pair Token (Maybe Token) [Char]
-> Parser Token [[Char]] -> Parser Token [[Char]]
forall a b.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AnaParser [Token] Pair Token (Maybe Token) [Char]
-> Parser Token [[Char]]
forall (p :: * -> *) a. IsParser p Token => p a -> p [a]
pCommas AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => p [Char]
pString)
             Parser Token [[Char]]
-> Parser Token [[Char]] -> Parser Token [[Char]]
forall a.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [[Char]] -> Parser Token [[Char]]
forall a. a -> AnaParser [Token] Pair Token (Maybe Token) 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))
                ([Char] -> [[Char]] -> [Options -> Options] -> AGFileOption)
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser
     [Token]
     Pair
     Token
     (Maybe Token)
     ([[Char]] -> [Options -> Options] -> AGFileOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"file" AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall a b.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) [Char]
pSep AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall a b.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => p [Char]
pString)
                AnaParser
  [Token]
  Pair
  Token
  (Maybe Token)
  ([[Char]] -> [Options -> Options] -> AGFileOption)
-> Parser Token [[Char]]
-> AnaParser
     [Token]
     Pair
     Token
     (Maybe Token)
     ([Options -> Options] -> AGFileOption)
forall a b.
AnaParser [Token] Pair Token (Maybe Token) (a -> b)
-> AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Token [[Char]]
pFileClasses
                AnaParser
  [Token]
  Pair
  Token
  (Maybe Token)
  ([Options -> Options] -> AGFileOption)
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
-> Parser Token AGFileOption
forall a b.
AnaParser [Token] Pair Token (Maybe Token) (a -> b)
-> AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"options" AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall a b.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) [Char]
pSep AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
forall a b.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Token (Options -> Options)
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
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))
                  ([Char] -> [Options -> Options] -> AGOptionsClass)
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser
     [Token]
     Pair
     Token
     (Maybe Token)
     ([Options -> Options] -> AGOptionsClass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"class" AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall a b.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) [Char]
pSep AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall a b.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => p [Char]
pString)
                  AnaParser
  [Token]
  Pair
  Token
  (Maybe Token)
  ([Options -> Options] -> AGOptionsClass)
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
-> Parser Token AGOptionsClass
forall a b.
AnaParser [Token] Pair Token (Maybe Token) (a -> b)
-> AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall (p :: * -> *). IsParser p Token => [Char] -> p [Char]
pKey [Char]
"options" AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Char]
forall a b.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) [Char]
pSep AnaParser [Token] Pair Token (Maybe Token) [Char]
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
forall a b.
AnaParser [Token] Pair Token (Maybe Token) a
-> AnaParser [Token] Pair Token (Maybe Token) b
-> AnaParser [Token] Pair Token (Maybe Token) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Token (Options -> Options)
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
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 = Parser Token AGFileOption -> Parser Token AGFileOptions
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
                 (Message Token (Maybe Token) -> IO ())
-> Parser Token AGFileOptions -> [Token] -> IO AGFileOptions
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 Token (Maybe Token) -> IO ()
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 = Parser Token AGFileOptions
-> [Token]
-> Steps (Pair AGFileOptions (Pair [Token] ())) Token (Maybe Token)
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) = Steps (Pair AGFileOptions (Pair [Token] ())) Token (Maybe Token)
-> (Pair AGFileOptions (Pair [Token] ()),
    [Message Token (Maybe Token)])
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 [Message Token (Maybe Token)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Message Token (Maybe Token)]
mesg
                     then Either ParserError AGFileOptions
-> IO (Either ParserError AGFileOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParserError AGFileOptions
 -> IO (Either ParserError AGFileOptions))
-> Either ParserError AGFileOptions
-> IO (Either ParserError AGFileOptions)
forall a b. (a -> b) -> a -> b
$ AGFileOptions -> Either ParserError AGFileOptions
forall a b. b -> Either a b
Right AGFileOptions
res
                     else do let err :: [Char]
err = ([Char] -> ShowS) -> [Char] -> [[Char]] -> [Char]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
(++) [] ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Message Token (Maybe Token) -> [Char])
-> [Message Token (Maybe Token)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Message Token (Maybe Token) -> [Char]
message2error [Message Token (Maybe Token)]
mesg
                             Either ParserError AGFileOptions
-> IO (Either ParserError AGFileOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParserError -> Either ParserError AGFileOptions
forall a b. a -> Either a b
Left (ParserError -> Either ParserError AGFileOptions)
-> ParserError -> Either ParserError AGFileOptions
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: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Expecting Token -> [Char]
forall a. Show a => a -> [Char]
show Expecting Token
e) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" at " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
action
    where action :: [Char]
action = case Action Token
a of
                     Insert Token
s -> [Char]
" Inserting: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Token -> [Char]
forall a. Show a => a -> [Char]
show Token
s)
                     Delete Token
s -> [Char]
" Deleting: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Token -> [Char]
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 = (Message Token (Maybe Token) -> IO ())
-> AnaParser [Token] Pair Token (Maybe Token) a -> [Token] -> IO a
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 Token (Maybe Token) -> IO ()
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 = Parser Token AGFileOption -> [Char] -> IO AGFileOption
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 = Parser Token AGOptionsClass -> [Char] -> IO AGOptionsClass
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 (Message s p -> [Char]
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 <- (Message Token (Maybe Token) -> IO ())
-> Parser Token a -> [Token] -> IO a
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 Token (Maybe Token) -> IO ()
forall s p. (Eq s, Show s, Show p) => Message s p -> IO ()
action Parser Token a
p [Token]
inp
                a -> IO ()
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) <- (Message s p -> IO ())
-> Steps (Pair a (Pair inp ())) s p -> IO (Pair a (Pair inp ()))
forall s p b. (Message s p -> IO ()) -> Steps b s p -> IO b
evalStepsIOAction Message s p -> IO ()
showMessage (AnaParser inp Pair s p a -> inp -> Steps (Pair a (Pair inp ())) s p
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 Pair inp () -> IO a -> IO a
forall a b. a -> b -> b
`seq` a -> IO a
forall a. a -> IO a
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 = (Message s p -> IO ()) -> Int -> Steps b s p -> IO b
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) = Int -> Steps b s p -> IO b
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               = a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Steps a s p -> a
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 <- IO a -> IO a
forall a. IO a -> IO a
unsafeInterleaveIO (Int -> Steps a s p -> IO a
forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest)
                                    a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
v a
arg)
          Ok             Steps a s p
rest -> Int -> Steps a s p -> IO a
forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest
          Cost  Int#
_        Steps a s p
rest -> Int -> Steps a s p -> IO a
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
                                    Int -> Steps a s p -> IO a
forall a. Int -> Steps a s p -> IO a
eval (Int
nInt -> Int -> Int
forall 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
_   -> Int -> Steps a s p -> IO a
forall a. Int -> Steps a s p -> IO a
eval Int
n Steps a s p
rest
          NoMoreSteps a
v       -> a -> IO a
forall a. a -> IO a
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) = Steps a s p -> (a, [Message 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
                                 in (a -> a
v a
arg, [Message s p]
ms)
     Ok                  Steps a s p
rest -> Steps a s p -> (a, [Message 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
     Cost Int#
_              Steps a s p
rest -> Steps a s p -> (a, [Message 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
     StRepair Int#
_    Message s p
msg   Steps a s p
rest -> let (a
v, [Message s p]
ms) = Steps a s p -> (a, [Message 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
                                 in (a
v, Message s p
msgMessage s p -> [Message s p] -> [Message s p]
forall a. a -> [a] -> [a]
:[Message s p]
ms)
     Best Steps a s p
_        Steps a s p
rest  Steps a s p
_    -> Steps a s p -> (a, [Message 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,[])