{-# LANGUAGE LambdaCase #-}

module Sit (main, check, checkFile) where

import System.Environment (getArgs)
import System.Exit (exitFailure)

import Control.Monad ((<=<))
import Data.Foldable

import Sit.Abs
import Sit.Lex
import Sit.Par
import Sit.Print

import TypeChecker

type Err = Either String

-- | Type-check file given by command line.

main :: IO ()
main :: IO ()
main = IO [String]
getArgs IO [String] -> ([String] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  [String
file] -> String -> IO ()
checkFile String
file
  [String]
_ -> IO ()
usage

usage :: IO ()
usage :: IO ()
usage = do
  String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
    [ String
"usage: Sit.bin FILE"
    , String
""
    , String
"Type-checks the given FILE."
    ]
  IO ()
forall a. IO a
exitFailure

-- | Handle error by failing hard.

failOnErr :: String -> Err a -> IO a
failOnErr :: String -> Err a -> IO a
failOnErr String
msg = \case
  Right a
a  -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  Left String
err -> String -> IO a
forall a. String -> IO a
exitMsg (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
msg , String
err ]

exitMsg :: String -> IO a
exitMsg :: String -> IO a
exitMsg String
msg = do
  String -> IO ()
putStrLn String
msg
  IO a
forall a. IO a
exitFailure

-- | Run the type checker on file given by path.

checkFile :: FilePath -> IO ()
checkFile :: String -> IO ()
checkFile = String -> IO ()
check (String -> IO ()) -> (String -> IO String) -> String -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO String
readFile

-- | Run the type checker on text/contents of a file.

check :: String -> IO ()
check :: String -> IO ()
check String
txt = do
  Prg [Decl]
decls <- String -> Err Prg -> IO Prg
forall a. String -> Err a -> IO a
failOnErr String
"PARSE ERROR" (Err Prg -> IO Prg) -> Err Prg -> IO Prg
forall a b. (a -> b) -> a -> b
$ [Token] -> Err Prg
pPrg ([Token] -> Err Prg) -> [Token] -> Err Prg
forall a b. (a -> b) -> a -> b
$ String -> [Token]
myLexer String
txt
  -- putStrLn "Parsed the following declarations"
  -- forM_ decls $ \ d -> do
  --   putStrLn $ printTree d
  (String -> IO ()) -> (() -> IO ()) -> Either String () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ String
err -> String -> IO ()
forall a. String -> IO a
exitMsg (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
"TYPE ERROR" , String
err ]) () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String () -> IO ()) -> Either String () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Decl] -> Either String ()
typeCheck [Decl]
decls