From 692d22afb9b93ba5411467def0788fdf4cf04e72 Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Mon, 22 Jan 2024 10:26:33 -0700
Subject: [PATCH] msgenvelope

---
 src/Compiler/RLPC.hs      | 12 ++++++------
 src/Compiler/RlpcError.hs |  3 ++-
 src/Core/HindleyMilner.hs |  6 +++---
 3 files changed, 11 insertions(+), 10 deletions(-)

diff --git a/src/Compiler/RLPC.hs b/src/Compiler/RLPC.hs
index 0de0638..a4b3556 100644
--- a/src/Compiler/RLPC.hs
+++ b/src/Compiler/RLPC.hs
@@ -60,7 +60,7 @@ import System.Exit
 ----------------------------------------------------------------------------------
 
 newtype RLPCT m a = RLPCT {
-        runRLPCT :: ReaderT RLPCOptions (ErrorfulT RlpcError m) a
+        runRLPCT :: ReaderT RLPCOptions (ErrorfulT (MsgEnvelope RlpcError) m) a
     }
     deriving (Functor, Applicative, Monad)
 
@@ -70,7 +70,7 @@ type RLPCIO = RLPCT IO
 
 evalRLPC :: RLPCOptions
          -> RLPC a
-         -> (Maybe a, [RlpcError])
+         -> (Maybe a, [MsgEnvelope RlpcError])
 evalRLPC opt r = runRLPCT r
                & flip runReaderT opt
                & runErrorful
@@ -78,7 +78,7 @@ evalRLPC opt r = runRLPCT r
 evalRLPCT :: (Monad m)
           => RLPCOptions
           -> RLPCT m a
-          -> m (Maybe a, [RlpcError])
+          -> m (Maybe a, [MsgEnvelope RlpcError])
 evalRLPCT = undefined
 
 evalRLPCIO :: RLPCOptions -> RLPCIO a -> IO a
@@ -89,11 +89,11 @@ evalRLPCIO opt r = do
         Just x  -> pure x
         Nothing -> die "Failed, no code compiled."
 
-putRlpcErrs :: [RlpcError] -> IO ()
+putRlpcErrs :: [MsgEnvelope RlpcError] -> IO ()
 putRlpcErrs = traverse_ print
 
-liftErrorful :: (Monad m, IsRlpcError e) => ErrorfulT e m a -> RLPCT m a
-liftErrorful e = RLPCT $ lift (liftRlpcErrors e)
+liftErrorful :: (Monad m, IsRlpcError e) => ErrorfulT (MsgEnvelope e) m a -> RLPCT m a
+liftErrorful e = RLPCT $ lift (fmap liftRlpcError `mapErrorful` e)
 
 data RLPCOptions = RLPCOptions
     { _rlpcLogFile     :: Maybe FilePath
diff --git a/src/Compiler/RlpcError.hs b/src/Compiler/RlpcError.hs
index 168ad17..2d748af 100644
--- a/src/Compiler/RlpcError.hs
+++ b/src/Compiler/RlpcError.hs
@@ -26,7 +26,7 @@ data MsgEnvelope e = MsgEnvelope
    , _msgDiagnostic  :: e
    , _msgSeverity    :: Severity
    }
-   deriving Functor
+   deriving (Functor, Show)
 
 newtype RlpcError = Text [Text]
     deriving Show
@@ -48,6 +48,7 @@ data SrcSpan = SrcSpan
     !Int -- ^ Line
     !Int -- ^ Column
     !Int -- ^ Length
+    deriving Show
 
 makeLenses ''MsgEnvelope
 
diff --git a/src/Core/HindleyMilner.hs b/src/Core/HindleyMilner.hs
index ba9e987..4cffcca 100644
--- a/src/Core/HindleyMilner.hs
+++ b/src/Core/HindleyMilner.hs
@@ -101,9 +101,9 @@ checkCoreProg p = scDefs
 
 -- | @checkCoreProgR p@ returns @p@ if @p@ successfully typechecks.
 checkCoreProgR :: Program' -> RLPC Program'
-checkCoreProgR p = do
-    liftErrorful (checkCoreProg p)
-    pure p
+checkCoreProgR p = undefined
+
+{-# WARNING checkCoreProgR "unimpl" #-}
 
 -- | Infer the type of an expression under some context.
 --