git.iko.soy/elk
on 5f2b2fc help sign in
elk/compiler/src/Reporting/Render/Code.hs
144 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 Data.Word (Word16)
16import qualified Reporting.Annotation as A
17import qualified Reporting.Doc as D
18import Reporting.Doc (Doc)
22-- CODE
25newtype Source =
26 Source [(Word16, String)]
29toSource :: String -> Source
30toSource source =
31 Source $ zip [1..] $
32 lines source ++ [""]
36-- RENDER
39(|>) :: a -> (a -> b) -> b
40(|>) a f =
41 f a
44render :: Source -> A.Region -> Maybe A.Region -> Doc
45render (Source sourceLines) region@(A.Region (A.Position startLine _) (A.Position endLine _)) maybeSubRegion =
46 let
47 relevantLines =
48 sourceLines
49 |> drop (fromIntegral (startLine - 1))
50 |> take (fromIntegral (1 + endLine - startLine))
52 width =
53 length (show (fst (last relevantLines)))
55 smallerRegion =
56 maybe region id maybeSubRegion
57 in
58 case makeUnderline width endLine smallerRegion of
59 Nothing ->
60 drawLines True width smallerRegion relevantLines D.empty
62 Just underline ->
63 drawLines False width smallerRegion relevantLines underline
66makeUnderline :: Int -> Word16 -> A.Region -> Maybe Doc
67makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end c2)) =
68 if start /= end || end < realEndLine then
69 Nothing
71 else
72 let
73 spaces = replicate (fromIntegral c1 + width + 1) ' '
74 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
75 in
76 Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))
79drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
80drawLines addZigZag width (A.Region (A.Position startLine _) (A.Position endLine _)) sourceLines finalLine =
81 D.vcat $
82 map (drawLine addZigZag width startLine endLine) sourceLines
83 ++ [finalLine]
86drawLine :: Bool -> Int -> Word16 -> Word16 -> (Word16, String) -> Doc
87drawLine addZigZag width startLine endLine (n, line) =
88 addLineNumber addZigZag width startLine endLine n (D.fromChars line)
91addLineNumber :: Bool -> Int -> Word16 -> Word16 -> Word16 -> Doc -> Doc
92addLineNumber addZigZag width start end n line =
93 let
94 number =
95 show n
97 lineNumber =
98 replicate (width - length number) ' ' ++ number ++ "|"
100 spacer =
101 if addZigZag && start <= n && n <= end then
102 D.dullred ">"
103 else
104 " "
105 in
106 D.fromChars lineNumber <> spacer <> line
110-- RENDER PAIR
113data CodePair
114 = OneLine Doc
115 | TwoChunks Doc Doc
118renderPair :: Source -> A.Region -> A.Region -> CodePair
119renderPair source@(Source sourceLines) region1 region2 =
120 let
121 (A.Region (A.Position startRow1 startCol1) (A.Position endRow1 endCol1)) = region1
122 (A.Region (A.Position startRow2 startCol2) (A.Position endRow2 endCol2)) = region2
123 in
124 if startRow1 == endRow1 && endRow1 == startRow2 && startRow2 == endRow2 then
125 let
126 lineNumber = show startRow1
127 spaces1 = replicate (fromIntegral startCol1 + length lineNumber + 1) ' '
128 zigzag1 = replicate (fromIntegral (endCol1 - startCol1)) '^'
129 spaces2 = replicate (fromIntegral (startCol2 - endCol1)) ' '
130 zigzag2 = replicate (fromIntegral (endCol2 - startCol2)) '^'
132 (Just line) = List.lookup startRow1 sourceLines
133 in
134 OneLine $
135 D.vcat
136 [ D.fromChars lineNumber <> "| " <> D.fromChars line
137 , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>
138 D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)
139 ]
141 else
142 TwoChunks
143 (render source region1 Nothing)
144 (render source region2 Nothing)