on d5da02e help sign in
elk/src/Reporting/Report.hs
132 lines 3.4 kB history raw
1module Reporting.Report
2 ( Report(Report)
3 , simple
4 , toString
5 ) where
7import Elm.Utils ((|>))
8import qualified Reporting.Region as R
11data Report = Report
12 { highlight :: Maybe R.Region
13 , preHint :: String
14 , postHint :: String
15 }
18simple :: String -> String -> Report
19simple pre post =
20 Report Nothing pre post
23toString :: String -> String -> R.Region -> Report -> String -> String
24toString tag location region report source =
25 concat
26 [ messageBar tag location
27 , preHint report ++ "\n\n"
28 , grabRegion (highlight report) region source ++ "\n"
29 , postHint report ++ "\n\n\n"
30 ]
33-- REPORT HEADER
35messageBar :: String -> String -> String
36messageBar tag location =
37 let usedSpace = 4 + length tag + 1 + length location
38 in
39 "-- " ++ tag ++ " "
40 ++ replicate (max 1 (80 - usedSpace)) '-'
41 ++ " " ++ location ++ "\n\n"
44-- REGIONS
46grabRegion :: Maybe R.Region -> R.Region -> String -> String
47grabRegion maybeSubRegion (R.Region start end) source =
48 let
49 (R.Position startLine startColumn) = start
50 (R.Position endLine endColumn) = end
52 relevantLines =
53 lines source
54 |> drop (startLine - 1)
55 |> take (endLine - startLine + 1)
56 in
57 case relevantLines of
58 [] ->
59 error "something has gone badly wrong with reporting source locations"
61 [sourceLine] ->
62 singleLineRegion startLine sourceLine $
63 case maybeSubRegion of
64 Nothing ->
65 (0, startColumn, endColumn, length sourceLine)
67 Just (R.Region s e) ->
68 (startColumn, R.column s, R.column e, endColumn)
70 firstLine : rest ->
71 let
72 filteredFirstLine =
73 replicate (startColumn - 1) ' '
74 ++ drop (startColumn - 1) firstLine
76 filteredLastLine =
77 take (endColumn) (last rest)
79 focusedRelevantLines =
80 filteredFirstLine : init rest ++ [filteredLastLine]
82 lineNumbersWidth =
83 length (show (endLine + 1))
85 numberedLines =
86 zipWith
87 (addLineNumber maybeSubRegion lineNumbersWidth)
88 [startLine - 1 .. endLine + 1]
89 ("" : focusedRelevantLines ++ [""])
90 in
91 unlines numberedLines
94addLineNumber :: Maybe R.Region -> Int -> Int -> String -> String
95addLineNumber maybeSubRegion width n line =
96 let
97 number =
98 if n < 0 then " " else show n
100 spacer (R.Region start end) =
101 if R.line start <= n && n <= R.line end
102 then ">"
103 else " "
104 in
105 replicate (width - length number) ' ' ++ number
106 ++ "|" ++ maybe " " spacer maybeSubRegion
107 ++ line
110singleLineRegion :: Int -> String -> (Int, Int, Int, Int) -> String
111singleLineRegion lineNum sourceLine (start, innerStart, innerEnd, end) =
112 let
113 w = length (show (lineNum + 1))
115 number =
116 addLineNumber Nothing w
118 underline =
119 replicate (innerStart - 1) ' '
120 ++ replicate (max 1 (innerEnd - innerStart)) '^'
122 trimmedSourceLine =
123 sourceLine
124 |> drop (start - 1)
125 |> take (end - start + 1)
126 |> (++) (replicate (start - 1) ' ')
127 in
128 unlines
129 [ number (lineNum-1) ""
130 , number lineNum trimmedSourceLine
131 , number (lineNum+1) underline
132 ]