on dca97ae help sign in
elk/src/Reporting/Report.hs
133 lines 3.3 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 { title :: String
13 , highlight :: Maybe R.Region
14 , preHint :: String
15 , postHint :: String
16 }
19simple :: String -> String -> String -> Report
20simple title pre post =
21 Report title Nothing pre post
24toString :: String -> R.Region -> Report -> String -> String
25toString location region report source =
26 concat
27 [ messageBar (title report) location
28 , preHint report ++ "\n\n"
29 , grabRegion (highlight report) region source ++ "\n"
30 , postHint report ++ "\n\n\n"
31 ]
34-- REPORT HEADER
36messageBar :: String -> String -> String
37messageBar tag location =
38 let usedSpace = 4 + length tag + 1 + length location
39 in
40 "-- " ++ tag ++ " "
41 ++ replicate (max 1 (80 - usedSpace)) '-'
42 ++ " " ++ location ++ "\n\n"
45-- REGIONS
47grabRegion :: Maybe R.Region -> R.Region -> String -> String
48grabRegion maybeSubRegion (R.Region start end) source =
49 let
50 (R.Position startLine startColumn) = start
51 (R.Position endLine endColumn) = end
53 relevantLines =
54 lines source
55 |> drop (startLine - 1)
56 |> take (endLine - startLine + 1)
57 in
58 case relevantLines of
59 [] ->
60 ""
62 [sourceLine] ->
63 singleLineRegion startLine sourceLine $
64 case maybeSubRegion of
65 Nothing ->
66 (0, startColumn, endColumn, length sourceLine)
68 Just (R.Region s e) ->
69 (startColumn, R.column s, R.column e, endColumn)
71 firstLine : rest ->
72 let
73 filteredFirstLine =
74 replicate (startColumn - 1) ' '
75 ++ drop (startColumn - 1) firstLine
77 filteredLastLine =
78 take (endColumn) (last rest)
80 focusedRelevantLines =
81 filteredFirstLine : init rest ++ [filteredLastLine]
83 lineNumbersWidth =
84 length (show (endLine + 1))
86 numberedLines =
87 zipWith
88 (addLineNumber maybeSubRegion lineNumbersWidth)
89 [startLine - 1 .. endLine + 1]
90 ("" : focusedRelevantLines ++ [""])
91 in
92 unlines numberedLines
95addLineNumber :: Maybe R.Region -> Int -> Int -> String -> String
96addLineNumber maybeSubRegion width n line =
97 let
98 number =
99 if n < 0 then " " else show n
101 spacer (R.Region start end) =
102 if R.line start <= n && n <= R.line end
103 then ">"
104 else " "
105 in
106 replicate (width - length number) ' ' ++ number
107 ++ "|" ++ maybe " " spacer maybeSubRegion
108 ++ line
111singleLineRegion :: Int -> String -> (Int, Int, Int, Int) -> String
112singleLineRegion lineNum sourceLine (start, innerStart, innerEnd, end) =
113 let
114 w = length (show (lineNum + 1))
116 number =
117 addLineNumber Nothing w
119 underline =
120 replicate (innerStart - 1) ' '
121 ++ replicate (max 1 (innerEnd - innerStart)) '^'
123 trimmedSourceLine =
124 sourceLine
125 |> drop (start - 1)
126 |> take (end - start + 1)
127 |> (++) (replicate (start - 1) ' ')
128 in
129 unlines
130 [ number (lineNum-1) ""
131 , number lineNum trimmedSourceLine
132 , number (lineNum+1) underline
133 ]