git.iko.soy/elk
on e5abcf4 help sign in
elk/compiler/src/Reporting/Render/Code.hs
243 lines 5.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 )
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 in
218 case List.find (\kwd -> startsWith kwd chars) (map Name.toChars (Set.toList reservedWords)) of
219 Just keyword ->
220 Keyword keyword
222 Nothing ->
223 case takeWhile isSymbol chars of
224 op@(_:_) ->
225 Operator op
227 []
228 | null chars -> Spaces
229 | startsWith " " chars -> Spaces
230 | startsWith ")" chars -> CloseParen
231 | startsWith "]" chars -> CloseSquare
232 | startsWith "}" chars -> CloseCurly
233 | otherwise -> Other
236isSymbol :: Char -> Bool
237isSymbol char =
238 IntSet.member (Char.ord char) binopCharSet
241startsWith :: [Char] -> [Char] -> Bool
242startsWith =
243 List.isPrefixOf