aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSimon Hengel <sol@typeful.net>2012-10-14 13:55:09 +0200
committerSimon Hengel <sol@typeful.net>2012-10-14 14:00:23 +0200
commitcea620e1f967ce066e11bcd79b831905f6151fef (patch)
tree035e6df7ea61bdc414b0e4166ee657aafb705c64 /src
parentdfc2cb4e31d6756b2d6ca7f87e80d8913751a4b7 (diff)
If parsing of deprecation message fails, include it verbatim
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Interface/Create.hs19
1 files changed, 10 insertions, 9 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index fca1a00e..3eb5205c 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -41,7 +41,7 @@ import Name
import Bag
import RdrName
import TcRnTypes
-import FastString (concatFS)
+import FastString (unpackFS, concatFS)
-- | Use a 'TypecheckedModule' to produce an 'Interface'.
@@ -179,9 +179,9 @@ mkWarningMap dflags warnings gre exps = case warnings of
WarnSome ws -> do
let ws' = [ (n, w) | (occ, w) <- ws, elt <- lookupGlobalRdrEnv gre occ
, let n = gre_name elt, n `elem` exps ]
- M.fromList . catMaybes <$> mapM parse ws'
+ M.fromList <$> mapM parse ws'
where
- parse (n, w) = (fmap $ (,) n) <$> parseWarning dflags gre w
+ parse (n, w) = (,) n <$> parseWarning dflags gre w
moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name))
@@ -189,18 +189,19 @@ moduleWarning dflags gre ws =
case ws of
NoWarnings -> return Nothing
WarnSome _ -> return Nothing
- WarnAll w -> parseWarning dflags gre w
+ WarnAll w -> Just <$> parseWarning dflags gre w
-parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Maybe (Doc Name))
+parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)
parseWarning dflags gre w = do
r <- case w of
- (DeprecatedTxt msg) -> format "Deprecated: " msg
- (WarningTxt msg) -> format "Warning: " msg
+ (DeprecatedTxt msg) -> format "Deprecated: " (concatFS msg)
+ (WarningTxt msg) -> format "Warning: " (concatFS msg)
r `deepseq` return r
where
- format x xs = fmap (DocWarning . DocParagraph . DocAppend (DocString x))
- <$> processDocString dflags gre (HsDocString $ concatFS xs)
+ format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
+ . fromMaybe (DocString . unpackFS $ xs)
+ <$> processDocString dflags gre (HsDocString xs)
-------------------------------------------------------------------------------