aboutsummaryrefslogtreecommitdiff
path: root/src/HSVIS/Diagnostic.hs
blob: 75a677f666977455063181c72015cac3fd4b2fa2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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]