git.iko.soy/elk
on 0cd361d help sign in
elk/compiler/src/Reporting/Render/Code.hs
261 lines 6.5 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 )
12 where
15import qualified Data.ByteString as B
16import qualified Data.ByteString.UTF8 as UTF8_BS
17import qualified Data.Char as Char
18import qualified Data.IntSet as IntSet
19import qualified Data.List as List
20import qualified Data.Name as Name
21import qualified Data.Set as Set
22import Data.Word (Word16)
24import qualified Reporting.Annotation as A
25import qualified Reporting.Doc as D
26import Reporting.Doc (Doc)
27import Parse.Primitives (Row, Col)
28import Parse.Symbol (binopCharSet)
29import Parse.Variable (reservedWords)
33-- CODE
36newtype Source =
37 Source [(Word16, String)]
40toSource :: B.ByteString -> Source
41toSource source =
42 Source $ zip [1..] $
43 lines (UTF8_BS.toString source) ++ [""]
47-- CODE FORMATTING
50toSnippet :: Source -> A.Region -> Maybe A.Region -> (D.Doc, D.Doc) -> D.Doc
51toSnippet source region highlight (preHint, postHint) =
52 D.vcat
53 [ preHint
54 , ""
55 , render source region highlight
56 , postHint
57 ]
60toPair :: Source -> A.Region -> A.Region -> (D.Doc, D.Doc) -> (D.Doc, D.Doc, D.Doc) -> D.Doc
61toPair source r1 r2 (oneStart, oneEnd) (twoStart, twoMiddle, twoEnd) =
62 case renderPair source r1 r2 of
63 OneLine codeDocs ->
64 D.vcat
65 [ oneStart
66 , ""
67 , codeDocs
68 , oneEnd
69 ]
71 TwoChunks code1 code2 ->
72 D.vcat
73 [ twoStart
74 , ""
75 , code1
76 , twoMiddle
77 , ""
78 , code2
79 , twoEnd
80 ]
84-- RENDER SNIPPET
87(|>) :: a -> (a -> b) -> b
88(|>) a f =
89 f a
92render :: Source -> A.Region -> Maybe A.Region -> Doc
93render (Source sourceLines) region@(A.Region (A.Position startLine _) (A.Position endLine _)) maybeSubRegion =
94 let
95 relevantLines =
96 sourceLines
97 |> drop (fromIntegral (startLine - 1))
98 |> take (fromIntegral (1 + endLine - startLine))
100 width =
101 length (show (fst (last relevantLines)))
103 smallerRegion =
104 maybe region id maybeSubRegion
105 in
106 case makeUnderline width endLine smallerRegion of
107 Nothing ->
108 drawLines True width smallerRegion relevantLines D.empty
110 Just underline ->
111 drawLines False width smallerRegion relevantLines underline
114makeUnderline :: Int -> Word16 -> A.Region -> Maybe Doc
115makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end c2)) =
116 if start /= end || end < realEndLine then
117 Nothing
119 else
120 let
121 spaces = replicate (fromIntegral c1 + width + 1) ' '
122 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
123 in
124 Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))
127drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
128drawLines addZigZag width (A.Region (A.Position startLine _) (A.Position endLine _)) sourceLines finalLine =
129 D.vcat $
130 map (drawLine addZigZag width startLine endLine) sourceLines
131 ++ [finalLine]
134drawLine :: Bool -> Int -> Word16 -> Word16 -> (Word16, String) -> Doc
135drawLine addZigZag width startLine endLine (n, line) =
136 addLineNumber addZigZag width startLine endLine n (D.fromChars line)
139addLineNumber :: Bool -> Int -> Word16 -> Word16 -> Word16 -> Doc -> Doc
140addLineNumber addZigZag width start end n line =
141 let
142 number =
143 show n
145 lineNumber =
146 replicate (width - length number) ' ' ++ number ++ "|"
148 spacer =
149 if addZigZag && start <= n && n <= end then
150 D.dullred ">"
151 else
152 " "
153 in
154 D.fromChars lineNumber <> spacer <> line
158-- RENDER PAIR
161data CodePair
162 = OneLine Doc
163 | TwoChunks Doc Doc
166renderPair :: Source -> A.Region -> A.Region -> CodePair
167renderPair source@(Source sourceLines) region1 region2 =
168 let
169 (A.Region (A.Position startRow1 startCol1) (A.Position endRow1 endCol1)) = region1
170 (A.Region (A.Position startRow2 startCol2) (A.Position endRow2 endCol2)) = region2
171 in
172 if startRow1 == endRow1 && endRow1 == startRow2 && startRow2 == endRow2 then
173 let
174 lineNumber = show startRow1
175 spaces1 = replicate (fromIntegral startCol1 + length lineNumber + 1) ' '
176 zigzag1 = replicate (fromIntegral (endCol1 - startCol1)) '^'
177 spaces2 = replicate (fromIntegral (startCol2 - endCol1)) ' '
178 zigzag2 = replicate (fromIntegral (endCol2 - startCol2)) '^'
180 (Just line) = List.lookup startRow1 sourceLines
181 in
182 OneLine $
183 D.vcat
184 [ D.fromChars lineNumber <> "| " <> D.fromChars line
185 , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>
186 D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)
187 ]
189 else
190 TwoChunks
191 (render source region1 Nothing)
192 (render source region2 Nothing)
196-- WHAT IS NEXT?
199data Next
200 = Keyword [Char]
201 | Operator [Char]
202 | Close [Char] Char
203 | Other (Maybe Char)
206whatIsNext :: Source -> Row -> Col -> Next
207whatIsNext (Source sourceLines) row col =
208 case List.lookup row sourceLines of
209 Nothing ->
210 Other Nothing
212 Just line ->
213 let
214 chars = drop (fromIntegral col - 1) line
215 keywords = map Name.toChars (Set.toList reservedWords)
216 in
217 case List.find (startsWithKeyword chars) keywords of
218 Just keyword ->
219 Keyword keyword
221 Nothing ->
222 case chars of
223 [] ->
224 Other Nothing
226 c:cs
227 | isSymbol c -> Operator (c : takeWhile isSymbol cs)
228 | c == ')' -> Close "parenthesis" ')'
229 | c == ']' -> Close "square bracket" ']'
230 | c == '}' -> Close "curly brace" '}'
231 | otherwise -> Other (Just c)
234isSymbol :: Char -> Bool
235isSymbol char =
236 IntSet.member (Char.ord char) binopCharSet
239startsWithKeyword :: [Char] -> [Char] -> Bool
240startsWithKeyword restOfLine keyword =
241 List.isPrefixOf keyword restOfLine
242 &&
243 case drop (length keyword) restOfLine of
244 [] ->
245 True
247 c:_ ->
248 not (Char.isAlphaNum c || c == '_')
251nextLineStartsWithKeyword :: [Char] -> Source -> Row -> Maybe (Row, Col)
252nextLineStartsWithKeyword keyword (Source sourceLines) row =
253 case List.lookup (row + 1) sourceLines of
254 Nothing ->
255 Nothing
257 Just line ->
258 if startsWithKeyword (dropWhile (==' ') line) keyword then
259 Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))
260 else
261 Nothing