From c8d85590c97e54dff4d1f0fadcb9b5e257f7b4b5 Mon Sep 17 00:00:00 2001
From: Chris Done <chrisdone@gmail.com>
Date: Mon, 25 Nov 2019 15:33:09 +0000
Subject: [PATCH] Display errors instead of printing

---
 app/Main.hs        | 33 +++++++++++++++++++--------------
 src/Duet/Errors.hs | 21 +++++++++++++++++++++
 src/Duet/Types.hs  |  5 ++---
 3 files changed, 42 insertions(+), 17 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 160a441..605c744 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -15,6 +15,7 @@ import           Control.Monad.Writer
 import qualified Data.Map.Strict as M
 import           Data.Semigroup ((<>))
 import           Duet.Context
+import           Duet.Errors
 import           Duet.Infer
 import           Duet.Parser
 import           Duet.Printer
@@ -108,20 +109,24 @@ runClassesPrint _ = do
 
 runProgram :: Run -> IO ()
 runProgram run@Run {..} = do
-  decls <- parseFile runInputFile
-  runNoLoggingT
-    (evalSupplyT
-       (do (binds, ctx) <- createContext decls
-           things <-
-             execWriterT
-               (runStepperIO
-                  run
-                  runSteps
-                  ctx
-                  (fmap (fmap typeSignatureA) binds)
-                  runMainIs)
-           pure things)
-       [1 ..])
+  catch
+    (catch
+       (runNoLoggingT
+          (evalSupplyT
+             (do decls <- liftIO (parseFile runInputFile)
+                 (binds, ctx) <- createContext decls
+                 things <-
+                   execWriterT
+                     (runStepperIO
+                        run
+                        runSteps
+                        ctx
+                        (fmap (fmap typeSignatureA) binds)
+                        runMainIs)
+                 pure things)
+             [1 ..]))
+       (putStrLn . displayContextException))
+    (putStrLn . displayParseException)
 
 -- | Run the substitution model on the code.
 runStepperIO ::
diff --git a/src/Duet/Errors.hs b/src/Duet/Errors.hs
index 948c7b9..2206967 100644
--- a/src/Duet/Errors.hs
+++ b/src/Duet/Errors.hs
@@ -4,15 +4,36 @@
 
 module Duet.Errors where
 
+import           Control.Exception
 import           Data.Char
 import           Data.Function
 import           Data.List
 import qualified Data.Map.Strict as M
 import           Data.Ord
+import           Data.Typeable
 import           Duet.Printer
 import           Duet.Types
 import           Text.EditDistance
 
+displayContextException :: ContextException -> String
+displayContextException (ContextException specialTypes (SomeException se)) =
+  maybe
+    (maybe
+       (maybe
+          (maybe
+             (maybe
+                (displayException se)
+                (displayRenamerException specialTypes)
+                (cast se))
+             (displayInferException specialTypes)
+             (cast se))
+          (displayStepperException specialTypes)
+          (cast se))
+       (displayResolveException specialTypes)
+       (cast se))
+    displayParseException
+    (cast se)
+
 displayParseException :: ParseException -> String
 displayParseException e =
   case e of
diff --git a/src/Duet/Types.hs b/src/Duet/Types.hs
index fd182df..c5930c9 100644
--- a/src/Duet/Types.hs
+++ b/src/Duet/Types.hs
@@ -217,9 +217,8 @@ data RenamerException
   deriving (Show, Generic, Data, Typeable, Typeable)
 instance Exception RenamerException
 
-
-data ContextException = ContextException (SpecialTypes Name) RenamerException
-  deriving (Show, Generic, Data, Typeable, Typeable)
+data ContextException = ContextException (SpecialTypes Name) SomeException
+  deriving (Show, Generic, Typeable)
 instance Exception ContextException
 
 -- | An exception that may be thrown when reading in source code,