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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
module Error.Pretty (
showError
, Options (..)
, defaults
) where
import Data.List (intercalate, nub)
import Error.Base (LispError (..))
import Text.Parsec
import Text.Parsec.Error
import Text.Parsec.Pos
import Text.Parsec.String (Parser)
import Text.ParserCombinators.Parsec
data Options =
Options
{ color :: Bool
, contextLineCount :: Int
, loudEscapeCode :: String
, softEscapeCode :: String
}
defaults :: Options
defaults =
Options True 1 "\ESC[31m" "\ESC[38;5;240m"
showError :: Options -> String -> LispError -> String
showError (Options color clc lec sec) source (Parse error) =
let
-- Colors
dull = if color then "\ESC[0m" else ""
loud = if color then lec else ""
soft = if color then sec else ""
-- Helper functions
spaces n = replicate n ' '
pad n s = spaces (n - length s) ++ s
joinOr [] = ""
joinOr [s] = s
joinOr [s,t] = s ++ " or " ++ t
joinOr (s:t:u) = s ++ ", " ++ joinOr (t:u)
-- Data about the error
msgs = errorMessages error
pos = errorPos error
name = sourceName pos
y = sourceLine pos - 1
x = sourceColumn pos - 1
sourceLines = lines source
address = name ++ ":" ++ show (y + 1) ++ ":" ++ show (x + 1)
-- Message display
showMsg (SysUnExpect s) = "unexpected " ++ s
showMsg (UnExpect s) = "unexpected " ++ s
showMsg (Expect s) = "expected " ++ s
showMsg (Message s) = s
showMsgs [] = "unknown parse error"
showMsgs [m] = showMsg m
showMsgs (m:ms) = showMsg m ++ "\n" ++ showMsgs ms
unexpections = joinOr $ nub $ [s | SysUnExpect s <- msgs, s /= ""]
++ [s | UnExpect s <- msgs, s /= ""]
expections = joinOr $ nub [s | Expect s <- msgs, s /= ""]
cleanMsgs = [UnExpect unexpections | unexpections /= ""]
++ [Expect expections | expections /= ""]
++ nub [Message s | Message s <- msgs]
-- Margin display
marginSize = max 3 $ length $ show $ length sourceLines
margin l r = soft ++ pad marginSize l ++ " | " ++ dull ++ r
number i = margin (show i)
numbered = zipWith number [1..] sourceLines
-- Explanation display
-- (Wrap lines to "not much more than 50 chars" at any indentation.)
-- (The wrapping is for readability, not to meet a term width)
continue = margin ""
pointer = continue (spaces x) ++ loud ++ "^-- "
newline = dull ++ "\n" ++ continue (spaces (x + 4)) ++ loud
wrap n [] = dull
wrap n (w:ws) | n >= 50 = newline ++ w ++ wrap (length w) ws
| otherwise = " " ++ w ++ wrap (n + length w + 1) ws
msgLines = lines (showMsgs cleanMsgs)
wrappedLines = map (drop 1 . wrap 0 . words) msgLines
explanationBody = intercalate newline wrappedLines
explanation = pointer ++ explanationBody
-- Final output
flower = replicate marginSize '-' ++ "-> "
header = soft ++ flower ++ address ++ dull
before = drop (y - clc) $ take y numbered
focused = numbered !! y
after = take clc $ drop (y + 1) numbered
in
unlines $ header : before ++ (focused : explanation : after)
showError _ _ err = show err
|
