git.iko.soy/elk
on fa9aba2 help sign in
elk/compiler/src/Reporting/Render/Code.hs
146 lines 3.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Render.Code
4 ( Source
5 , toSource
6 , render
7 , CodePair(..)
8 , renderPair
9 )
10 where
13import qualified Data.ByteString as B
14import qualified Data.ByteString.UTF8 as UTF8_BS
15import qualified Data.List as List
16import Data.Word (Word16)
18import qualified Reporting.Annotation as A
19import qualified Reporting.Doc as D
20import Reporting.Doc (Doc)
24-- CODE
27newtype Source =
28 Source [(Word16, String)]
31toSource :: B.ByteString -> Source
32toSource source =
33 Source $ zip [1..] $
34 lines (UTF8_BS.toString source) ++ [""]
38-- RENDER
41(|>) :: a -> (a -> b) -> b
42(|>) a f =
43 f a
46render :: Source -> A.Region -> Maybe A.Region -> Doc
47render (Source sourceLines) region@(A.Region (A.Position startLine _) (A.Position endLine _)) maybeSubRegion =
48 let
49 relevantLines =
50 sourceLines
51 |> drop (fromIntegral (startLine - 1))
52 |> take (fromIntegral (1 + endLine - startLine))
54 width =
55 length (show (fst (last relevantLines)))
57 smallerRegion =
58 maybe region id maybeSubRegion
59 in
60 case makeUnderline width endLine smallerRegion of
61 Nothing ->
62 drawLines True width smallerRegion relevantLines D.empty
64 Just underline ->
65 drawLines False width smallerRegion relevantLines underline
68makeUnderline :: Int -> Word16 -> A.Region -> Maybe Doc
69makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end c2)) =
70 if start /= end || end < realEndLine then
71 Nothing
73 else
74 let
75 spaces = replicate (fromIntegral c1 + width + 1) ' '
76 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
77 in
78 Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))
81drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
82drawLines addZigZag width (A.Region (A.Position startLine _) (A.Position endLine _)) sourceLines finalLine =
83 D.vcat $
84 map (drawLine addZigZag width startLine endLine) sourceLines
85 ++ [finalLine]
88drawLine :: Bool -> Int -> Word16 -> Word16 -> (Word16, String) -> Doc
89drawLine addZigZag width startLine endLine (n, line) =
90 addLineNumber addZigZag width startLine endLine n (D.fromChars line)
93addLineNumber :: Bool -> Int -> Word16 -> Word16 -> Word16 -> Doc -> Doc
94addLineNumber addZigZag width start end n line =
95 let
96 number =
97 show n
99 lineNumber =
100 replicate (width - length number) ' ' ++ number ++ "|"
102 spacer =
103 if addZigZag && start <= n && n <= end then
104 D.dullred ">"
105 else
106 " "
107 in
108 D.fromChars lineNumber <> spacer <> line
112-- RENDER PAIR
115data CodePair
116 = OneLine Doc
117 | TwoChunks Doc Doc
120renderPair :: Source -> A.Region -> A.Region -> CodePair
121renderPair source@(Source sourceLines) region1 region2 =
122 let
123 (A.Region (A.Position startRow1 startCol1) (A.Position endRow1 endCol1)) = region1
124 (A.Region (A.Position startRow2 startCol2) (A.Position endRow2 endCol2)) = region2
125 in
126 if startRow1 == endRow1 && endRow1 == startRow2 && startRow2 == endRow2 then
127 let
128 lineNumber = show startRow1
129 spaces1 = replicate (fromIntegral startCol1 + length lineNumber + 1) ' '
130 zigzag1 = replicate (fromIntegral (endCol1 - startCol1)) '^'
131 spaces2 = replicate (fromIntegral (startCol2 - endCol1)) ' '
132 zigzag2 = replicate (fromIntegral (endCol2 - startCol2)) '^'
134 (Just line) = List.lookup startRow1 sourceLines
135 in
136 OneLine $
137 D.vcat
138 [ D.fromChars lineNumber <> "| " <> D.fromChars line
139 , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>
140 D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)
141 ]
143 else
144 TwoChunks
145 (render source region1 Nothing)
146 (render source region2 Nothing)