Main.hs

-- File generated by the BNF Converter (bnfc 2.9.5).

module Main where

import AbsGrammar (Program)
import Control.Monad (Monad (return), when)
import Control.Monad.Except (Except, ExceptT, runExceptT)
import Interpreter (runInterpreter)
import LexGrammar (Token, mkPosToken)
import ParGrammar (myLexer, pProgram)
import PrintGrammar (Print, printTree)
import SkelGrammar ()
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import TypeChecker (runTypeChecker)
import Prelude
  ( Either (..),
    FilePath,
    IO,
    Int,
    Show,
    String,
    concat,
    getContents,
    mapM_,
    putStrLn,
    readFile,
    show,
    unlines,
    ($),
    (++),
    (.),
    (>),
    (>>),
    (>>=),
  )

type Verbosity = Int

putStrV :: Verbosity -> String -> IO ()
putStrV v s = when (v > 1) $ putStrLn s

runFile :: Verbosity -> FilePath -> IO ()
runFile v f = readFile f >>= run v

failWithMessage :: String -> IO ()
failWithMessage msg = do
  hPutStrLn stderr msg
  exitFailure

execute :: Program -> ExceptT String IO ()
execute program = do
  runTypeChecker program
  runInterpreter program
  return ()

run :: Verbosity -> String -> IO ()
run v input =
  case pProgram tokens of
    Left err -> do
      putStrV v "Tokens:"
      mapM_ (putStrV v . showPosToken . mkPosToken) tokens
      failWithMessage err
    Right tree -> do
      showTree v tree
      result <- runExceptT $ execute tree
      case result of
        Left err -> failWithMessage err
        Right _ -> return ()
  where
    tokens = myLexer input
    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:",
        "  -h              Display this help message.",
        "  -v              Run in verbose mode.",
        "  (no arguments)  Parse stdin.",
        "  (file)          Parse content of file."
      ]

main :: IO ()
main = do
  args <- getArgs
  case args of
    ["-h"] -> usage
    [] -> getContents >>= run 0
    ["-v"] -> getContents >>= run 2
    [file] -> runFile 0 file
    ["-v", file] -> runFile 2 file
    _ -> usage