blob: 322f9eb26ed151d4d919931a1d0236f1950f4d35 (
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
43
44
45
|
module HSVIS.Diagnostic where
import Data.List (intercalate)
data Pos = Pos
{ posLine :: Int -- ^ zero-based
, posCol :: Int -- ^ zero-based
}
deriving (Show, Eq, Ord)
-- | Inclusive-exclusive range of positions in a file.
data Range = Range Pos Pos
deriving (Show)
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
, 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]
|
