{-# 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
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,[])