git.iko.soy/elk
on 11ffbf5 help sign in
elk/compiler/src/Reporting/Render/Code.hs
277 lines 6.9 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.dullred (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.dullred ">"
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.dullred (D.fromChars zigzag1) <>
187 D.fromChars spaces2 <> D.dullred (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 | Other (Maybe Char)
207whatIsNext :: Source -> Row -> Col -> Next
208whatIsNext (Source sourceLines) row col =
209 case List.lookup row sourceLines of
210 Nothing ->
211 Other Nothing
213 Just line ->
214 let
215 chars = drop (fromIntegral col - 1) line
216 keywords = map Name.toChars (Set.toList reservedWords)
217 in
218 case List.find (startsWithKeyword chars) keywords of
219 Just keyword ->
220 Keyword keyword
222 Nothing ->
223 case chars of
224 [] ->
225 Other Nothing
227 c:cs
228 | isSymbol c -> Operator (c : takeWhile isSymbol cs)
229 | c == ')' -> Close "parenthesis" ')'
230 | c == ']' -> Close "square bracket" ']'
231 | c == '}' -> Close "curly brace" '}'
232 | otherwise -> Other (Just c)
235isSymbol :: Char -> Bool
236isSymbol char =
237 IntSet.member (Char.ord char) binopCharSet
240startsWithKeyword :: [Char] -> [Char] -> Bool
241startsWithKeyword restOfLine keyword =
242 List.isPrefixOf keyword restOfLine
243 &&
244 case drop (length keyword) restOfLine of
245 [] ->
246 True
248 c:_ ->
249 not (Char.isAlphaNum c || c == '_')
252nextLineStartsWithKeyword :: [Char] -> Source -> Row -> Maybe (Row, Col)
253nextLineStartsWithKeyword keyword (Source sourceLines) row =
254 case List.lookup (row + 1) sourceLines of
255 Nothing ->
256 Nothing
258 Just line ->
259 if startsWithKeyword (dropWhile (==' ') line) keyword then
260 Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))
261 else
262 Nothing
265nextLineStartsWithCloseCurly :: Source -> Row -> Maybe (Row, Col)
266nextLineStartsWithCloseCurly (Source sourceLines) row =
267 case List.lookup (row + 1) sourceLines of
268 Nothing ->
269 Nothing
271 Just line ->
272 case dropWhile (==' ') line of
273 '}':_ ->
274 Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))
276 _ ->
277 Nothing