git.iko.soy/elk
on 1c91efd help sign in
elk/compiler/src/Reporting/Render/Code.hs
151 lines 3.7 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.List as List
14import qualified Data.Text as Text
16import Reporting.Doc (Doc, (<>))
17import qualified Reporting.Doc as D
18import qualified Reporting.Region as R
22-- CODE
25newtype Source =
26 Source [(Int, Text.Text)]
29toSource :: Text.Text -> Source
30toSource source =
31 Source $ zip [1..] $
32 Text.lines source ++ [Text.empty]
36-- RENDER
39(|>) :: a -> (a -> b) -> b
40(|>) a f =
41 f a
44render :: Source -> R.Region -> Maybe R.Region -> Doc
45render (Source sourceLines) region@(R.Region start end) maybeSubRegion =
46 let
47 (R.Position startLine _) = start
48 (R.Position endLine _) = end
50 relevantLines =
51 sourceLines
52 |> drop (startLine - 1)
53 |> take (1 + endLine - startLine)
55 width =
56 length (show (fst (last relevantLines)))
58 smallerRegion =
59 maybe region id maybeSubRegion
60 in
61 case makeUnderline width endLine smallerRegion of
62 Nothing ->
63 drawLines True width smallerRegion relevantLines D.empty
65 Just underline ->
66 drawLines False width smallerRegion relevantLines underline
69makeUnderline :: Int -> Int -> R.Region -> Maybe Doc
70makeUnderline width realEndLine (R.Region (R.Position start c1) (R.Position end c2)) =
71 if start /= end || end < realEndLine then
72 Nothing
74 else
75 let
76 spaces = replicate (c1 + width + 1) ' '
77 zigzag = replicate (max 1 (c2 - c1)) '^'
78 in
79 Just (D.fromString spaces <> D.dullred (D.fromString zigzag))
82drawLines :: Bool -> Int -> R.Region -> [(Int, Text.Text)] -> Doc -> Doc
83drawLines addZigZag width (R.Region start end) sourceLines finalLine =
84 let
85 (R.Position startLine _) = start
86 (R.Position endLine _) = end
87 in
88 D.vcat $
89 map (drawLine addZigZag width startLine endLine) sourceLines
90 ++ [finalLine]
93drawLine :: Bool -> Int -> Int -> Int -> (Int, Text.Text) -> Doc
94drawLine addZigZag width startLine endLine (n, line) =
95 addLineNumber addZigZag width startLine endLine n (D.fromText line)
98addLineNumber :: Bool -> Int -> Int -> Int -> Int -> Doc -> Doc
99addLineNumber addZigZag width start end n line =
100 let
101 number =
102 if n < 0 then " " else show n
104 lineNumber =
105 replicate (width - length number) ' ' ++ number ++ "|"
107 spacer =
108 if addZigZag && start <= n && n <= end then
109 D.dullred ">"
110 else
111 " "
112 in
113 D.fromString lineNumber <> spacer <> line
117-- RENDER PAIR
120data CodePair
121 = OneLine Doc
122 | TwoChunks Doc Doc
125renderPair :: Source -> R.Region -> R.Region -> CodePair
126renderPair source@(Source sourceLines) region1 region2 =
127 let
128 (R.Region (R.Position startRow1 startCol1) (R.Position endRow1 endCol1)) = region1
129 (R.Region (R.Position startRow2 startCol2) (R.Position endRow2 endCol2)) = region2
130 in
131 if startRow1 == endRow1 && endRow1 == startRow2 && startRow2 == endRow2 then
132 let
133 lineNumber = show startRow1
134 spaces1 = replicate (startCol1 + length lineNumber + 1) ' '
135 zigzag1 = replicate (endCol1 - startCol1) '^'
136 spaces2 = replicate (startCol2 - endCol1) ' '
137 zigzag2 = replicate (endCol2 - startCol2) '^'
139 (Just line) = List.lookup startRow1 sourceLines
140 in
141 OneLine $
142 D.vcat
143 [ D.fromString lineNumber <> "| " <> D.fromText line
144 , D.fromString spaces1 <> D.dullred (D.fromString zigzag1) <>
145 D.fromString spaces2 <> D.dullred (D.fromString zigzag2)
146 ]
148 else
149 TwoChunks
150 (render source region1 Nothing)
151 (render source region2 Nothing)