git.iko.soy/Idris-dev
on master help sign in
Annotate warning source line
cd87fcdJason Felice
src/Idris/Output.hs+51−5
compare with master
unifiedsplit
@@ -31,6 +31,7 @@ import Util.System (isATTY)
31
31
32import Prelude hiding ((<$>))
32import Prelude hiding ((<$>))
33
33
34+import Control.Arrow (first)
34import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
35import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
35import Data.List (intersperse, nub)
36import Data.List (intersperse, nub)
36import Data.Maybe (fromMaybe, fromJust, isJust, listToMaybe)
37import Data.Maybe (fromMaybe, fromJust, isJust, listToMaybe)
@@ -52,13 +53,15 @@ pshow ist err = displayDecorated (consoleDecorate ist) .
52
53
53type OutputDoc = Doc OutputAnnotation
54type OutputDoc = Doc OutputAnnotation
54
55
56+data Ann = AText String | ATagged OutputAnnotation Ann | ASplit Ann Ann
57+
55iWarn :: FC -> OutputDoc -> Idris ()
58iWarn :: FC -> OutputDoc -> Idris ()
56iWarn fc err =
59iWarn fc err =
57 do i <- getIState
60 do i <- getIState
58 case idris_outputmode i of
61 case idris_outputmode i of
59 RawOutput h ->
62 RawOutput h ->
60 do maybeSource <- readSource fc
63 do maybeSource <- readSource fc
61− let maybeFormattedSource = (maybeSource >>= layoutSource fc)
64+ let maybeFormattedSource = (maybeSource >>= layoutSource fc (idris_highlightedRegions i))
62 err' <- iRender . fmap (fancifyAnnots i True) $
65 err' <- iRender . fmap (fancifyAnnots i True) $
63 layoutWarning (layoutFC fc) maybeFormattedSource err
66 layoutWarning (layoutFC fc) maybeFormattedSource err
64 hWriteDoc h i err'
67 hWriteDoc h i err'
@@ -80,8 +83,8 @@ iWarn fc err =
80 Right v -> pure (Just v)
83 Right v -> pure (Just v)
81 readSource _ = pure Nothing
84 readSource _ = pure Nothing
82
85
83− layoutSource :: FC -> String -> Maybe OutputDoc
86+ layoutSource :: FC -> [(FC, OutputAnnotation)] -> String -> Maybe OutputDoc
84− layoutSource (FC fn (si, sj) (ei, ej)) src =
87+ layoutSource (FC fn (si, sj) (ei, ej)) highlights src =
85 if haveSource
88 if haveSource
86 then Just source
89 then Just source
87 else Nothing
90 else Nothing
@@ -95,8 +98,51 @@ iWarn fc err =
95 line1 :: OutputDoc
98 line1 :: OutputDoc
96 line1 = text $ replicate (length (show si)) ' ' ++ " |"
99 line1 = text $ replicate (length (show si)) ' ' ++ " |"
97
100
101+ lineFC :: FC
102+ lineFC = FC fn (si, 1) (si, length (fromJust sourceLine))
103+
104+ intersection :: FC -> FC -> FC
105+ intersection (FC fn1 s1 e1) (FC fn2 s2 e2) = FC fn1 (max s1 s2) (min e1 e2)
106+ intersection _ _ = NoFC
107+
108+ intersects :: FC -> FC -> Bool
109+ intersects (FC fn1 s1 e1) (FC fn2 s2 e2)
110+ | fn1 /= fn2 = False
111+ | e1 < s2 = False
112+ | e2 < s1 = False
113+ | otherwise = True
114+ intersects _ _ = False
115+
116+ width :: Ann -> Int
117+ width (AText s) = length s
118+ width (ATagged _ n) = width n
119+ width (ASplit l r) = width l + width r
120+
121+ buildHighlightedSource :: Ann -> OutputDoc
122+ buildHighlightedSource (AText s) = text s
123+ buildHighlightedSource (ATagged a n) = annotate a (buildHighlightedSource n)
124+ buildHighlightedSource (ASplit l r) = buildHighlightedSource l <> buildHighlightedSource r
125+
126+ insertAnnotation :: ((Int, Int), OutputAnnotation) -> Ann -> Ann
127+ insertAnnotation ((sj, ej), oa) (ATagged tag n) = ATagged tag (insertAnnotation ((sj, ej), oa) n)
128+ insertAnnotation ((sj, ej), oa) (ASplit l r)
129+ | w <- width l = ASplit (insertAnnotation ((sj, ej), oa) l) (insertAnnotation ((sj - w, ej - w), oa) r)
130+ insertAnnotation ((sj, ej), oa) a@(AText t)
131+ | sj <= 1, ej >= width a = ATagged oa a
132+ | sj > 1, sj <= width a = ASplit (AText $ take (sj - 1) t) (insertAnnotation ((1, ej - sj + 1), oa) (AText $ drop (sj - 1) t))
133+ | sj == 1, ej >= 1, ej < width a = ASplit (insertAnnotation ((1, ej), oa) (AText $ take ej t)) (AText $ drop ej t)
134+ | otherwise = a
135+
136+ highlightedSource :: OutputDoc
137+ highlightedSource = buildHighlightedSource .
138+ foldr insertAnnotation (AText $ fromJust sourceLine) .
139+ map (\(FC _ (_, sj) (_, ej), ann) -> ((sj, ej), ann)) .
140+ map (first (intersection lineFC)) .
141+ filter (intersects lineFC . fst) $
142+ highlights
143+
98 line2 :: OutputDoc
144 line2 :: OutputDoc
99− line2 = text $ show si ++ " | " ++ fromJust sourceLine
145+ line2 = text (show si ++ " | ") <> highlightedSource
100
146
101 indicator :: OutputDoc
147 indicator :: OutputDoc
102 indicator = text (replicate (end - sj + 1) ch) <> ellipsis
148 indicator = text (replicate (end - sj + 1) ch) <> ellipsis
@@ -111,7 +157,7 @@ iWarn fc err =
111
157
112 source :: OutputDoc
158 source :: OutputDoc
113 source = line1 <$$> line2 <$$> line3
159 source = line1 <$$> line2 <$$> line3
114− layoutSource _ _ = Nothing
160+ layoutSource _ _ _ = Nothing
115
161
116 layoutWarning :: OutputDoc -> Maybe OutputDoc -> OutputDoc -> OutputDoc
162 layoutWarning :: OutputDoc -> Maybe OutputDoc -> OutputDoc -> OutputDoc
117 layoutWarning loc (Just src) err = loc <$$> src <$$> err <$$> empty
163 layoutWarning loc (Just src) err = loc <$$> src <$$> err <$$> empty