git.iko.soy/elk
on e43ce3d help sign in
elk/compiler/src/Reporting/Render/Code.hs
182 lines 4.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Render.Code
4 ( Source
5 , toSource
6 , toSnippet
7 , toPair
8 )
9 where
12import qualified Data.ByteString as B
13import qualified Data.ByteString.UTF8 as UTF8_BS
14import qualified Data.List as List
15import Data.Word (Word16)
17import qualified Reporting.Annotation as A
18import qualified Reporting.Doc as D
19import Reporting.Doc (Doc)
23-- CODE
26newtype Source =
27 Source [(Word16, String)]
30toSource :: B.ByteString -> Source
31toSource source =
32 Source $ zip [1..] $
33 lines (UTF8_BS.toString source) ++ [""]
37-- CODE FORMATTING
40toSnippet :: Source -> A.Region -> Maybe A.Region -> (D.Doc, D.Doc) -> D.Doc
41toSnippet source region highlight (preHint, postHint) =
42 D.vcat
43 [ preHint
44 , ""
45 , render source region highlight
46 , postHint
47 ]
50toPair :: Source -> A.Region -> A.Region -> (D.Doc, D.Doc) -> (D.Doc, D.Doc, D.Doc) -> D.Doc
51toPair source r1 r2 (oneStart, oneEnd) (twoStart, twoMiddle, twoEnd) =
52 case renderPair source r1 r2 of
53 OneLine codeDocs ->
54 D.vcat
55 [ oneStart
56 , ""
57 , codeDocs
58 , oneEnd
59 ]
61 TwoChunks code1 code2 ->
62 D.vcat
63 [ twoStart
64 , ""
65 , code1
66 , twoMiddle
67 , ""
68 , code2
69 , twoEnd
70 ]
74-- RENDER SNIPPET
77(|>) :: a -> (a -> b) -> b
78(|>) a f =
79 f a
82render :: Source -> A.Region -> Maybe A.Region -> Doc
83render (Source sourceLines) region@(A.Region (A.Position startLine _) (A.Position endLine _)) maybeSubRegion =
84 let
85 relevantLines =
86 sourceLines
87 |> drop (fromIntegral (startLine - 1))
88 |> take (fromIntegral (1 + endLine - startLine))
90 width =
91 length (show (fst (last relevantLines)))
93 smallerRegion =
94 maybe region id maybeSubRegion
95 in
96 case makeUnderline width endLine smallerRegion of
97 Nothing ->
98 drawLines True width smallerRegion relevantLines D.empty
100 Just underline ->
101 drawLines False width smallerRegion relevantLines underline
104makeUnderline :: Int -> Word16 -> A.Region -> Maybe Doc
105makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end c2)) =
106 if start /= end || end < realEndLine then
107 Nothing
109 else
110 let
111 spaces = replicate (fromIntegral c1 + width + 1) ' '
112 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
113 in
114 Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))
117drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
118drawLines addZigZag width (A.Region (A.Position startLine _) (A.Position endLine _)) sourceLines finalLine =
119 D.vcat $
120 map (drawLine addZigZag width startLine endLine) sourceLines
121 ++ [finalLine]
124drawLine :: Bool -> Int -> Word16 -> Word16 -> (Word16, String) -> Doc
125drawLine addZigZag width startLine endLine (n, line) =
126 addLineNumber addZigZag width startLine endLine n (D.fromChars line)
129addLineNumber :: Bool -> Int -> Word16 -> Word16 -> Word16 -> Doc -> Doc
130addLineNumber addZigZag width start end n line =
131 let
132 number =
133 show n
135 lineNumber =
136 replicate (width - length number) ' ' ++ number ++ "|"
138 spacer =
139 if addZigZag && start <= n && n <= end then
140 D.dullred ">"
141 else
142 " "
143 in
144 D.fromChars lineNumber <> spacer <> line
148-- RENDER PAIR
151data CodePair
152 = OneLine Doc
153 | TwoChunks Doc Doc
156renderPair :: Source -> A.Region -> A.Region -> CodePair
157renderPair source@(Source sourceLines) region1 region2 =
158 let
159 (A.Region (A.Position startRow1 startCol1) (A.Position endRow1 endCol1)) = region1
160 (A.Region (A.Position startRow2 startCol2) (A.Position endRow2 endCol2)) = region2
161 in
162 if startRow1 == endRow1 && endRow1 == startRow2 && startRow2 == endRow2 then
163 let
164 lineNumber = show startRow1
165 spaces1 = replicate (fromIntegral startCol1 + length lineNumber + 1) ' '
166 zigzag1 = replicate (fromIntegral (endCol1 - startCol1)) '^'
167 spaces2 = replicate (fromIntegral (startCol2 - endCol1)) ' '
168 zigzag2 = replicate (fromIntegral (endCol2 - startCol2)) '^'
170 (Just line) = List.lookup startRow1 sourceLines
171 in
172 OneLine $
173 D.vcat
174 [ D.fromChars lineNumber <> "| " <> D.fromChars line
175 , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>
176 D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)
177 ]
179 else
180 TwoChunks
181 (render source region1 Nothing)
182 (render source region2 Nothing)