[commit: haddock] ghc-7.6: If parsing of deprecation message fails, include it verbatim (cea620e)
Simon Hengel <[email protected]>
| Newsgroups | gmane.comp.lang.haskell.cvs.ghc |
|---|---|
| Message-ID | <[email protected]> |
Repository : ssh://darcs.haskell.org//srv/darcs/haddock On branch : ghc-7.6 http://hackage.haskell.org/trac/ghc/changeset/cea620e1f967ce066e11bcd79b831905f6151fef >--------------------------------------------------------------- commit cea620e1f967ce066e11bcd79b831905f6151fef Author: Simon Hengel <[email protected]> Date: Sun Oct 14 13:55:09 2012 +0200 If parsing of deprecation message fails, include it verbatim >--------------------------------------------------------------- src/Haddock/Interface/Create.hs | 19 ++++---- .../tests/DeprecationMessageParseError.hs | 12 +++++ ...l.ref => DeprecationMessageParseError.html.ref} | 47 ++++++++------------ ... => mini_DeprecationMessageParseError.html.ref} | 4 +- 4 files changed, 43 insertions(+), 39 deletions(-) diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index fca1a00..3eb5205 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) ------------------------------------------------------------------------------- diff --git a/tests/html-tests/tests/DeprecationMessageParseError.hs b/tests/html-tests/tests/DeprecationMessageParseError.hs new file mode 100644 index 0000000..5f0b871 --- /dev/null +++ b/tests/html-tests/tests/DeprecationMessageParseError.hs @@ -0,0 +1,12 @@ +-- | +-- What is tested here: +-- +-- * if parsing of a deprecation message fails, the message is included +-- verbatim +-- +module DeprecationMessageParseError where + +-- | some documentation for foo +foo :: Int +foo = 23 +{-# DEPRECATED foo "use @bar instead" #-} diff --git a/tests/html-tests/tests/DeprecatedFunction.html.ref b/tests/html-tests/tests/DeprecationMessageParseError.html.ref similarity index 79% copy from tests/html-tests/tests/DeprecatedFunction.html.ref copy to tests/html-tests/tests/DeprecationMessageParseError.html.ref index 1fc678b..b4ea426 100644 --- a/tests/html-tests/tests/DeprecatedFunction.html.ref +++ b/tests/html-tests/tests/DeprecationMessageParseError.html.ref @@ -3,13 +3,13 @@ ><head ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /><title - >DeprecatedFunction</title + >DeprecationMessageParseError</title ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" /><script src="haddock-util.js" type="text/javascript" ></script ><script type="text/javascript" >//<![CDATA[ -window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedFunction.html");}; +window.onload = function () {pageLoad();setSynopsis("mini_DeprecationMessageParseError.html");}; //]]> </script ></head @@ -39,7 +39,22 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedFunction.htm ></tr ></table ><p class="caption" - >DeprecatedFunction</p + >DeprecationMessageParseError</p + ></div + ><div id="description" + ><p class="caption" + >Description</p + ><div class="doc" + ><p + >What is tested here: +</p + ><ul + ><li + > if parsing of a deprecation message fails, the message is included + verbatim +</li + ></ul + ></div ></div ><div id="synopsis" ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')" @@ -51,12 +66,6 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedFunction.htm > :: <a href="" >Int</a ></li - ><li class="src short" - ><a href="" - >bar</a - > :: <a href="" - >Int</a - ></li ></ul ></div ><div id="interface" @@ -72,31 +81,13 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedFunction.htm ><div class="doc" ><div class="warning" ><p - >Deprecated: use <code - ><a href="" - >bar</a - ></code - > instead -</p + >Deprecated: use @bar instead</p ></div ><p >some documentation for foo </p ></div ></div - ><div class="top" - ><p class="src" - ><a name="v:bar" class="def" - >bar</a - > :: <a href="" - >Int</a - ></p - ><div class="doc" - ><p - >some documentation for bar -</p - ></div - ></div ></div ></div ><div id="footer" diff --git a/tests/html-tests/tests/mini_DeprecatedFunction3.html.ref b/tests/html-tests/tests/mini_DeprecationMessageParseError.html.ref similarity index 90% copy from tests/html-tests/tests/mini_DeprecatedFunction3.html.ref copy to tests/html-tests/tests/mini_DeprecationMessageParseError.html.ref index 4ea6033..e52f487 100644 --- a/tests/html-tests/tests/mini_DeprecatedFunction3.html.ref +++ b/tests/html-tests/tests/mini_DeprecationMessageParseError.html.ref @@ -3,7 +3,7 @@ ><head ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /><title - >DeprecatedFunction3</title + >DeprecationMessageParseError</title ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" /><script src="haddock-util.js" type="text/javascript" ></script @@ -16,7 +16,7 @@ window.onload = function () {pageLoad();}; ><body id="mini" ><div id="module-header" ><p class="caption" - >DeprecatedFunction3</p + >DeprecationMessageParseError</p ></div ><div id="interface" ><div class="top"