RunParsers.hs revision 10b02b2343246df6773585636fe3ddbefa3b6a1b
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaModule : $Header$
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaDescription : test some parsers (and printers)
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaCopyright : (c) Christian Maeder and Uni Bremen 2002-2003
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaMaintainer : Christian.Maeder@dfki.de
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaStability : provisional
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaPortability : portable
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksatest some parsers (and printers)
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksamodule Common.RunParsers (exec, StringParser, toStringParser, fromAParser)
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksaimport Common.AnalyseAnnos (addGlobalAnnos)
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksaimport Common.Lexer (parseString)
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksatype StringParser = GlobalAnnos -> AParser () String
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksafromAParser :: Pretty a => AParser () a -> StringParser
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksafromAParser p ga = fmap (flip (showGlobalDoc ga) "") p
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksatoStringParser :: Pretty a => (GlobalAnnos -> AParser () a) -> StringParser
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksatoStringParser p ga = fmap (flip (showGlobalDoc ga) "") $ p ga
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksaexec :: [(String, StringParser)] -> [(String, StringParser)] -> IO ()
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksaexec lps fps = do
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa l <- getArgs
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa [] -> parseSpec emptyGlobalAnnos . snd $ head fps
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa opt : tl -> do
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa let lps' = filter (\(s, _) -> s == opt) lps
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa fps' = filter (\(s, _) -> s == opt) fps
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa ga <- case tl of
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa [] -> return emptyGlobalAnnos
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa annoFile : _ -> do
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa str <- readFile annoFile
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa maybe (error "run parser") return $ maybeResult
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa $ addGlobalAnnos emptyGlobalAnnos
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa $ parseString annotations str
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa -- should not fail
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa -- but may return empty annos
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa case (lps', fps') of
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa ([], []) -> do
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa putStrLn ("unknown option: " ++ opt)
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa p <- getProgName
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa putStrLn $ "Usage: " ++ p ++ " [OPTIONS] <Annotations> < infile"
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa putStrLn "where OPTIONS is one of:"
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa putStrLn $ unwords $ map fst lps ++ map fst fps
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa ([], (_, hd) : _) -> parseSpec ga hd
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa ((_, hd) : _, _) -> checkLines ga hd
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksacheckLines :: GlobalAnnos -> StringParser -> IO ()
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksacheckLines ga p =
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa getContents >>= putStr . unlines . scanLines ga p 1 . lines
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksascanLines :: GlobalAnnos -> StringParser -> Line -> [String] -> [String]
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksascanLines ga p n inp = case inp of
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa x : l -> parseLine ga p x n : scanLines ga p (n + 1) l
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaparseLine :: GlobalAnnos -> StringParser -> String -> Line -> String
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaparseLine ga p line n =
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa let pos = setSourceLine (initialPos "") n
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa setPosition pos
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa in showParse $ runParser parser (emptyAnnos ()) "" line
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaparseSpec :: GlobalAnnos -> StringParser -> IO ()
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksaparseSpec ga p =
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa getContents >>= putStrLn . showParse
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa . runParser (p ga << eof) (emptyAnnos ()) ""
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksashowParse :: Either ParseError String -> String
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen KuksashowParse e = case e of
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa Left err -> "parse error at " ++ showErr err ++ "\n"
7bb0a9e92bc7a6f868eaa0b9c3212c0af4f96b7fEugen Kuksa Right x -> x