gecco/app/Main.hs

module Main where

import Text.Megaparsec.Error (errorBundlePretty)

import System.Environment
import System.IO
import System.Exit
import qualified Data.Text.IO as T
import Control.Monad ((<=<))

import Parse (parseExpr)
import Type (infer)
import CompChez (comp)
import Eval (eval)

main :: IO ()
main = getArgs >>= \case
  [] -> processFile "stdin" stdin
  xs -> mapM_ (\file -> processFile file =<< openFile file ReadMode) xs

putStyle :: String -> IO () -- bold blue :)
putStyle s = putStrLn ("\x1b[38;5;87m\x1b[1m=>> " ++ s ++ "\x1b[0m")

processFile :: String -> Handle -> IO ()
processFile f h = do
  contents <- T.hGetContents h
  case parseExpr f contents of
    Left e -> putStrLn (errorBundlePretty e)
    Right ast -> do
      putStyle "Parse Successful"
      print ast
      putStyle "Type Checking / Inferring"
      case infer [] ast of
        Nothing -> putStrLn "=> Type error" >> exitWith (ExitFailure 1)
        Just t -> print t
      putStyle "Compiling to Chez"
      putStrLn (comp ast)
      putStyle "Evaluating"
      print (eval [] ast)