blob: 675482d1e93e4fa22fbc2546ff3cf38f253cf75f (
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
46
47
48
49
50
51
52
53
54
|
module HSVIS.Diagnostic where
import Data.List (intercalate)
import HSVIS.Pretty
data Pos = Pos
{ posLine :: Int -- ^ zero-based
, posCol :: Int -- ^ zero-based
}
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)
instance Semigroup Range where
Range a b <> Range c d = Range (min a c) (max b d)
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
, dMsg :: String -- ^ The error message
}
deriving (Show)
printDiagnostic :: Diagnostic -> String
printDiagnostic (Diagnostic 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 ++ " |"
,linenum ++ " | " ++ srcline
,map (\_ -> ' ') linenum ++ " | " ++ replicate x1 ' ' ++
replicate ncarets '^' ++ caretsuffix]
|
