@@ -1,13 +1,13 @@
11{-# OPTIONS_GHC -Wall #-}
2−module Reporting.Render.Code
3− ( render
4− )
5− where
2+module Reporting.Render.Code (render) where
63
7−import Control.Applicative ((<|>))
8−import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), hardline, dullred, empty, text)
4+import Data.Text (Text)
5+import qualified Data.Text as Text
6+import Text.PrettyPrint.ANSI.Leijen
7+ ( Doc, (<>), hardline, dullred, empty, text )
98
109import qualified Reporting.Region as R
10+import qualified Reporting.Helpers as H
1111
1212
1313(|>) :: a -> (a -> b) -> b
@@ -20,59 +20,62 @@ import qualified Reporting.Region as R
2020 a <> hardline <> b
2121
2222
23−render :: Maybe R.Region -> R.Region -> String -> Doc
23+render :: Maybe R.Region -> R.Region -> Text -> Doc
2424render maybeSubRegion region@(R.Region start end) source =
2525 let
26− (R.Position startLine startColumn) = start
27− (R.Position endLine endColumn) = end
26+ (R.Position startLine _) = start
27+ (R.Position endLine _) = end
2828
2929 relevantLines =
30− lines source
31− |> drop (startLine - 1)
32− |> take (endLine - startLine + 1)
30+ (Text.lines source ++ [Text.empty])
31+ |> take endLine
32+ |> drop (startLine - 1)
33+ |> zip [startLine .. endLine + 1]
34+
35+ width =
36+ length (show (fst (last relevantLines)))
37+
38+ smallerRegion =
39+ maybe region id maybeSubRegion
3340 in
34− case relevantLines of
35− [] ->
36− empty
41+ case makeUnderline width endLine smallerRegion of
42+ Nothing ->
43+ drawLines True width smallerRegion relevantLines empty
3744
38− [sourceLine] ->
39− singleLineRegion startLine sourceLine $
40− case maybeSubRegion of
41− Nothing ->
42− (0, startColumn, endColumn, length sourceLine)
45+ Just underline ->
46+ drawLines False width smallerRegion relevantLines underline
4347
44− Just (R.Region s e) ->
45− (startColumn, R.column s, R.column e, endColumn)
4648
47− firstLine : rest ->
48− let
49− filteredFirstLine =
50− replicate (startColumn - 1) ' '
51− ++ drop (startColumn - 1) firstLine
49+makeUnderline :: Int -> Int -> R.Region -> Maybe Doc
50+makeUnderline width realEndLine (R.Region (R.Position start c1) (R.Position end c2)) =
51+ if start /= end || end < realEndLine then
52+ Nothing
5253
53− filteredLastLine =
54− take (endColumn) (last rest)
54+ else
55+ let
56+ spaces = replicate (c1 + width + 1) ' '
57+ zigzag = replicate (max 1 (c2 - c1)) '^'
58+ in
59+ Just (text spaces <> dullred (text zigzag))
5560
56− focusedRelevantLines =
57− filteredFirstLine : init rest ++ [filteredLastLine]
5861
59− lineNumbersWidth =
60− length (show endLine)
62+drawLines :: Bool -> Int -> R.Region -> [(Int, Text)] -> Doc -> Doc
63+drawLines addZigZag width (R.Region start end) sourceLines finalLine =
64+ let
65+ (R.Position startLine _) = start
66+ (R.Position endLine _) = end
67+ in
68+ foldr (<==>) finalLine $
69+ map (drawLine addZigZag width startLine endLine) sourceLines
6170
62− subregion =
63− maybeSubRegion <|> Just region
6471
65− numberedLines =
66− zipWith
67− (addLineNumber subregion lineNumbersWidth)
68− [startLine .. endLine]
69− focusedRelevantLines
70− in
71− foldr (<==>) empty numberedLines
72+drawLine :: Bool -> Int -> Int -> Int -> (Int, Text) -> Doc
73+drawLine addZigZag width startLine endLine (n, line) =
74+ addLineNumber addZigZag width startLine endLine n (H.text line)
7275
7376
74−addLineNumber :: Maybe R.Region -> Int -> Int -> String -> Doc
75−addLineNumber maybeSubRegion width n line =
77+addLineNumber :: Bool -> Int -> Int -> Int -> Int -> Doc -> Doc
78+addLineNumber addZigZag width start end n line =
7679 let
7780 number =
7881 if n < 0 then " " else show n
@@ -80,34 +83,10 @@ addLineNumber maybeSubRegion width n line =
8083 lineNumber =
8184 replicate (width - length number) ' ' ++ number ++ "|"
8285
83− spacer (R.Region start end) =
84− if R.line start <= n && n <= R.line end then
85− dullred (text ">")
86+ spacer =
87+ if addZigZag && start <= n && n <= end then
88+ dullred (text ">")
8689 else
87− text " "
88− in
89− text lineNumber
90− <> maybe (text " ") spacer maybeSubRegion
91− <> text line
92−
93−
94−singleLineRegion :: Int -> String -> (Int, Int, Int, Int) -> Doc
95−singleLineRegion lineNum sourceLine (start, innerStart, innerEnd, end) =
96− let
97− width =
98− length (show lineNum)
99−
100− underline =
101− text (replicate (innerStart + width + 1) ' ')
102− <>
103− dullred (text (replicate (max 1 (innerEnd - innerStart)) '^'))
104−
105− trimmedSourceLine =
106− sourceLine
107− |> drop (start - 1)
108− |> take (end - start + 1)
109− |> (++) (replicate (start - 1) ' ')
90+ text " "
11091 in
111− addLineNumber Nothing width lineNum trimmedSourceLine
112− <==>
113− underline
92+ text lineNumber <> spacer <> line