git.iko.soy/elk
on 37e4dfe help sign in
elk/src/Reporting/Report.hs
154 lines 3.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Report
4 ( Report(Report)
5 , simple
6 , toString
7 , toJson
8 ) where
10import Data.Aeson ((.=))
11import qualified Data.Aeson.Types as Json
13import qualified Reporting.Region as R
16data Report = Report
17 { _title :: String
18 , _highlight :: Maybe R.Region
19 , _preHint :: String
20 , _postHint :: String
21 }
24simple :: String -> String -> String -> Report
25simple title pre post =
26 Report title Nothing pre post
29toString :: String -> R.Region -> Report -> String -> String
30toString location region (Report title highlight pre post) source =
31 concat
32 [ messageBar title location
33 , pre ++ "\n\n"
34 , grabRegion highlight region source ++ "\n"
35 , if null post then "\n" else post ++ "\n\n\n"
36 ]
39toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])
40toJson extraFields (Report title subregion pre post) =
41 let
42 fields =
43 [ "tag" .= title
44 , "overview" .= pre
45 , "details" .= post
46 ]
47 in
48 (subregion, fields ++ extraFields)
51-- REPORT HEADER
53messageBar :: String -> String -> String
54messageBar tag location =
55 let usedSpace = 4 + length tag + 1 + length location
56 in
57 "-- " ++ tag ++ " "
58 ++ replicate (max 1 (80 - usedSpace)) '-'
59 ++ " " ++ location ++ "\n\n"
62-- REGIONS
64grabRegion :: Maybe R.Region -> R.Region -> String -> String
65grabRegion maybeSubRegion (R.Region start end) source =
66 let
67 (R.Position startLine startColumn) = start
68 (R.Position endLine endColumn) = end
70 (|>) = flip ($)
72 relevantLines =
73 lines source
74 |> drop (startLine - 1)
75 |> take (endLine - startLine + 1)
76 in
77 case relevantLines of
78 [] ->
79 ""
81 [sourceLine] ->
82 singleLineRegion startLine sourceLine $
83 case maybeSubRegion of
84 Nothing ->
85 (0, startColumn, endColumn, length sourceLine)
87 Just (R.Region s e) ->
88 (startColumn, R.column s, R.column e, endColumn)
90 firstLine : rest ->
91 let
92 filteredFirstLine =
93 replicate (startColumn - 1) ' '
94 ++ drop (startColumn - 1) firstLine
96 filteredLastLine =
97 take (endColumn) (last rest)
99 focusedRelevantLines =
100 filteredFirstLine : init rest ++ [filteredLastLine]
102 lineNumbersWidth =
103 length (show (endLine + 1))
105 numberedLines =
106 zipWith
107 (addLineNumber maybeSubRegion lineNumbersWidth)
108 [startLine - 1 .. endLine + 1]
109 ("" : focusedRelevantLines ++ [""])
110 in
111 unlines numberedLines
114addLineNumber :: Maybe R.Region -> Int -> Int -> String -> String
115addLineNumber maybeSubRegion width n line =
116 let
117 number =
118 if n < 0 then " " else show n
120 spacer (R.Region start end) =
121 if R.line start <= n && n <= R.line end
122 then ">"
123 else " "
124 in
125 replicate (width - length number) ' ' ++ number
126 ++ "|" ++ maybe " " spacer maybeSubRegion
127 ++ line
130singleLineRegion :: Int -> String -> (Int, Int, Int, Int) -> String
131singleLineRegion lineNum sourceLine (start, innerStart, innerEnd, end) =
132 let
133 w = length (show (lineNum + 1))
135 number =
136 addLineNumber Nothing w
138 underline =
139 replicate (innerStart - 1) ' '
140 ++ replicate (max 1 (innerEnd - innerStart)) '^'
142 (|>) = flip ($)
144 trimmedSourceLine =
145 sourceLine
146 |> drop (start - 1)
147 |> take (end - start + 1)
148 |> (++) (replicate (start - 1) ' ')
149 in
150 unlines
151 [ number (lineNum-1) ""
152 , number lineNum trimmedSourceLine
153 , number (lineNum+1) underline
154 ]