From 909b7a4eacaba7323ac44f7950e60e8956e4081c Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Fri, 22 Mar 2024 21:56:35 +0100
Subject: Working kind inference

---
 src/HSVIS/Diagnostic.hs | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

(limited to 'src/HSVIS/Diagnostic.hs')

diff --git a/src/HSVIS/Diagnostic.hs b/src/HSVIS/Diagnostic.hs
index 675482d..778fe34 100644
--- a/src/HSVIS/Diagnostic.hs
+++ b/src/HSVIS/Diagnostic.hs
@@ -27,9 +27,13 @@ instance Pretty Range where
     | y2 <= y1 + 1               = showString (show (y1 + 1) ++ ":" ++ show (x1 + 1) ++ "-" ++ show x2)
     | otherwise                  =
         showString ("(" ++ show (y1 + 1) ++ ":" ++ show (x1 + 1) ++ ")-(" ++ show (y2 + 1) ++ ":" ++ show x2 ++ ")") 
+
+data Severity = SError | SWarning
+  deriving (Show)
                                                                            
 data Diagnostic = Diagnostic                                               
-  { dFile :: FilePath      -- ^ The file for which the diagnostic was rai  sed
+  { dSeverity :: Severity  -- ^ Error level
+  , dFile :: FilePath      -- ^ The file for which the diagnostic was raised
   , dRange :: Range        -- ^ Where in the file
   , dStk :: [String]       -- ^ Stack of contexts (innermost at head) of the diagnostic
   , dSourceLine :: String  -- ^ The line in the source file of the start of the range
@@ -38,17 +42,23 @@ data Diagnostic = Diagnostic
   deriving (Show)
 
 printDiagnostic :: Diagnostic -> String
-printDiagnostic (Diagnostic fp rng@(Range (Pos y1 x1) (Pos y2 x2)) stk srcline msg) =
+printDiagnostic (Diagnostic sev fp rng@(Range (Pos y1 x1) (Pos y2 x2)) stk srcline msg) =
   let linenum = show (y1 + 1)
       locstr = pretty rng
       ncarets | y1 == y2  = max 1 (x2 - x1 + 1)
               | otherwise = length srcline - x1
       caretsuffix | y1 == y2  = ""
                   | otherwise = "..."
-  in intercalate "\n" $
-      map (\descr -> "In " ++ descr ++ ":") (reverse stk)
-      ++ [fp ++ ":" ++ locstr ++ ": " ++ msg
-         ,map (\_ -> ' ') linenum ++ " |"
+
+      mainLine =
+        (case sev of SError -> "Error: "
+                     SWarning -> "Warning: ")
+        ++ fp ++ ":" ++ locstr ++ ": " ++ msg
+      revCtxTrace = reverse $ map (\(i, descr) -> "in " ++ descr ++ (if i == 0 then "" else ","))
+                                  (zip [0::Int ..] (reverse stk))
+      srcPointer =
+         [map (\_ -> ' ') linenum ++ " |"
          ,linenum ++ " | " ++ srcline
          ,map (\_ -> ' ') linenum ++ " | " ++ replicate x1 ' ' ++
             replicate ncarets '^' ++ caretsuffix]
+  in intercalate "\n" $ [mainLine] ++ srcPointer ++ revCtxTrace
-- 
cgit v1.2.3-70-g09d2