{-# 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 -> String
(Int -> ParserError -> ShowS)
-> (ParserError -> String)
-> ([ParserError] -> ShowS)
-> Show ParserError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserError] -> ShowS
$cshowList :: [ParserError] -> ShowS
show :: ParserError -> String
$cshow :: ParserError -> String
showsPrec :: Int -> ParserError -> ShowS
$cshowsPrec :: Int -> ParserError -> ShowS
Show, ParserError -> ParserError -> Bool
(ParserError -> ParserError -> Bool)
-> (ParserError -> ParserError -> Bool) -> Eq ParserError
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]
(Int -> ReadS ParserError)
-> ReadS [ParserError]
-> ReadPrec ParserError
-> ReadPrec [ParserError]
-> Read 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 :: String -> ParserError
strMsg x :: String
x = String -> ParserError
DefParserError String
x

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

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

posTxt :: Pos
posTxt :: Pos
posTxt = Int -> Int -> String -> Pos
Pos 0 0 ""

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

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

pAGFileOption :: Parser Token AGFileOption
pAGFileOption :: Parser Token AGFileOption
pAGFileOption = (\f :: String
f cl :: [String]
cl opt :: [Options -> Options]
opt -> String -> [String] -> Options -> AGFileOption
AGFileOption String
f [String]
cl ([Options -> Options] -> Options
constructOptions [Options -> Options]
opt))
                (String -> [String] -> [Options -> Options] -> AGFileOption)
-> AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser
     [Token]
     Pair
     Token
     (Maybe Token)
     ([String] -> [Options -> Options] -> AGFileOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> AnaParser [Token] Pair Token (Maybe Token) String
forall (p :: * -> *). IsParser p Token => String -> p String
pKey "file" AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) String
pSep AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) String
forall (p :: * -> *). IsParser p Token => p String
pString)
                AnaParser
  [Token]
  Pair
  Token
  (Maybe Token)
  ([String] -> [Options -> Options] -> AGFileOption)
-> Parser Token [String]
-> AnaParser
     [Token]
     Pair
     Token
     (Maybe Token)
     ([Options -> Options] -> AGFileOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Token [String]
pFileClasses
                AnaParser
  [Token]
  Pair
  Token
  (Maybe Token)
  ([Options -> Options] -> AGFileOption)
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
-> Parser Token AGFileOption
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> AnaParser [Token] Pair Token (Maybe Token) String
forall (p :: * -> *). IsParser p Token => String -> p String
pKey "options" AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) String
pSep AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
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 = (\c :: String
c opt :: [Options -> Options]
opt -> String -> Options -> AGOptionsClass
AGOptionsClass String
c ([Options -> Options] -> Options
constructOptions [Options -> Options]
opt))
                  (String -> [Options -> Options] -> AGOptionsClass)
-> AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser
     [Token]
     Pair
     Token
     (Maybe Token)
     ([Options -> Options] -> AGOptionsClass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> AnaParser [Token] Pair Token (Maybe Token) String
forall (p :: * -> *). IsParser p Token => String -> p String
pKey "class" AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) String
pSep AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) String
forall (p :: * -> *). IsParser p Token => p String
pString)
                  AnaParser
  [Token]
  Pair
  Token
  (Maybe Token)
  ([Options -> Options] -> AGOptionsClass)
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
-> Parser Token AGOptionsClass
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> AnaParser [Token] Pair Token (Maybe Token) String
forall (p :: * -> *). IsParser p Token => String -> p String
pKey "options" AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AnaParser [Token] Pair Token (Maybe Token) String
pSep AnaParser [Token] Pair Token (Maybe Token) String
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
-> AnaParser [Token] Pair Token (Maybe Token) [Options -> Options]
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 :: String -> IO AGFileOptions
parserAG fp :: String
fp = do String
s <- String -> IO String
readFile String
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 (String -> String -> [Token]
scanner String
fp String
s)

parserAG' :: FilePath -> IO (Either ParserError AGFileOptions)
parserAG' :: String -> IO (Either ParserError AGFileOptions)
parserAG' fp :: String
fp = do String
s <- String -> IO String
readFile String
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 (String -> String -> [Token]
scanner String
fp String
s)
                  let (Pair res :: AGFileOptions
res _, mesg :: [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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Message Token (Maybe Token)]
mesg
                     then Either ParserError AGFileOptions
-> IO (Either ParserError AGFileOptions)
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 :: String
err = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> ShowS
forall a. [a] -> [a] -> [a]
(++) [] ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Message Token (Maybe Token) -> String)
-> [Message Token (Maybe Token)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Message Token (Maybe Token) -> String
message2error [Message Token (Maybe Token)]
mesg
                             Either ParserError AGFileOptions
-> IO (Either ParserError AGFileOptions)
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
$ String -> ParserError
DefParserError String
err)

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

liftParse :: AnaParser [Token] Pair Token (Maybe Token) a -> String -> IO a
liftParse p :: AnaParser [Token] Pair Token (Maybe Token) a
p text :: String
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 (String -> String -> [Token]
scanner String
text String
text)

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

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

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

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

test :: (Show a) => Parser Token a -> [Token] -> IO ()
test :: Parser Token a -> [Token] -> IO ()
test p :: Parser Token a
p inp :: [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 :: (Message s p -> IO ()) -> AnaParser inp Pair s p a -> inp -> IO a
parseIOAction  showMessage :: Message s p -> IO ()
showMessage p :: AnaParser inp Pair s p a
p inp :: inp
inp
 = do  (Pair v :: a
v final :: 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 (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 :: (Message s p -> IO ()) -> Steps b s p -> IO b
evalStepsIOAction showMessage :: 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 (-1)


evalStepsIOAction' :: (Message s p -> IO ())
                   -> Int
                   ->  Steps b s p
                   -> IO b
evalStepsIOAction' :: (Message s p -> IO ()) -> Int -> Steps b s p -> IO b
evalStepsIOAction' showMessage :: Message s p -> IO ()
showMessage n :: 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 :: Int -> Steps a s p -> IO a
eval 0 steps :: Steps a s p
steps               = 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 n :: Int
n steps :: Steps a s p
steps = case Steps a s p
steps of
          OkVal v :: a -> a
v        rest :: 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 (m :: * -> *) a. Monad m => a -> m a
return (a -> a
v a
arg)
          Ok             rest :: 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  _        rest :: 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 _ msg :: Message s p
msg rest :: 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
-1) Steps a s p
rest
          Best _   rest :: 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
          NoMoreSteps v :: a
v       -> 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 :: Steps a s p -> (a, [Message s p])
evalStepsMessages steps :: Steps a s p
steps = case Steps a s p
steps of
     OkVal v :: a -> a
v             rest :: Steps a s p
rest -> let (arg :: a
arg, ms :: [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                  rest :: 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 _              rest :: 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 _    msg :: Message s p
msg   rest :: Steps a s p
rest -> let (v :: a
v, ms :: [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 _        rest :: 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
     NoMoreSteps v :: a
v            -> (a
v,[])