From 77f0e7521e0d6fd6e770dd889665b0b7039515ed Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Mon, 27 Nov 2023 17:38:46 -0700
Subject: [PATCH] small steps towards actual error handling

---
 app/Main.hs          | 16 ++++++++++------
 src/Compiler/RLPC.hs | 12 +++++++-----
 2 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 81eb38d..342c461 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -50,33 +50,37 @@ debugFlagReader = maybeReader $ Just . \case
 
 ----------------------------------------------------------------------------------
 
+-- temp
+data CompilerError = CompilerError String
+
 main :: IO ()
 main = do
     opts <- execParser optParser
-    evalRLPCIO opts driver
+    (_, es) <- evalRLPCIO opts driver
+    forM_ es $ \ (CompilerError e) -> print $ "warning: " <> e
     pure ()
 
-driver :: RLPCIO () ()
+driver :: RLPCIO CompilerError ()
 driver = sequence_
     [ dshowFlags
     , ddumpEval
     ]
 
-dshowFlags :: RLPCIO () ()
+dshowFlags :: RLPCIO CompilerError ()
 dshowFlags = whenFlag flagDDumpOpts do
     ask >>= liftIO . print
     liftIO $ exitSuccess
 
-ddumpEval :: RLPCIO () ()
+ddumpEval :: RLPCIO CompilerError ()
 ddumpEval = whenFlag flagDDumpEval do
     fs <- view rlpcInputFiles
     forM_ fs $ \f -> liftIO (readFile f) >>= doProg
 
     where
-        doProg :: String -> RLPCIO () ()
+        doProg :: String -> RLPCIO CompilerError ()
         doProg s = ask >>= \o -> case parseProg o s of
             -- TODO: error handling
-            Left e -> error $ show e
+            Left e -> addFatal . CompilerError $ show e
             Right (a,_) -> do
                 log <- view rlpcLogFile
                 case log of
diff --git a/src/Compiler/RLPC.hs b/src/Compiler/RLPC.hs
index 1163542..bcb9618 100644
--- a/src/Compiler/RLPC.hs
+++ b/src/Compiler/RLPC.hs
@@ -2,11 +2,13 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DeriveGeneric, DerivingStrategies, DerivingVia #-}
 module Compiler.RLPC
-    ( RLPC(..)
+    ( RLPC
+    , RLPCT
     , RLPCIO
     , RLPCOptions(RLPCOptions)
     , addFatal
     , addWound
+    , MonadErrorful
     , Severity(..)
     , evalRLPCT
     , evalRLPCIO
@@ -37,7 +39,7 @@ import Lens.Micro.TH
 ----------------------------------------------------------------------------------
 
 -- TODO: fancy errors
-newtype RLPCT e m a = RLPC {
+newtype RLPCT e m a = RLPCT {
         runRLPCT :: ReaderT RLPCOptions (ErrorfulT e m) a
     }
     deriving (Functor, Applicative, Monad, MonadReader RLPCOptions)
@@ -86,9 +88,9 @@ type ErrorDoc = String
 class Diagnostic e where
     errorDoc :: e -> ErrorDoc
 
-instance MonadErrorful e (RLPC e) where
-    addWound = RLPC . lift . addWound
-    addFatal = RLPC . lift . addFatal
+instance (Monad m) => MonadErrorful e (RLPCT e m) where
+    addWound = RLPCT . lift . addWound
+    addFatal = RLPCT . lift . addFatal
 
 ----------------------------------------------------------------------------------