export new listErrors & listWarnings API functions

2 files changed, 9 insertions, 2 deletions

diff --git a/src/LambdaCube/Compiler.hs b/src/LambdaCube/Compiler.hs
index bc34a088..a61686ff 100644
--- a/src/LambdaCube/Compiler.hs
+++ b/src/LambdaCube/Compiler.hs
@@ -50,7 +50,7 @@ import LambdaCube.Compiler.CoreToIR
 import LambdaCube.Compiler.Utils
 import LambdaCube.Compiler.DesugaredSource as Exported (FileInfo(..), Range(..), SPos(..), pattern SPos, SIName(..), pattern SIName, sName, SI(..))
 import LambdaCube.Compiler.Core as Exported (mkDoc, Exp, ExpType(..), pattern ET, outputType, boolType, trueExp, hnf)
-import LambdaCube.Compiler.InferMonad as Exported (errorRange, listAllInfos, listAllInfos', listTypeInfos, listTraceInfos, Infos, Info(..))
+import LambdaCube.Compiler.InferMonad as Exported (errorRange, listAllInfos, listAllInfos', listTypeInfos, listErrors, listWarnings, listTraceInfos, Infos, Info(..))
 --import LambdaCube.Compiler.Infer as Exported ()
 
 -- inlcude path for: Builtins, Internals and Prelude
diff --git a/src/LambdaCube/Compiler/InferMonad.hs b/src/LambdaCube/Compiler/InferMonad.hs
index 8d46f7c7..1905c839 100644
--- a/src/LambdaCube/Compiler/InferMonad.hs
+++ b/src/LambdaCube/Compiler/InferMonad.hs
@@ -30,7 +30,7 @@ import Control.Arrow hiding ((<+>))
 import LambdaCube.Compiler.DeBruijn
 import LambdaCube.Compiler.Pretty hiding (braces, parens)
 import LambdaCube.Compiler.DesugaredSource hiding (getList)
-import LambdaCube.Compiler.Parser (ParseWarning) -- TODO: remove
+import LambdaCube.Compiler.Parser (ParseWarning (..))
 import LambdaCube.Compiler.Core
 
 -------------------------------------------------------------------------------- error messages
@@ -97,6 +97,13 @@ listAllInfos' f m
 
 listTraceInfos m = [DResetFreshNames $ pShow i | i <- m, case i of Info{} -> False; ParseWarning{} -> False; _ -> True]
 listTypeInfos m = Map.toList $ Map.unionsWith (<>) [Map.singleton r [DResetFreshNames i] | Info r i <- m]
+listErrors m = Map.toList $ Map.unionsWith (<>) [Map.singleton r [DResetFreshNames (pShow e)] | IError e <- m, RangeSI r <- errorRange_ e]
+listWarnings m = Map.toList $ Map.unionsWith (<>) [Map.singleton r [DResetFreshNames msg] | ParseWarning (getRangeAndMsg -> Just (r, msg)) <- m]
+  where
+    getRangeAndMsg = \case
+        Unreachable r -> Just (r, "Unreachable")
+        w@(Uncovered (getRange . sourceInfo -> Just r) _) -> Just (r, pShow w)
+        _ -> Nothing
 
 tellType si t = tell $ mkInfoItem (sourceInfo si) $ DTypeNamespace True $ pShow t