git.iko.soy/elk
on df0fb5d help sign in
elk/src/Reporting/Report.hs
151 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 Elm.Utils ((|>))
14import qualified Reporting.Region as R
17data Report = Report
18 { _title :: String
19 , _highlight :: Maybe R.Region
20 , _preHint :: String
21 , _postHint :: String
22 }
25simple :: String -> String -> String -> Report
26simple title pre post =
27 Report title Nothing pre post
30toString :: String -> R.Region -> Report -> String -> String
31toString location region (Report title highlight pre post) source =
32 concat
33 [ messageBar title location
34 , pre ++ "\n\n"
35 , grabRegion highlight region source ++ "\n"
36 , if null post then "\n" else post ++ "\n\n\n"
37 ]
40toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])
41toJson extraFields (Report title subregion pre post) =
42 let
43 fields =
44 [ "tag" .= title
45 , "overview" .= pre
46 , "details" .= post
47 ]
48 in
49 (subregion, fields ++ extraFields)
52-- REPORT HEADER
54messageBar :: String -> String -> String
55messageBar tag location =
56 let usedSpace = 4 + length tag + 1 + length location
57 in
58 "-- " ++ tag ++ " "
59 ++ replicate (max 1 (80 - usedSpace)) '-'
60 ++ " " ++ location ++ "\n\n"
63-- REGIONS
65grabRegion :: Maybe R.Region -> R.Region -> String -> String
66grabRegion maybeSubRegion (R.Region start end) source =
67 let
68 (R.Position startLine startColumn) = start
69 (R.Position endLine endColumn) = end
71 relevantLines =
72 lines source
73 |> drop (startLine - 1)
74 |> take (endLine - startLine + 1)
75 in
76 case relevantLines of
77 [] ->
78 ""
80 [sourceLine] ->
81 singleLineRegion startLine sourceLine $
82 case maybeSubRegion of
83 Nothing ->
84 (0, startColumn, endColumn, length sourceLine)
86 Just (R.Region s e) ->
87 (startColumn, R.column s, R.column e, endColumn)
89 firstLine : rest ->
90 let
91 filteredFirstLine =
92 replicate (startColumn - 1) ' '
93 ++ drop (startColumn - 1) firstLine
95 filteredLastLine =
96 take (endColumn) (last rest)
98 focusedRelevantLines =
99 filteredFirstLine : init rest ++ [filteredLastLine]
101 lineNumbersWidth =
102 length (show (endLine + 1))
104 numberedLines =
105 zipWith
106 (addLineNumber maybeSubRegion lineNumbersWidth)
107 [startLine - 1 .. endLine + 1]
108 ("" : focusedRelevantLines ++ [""])
109 in
110 unlines numberedLines
113addLineNumber :: Maybe R.Region -> Int -> Int -> String -> String
114addLineNumber maybeSubRegion width n line =
115 let
116 number =
117 if n < 0 then " " else show n
119 spacer (R.Region start end) =
120 if R.line start <= n && n <= R.line end
121 then ">"
122 else " "
123 in
124 replicate (width - length number) ' ' ++ number
125 ++ "|" ++ maybe " " spacer maybeSubRegion
126 ++ line
129singleLineRegion :: Int -> String -> (Int, Int, Int, Int) -> String
130singleLineRegion lineNum sourceLine (start, innerStart, innerEnd, end) =
131 let
132 w = length (show (lineNum + 1))
134 number =
135 addLineNumber Nothing w
137 underline =
138 replicate (innerStart - 1) ' '
139 ++ replicate (max 1 (innerEnd - innerStart)) '^'
141 trimmedSourceLine =
142 sourceLine
143 |> drop (start - 1)
144 |> take (end - start + 1)
145 |> (++) (replicate (start - 1) ' ')
146 in
147 unlines
148 [ number (lineNum-1) ""
149 , number lineNum trimmedSourceLine
150 , number (lineNum+1) underline
151 ]