git.iko.soy/elk
on f91bfde help sign in
elk/compiler/src/Reporting/Render/Code.hs
288 lines 7.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Render.Code
4 ( Source
5 , toSource
6 , toSnippet
7 , toPair
8 , Next(..)
9 , whatIsNext
10 , nextLineStartsWithKeyword
11 , nextLineStartsWithCloseCurly
12 )
13 where
16import qualified Data.ByteString as B
17import qualified Data.ByteString.UTF8 as UTF8_BS
18import qualified Data.Char as Char
19import qualified Data.IntSet as IntSet
20import qualified Data.List as List
21import qualified Data.Name as Name
22import qualified Data.Set as Set
23import Data.Word (Word16)
25import qualified Reporting.Annotation as A
26import qualified Reporting.Doc as D
27import Reporting.Doc (Doc)
28import Parse.Primitives (Row, Col)
29import Parse.Symbol (binopCharSet)
30import Parse.Variable (reservedWords)
34-- CODE
37newtype Source =
38 Source [(Word16, String)]
41toSource :: B.ByteString -> Source
42toSource source =
43 Source $ zip [1..] $
44 lines (UTF8_BS.toString source) ++ [""]
48-- CODE FORMATTING
51toSnippet :: Source -> A.Region -> Maybe A.Region -> (D.Doc, D.Doc) -> D.Doc
52toSnippet source region highlight (preHint, postHint) =
53 D.vcat
54 [ preHint
55 , ""
56 , render source region highlight
57 , postHint
58 ]
61toPair :: Source -> A.Region -> A.Region -> (D.Doc, D.Doc) -> (D.Doc, D.Doc, D.Doc) -> D.Doc
62toPair source r1 r2 (oneStart, oneEnd) (twoStart, twoMiddle, twoEnd) =
63 case renderPair source r1 r2 of
64 OneLine codeDocs ->
65 D.vcat
66 [ oneStart
67 , ""
68 , codeDocs
69 , oneEnd
70 ]
72 TwoChunks code1 code2 ->
73 D.vcat
74 [ twoStart
75 , ""
76 , code1
77 , twoMiddle
78 , ""
79 , code2
80 , twoEnd
81 ]
85-- RENDER SNIPPET
88(|>) :: a -> (a -> b) -> b
89(|>) a f =
90 f a
93render :: Source -> A.Region -> Maybe A.Region -> Doc
94render (Source sourceLines) region@(A.Region (A.Position startLine _) (A.Position endLine _)) maybeSubRegion =
95 let
96 relevantLines =
97 sourceLines
98 |> drop (fromIntegral (startLine - 1))
99 |> take (fromIntegral (1 + endLine - startLine))
101 width =
102 length (show (fst (last relevantLines)))
104 smallerRegion =
105 maybe region id maybeSubRegion
106 in
107 case makeUnderline width endLine smallerRegion of
108 Nothing ->
109 drawLines True width smallerRegion relevantLines D.empty
111 Just underline ->
112 drawLines False width smallerRegion relevantLines underline
115makeUnderline :: Int -> Word16 -> A.Region -> Maybe Doc
116makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end c2)) =
117 if start /= end || end < realEndLine then
118 Nothing
120 else
121 let
122 spaces = replicate (fromIntegral c1 + width + 1) ' '
123 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
124 in
125 Just (D.fromChars spaces <> D.red (D.fromChars zigzag))
128drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
129drawLines addZigZag width (A.Region (A.Position startLine _) (A.Position endLine _)) sourceLines finalLine =
130 D.vcat $
131 map (drawLine addZigZag width startLine endLine) sourceLines
132 ++ [finalLine]
135drawLine :: Bool -> Int -> Word16 -> Word16 -> (Word16, String) -> Doc
136drawLine addZigZag width startLine endLine (n, line) =
137 addLineNumber addZigZag width startLine endLine n (D.fromChars line)
140addLineNumber :: Bool -> Int -> Word16 -> Word16 -> Word16 -> Doc -> Doc
141addLineNumber addZigZag width start end n line =
142 let
143 number =
144 show n
146 lineNumber =
147 replicate (width - length number) ' ' ++ number ++ "|"
149 spacer =
150 if addZigZag && start <= n && n <= end then
151 D.red ">"
152 else
153 " "
154 in
155 D.fromChars lineNumber <> spacer <> line
159-- RENDER PAIR
162data CodePair
163 = OneLine Doc
164 | TwoChunks Doc Doc
167renderPair :: Source -> A.Region -> A.Region -> CodePair
168renderPair source@(Source sourceLines) region1 region2 =
169 let
170 (A.Region (A.Position startRow1 startCol1) (A.Position endRow1 endCol1)) = region1
171 (A.Region (A.Position startRow2 startCol2) (A.Position endRow2 endCol2)) = region2
172 in
173 if startRow1 == endRow1 && endRow1 == startRow2 && startRow2 == endRow2 then
174 let
175 lineNumber = show startRow1
176 spaces1 = replicate (fromIntegral startCol1 + length lineNumber + 1) ' '
177 zigzag1 = replicate (fromIntegral (endCol1 - startCol1)) '^'
178 spaces2 = replicate (fromIntegral (startCol2 - endCol1)) ' '
179 zigzag2 = replicate (fromIntegral (endCol2 - startCol2)) '^'
181 (Just line) = List.lookup startRow1 sourceLines
182 in
183 OneLine $
184 D.vcat
185 [ D.fromChars lineNumber <> "| " <> D.fromChars line
186 , D.fromChars spaces1 <> D.red (D.fromChars zigzag1) <>
187 D.fromChars spaces2 <> D.red (D.fromChars zigzag2)
188 ]
190 else
191 TwoChunks
192 (render source region1 Nothing)
193 (render source region2 Nothing)
197-- WHAT IS NEXT?
200data Next
201 = Keyword [Char]
202 | Operator [Char]
203 | Close [Char] Char
204 | Upper Char [Char]
205 | Lower Char [Char]
206 | Other (Maybe Char)
209whatIsNext :: Source -> Row -> Col -> Next
210whatIsNext (Source sourceLines) row col =
211 case List.lookup row sourceLines of
212 Nothing ->
213 Other Nothing
215 Just line ->
216 case drop (fromIntegral col - 1) line of
217 [] ->
218 Other Nothing
220 c:cs
221 | Char.isUpper c -> Upper c (takeWhile isInner cs)
222 | Char.isLower c -> detectKeywords c cs
223 | isSymbol c -> Operator (c : takeWhile isSymbol cs)
224 | c == ')' -> Close "parenthesis" ')'
225 | c == ']' -> Close "square bracket" ']'
226 | c == '}' -> Close "curly brace" '}'
227 | otherwise -> Other (Just c)
230detectKeywords :: Char -> [Char] -> Next
231detectKeywords c rest =
232 let
233 cs = takeWhile isInner rest
234 name = c : cs
235 in
236 if Set.member (Name.fromChars name) reservedWords
237 then Keyword name
238 else Lower c name
241isInner :: Char -> Bool
242isInner char =
243 Char.isAlphaNum char || char == '_'
246isSymbol :: Char -> Bool
247isSymbol char =
248 IntSet.member (Char.ord char) binopCharSet
251startsWithKeyword :: [Char] -> [Char] -> Bool
252startsWithKeyword restOfLine keyword =
253 List.isPrefixOf keyword restOfLine
254 &&
255 case drop (length keyword) restOfLine of
256 [] ->
257 True
259 c:_ ->
260 not (isInner c)
263nextLineStartsWithKeyword :: [Char] -> Source -> Row -> Maybe (Row, Col)
264nextLineStartsWithKeyword keyword (Source sourceLines) row =
265 case List.lookup (row + 1) sourceLines of
266 Nothing ->
267 Nothing
269 Just line ->
270 if startsWithKeyword (dropWhile (==' ') line) keyword then
271 Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))
272 else
273 Nothing
276nextLineStartsWithCloseCurly :: Source -> Row -> Maybe (Row, Col)
277nextLineStartsWithCloseCurly (Source sourceLines) row =
278 case List.lookup (row + 1) sourceLines of
279 Nothing ->
280 Nothing
282 Just line ->
283 case dropWhile (==' ') line of
284 '}':_ ->
285 Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))
287 _ ->
288 Nothing