diff options
22 files changed, 179 insertions, 61 deletions
diff --git a/haddock.cabal b/haddock.cabal index b77fc5ac..88c18cd3 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -189,6 +189,7 @@ test-suite spec base , ghc , containers + , deepseq , array -- NOTE: As of this writing, Cabal does not properly handle alex/happy for diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 32f287f5..fca1a00e 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 (unpackFS) +import FastString (concatFS) -- | Use a 'TypecheckedModule' to produce an 'Interface'. @@ -90,7 +90,8 @@ createInterface tm flags modMap instIfaceMap = do liftErrMsg $ warnAboutFilteredDecls dflags mdl decls - let warningMap = mkWarningMap warnings gre exportedNames + warningMap <- liftErrMsg $ mkWarningMap dflags warnings gre exportedNames + exportItems <- mkExportItems modMap mdl warningMap gre exportedNames decls maps exports instances instIfaceMap dflags @@ -112,11 +113,13 @@ createInterface tm flags modMap instIfaceMap = do let !aliases = mkAliasMap dflags $ tm_renamed_source tm + modWarn <- liftErrMsg $ moduleWarning dflags gre warnings + return $! Interface { ifaceMod = mdl, ifaceOrigFilename = msHsFilePath ms, ifaceInfo = info, - ifaceDoc = Documentation mbDoc (moduleWarning warnings), + ifaceDoc = Documentation mbDoc modWarn, ifaceRnDoc = Documentation Nothing Nothing, ifaceOptions = opts, ifaceDocMap = docMap, @@ -169,29 +172,35 @@ lookupModuleDyn dflags Nothing mdlName = type WarningMap = DocMap Name -mkWarningMap :: Warnings -> GlobalRdrEnv -> [Name] -> WarningMap -mkWarningMap NoWarnings _ _ = M.empty -mkWarningMap (WarnAll _) _ _ = M.empty -mkWarningMap (WarnSome ws) gre exps = M.fromList - [ (n, warnToDoc w) | (occ, w) <- ws, elt <- lookupGlobalRdrEnv gre occ - , let n = gre_name elt, n `elem` exps ] +mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap +mkWarningMap dflags warnings gre exps = case warnings of + NoWarnings -> return M.empty + WarnAll _ -> return M.empty + 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' + where + parse (n, w) = (fmap $ (,) n) <$> parseWarning dflags gre w -moduleWarning :: Warnings -> Maybe (Doc id) -moduleWarning ws = +moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name)) +moduleWarning dflags gre ws = case ws of - NoWarnings -> Nothing - WarnSome _ -> Nothing - WarnAll w -> Just $! warnToDoc w + NoWarnings -> return Nothing + WarnSome _ -> return Nothing + WarnAll w -> parseWarning dflags gre w -warnToDoc :: WarningTxt -> Doc id -warnToDoc w = case w of - (DeprecatedTxt msg) -> format "Deprecated: " msg - (WarningTxt msg) -> format "Warning: " msg +parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Maybe (Doc Name)) +parseWarning dflags gre w = do + r <- case w of + (DeprecatedTxt msg) -> format "Deprecated: " msg + (WarningTxt msg) -> format "Warning: " msg + r `deepseq` return r where - format x xs = let !str = force $ concat (x : map unpackFS xs) - in DocWarning $ DocParagraph $ DocString str + format x xs = fmap (DocWarning . DocParagraph . DocAppend (DocString x)) + <$> processDocString dflags gre (HsDocString $ concatFS xs) ------------------------------------------------------------------------------- diff --git a/src/Haddock/Parse.y b/src/Haddock/Parse.y index 0befe395..f40ff521 100644 --- a/src/Haddock/Parse.y +++ b/src/Haddock/Parse.y @@ -7,7 +7,7 @@ -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details -module Haddock.Parse where +module Haddock.Parse (parseString, parseParas) where import Haddock.Lex import Haddock.Types (Doc(..), Example(Example), Hyperlink(..)) diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index 05fc9747..9be46748 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -1,5 +1,5 @@ -{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Haddock.Types @@ -22,6 +22,7 @@ module Haddock.Types ( import Control.Exception import Control.Arrow +import Control.DeepSeq import Data.Typeable import Data.Map (Map) import Data.Maybe @@ -316,18 +317,54 @@ instance Monoid (Doc id) where mappend = DocAppend +instance NFData a => NFData (Doc a) where + rnf doc = case doc of + DocEmpty -> () + DocAppend a b -> a `deepseq` b `deepseq` () + DocString a -> a `deepseq` () + DocParagraph a -> a `deepseq` () + DocIdentifier a -> a `deepseq` () + DocIdentifierUnchecked a -> a `deepseq` () + DocModule a -> a `deepseq` () + DocWarning a -> a `deepseq` () + DocEmphasis a -> a `deepseq` () + DocMonospaced a -> a `deepseq` () + DocUnorderedList a -> a `deepseq` () + DocOrderedList a -> a `deepseq` () + DocDefList a -> a `deepseq` () + DocCodeBlock a -> a `deepseq` () + DocHyperlink a -> a `deepseq` () + DocPic a -> a `deepseq` () + DocAName a -> a `deepseq` () + DocProperty a -> a `deepseq` () + DocExamples a -> a `deepseq` () + + +instance NFData Name +instance NFData OccName +instance NFData ModuleName + + data Hyperlink = Hyperlink { hyperlinkUrl :: String , hyperlinkLabel :: Maybe String } deriving (Eq, Show) +instance NFData Hyperlink where + rnf (Hyperlink a b) = a `deepseq` b `deepseq` () + + data Example = Example { exampleExpression :: String , exampleResult :: [String] } deriving (Eq, Show) +instance NFData Example where + rnf (Example a b) = a `deepseq` b `deepseq` () + + exampleToString :: Example -> String exampleToString (Example expression result) = ">>> " ++ expression ++ "\n" ++ unlines result diff --git a/tests/html-tests/tests/BugDeprecated.html.ref b/tests/html-tests/tests/BugDeprecated.html.ref index f632d670..913b189d 100644 --- a/tests/html-tests/tests/BugDeprecated.html.ref +++ b/tests/html-tests/tests/BugDeprecated.html.ref @@ -96,7 +96,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugDeprecated.html");} ><div class="doc" ><div class="warning" ><p - >Deprecated: for foo</p + >Deprecated: for foo +</p ></div ></div ></div @@ -110,7 +111,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugDeprecated.html");} ><div class="doc" ><div class="warning" ><p - >Deprecated: for baz</p + >Deprecated: for baz +</p ></div ></div ></div @@ -124,7 +126,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugDeprecated.html");} ><div class="doc" ><div class="warning" ><p - >Deprecated: for bar</p + >Deprecated: for bar +</p ></div ></div ></div @@ -138,7 +141,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugDeprecated.html");} ><div class="doc" ><div class="warning" ><p - >Deprecated: for one</p + >Deprecated: for one +</p ></div ><p >some documentation for one, two and three @@ -155,7 +159,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugDeprecated.html");} ><div class="doc" ><div class="warning" ><p - >Deprecated: for three</p + >Deprecated: for three +</p ></div ><p >some documentation for one, two and three @@ -172,7 +177,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugDeprecated.html");} ><div class="doc" ><div class="warning" ><p - >Deprecated: for two</p + >Deprecated: for two +</p ></div ><p >some documentation for one, two and three diff --git a/tests/html-tests/tests/BugExportHeadings.html.ref b/tests/html-tests/tests/BugExportHeadings.html.ref index d3298b2e..457e2c50 100644 --- a/tests/html-tests/tests/BugExportHeadings.html.ref +++ b/tests/html-tests/tests/BugExportHeadings.html.ref @@ -166,7 +166,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugExportHeadings.html ><div class="doc" ><div class="warning" ><p - >Deprecated: for one</p + >Deprecated: for one +</p ></div ></div ></div @@ -183,7 +184,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugExportHeadings.html ><div class="doc" ><div class="warning" ><p - >Deprecated: for two</p + >Deprecated: for two +</p ></div ></div ></div @@ -200,7 +202,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_BugExportHeadings.html ><div class="doc" ><div class="warning" ><p - >Deprecated: for three</p + >Deprecated: for three +</p ></div ></div ></div diff --git a/tests/html-tests/tests/DeprecatedClass.html.ref b/tests/html-tests/tests/DeprecatedClass.html.ref index 21806843..d716c1d8 100644 --- a/tests/html-tests/tests/DeprecatedClass.html.ref +++ b/tests/html-tests/tests/DeprecatedClass.html.ref @@ -90,7 +90,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedClass.html") ><div class="doc" ><div class="warning" ><p - >Deprecated: SomeClass</p + >Deprecated: SomeClass +</p ></div ><p >some class @@ -106,7 +107,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedClass.html") ><div class="doc" ><div class="warning" ><p - >Deprecated: foo</p + >Deprecated: foo +</p ></div ><p >documentation for foo @@ -126,7 +128,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedClass.html") ><div class="doc" ><div class="warning" ><p - >Deprecated: SomeOtherClass</p + >Deprecated: SomeOtherClass +</p ></div ></div ><div class="subs methods" @@ -139,7 +142,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedClass.html") ><div class="doc" ><div class="warning" ><p - >Deprecated: bar</p + >Deprecated: bar +</p ></div ></div ></div diff --git a/tests/html-tests/tests/DeprecatedData.html.ref b/tests/html-tests/tests/DeprecatedData.html.ref index c7ea7579..24758345 100644 --- a/tests/html-tests/tests/DeprecatedData.html.ref +++ b/tests/html-tests/tests/DeprecatedData.html.ref @@ -92,7 +92,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedData.html"); ><div class="doc" ><div class="warning" ><p - >Deprecated: Foo</p + >Deprecated: Foo +</p ></div ><p >type Foo @@ -110,7 +111,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedData.html"); ><td class="doc" ><div class="warning" ><p - >Deprecated: Foo</p + >Deprecated: Foo +</p ></div ><p >constructor Foo @@ -125,7 +127,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedData.html"); ><td class="doc" ><div class="warning" ><p - >Deprecated: Bar</p + >Deprecated: Bar +</p ></div ><p >constructor Bar @@ -145,7 +148,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedData.html"); ><div class="doc" ><div class="warning" ><p - >Deprecated: One</p + >Deprecated: One +</p ></div ></div ><div class="subs constructors" @@ -160,7 +164,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedData.html"); ><td class="doc" ><div class="warning" ><p - >Deprecated: One</p + >Deprecated: One +</p ></div ></td ></tr @@ -172,7 +177,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedData.html"); ><td class="doc" ><div class="warning" ><p - >Deprecated: Two</p + >Deprecated: Two +</p ></div ></td ></tr diff --git a/tests/html-tests/tests/DeprecatedFunction.hs b/tests/html-tests/tests/DeprecatedFunction.hs index 55416369..8d626435 100644 --- a/tests/html-tests/tests/DeprecatedFunction.hs +++ b/tests/html-tests/tests/DeprecatedFunction.hs @@ -1,6 +1,10 @@ module DeprecatedFunction where --- | some documentation foo +-- | some documentation for foo foo :: Int foo = 23 -{-# DEPRECATED foo "use bar instead" #-} +{-# DEPRECATED foo "use `bar` instead" #-} + +-- | some documentation for bar +bar :: Int +bar = 42 diff --git a/tests/html-tests/tests/DeprecatedFunction.html.ref b/tests/html-tests/tests/DeprecatedFunction.html.ref index a44d2265..1fc678bb 100644 --- a/tests/html-tests/tests/DeprecatedFunction.html.ref +++ b/tests/html-tests/tests/DeprecatedFunction.html.ref @@ -51,6 +51,12 @@ 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" @@ -66,10 +72,28 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedFunction.htm ><div class="doc" ><div class="warning" ><p - >Deprecated: use bar instead</p + >Deprecated: use <code + ><a href="" + >bar</a + ></code + > instead +</p ></div ><p - >some documentation foo + >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 diff --git a/tests/html-tests/tests/DeprecatedFunction2.html.ref b/tests/html-tests/tests/DeprecatedFunction2.html.ref index 5b8c8b6c..b5068c8e 100644 --- a/tests/html-tests/tests/DeprecatedFunction2.html.ref +++ b/tests/html-tests/tests/DeprecatedFunction2.html.ref @@ -66,7 +66,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedFunction2.ht ><div class="doc" ><div class="warning" ><p - >Deprecated: use bar instead</p + >Deprecated: use bar instead +</p ></div ></div ></div diff --git a/tests/html-tests/tests/DeprecatedFunction3.html.ref b/tests/html-tests/tests/DeprecatedFunction3.html.ref index 942e12b8..f24eb666 100644 --- a/tests/html-tests/tests/DeprecatedFunction3.html.ref +++ b/tests/html-tests/tests/DeprecatedFunction3.html.ref @@ -66,7 +66,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedFunction3.ht ><div class="doc" ><div class="warning" ><p - >Deprecated: use bar instead</p + >Deprecated: use bar instead +</p ></div ></div ></div diff --git a/tests/html-tests/tests/DeprecatedModule.hs b/tests/html-tests/tests/DeprecatedModule.hs index 61a09d64..369dba4f 100644 --- a/tests/html-tests/tests/DeprecatedModule.hs +++ b/tests/html-tests/tests/DeprecatedModule.hs @@ -1,5 +1,5 @@ -- | Documentation for "DeprecatedModule". -module DeprecatedModule {-# DEPRECATED "Use Foo instead" #-} where +module DeprecatedModule {-# DEPRECATED "Use \"Foo\" instead" #-} where foo :: Int foo = 23 diff --git a/tests/html-tests/tests/DeprecatedModule.html.ref b/tests/html-tests/tests/DeprecatedModule.html.ref index 7c035bf9..0ca4fafe 100644 --- a/tests/html-tests/tests/DeprecatedModule.html.ref +++ b/tests/html-tests/tests/DeprecatedModule.html.ref @@ -47,7 +47,10 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedModule.html" ><div class="doc" ><div class="warning" ><p - >Deprecated: Use Foo instead</p + >Deprecated: Use <a href="" + >Foo</a + > instead +</p ></div ><p >Documentation for <a href="" diff --git a/tests/html-tests/tests/DeprecatedModule2.html.ref b/tests/html-tests/tests/DeprecatedModule2.html.ref index c2a61074..0a313ae9 100644 --- a/tests/html-tests/tests/DeprecatedModule2.html.ref +++ b/tests/html-tests/tests/DeprecatedModule2.html.ref @@ -47,7 +47,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedModule2.html ><div class="doc" ><div class="warning" ><p - >Deprecated: Use Foo instead</p + >Deprecated: Use Foo instead +</p ></div ></div ></div diff --git a/tests/html-tests/tests/DeprecatedNewtype.html.ref b/tests/html-tests/tests/DeprecatedNewtype.html.ref index 2a854dd9..521ffb92 100644 --- a/tests/html-tests/tests/DeprecatedNewtype.html.ref +++ b/tests/html-tests/tests/DeprecatedNewtype.html.ref @@ -80,7 +80,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedNewtype.html ><div class="doc" ><div class="warning" ><p - >Deprecated: SomeNewType</p + >Deprecated: SomeNewType +</p ></div ><p >some documentation @@ -100,7 +101,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedNewtype.html ><td class="doc" ><div class="warning" ><p - >Deprecated: SomeNewTypeConst</p + >Deprecated: SomeNewTypeConst +</p ></div ><p >constructor docu @@ -120,7 +122,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedNewtype.html ><div class="doc" ><div class="warning" ><p - >Deprecated: SomeOtherNewType</p + >Deprecated: SomeOtherNewType +</p ></div ></div ><div class="subs constructors" @@ -137,7 +140,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedNewtype.html ><td class="doc" ><div class="warning" ><p - >Deprecated: SomeOtherNewTypeConst</p + >Deprecated: SomeOtherNewTypeConst +</p ></div ></td ></tr diff --git a/tests/html-tests/tests/DeprecatedRecord.html.ref b/tests/html-tests/tests/DeprecatedRecord.html.ref index 77839ca7..9ade8377 100644 --- a/tests/html-tests/tests/DeprecatedRecord.html.ref +++ b/tests/html-tests/tests/DeprecatedRecord.html.ref @@ -122,7 +122,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedRecord.html" ><dd class="doc" ><div class="warning" ><p - >Deprecated: do not use this</p + >Deprecated: do not use this +</p ></div ><p >some value diff --git a/tests/html-tests/tests/DeprecatedTypeFamily.html.ref b/tests/html-tests/tests/DeprecatedTypeFamily.html.ref index cd091802..ffc069a6 100644 --- a/tests/html-tests/tests/DeprecatedTypeFamily.html.ref +++ b/tests/html-tests/tests/DeprecatedTypeFamily.html.ref @@ -72,7 +72,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedTypeFamily.h ><div class="doc" ><div class="warning" ><p - >Deprecated: SomeTypeFamily</p + >Deprecated: SomeTypeFamily +</p ></div ><p >some documentation @@ -89,7 +90,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedTypeFamily.h ><div class="doc" ><div class="warning" ><p - >Deprecated: SomeOtherTypeFamily</p + >Deprecated: SomeOtherTypeFamily +</p ></div ></div ></div diff --git a/tests/html-tests/tests/DeprecatedTypeSynonym.html.ref b/tests/html-tests/tests/DeprecatedTypeSynonym.html.ref index e148012a..665dcf5d 100644 --- a/tests/html-tests/tests/DeprecatedTypeSynonym.html.ref +++ b/tests/html-tests/tests/DeprecatedTypeSynonym.html.ref @@ -78,7 +78,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedTypeSynonym. ><div class="doc" ><div class="warning" ><p - >Deprecated: TypeSyn</p + >Deprecated: TypeSyn +</p ></div ><p >some documentation @@ -97,7 +98,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedTypeSynonym. ><div class="doc" ><div class="warning" ><p - >Deprecated: OtherTypeSyn</p + >Deprecated: OtherTypeSyn +</p ></div ></div ></div diff --git a/tests/html-tests/tests/ModuleWithWarning.hs b/tests/html-tests/tests/ModuleWithWarning.hs index 2114bac6..e64d9d7e 100644 --- a/tests/html-tests/tests/ModuleWithWarning.hs +++ b/tests/html-tests/tests/ModuleWithWarning.hs @@ -1,5 +1,5 @@ -- | Documentation for "ModuleWithWarning". -module ModuleWithWarning {-# WARNING "This is an unstable interface." #-} where +module ModuleWithWarning {-# WARNING "This is an unstable interface. Prefer functions from \"Prelude\" instead!" #-} where foo :: Int foo = 23 diff --git a/tests/html-tests/tests/ModuleWithWarning.html.ref b/tests/html-tests/tests/ModuleWithWarning.html.ref index 6a427259..348f0822 100644 --- a/tests/html-tests/tests/ModuleWithWarning.html.ref +++ b/tests/html-tests/tests/ModuleWithWarning.html.ref @@ -47,7 +47,10 @@ window.onload = function () {pageLoad();setSynopsis("mini_ModuleWithWarning.html ><div class="doc" ><div class="warning" ><p - >Warning: This is an unstable interface.</p + >Warning: This is an unstable interface. Prefer functions from <a href="" + >Prelude</a + > instead! +</p ></div ><p >Documentation for <a href="" diff --git a/tests/html-tests/tests/mini_DeprecatedFunction.html.ref b/tests/html-tests/tests/mini_DeprecatedFunction.html.ref index 17d3e526..9bb90dac 100644 --- a/tests/html-tests/tests/mini_DeprecatedFunction.html.ref +++ b/tests/html-tests/tests/mini_DeprecatedFunction.html.ref @@ -25,6 +25,12 @@ window.onload = function () {pageLoad();}; >foo</a ></p ></div + ><div class="top" + ><p class="src" + ><a href="" target="main" + >bar</a + ></p + ></div ></div ></body ></html |