Implement basic interpreted language

src/Grammar/Test.hs

@@ -0,0 +1,76 @@
+-- File generated by the BNF Converter (bnfc 2.9.4.1).
+
+-- | Program to test parser.
+
+module Main where
+
+import Prelude
+  ( ($), (.)
+  , Either(..)
+  , Int, (>)
+  , String, (++), concat, unlines
+  , Show, show
+  , IO, (>>), (>>=), mapM_, putStrLn
+  , FilePath
+  , getContents, readFile
+  )
+import System.Environment ( getArgs )
+import System.Exit        ( exitFailure )
+import Control.Monad      ( when )
+
+import Grammar.Abs   ()
+import Grammar.Lex   ( Token, mkPosToken )
+import Grammar.Par   ( pProgram, myLexer )
+import Grammar.Print ( Print, printTree )
+import Grammar.Skel  ()
+
+type Err        = Either String
+type ParseFun a = [Token] -> Err a
+type Verbosity  = Int
+
+putStrV :: Verbosity -> String -> IO ()
+putStrV v s = when (v > 1) $ putStrLn s
+
+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 =
+  case p ts of
+    Left err -> do
+      putStrLn "\nParse              Failed...\n"
+      putStrV v "Tokens:"
+      mapM_ (putStrV v . showPosToken . mkPosToken) ts
+      putStrLn err
+      exitFailure
+    Right tree -> do
+      putStrLn "\nParse Successful!"
+      showTree v tree
+  where
+  ts = myLexer s
+  showPosToken ((l,c),t) = concat [ show l, ":", show c, "\t", show t ]
+
+showTree :: (Show a, Print a) => Int -> a -> IO ()
+showTree v tree = do
+  putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
+  putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
+
+usage :: IO ()
+usage = do
+  putStrLn $ unlines
+    [ "usage: Call with one of the following argument combinations:"
+    , "  --help          Display this help message."
+    , "  (no arguments)  Parse stdin verbosely."
+    , "  (files)         Parse content of files verbosely."
+    , "  -s (files)      Silent mode. Parse content of files silently."
+    ]
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case args of
+    ["--help"] -> usage
+    []         -> getContents >>= run 2 pProgram
+    "-s":fs    -> mapM_ (runFile 0 pProgram) fs
+    fs         -> mapM_ (runFile 2 pProgram) fs
+