4632N/A

4632N/A{- |

4632N/A

4632N/AModule : $Header$

4632N/ACopyright : (c) Christian Maeder and Uni Bremen 2002-2003

4632N/ALicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

4632N/A

4632N/AMaintainer : maeder@tzi.de

4632N/AStability : provisional

4632N/APortability : portable

4632N/A

4632N/Atest some parsers (and printers)

4632N/A

4632N/A-}

4632N/A

4632N/Amodule Common.RunParsers (exec, StringParser, toStringParser, fromAParser)

4632N/A where

4632N/A

4632N/Aimport Common.Lexer((<<), parseString)

4632N/Aimport Text.ParserCombinators.Parsec

4632N/Aimport Text.ParserCombinators.Parsec.Pos

4632N/Aimport Common.Anno_Parser

4632N/Aimport Common.AnnoState

4632N/Aimport Common.PrettyPrint

4632N/Aimport Common.GlobalAnnotations

4632N/Aimport Common.AnalyseAnnos(addGlobalAnnos)

4632N/Aimport Common.Result

4632N/Aimport System.Environment

4632N/A

4632N/Atype StringParser = GlobalAnnos -> AParser () String

4632N/A

4632N/AfromAParser :: (PrettyPrint a) => AParser () a -> StringParser

4632N/AfromAParser p ga = fmap (show . printText0 ga) p

4632N/A

4632N/AtoStringParser :: (PrettyPrint a) => (GlobalAnnos -> AParser () a)

4632N/A -> StringParser

4632N/AtoStringParser p ga = fmap (show . printText0 ga) $ p ga

4632N/A

4632N/Aexec :: [(String, StringParser)] -> [(String, StringParser)] -> IO ()

4632N/Aexec lps fps = do l <- getArgs

4632N/A if null l then

4632N/A parseSpec emptyGlobalAnnos $ snd $ head $ fps

4632N/A else do let opt = head l

4632N/A lps' = filter (\(s, _) -> s == opt) lps

4632N/A fps' = filter (\(s, _) -> s == opt) fps

4632N/A ga <- if not $ null $ tail l then

4632N/A do let annoFile = head (tail l)

4632N/A str <- readFile annoFile

4632N/A maybe (error "run parser")

4632N/A return $ maybeResult

4632N/A $ addGlobalAnnos emptyGlobalAnnos

4632N/A $ parseString annotations str

4632N/A -- should not fail

4632N/A -- but may return empty annos

4632N/A else return emptyGlobalAnnos

4632N/A if null lps' && null fps' then

4632N/A do putStrLn ("unknown option: " ++ opt)

4632N/A p <- getProgName

4632N/A putStrLn("Usage: "++p++

4632N/A " [OPTIONS] <Annotations> < infile")

4632N/A putStrLn "where OPTIONS is one of:"

4632N/A putStrLn $ unwords

4632N/A (map fst lps ++ map fst fps)

4632N/A else if null lps'

4632N/A then parseSpec ga $ snd $ head fps'

4632N/A else checkLines ga $ snd $ head lps'

4632N/A

4632N/AcheckLines :: GlobalAnnos -> StringParser -> IO ()

4632N/AcheckLines ga p =

4632N/A do s <- getContents

4632N/A putStr (unlines (scanLines ga p (lines s) 1))

4632N/A

4632N/AscanLines :: GlobalAnnos -> StringParser -> [String] -> Line -> [String]

4632N/AscanLines _ _ [] _ = []

4632N/AscanLines ga p (x:l) n = (parseLine ga p x n) : (scanLines ga p l (n+1))

4632N/A

4632N/AparseLine :: GlobalAnnos -> StringParser -> String -> Line -> String

4632N/AparseLine ga p line n =

4632N/A let pos = setSourceLine (initialPos "") n

4632N/A parser = do setPosition pos

4632N/A i <- p ga

4632N/A eof

4632N/A return i

4632N/A in showParse $ runParser parser (emptyAnnos ()) "" line

4632N/A

4632N/AparseSpec :: GlobalAnnos -> StringParser -> IO ()

4632N/AparseSpec ga p = do str <- getContents

4632N/A putStrLn $ showParse $

4632N/A runParser (p ga << eof) (emptyAnnos ()) "" str

4632N/A

4632N/AshowParse :: Either ParseError String -> String

4632N/AshowParse e = case e of

4632N/A Left err -> "parse error at " ++ showErr err ++ "\n"

4632N/A Right x -> x

4632N/A