Copyright holders shown on several lines. Fix #279

1 files changed, 14 insertions, 4 deletions

diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 8252839c..0958c2cd 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -35,8 +35,8 @@ import Text.XHtml hiding ( name, title, p, quote )
 import Haddock.GhcUtils
 
 import Control.Monad         ( when, unless )
-import Data.Char             ( toUpper )
-import Data.List             ( sortBy, intercalate, isPrefixOf )
+import Data.Char             ( toUpper, isSpace )
+import Data.List             ( sortBy, intercalate, isPrefixOf, intersperse )
 import Data.Maybe
 import System.FilePath hiding ( (</>) )
 import System.Directory
@@ -201,8 +201,7 @@ moduleInfo iface =
         field info >>= \a -> return (th << fieldName <-> td << a)
 
       entries :: [HtmlTable]
-      entries = mapMaybe doOneEntry [
-          ("Copyright",hmi_copyright),
+      entries = maybeToList copyrightsTable ++ mapMaybe doOneEntry [
           ("License",hmi_license),
           ("Maintainer",hmi_maintainer),
           ("Stability",hmi_stability),
@@ -216,6 +215,14 @@ moduleInfo iface =
             Just Haskell98 -> Just "Haskell98"
             Just Haskell2010 -> Just "Haskell2010"
 
+          multilineRow :: String -> [String] -> HtmlTable
+          multilineRow title xs = (th ! [valign "top"]) << title <-> td << (toLines xs)
+            where toLines = mconcat . intersperse br . map toHtml
+
+          copyrightsTable :: Maybe HtmlTable
+          copyrightsTable = fmap (multilineRow "Copyright" . split) (hmi_copyright info)
+            where split = map (trim . filter (/= ',')) . lines
+
           extsForm
             | OptShowExtensions `elem` ifaceOptions iface =
               let fs = map (dropOpt . show) (hmi_extensions info)
@@ -648,6 +655,9 @@ processDecl :: Bool -> Html -> Maybe Html
 processDecl True = Just
 processDecl False = Just . divTopDecl
 
+trim :: String -> String
+trim = f . f
+  where f = reverse . dropWhile isSpace
 
 processDeclOneLiner :: Bool -> Html -> Maybe Html
 processDeclOneLiner True = Just