on 83e18b3 help sign in
131 lines 2.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Render.Code
3 ( Source
4 , toSource
5 , render
6 , CodePair(..)
7 , renderPair
8 )
9 where
12import Data.Text (Text)
13import qualified Data.Text as Text
14import Text.PrettyPrint.ANSI.Leijen
15 ( Doc, (<>), hardline, dullred, empty, text )
17import qualified Reporting.Region as R
18import qualified Reporting.Helpers as H
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
44(<==>) :: Doc -> Doc -> Doc
45(<==>) a b =
46 a <> hardline <> b
49render :: Source -> R.Region -> Maybe R.Region -> Doc
50render (Source sourceLines) region@(R.Region start end) maybeSubRegion =
51 let
52 (R.Position startLine _) = start
53 (R.Position endLine _) = end
55 relevantLines =
56 sourceLines
57 |> drop (startLine - 1)
58 |> take (1 + endLine - startLine)
60 width =
61 length (show (fst (last relevantLines)))
63 smallerRegion =
64 maybe region id maybeSubRegion
65 in
66 case makeUnderline width endLine smallerRegion of
67 Nothing ->
68 drawLines True width smallerRegion relevantLines empty
70 Just underline ->
71 drawLines False width smallerRegion relevantLines underline
74makeUnderline :: Int -> Int -> R.Region -> Maybe Doc
75makeUnderline width realEndLine (R.Region (R.Position start c1) (R.Position end c2)) =
76 if start /= end || end < realEndLine then
77 Nothing
79 else
80 let
81 spaces = replicate (c1 + width + 1) ' '
82 zigzag = replicate (max 1 (c2 - c1)) '^'
83 in
84 Just (text spaces <> dullred (text zigzag))
87drawLines :: Bool -> Int -> R.Region -> [(Int, Text)] -> Doc -> Doc
88drawLines addZigZag width (R.Region start end) sourceLines finalLine =
89 let
90 (R.Position startLine _) = start
91 (R.Position endLine _) = end
92 in
93 foldr (<==>) finalLine $
94 map (drawLine addZigZag width startLine endLine) sourceLines
97drawLine :: Bool -> Int -> Int -> Int -> (Int, Text) -> Doc
98drawLine addZigZag width startLine endLine (n, line) =
99 addLineNumber addZigZag width startLine endLine n (H.textToDoc line)
102addLineNumber :: Bool -> Int -> Int -> Int -> Int -> Doc -> Doc
103addLineNumber addZigZag width start end n line =
104 let
105 number =
106 if n < 0 then " " else show n
108 lineNumber =
109 replicate (width - length number) ' ' ++ number ++ "|"
111 spacer =
112 if addZigZag && start <= n && n <= end then
113 dullred (text ">")
114 else
115 text " "
116 in
117 text lineNumber <> spacer <> line
121-- RENDER PAIR
124data CodePair
125 = OneLine Doc
126 | TwoChunks Doc Doc
129renderPair :: Source -> R.Region -> R.Region -> CodePair
130renderPair source r1 r2 =
131 error "TODO" source r1 r2