Add DocWarning to Doc

The Xhtml backend has special markup for that, Hoogle and LaTeX reuse
what we have for DocEmphasis.

10 files changed, 28 insertions, 7 deletions

diff --git a/html/Classic.theme/xhaddock.css b/html/Classic.theme/xhaddock.css
index d6b58d22..40ea0d06 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 e0ba8b0c..42238709 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 6e3e306a..cbb5921d 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 e0a530be..ffe507ab 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 f506d2b8..ee0a549f 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 f70c5953..ebd2b8fc 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 691dafbc..582c2ccd 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 fcf7fe65..e998ffec 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 a3a7db15..fe4039a7 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 de97ef85..9865fdf1 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,