Diagnostics refactor

1 files changed, 42 insertions, 0 deletions

diff --git a/src/HSVIS/Diagnostic.hs b/src/HSVIS/Diagnostic.hs
new file mode 100644
index 0000000..75a677f
--- /dev/null
+++ b/src/HSVIS/Diagnostic.hs
@@ -0,0 +1,42 @@
+module HSVIS.Diagnostic where
+
+import Data.List (intercalate)
+
+
+data Pos = Pos
+  { posLine :: Int  -- ^ zero-based
+  , posCol :: Int   -- ^ zero-based
+  }
+  deriving (Show)
+
+-- | Inclusive-exclusive range of positions in a file.
+data Range = Range Pos Pos
+  deriving (Show)
+
+data Diagnostic = Diagnostic
+  { 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
+  , dMsg :: String         -- ^ The error message
+  }
+  deriving (Show)
+
+printDiagnostic :: Diagnostic -> String
+printDiagnostic (Diagnostic fp (Range (Pos y1 x1) (Pos y2 x2)) stk srcline msg) =
+  let linenum = show (y1 + 1)
+      locstr | y1 == y2, x1 == x2 = show y1 ++ ":" ++ show x1
+             | y1 == y2           = show y1 ++ ":" ++ show x1 ++ "-" ++ show x2
+             | otherwise          = "(" ++ show y1 ++ ":" ++ show x1 ++ ")-(" ++
+                                      show y1 ++ ":" ++ show x1 ++ ")"
+      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 ++ " |"
+         ,linenum ++ " | " ++ srcline
+         ,map (\_ -> ' ') linenum ++ " | " ++ replicate x1 ' ' ++
+            replicate ncarets '^' ++ caretsuffix]