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 14 15 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) 24 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) 31 32 33 34-- CODE 35 36 37newtype Source = 38 Source [(Word16, String)] 39 40 41toSource :: B.ByteString -> Source 42toSource source = 43 Source $ zip [1..] $ 44 lines (UTF8_BS.toString source) ++ [""] 45 46 47 48-- CODE FORMATTING 49 50 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 ] 59 60 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 ] 71 72 TwoChunks code1 code2 -> 73 D.vcat 74 [ twoStart 75 , "" 76 , code1 77 , twoMiddle 78 , "" 79 , code2 80 , twoEnd 81 ] 82 83 84 85-- RENDER SNIPPET 86 87 88(|>) :: a -> (a -> b) -> b 89(|>) a f = 90 f a 91 92 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)) 100 101 width = 102 length (show (fst (last relevantLines))) 103 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 110 111 Just underline -> 112 drawLines False width smallerRegion relevantLines underline 113 114 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 119 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.red (D.fromChars zigzag)) 126 127 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] 133 134 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) 138 139 140addLineNumber :: Bool -> Int -> Word16 -> Word16 -> Word16 -> Doc -> Doc 141addLineNumber addZigZag width start end n line = 142 let 143 number = 144 show n 145 146 lineNumber = 147 replicate (width - length number) ' ' ++ number ++ "|" 148 149 spacer = 150 if addZigZag && start <= n && n <= end then 151 D.red ">" 152 else 153 " " 154 in 155 D.fromChars lineNumber <> spacer <> line 156 157 158 159-- RENDER PAIR 160 161 162data CodePair 163 = OneLine Doc 164 | TwoChunks Doc Doc 165 166 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)) '^' 180 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.red (D.fromChars zigzag1) <> 187 D.fromChars spaces2 <> D.red (D.fromChars zigzag2) 188 ] 189 190 else 191 TwoChunks 192 (render source region1 Nothing) 193 (render source region2 Nothing) 194 195 196 197-- WHAT IS NEXT? 198 199 200data Next 201 = Keyword [Char] 202 | Operator [Char] 203 | Close [Char] Char 204 | Upper Char [Char] 205 | Lower Char [Char] 206 | Other (Maybe Char) 207 208 209whatIsNext :: Source -> Row -> Col -> Next 210whatIsNext (Source sourceLines) row col = 211 case List.lookup row sourceLines of 212 Nothing -> 213 Other Nothing 214 215 Just line -> 216 case drop (fromIntegral col - 1) line of 217 [] -> 218 Other Nothing 219 220 c:cs 221 | Char.isUpper c -> Upper c (takeWhile isInner cs) 222 | Char.isLower c -> detectKeywords c cs 223 | isSymbol c -> Operator (c : takeWhile isSymbol cs) 224 | c == ')' -> Close "parenthesis" ')' 225 | c == ']' -> Close "square bracket" ']' 226 | c == '}' -> Close "curly brace" '}' 227 | otherwise -> Other (Just c) 228 229 230detectKeywords :: Char -> [Char] -> Next 231detectKeywords c rest = 232 let 233 cs = takeWhile isInner rest 234 name = c : cs 235 in 236 if Set.member (Name.fromChars name) reservedWords 237 then Keyword name 238 else Lower c name 239 240 241isInner :: Char -> Bool 242isInner char = 243 Char.isAlphaNum char || char == '_' 244 245 246isSymbol :: Char -> Bool 247isSymbol char = 248 IntSet.member (Char.ord char) binopCharSet 249 250 251startsWithKeyword :: [Char] -> [Char] -> Bool 252startsWithKeyword restOfLine keyword = 253 List.isPrefixOf keyword restOfLine 254 && 255 case drop (length keyword) restOfLine of 256 [] -> 257 True 258 259 c:_ -> 260 not (isInner c) 261 262 263nextLineStartsWithKeyword :: [Char] -> Source -> Row -> Maybe (Row, Col) 264nextLineStartsWithKeyword keyword (Source sourceLines) row = 265 case List.lookup (row + 1) sourceLines of 266 Nothing -> 267 Nothing 268 269 Just line -> 270 if startsWithKeyword (dropWhile (==' ') line) keyword then 271 Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line))) 272 else 273 Nothing 274 275 276nextLineStartsWithCloseCurly :: Source -> Row -> Maybe (Row, Col) 277nextLineStartsWithCloseCurly (Source sourceLines) row = 278 case List.lookup (row + 1) sourceLines of 279 Nothing -> 280 Nothing 281 282 Just line -> 283 case dropWhile (==' ') line of 284 '}':_ -> 285 Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line))) 286 287 _ -> 288 Nothing 289