@@ -56,28 +56,31 @@ type OutputDoc = Doc OutputAnnotation
5656class Warning a where
5757 warningExtent :: a -> FC
5858 warningMessage :: a -> OutputDoc
59+ warningSource :: a -> Maybe String
5960
6061data Ann = AText String | ATagged OutputAnnotation Ann | ASplit Ann Ann
6162
62−iWarn :: FC -> OutputDoc -> Idris ()
63−iWarn fc err =
64− do i <- getIState
65− case idris_outputmode i of
66− RawOutput h ->
67− do maybeSource <- readSource fc
68− let maybeFormattedSource = (maybeSource >>= layoutSource fc (idris_highlightedRegions i))
69− err' <- iRender . fmap (fancifyAnnots i True) $
70− layoutWarning (layoutFC fc) maybeFormattedSource err
71− hWriteDoc h i err'
72− IdeMode n h ->
73− do err' <- iRender . fmap (fancifyAnnots i True) $ err
74− let (str, spans) = displaySpans err'
75− runIO . hPutStrLn h $
76− convSExp "warning" (fc_fname fc, fc_start fc, fc_end fc, str, spans) n
63+data Hack = Hack FC OutputDoc
64+instance Warning Hack where
65+ warningExtent (Hack extent _) = extent
66+ warningMessage (Hack _ msg) = msg
67+ warningSource _ = Nothing
68+
69+formatWarning :: Warning w => w -> Idris OutputDoc
70+formatWarning w = do
71+ i <- getIState
72+ maybeSource <- case warningSource w of
73+ Just src -> pure (Just src)
74+ Nothing -> readSource fc
75+ let maybeFormattedSource = maybeSource >>= layoutSource fc (idris_highlightedRegions i)
76+ return $ layoutWarning (layoutFC fc) maybeFormattedSource (warningMessage w)
7777 where
78+ fc :: FC
79+ fc = warningExtent w
80+
7881 layoutFC :: FC -> OutputDoc
79− layoutFC (FC fn _ _) | fn /= "" = text (show fc) <> colon
80− layoutFC _ = empty
82+ layoutFC fc@(FC fn _ _) | fn /= "" = text (show $ fc) <> colon
83+ layoutFC _ = empty
8184
8285 readSource :: FC -> Idris (Maybe String)
8386 readSource (FC fn _ _) = do
@@ -169,8 +172,23 @@ iWarn fc err =
169172 layoutWarning loc (Just src) err = loc <$$> src <$$> err <$$> empty
170173 layoutWarning loc Nothing err = loc </> err
171174
175+iWarn :: FC -> OutputDoc -> Idris ()
176+iWarn fc err = emit $ Hack fc err
177+
172178emit :: Warning w => w -> Idris ()
173−emit w = iWarn (warningExtent w) (warningMessage w)
179+emit w =
180+ do i <- getIState
181+ case idris_outputmode i of
182+ RawOutput h ->
183+ do formattedErr <- formatWarning w
184+ err' <- iRender . fmap (fancifyAnnots i True) $ formattedErr
185+ hWriteDoc h i err'
186+ IdeMode n h ->
187+ do err' <- iRender . fmap (fancifyAnnots i True) $ warningMessage w
188+ let fc = warningExtent w
189+ let (str, spans) = displaySpans err'
190+ runIO . hPutStrLn h $
191+ convSExp "warning" (fc_fname fc, fc_start fc, fc_end fc, str, spans) n
174192
175193iRender :: Doc a -> Idris (SimpleDoc a)
176194iRender d = do w <- getWidth