git.iko.soy/elk
on 1c3cda7 help sign in
elk/src/Reporting/Render/Code.hs
153 lines 3.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Render.Code
4 ( Source
5 , toSource
6 , render
7 , CodePair(..)
8 , renderPair
9 )
10 where
13import qualified Data.List as List
14import qualified Data.Text as Text
15import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), hardline, dullred, empty, text)
17import qualified Reporting.Region as R
21-- CODE
24newtype Source =
25 Source [(Int, Text.Text)]
28toSource :: Text.Text -> Source
29toSource source =
30 Source $ zip [1..] $
31 Text.lines source ++ [Text.empty]
35-- RENDER
38(|>) :: a -> (a -> b) -> b
39(|>) a f =
40 f a
43(<==>) :: Doc -> Doc -> Doc
44(<==>) a b =
45 a <> hardline <> b
48render :: Source -> R.Region -> Maybe R.Region -> Doc
49render (Source sourceLines) region@(R.Region start end) maybeSubRegion =
50 let
51 (R.Position startLine _) = start
52 (R.Position endLine _) = end
54 relevantLines =
55 sourceLines
56 |> drop (startLine - 1)
57 |> take (1 + endLine - startLine)
59 width =
60 length (show (fst (last relevantLines)))
62 smallerRegion =
63 maybe region id maybeSubRegion
64 in
65 case makeUnderline width endLine smallerRegion of
66 Nothing ->
67 drawLines True width smallerRegion relevantLines empty
69 Just underline ->
70 drawLines False width smallerRegion relevantLines underline
73makeUnderline :: Int -> Int -> R.Region -> Maybe Doc
74makeUnderline width realEndLine (R.Region (R.Position start c1) (R.Position end c2)) =
75 if start /= end || end < realEndLine then
76 Nothing
78 else
79 let
80 spaces = replicate (c1 + width + 1) ' '
81 zigzag = replicate (max 1 (c2 - c1)) '^'
82 in
83 Just (text spaces <> dullred (text zigzag))
86drawLines :: Bool -> Int -> R.Region -> [(Int, Text.Text)] -> Doc -> Doc
87drawLines addZigZag width (R.Region start end) sourceLines finalLine =
88 let
89 (R.Position startLine _) = start
90 (R.Position endLine _) = end
91 in
92 foldr (<==>) finalLine $
93 map (drawLine addZigZag width startLine endLine) sourceLines
96drawLine :: Bool -> Int -> Int -> Int -> (Int, Text.Text) -> Doc
97drawLine addZigZag width startLine endLine (n, line) =
98 addLineNumber addZigZag width startLine endLine n (text (Text.unpack line))
101addLineNumber :: Bool -> Int -> Int -> Int -> Int -> Doc -> Doc
102addLineNumber addZigZag width start end n line =
103 let
104 number =
105 if n < 0 then " " else show n
107 lineNumber =
108 replicate (width - length number) ' ' ++ number ++ "|"
110 spacer =
111 if addZigZag && start <= n && n <= end then
112 dullred ">"
113 else
114 " "
115 in
116 text lineNumber <> spacer <> line
120-- RENDER PAIR
123data CodePair
124 = OneLine Doc
125 | TwoChunks Doc Doc
128renderPair :: Source -> R.Region -> R.Region -> CodePair
129renderPair source@(Source sourceLines) region1 region2 =
130 let
131 (R.Region (R.Position startRow1 startCol1) (R.Position endRow1 endCol1)) = region1
132 (R.Region (R.Position startRow2 startCol2) (R.Position endRow2 endCol2)) = region2
133 in
134 if startRow1 == endRow1 && endRow1 == startRow2 && startRow2 == endRow2 then
135 let
136 lineNumber = show startRow1
137 spaces1 = replicate (startCol1 + length lineNumber + 1) ' '
138 zigzag1 = replicate (endCol1 - startCol1) '^'
139 spaces2 = replicate (startCol2 - endCol1) ' '
140 zigzag2 = replicate (endCol2 - startCol2) '^'
142 (Just line) = List.lookup startRow1 sourceLines
143 in
144 OneLine $
145 text lineNumber <> "|" <> text (Text.unpack line)
146 <> hardline
147 <> text spaces1 <> dullred (text zigzag1)
148 <> text spaces2 <> dullred (text zigzag2)
150 else
151 TwoChunks
152 (render source region1 Nothing)
153 (render source region2 Nothing)