Typecheck work; solver is incorrect

1 files changed, 16 insertions, 7 deletions

diff --git a/src/HSVIS/Diagnostic.hs b/src/HSVIS/Diagnostic.hs
index 322f9eb..675482d 100644
--- a/src/HSVIS/Diagnostic.hs
+++ b/src/HSVIS/Diagnostic.hs
@@ -2,6 +2,8 @@ module HSVIS.Diagnostic where
 
 import Data.List (intercalate)
 
+import HSVIS.Pretty
+
 
 data Pos = Pos
   { posLine :: Int  -- ^ zero-based
@@ -9,6 +11,9 @@ data Pos = Pos
   }
   deriving (Show, Eq, Ord)
 
+instance Pretty Pos where
+  prettysPrec _ (Pos y x) = showString (show (y + 1) ++ ":" ++ show (x + 1))
+
 -- | Inclusive-exclusive range of positions in a file.
 data Range = Range Pos Pos
   deriving (Show)
@@ -16,8 +21,15 @@ data Range = Range Pos Pos
 instance Semigroup Range where
   Range a b <> Range c d = Range (min a c) (max b d)
 
-data Diagnostic = Diagnostic
-  { dFile :: FilePath      -- ^ The file for which the diagnostic was raised
+instance Pretty Range where
+  prettysPrec _ (Range (Pos y1 x1) (Pos y2 x2))
+    | y2 <= y1 + 1, x2 <= x1 + 1 = showString (show (y1 + 1) ++ ":" ++ show (x1 + 1))
+    | 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 Diagnostic = Diagnostic                                               
+  { dFile :: FilePath      -- ^ The file for which the diagnostic was rai  sed
   , 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
@@ -26,12 +38,9 @@ data Diagnostic = Diagnostic
   deriving (Show)
 
 printDiagnostic :: Diagnostic -> String
-printDiagnostic (Diagnostic fp (Range (Pos y1 x1) (Pos y2 x2)) stk srcline msg) =
+printDiagnostic (Diagnostic fp rng@(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 ++ ")"
+      locstr = pretty rng
       ncarets | y1 == y2  = max 1 (x2 - x1 + 1)
               | otherwise = length srcline - x1
       caretsuffix | y1 == y2  = ""