Repository : ssh://darcs.haskell.org//srv/darcs/haddock On branch : local
http://hackage.haskell.org/trac/ghc/changeset/50b3ad3973616b49122dc1d143f1d7f75daf4033 >--------------------------------------------------------------- commit 50b3ad3973616b49122dc1d143f1d7f75daf4033 Author: Simon Hengel <[email protected]> Date: Thu Jan 12 11:54:37 2012 +0100 Add DocWarning to Doc The Xhtml backend has special markup for that, Hoogle and LaTeX reuse what we have for DocEmphasis. >--------------------------------------------------------------- html/Classic.theme/xhaddock.css | 6 +++--- html/Ocean.std-theme/ocean.css | 4 ++++ src/Haddock/Backends/Hoogle.hs | 1 + src/Haddock/Backends/LaTeX.hs | 1 + src/Haddock/Backends/Xhtml/DocMarkup.hs | 1 + src/Haddock/Interface/LexParseRn.hs | 1 + src/Haddock/Interface/Rename.hs | 3 +++ src/Haddock/InterfaceFile.hs | 14 ++++++++++---- src/Haddock/Types.hs | 2 ++ src/Haddock/Utils.hs | 2 ++ 10 files changed, 28 insertions(+), 7 deletions(-) diff --git a/html/Classic.theme/xhaddock.css b/html/Classic.theme/xhaddock.css index d6b58d2..40ea0d0 100644 --- a/html/Classic.theme/xhaddock.css +++ b/html/Classic.theme/xhaddock.css @@ -488,6 +488,6 @@ td.rdoc p { background: inherit; } - - - +.warning { + color: red; +} diff --git a/html/Ocean.std-theme/ocean.css b/html/Ocean.std-theme/ocean.css index e0ba8b0..4223870 100644 --- a/html/Ocean.std-theme/ocean.css +++ b/html/Ocean.std-theme/ocean.css @@ -429,6 +429,10 @@ div#style-menu-holder { padding-left: 2em; } +.warning { + color: red; +} + .arguments { margin-top: -0.4em; } diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index 6e3e306..cbb5921 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/src/Haddock/Backends/Hoogle.hs @@ -235,6 +235,7 @@ markupTag = Markup { markupIdentifier = box (TagInline "a") . str . out, markupIdentifierUnchecked = box (TagInline "a") . str . out . snd, markupModule = box (TagInline "a") . str, + markupWarning = box (TagInline "i"), markupEmphasis = box (TagInline "i"), markupMonospaced = box (TagInline "tt"), markupPic = const $ str " ", diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index e0a530b..ffe507a 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/src/Haddock/Backends/LaTeX.hs @@ -1006,6 +1006,7 @@ parLatexMarkup ppId = Markup { markupIdentifier = markupId ppId, markupIdentifierUnchecked = markupId (ppVerbOccName . snd), markupModule = \m _ -> let (mdl,_ref) = break (=='#') m in tt (text mdl), + markupWarning = \p v -> emph (p v), markupEmphasis = \p v -> emph (p v), markupMonospaced = \p _ -> tt (p Mono), markupUnorderedList = \p v -> itemizedList (map ($v) p) $$ text "", diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs index f506d2b..ee0a549 100644 --- a/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -39,6 +39,7 @@ parHtmlMarkup qual ppId = Markup { markupIdentifierUnchecked = thecode . ppUncheckedLink qual, markupModule = \m -> let (mdl,ref) = break (=='#') m in ppModuleRef (mkModuleName mdl) ref, + markupWarning = thediv ! [theclass "warning"], markupEmphasis = emphasize, markupMonospaced = thecode, markupUnorderedList = unordList, diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs index f70c595..ebd2b8f 100644 --- a/src/Haddock/Interface/LexParseRn.hs +++ b/src/Haddock/Interface/LexParseRn.hs @@ -108,6 +108,7 @@ rename gre = rn a:b:_ | isTyConName a -> DocIdentifier a | otherwise -> DocIdentifier b -- If an id can refer to multiple things, we give precedence to type -- constructors. + DocWarning doc -> DocWarning (rn doc) DocEmphasis doc -> DocEmphasis (rn doc) DocMonospaced doc -> DocMonospaced (rn doc) DocUnorderedList docs -> DocUnorderedList (map rn docs) diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index 691dafb..582c2cc 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -169,6 +169,9 @@ renameDoc d = case d of return (DocIdentifier x') DocIdentifierUnchecked x -> return (DocIdentifierUnchecked x) DocModule str -> return (DocModule str) + DocWarning doc -> do + doc' <- renameDoc doc + return (DocWarning doc') DocEmphasis doc -> do doc' <- renameDoc doc return (DocEmphasis doc') diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs index fcf7fe6..e998ffe 100644 --- a/src/Haddock/InterfaceFile.hs +++ b/src/Haddock/InterfaceFile.hs @@ -65,13 +65,13 @@ binaryInterfaceMagic = 0xD0Cface -- we version our interface files accordingly. binaryInterfaceVersion :: Word16 #if __GLASGOW_HASKELL__ == 702 -binaryInterfaceVersion = 19 +binaryInterfaceVersion = 20 #elif __GLASGOW_HASKELL__ == 703 -binaryInterfaceVersion = 19 +binaryInterfaceVersion = 20 #elif __GLASGOW_HASKELL__ == 704 -binaryInterfaceVersion = 19 +binaryInterfaceVersion = 20 #elif __GLASGOW_HASKELL__ == 705 -binaryInterfaceVersion = 19 +binaryInterfaceVersion = 20 #else #error Unknown GHC version #endif @@ -469,6 +469,9 @@ instance (Binary id) => Binary (Doc id) where put_ bh (DocIdentifierUnchecked x) = do putByte bh 16 put_ bh x + put_ bh (DocWarning ag) = do + putByte bh 17 + put_ bh ag get bh = do h <- getByte bh case h of @@ -523,6 +526,9 @@ instance (Binary id) => Binary (Doc id) where 16 -> do x <- get bh return (DocIdentifierUnchecked x) + 17 -> do + ag <- get bh + return (DocWarning ag) _ -> fail "invalid binary data found" diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index a3a7db1..fe4039a 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -283,6 +283,7 @@ data Doc id | DocIdentifier id | DocIdentifierUnchecked (ModuleName, OccName) | DocModule String + | DocWarning (Doc id) | DocEmphasis (Doc id) | DocMonospaced (Doc id) | DocUnorderedList [Doc id] @@ -324,6 +325,7 @@ data DocMarkup id a = Markup , markupIdentifier :: id -> a , markupIdentifierUnchecked :: (ModuleName, OccName) -> a , markupModule :: String -> a + , markupWarning :: a -> a , markupEmphasis :: a -> a , markupMonospaced :: a -> a , markupUnorderedList :: [a] -> a diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs index de97ef8..9865fdf 100644 --- a/src/Haddock/Utils.hs +++ b/src/Haddock/Utils.hs @@ -410,6 +410,7 @@ markup m (DocParagraph d) = markupParagraph m (markup m d) markup m (DocIdentifier x) = markupIdentifier m x markup m (DocIdentifierUnchecked x) = markupIdentifierUnchecked m x markup m (DocModule mod0) = markupModule m mod0 +markup m (DocWarning d) = markupWarning m (markup m d) markup m (DocEmphasis d) = markupEmphasis m (markup m d) markup m (DocMonospaced d) = markupMonospaced m (markup m d) markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds) @@ -436,6 +437,7 @@ idMarkup = Markup { markupIdentifier = DocIdentifier, markupIdentifierUnchecked = DocIdentifierUnchecked, markupModule = DocModule, + markupWarning = DocWarning, markupEmphasis = DocEmphasis, markupMonospaced = DocMonospaced, markupUnorderedList = DocUnorderedList, _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
