git.iko.soy/elk
on e37ceaa help sign in
elk/compiler/src/Reporting/Render/Code.hs
261 lines 6.2 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 )
11 where
14import qualified Data.ByteString as B
15import qualified Data.ByteString.UTF8 as UTF8_BS
16import qualified Data.Char as Char
17import qualified Data.IntSet as IntSet
18import qualified Data.List as List
19import qualified Data.Name as Name
20import qualified Data.Set as Set
21import Data.Word (Word16)
23import qualified Reporting.Annotation as A
24import qualified Reporting.Doc as D
25import Reporting.Doc (Doc)
26import Parse.Primitives (Row, Col)
27import Parse.Symbol (binopCharSet)
28import Parse.Variable (reservedWords)
32-- CODE
35newtype Source =
36 Source [(Word16, String)]
39toSource :: B.ByteString -> Source
40toSource source =
41 Source $ zip [1..] $
42 lines (UTF8_BS.toString source) ++ [""]
46-- CODE FORMATTING
49toSnippet :: Source -> A.Region -> Maybe A.Region -> (D.Doc, D.Doc) -> D.Doc
50toSnippet source region highlight (preHint, postHint) =
51 D.vcat
52 [ preHint
53 , ""
54 , render source region highlight
55 , postHint
56 ]
59toPair :: Source -> A.Region -> A.Region -> (D.Doc, D.Doc) -> (D.Doc, D.Doc, D.Doc) -> D.Doc
60toPair source r1 r2 (oneStart, oneEnd) (twoStart, twoMiddle, twoEnd) =
61 case renderPair source r1 r2 of
62 OneLine codeDocs ->
63 D.vcat
64 [ oneStart
65 , ""
66 , codeDocs
67 , oneEnd
68 ]
70 TwoChunks code1 code2 ->
71 D.vcat
72 [ twoStart
73 , ""
74 , code1
75 , twoMiddle
76 , ""
77 , code2
78 , twoEnd
79 ]
83-- RENDER SNIPPET
86(|>) :: a -> (a -> b) -> b
87(|>) a f =
88 f a
91render :: Source -> A.Region -> Maybe A.Region -> Doc
92render (Source sourceLines) region@(A.Region (A.Position startLine _) (A.Position endLine _)) maybeSubRegion =
93 let
94 relevantLines =
95 sourceLines
96 |> drop (fromIntegral (startLine - 1))
97 |> take (fromIntegral (1 + endLine - startLine))
99 width =
100 length (show (fst (last relevantLines)))
102 smallerRegion =
103 maybe region id maybeSubRegion
104 in
105 case makeUnderline width endLine smallerRegion of
106 Nothing ->
107 drawLines True width smallerRegion relevantLines D.empty
109 Just underline ->
110 drawLines False width smallerRegion relevantLines underline
113makeUnderline :: Int -> Word16 -> A.Region -> Maybe Doc
114makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end c2)) =
115 if start /= end || end < realEndLine then
116 Nothing
118 else
119 let
120 spaces = replicate (fromIntegral c1 + width + 1) ' '
121 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
122 in
123 Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))
126drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
127drawLines addZigZag width (A.Region (A.Position startLine _) (A.Position endLine _)) sourceLines finalLine =
128 D.vcat $
129 map (drawLine addZigZag width startLine endLine) sourceLines
130 ++ [finalLine]
133drawLine :: Bool -> Int -> Word16 -> Word16 -> (Word16, String) -> Doc
134drawLine addZigZag width startLine endLine (n, line) =
135 addLineNumber addZigZag width startLine endLine n (D.fromChars line)
138addLineNumber :: Bool -> Int -> Word16 -> Word16 -> Word16 -> Doc -> Doc
139addLineNumber addZigZag width start end n line =
140 let
141 number =
142 show n
144 lineNumber =
145 replicate (width - length number) ' ' ++ number ++ "|"
147 spacer =
148 if addZigZag && start <= n && n <= end then
149 D.dullred ">"
150 else
151 " "
152 in
153 D.fromChars lineNumber <> spacer <> line
157-- RENDER PAIR
160data CodePair
161 = OneLine Doc
162 | TwoChunks Doc Doc
165renderPair :: Source -> A.Region -> A.Region -> CodePair
166renderPair source@(Source sourceLines) region1 region2 =
167 let
168 (A.Region (A.Position startRow1 startCol1) (A.Position endRow1 endCol1)) = region1
169 (A.Region (A.Position startRow2 startCol2) (A.Position endRow2 endCol2)) = region2
170 in
171 if startRow1 == endRow1 && endRow1 == startRow2 && startRow2 == endRow2 then
172 let
173 lineNumber = show startRow1
174 spaces1 = replicate (fromIntegral startCol1 + length lineNumber + 1) ' '
175 zigzag1 = replicate (fromIntegral (endCol1 - startCol1)) '^'
176 spaces2 = replicate (fromIntegral (startCol2 - endCol1)) ' '
177 zigzag2 = replicate (fromIntegral (endCol2 - startCol2)) '^'
179 (Just line) = List.lookup startRow1 sourceLines
180 in
181 OneLine $
182 D.vcat
183 [ D.fromChars lineNumber <> "| " <> D.fromChars line
184 , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>
185 D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)
186 ]
188 else
189 TwoChunks
190 (render source region1 Nothing)
191 (render source region2 Nothing)
195-- WHAT IS NEXT?
198data Next
199 = Spaces
200 | Keyword String
201 | Operator String
202 | CloseParen
203 | CloseSquare
204 | CloseCurly
205 | Other
208whatIsNext :: Source -> Row -> Col -> Next
209whatIsNext (Source sourceLines) row col =
210 case List.lookup row sourceLines of
211 Nothing ->
212 Other
214 Just line ->
215 let
216 chars = drop (fromIntegral col - 1) line
217 keywords = map Name.toChars (Set.toList reservedWords)
218 in
219 case List.find (startsWithKeyword chars) keywords of
220 Just keyword ->
221 Keyword keyword
223 Nothing ->
224 case takeWhile isSymbol chars of
225 op@(_:_) ->
226 Operator op
228 []
229 | null chars -> Spaces
230 | isNext ' ' chars -> Spaces
231 | isNext ')' chars -> CloseParen
232 | isNext ']' chars -> CloseSquare
233 | isNext '}' chars -> CloseCurly
234 | otherwise -> Other
237isSymbol :: Char -> Bool
238isSymbol char =
239 IntSet.member (Char.ord char) binopCharSet
242isNext :: Char -> [Char] -> Bool
243isNext expected chars =
244 case chars of
245 [] ->
246 False
248 actual:_ ->
249 actual == expected
252startsWithKeyword :: [Char] -> [Char] -> Bool
253startsWithKeyword restOfLine keyword =
254 List.isPrefixOf keyword restOfLine
255 &&
256 case drop (length keyword) restOfLine of
257 [] ->
258 True
260 c:_ ->
261 not (Char.isAlphaNum c || c == '_')