diff options
Diffstat (limited to 'src/GF/Canon/TestGFC.hs')
| -rw-r--r-- | src/GF/Canon/TestGFC.hs | 28 |
1 files changed, 17 insertions, 11 deletions
diff --git a/src/GF/Canon/TestGFC.hs b/src/GF/Canon/TestGFC.hs index ee4175610..0ee7c8ebf 100644 --- a/src/GF/Canon/TestGFC.hs +++ b/src/GF/Canon/TestGFC.hs @@ -18,22 +18,28 @@ type ParseFun a = [Token] -> Err a myLLexer = myLexer -runFile :: (Print a, Show a) => ParseFun a -> FilePath -> IO () -runFile p f = readFile f >>= run p +type Verbosity = Int -run :: (Print a, Show a) => ParseFun a -> String -> IO () -run p s = case (p (myLLexer s)) of - Bad s -> do putStrLn "\nParse Failed...\n" +putStrV :: Verbosity -> String -> IO () +putStrV v s = if v > 1 then putStrLn s else return () + +runFile :: (Print a, Show a) => Verbosity -> ParseFun a -> FilePath -> IO () +runFile v p f = putStrLn f >> readFile f >>= run v p + +run :: (Print a, Show a) => Verbosity -> ParseFun a -> String -> IO () +run v p s = let ts = myLLexer s in case p ts of + Bad s -> do putStrLn "\nParse Failed...\n" + putStrV v "Tokens:" + putStrV v $ show ts putStrLn s Ok tree -> do putStrLn "\nParse Successful!" - putStrLn $ "\n[Abstract Syntax]\n\n" ++ show tree - putStrLn $ "\n[Linearized tree]\n\n" ++ printTree tree + putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree + putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree main :: IO () main = do args <- getArgs case args of - [] -> hGetContents stdin >>= run pCanon - [f] -> runFile pCanon f - _ -> do progName <- getProgName - putStrLn $ progName ++ ": excess arguments." + [] -> hGetContents stdin >>= run 2 pCanon + "-s":fs -> mapM_ (runFile 0 pCanon) fs + fs -> mapM_ (runFile 2 pCanon) fs |