git.iko.soy/elk
on d635ede help sign in
elk/compiler/src/Reporting/Render/Code.hs
247 lines 6.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 )
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 = Keyword [Char]
200 | Operator [Char]
201 | Close [Char] Char
202 | Other
205whatIsNext :: Source -> Row -> Col -> Next
206whatIsNext (Source sourceLines) row col =
207 case List.lookup row sourceLines of
208 Nothing ->
209 Other
211 Just line ->
212 let
213 chars = drop (fromIntegral col - 1) line
214 keywords = map Name.toChars (Set.toList reservedWords)
215 in
216 case List.find (startsWithKeyword chars) keywords of
217 Just keyword ->
218 Keyword keyword
220 Nothing ->
221 case chars of
222 [] ->
223 Other
225 c:cs
226 | isSymbol c -> Operator (c : takeWhile isSymbol cs)
227 | c == ')' -> Close "parenthesis" ')'
228 | c == ']' -> Close "square bracket" ']'
229 | c == '}' -> Close "curly brace" '}'
230 | otherwise -> Other
233isSymbol :: Char -> Bool
234isSymbol char =
235 IntSet.member (Char.ord char) binopCharSet
238startsWithKeyword :: [Char] -> [Char] -> Bool
239startsWithKeyword restOfLine keyword =
240 List.isPrefixOf keyword restOfLine
241 &&
242 case drop (length keyword) restOfLine of
243 [] ->
244 True
246 c:_ ->
247 not (Char.isAlphaNum c || c == '_')