git.iko.soy/Idris-dev
on master help sign in
Extract formatWarning
826b491Jason Felice
src/Idris/Output.hs+36−18
compare with master
unifiedsplit
@@ -56,28 +56,31 @@ type OutputDoc = Doc OutputAnnotation
56class Warning a where
56class Warning a where
57 warningExtent :: a -> FC
57 warningExtent :: a -> FC
58 warningMessage :: a -> OutputDoc
58 warningMessage :: a -> OutputDoc
59+ warningSource :: a -> Maybe String
59
60
60data Ann = AText String | ATagged OutputAnnotation Ann | ASplit Ann Ann
61data Ann = AText String | ATagged OutputAnnotation Ann | ASplit Ann Ann
61
62
62−iWarn :: FC -> OutputDoc -> Idris ()
63+data Hack = Hack FC OutputDoc
63−iWarn fc err =
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
64− do i <- getIState
71+ i <- getIState
65− case idris_outputmode i of
72+ maybeSource <- case warningSource w of
66− RawOutput h ->
73+ Just src -> pure (Just src)
67− do maybeSource <- readSource fc
74+ Nothing -> readSource fc
68− let maybeFormattedSource = (maybeSource >>= layoutSource fc (idris_highlightedRegions i))
75+ let maybeFormattedSource = maybeSource >>= layoutSource fc (idris_highlightedRegions i)
69− err' <- iRender . fmap (fancifyAnnots i True) $
70− layoutWarning (layoutFC fc) maybeFormattedSource err
76+ return $ layoutWarning (layoutFC fc) maybeFormattedSource (warningMessage w)
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
77 where
77 where
78+ fc :: FC
79+ fc = warningExtent w
80+
78 layoutFC :: FC -> OutputDoc
81 layoutFC :: FC -> OutputDoc
79− layoutFC (FC fn _ _) | fn /= "" = text (show fc) <> colon
82+ layoutFC fc@(FC fn _ _) | fn /= "" = text (show $ fc) <> colon
80− layoutFC _ = empty
83+ layoutFC _ = empty
81
84
82 readSource :: FC -> Idris (Maybe String)
85 readSource :: FC -> Idris (Maybe String)
83 readSource (FC fn _ _) = do
86 readSource (FC fn _ _) = do
@@ -169,8 +172,23 @@ iWarn fc err =
169 layoutWarning loc (Just src) err = loc <$$> src <$$> err <$$> empty
172 layoutWarning loc (Just src) err = loc <$$> src <$$> err <$$> empty
170 layoutWarning loc Nothing err = loc </> err
173 layoutWarning loc Nothing err = loc </> err
171
174
175+iWarn :: FC -> OutputDoc -> Idris ()
176+iWarn fc err = emit $ Hack fc err
177+
172emit :: Warning w => w -> Idris ()
178emit :: 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
174
192
175iRender :: Doc a -> Idris (SimpleDoc a)
193iRender :: Doc a -> Idris (SimpleDoc a)
176iRender d = do w <- getWidth
194iRender d = do w <- getWidth
src/Idris/Parser/Stack.hs+1
@@ -69,6 +69,7 @@ instance Warning ParseError where
69 where
69 where
70 (pos NonEmpty.:| _) = P.errorPos err
70 (pos NonEmpty.:| _) = P.errorPos err
71 warningMessage (ParseError _ err) = PP.text . init . P.parseErrorTextPretty $ err
71 warningMessage (ParseError _ err) = PP.text . init . P.parseErrorTextPretty $ err
72+ warningSource (ParseError src _) = Just src
72
73
73-- | A fully formatted parse error, with caret and bar, etc.
74-- | A fully formatted parse error, with caret and bar, etc.
74prettyError :: ParseError -> String
75prettyError :: ParseError -> String
src/Idris/REPL.hs+1−1
@@ -727,7 +727,7 @@ processInput cmd orig inputs efile
727 let fn = fromMaybe "" (listToMaybe inputs)
727 let fn = fromMaybe "" (listToMaybe inputs)
728 c <- colourise
728 c <- colourise
729 case parseCmd i "(input)" cmd of
729 case parseCmd i "(input)" cmd of
730− Left err -> Just inputs <$ iputStrLn (show . fixColour c . parseErrorDoc $ err)
730+ Left err -> Just inputs <$ emit err
731 Right (Right Reload) ->
731 Right (Right Reload) ->
732 reload orig inputs
732 reload orig inputs
733 Right (Right Watch) ->
733 Right (Right Watch) ->