update Interpreter to make "testable"

app/Interpreter.hs

@@ -1,34 +1,18 @@
 module Main where
 
-import Control.Monad.Foil (emptyNameMap, emptyScope)
-import HM.Eval
-import HM.Parser.Par
-import HM.Syntax (toExpClosed)
-import HM.Typecheck
+import HM.Interpret
 import System.Exit
 
-data Result
-  = Success String -- Output of evaluation.
-  | Failure Int String -- Exit code and error message.
-
 main :: IO ()
 main = do
   sourceCode <- getContents
-  case run sourceCode of
+  case interpret sourceCode of
     Success output -> putStrLn output
-    Failure code msg -> do
-      putStrLn msg
-      exitWith (ExitFailure code)
+    Failure errorKind errorMsg -> do
+      putStrLn errorMsg
+      exitWith (ExitFailure (errorCode errorKind))
 
-run :: String -> Result
-run input =
-
-  case toExpClosed <$> pExp tokens of
-    Left err -> Failure 1 ("Parsing error: " ++ err)
-    Right e -> case inferType emptyNameMap e of
-      Left err -> Failure 2 ("Typechecking error: " ++ err)
-      Right _type -> case eval emptyScope e of
-        Left err -> Failure 3 ("Evaluation error: " ++ err)
-        Right outExp -> Success (show outExp)
-  where
-    tokens = myLexer input
+errorCode :: ErrorKind -> Int
+errorCode ParsingError = 1
+errorCode TypecheckingError = 2
+errorCode EvaluationError = 3

free-foil-hm.cabal

@@ -30,6 +30,7 @@ custom-setup
 library
   exposed-modules:
       HM.Eval
+      HM.Interpret
       HM.Parser.Abs
       HM.Parser.Lex
       HM.Parser.Par

src/HM/Interpret.hs

@@ -0,0 +1,28 @@
+module HM.Interpret where
+
+import Control.Monad.Foil (emptyNameMap, emptyScope)
+import HM.Eval
+import HM.Parser.Par
+import HM.Syntax (toExpClosed)
+import HM.Typecheck
+
+data Result
+  = Success String -- Output of evaluation.
+  | Failure ErrorKind String -- Error kind with message.
+
+data ErrorKind
+  = ParsingError
+  | TypecheckingError
+  | EvaluationError
+
+interpret :: String -> Result
+interpret input =
+  case toExpClosed <$> pExp tokens of
+    Left err -> Failure ParsingError ("Parsing error: " ++ err)
+    Right e -> case inferType emptyNameMap e of
+      Left err -> Failure TypecheckingError ("Typechecking error: " ++ err)
+      Right _type -> case eval emptyScope e of
+        Left err -> Failure EvaluationError ("Evaluation error: " ++ err)
+        Right outExp -> Success (show outExp)
+  where
+    tokens = myLexer input