Output Copright and License keys in Xhtml backend.

This information is as relevant in the documentation as it is in the
source files themselves.

Signed-off-by: David Waern <david.waern@gmail.com>

4 files changed, 38 insertions, 26 deletions

diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index fde2da69..96aea5e5 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -200,11 +200,13 @@ moduleInfo iface =
 
       entries :: [HtmlTable]
       entries = mapMaybe doOneEntry [
-         ("Portability",hmi_portability),
-         ("Stability",hmi_stability),
-         ("Maintainer",hmi_maintainer),
-         ("Safe Haskell",hmi_safety)
-         ]
+          ("Copyright",hmi_copyright),
+          ("License",hmi_copyright),
+          ("Maintainer",hmi_maintainer),
+          ("Stability",hmi_stability),
+          ("Portability",hmi_portability),
+          ("Safe Haskell",hmi_safety)
+          ]
    in
       case entries of
          [] -> noHtml
diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs
index 18f4c768..5087affe 100644
--- a/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/src/Haddock/Interface/ParseModuleHeader.hs
@@ -19,6 +19,7 @@ import RdrName
 import DynFlags
 
 import Data.Char
+import Control.Monad (mplus)
 
 -- -----------------------------------------------------------------------------
 -- Parsing module headers
@@ -36,9 +37,9 @@ parseModuleHeader dflags str0 =
 
       (_moduleOpt,str1) = getKey "Module" str0
       (descriptionOpt,str2) = getKey "Description" str1
-      (_copyrightOpt,str3) = getKey "Copyright" str2
-      (_licenseOpt,str4) = getKey "License" str3
-      (_licenceOpt,str5) = getKey "Licence" str4
+      (copyrightOpt,str3) = getKey "Copyright" str2
+      (licenseOpt,str4) = getKey "License" str3
+      (licenceOpt,str5) = getKey "Licence" str4
       (maintainerOpt,str6) = getKey "Maintainer" str5
       (stabilityOpt,str7) = getKey "Stability" str6
       (portabilityOpt,str8) = getKey "Portability" str7
@@ -58,9 +59,11 @@ parseModuleHeader dflags str0 =
            Nothing -> Left "Cannot parse header documentation paragraphs"
            Just doc -> Right (HaddockModInfo {
             hmi_description = docOpt,
-            hmi_portability = portabilityOpt,
-            hmi_stability = stabilityOpt,
+            hmi_copyright = copyrightOpt,
+            hmi_license = licenseOpt `mplus` licenceOpt,
             hmi_maintainer = maintainerOpt,
+            hmi_stability = stabilityOpt,
+            hmi_portability = portabilityOpt,
             hmi_safety = Nothing
             }, doc)
 
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index ec7272e7..27a176ae 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -99,7 +99,7 @@ initBinMemSize = 1024*1024
 
 
 writeInterfaceFile :: FilePath -> InterfaceFile -> IO ()
-writeInterfaceFile filename iface = do 
+writeInterfaceFile filename iface = do
   bh0 <- openBinMem initBinMemSize
   put_ bh0 binaryInterfaceMagic
   put_ bh0 binaryInterfaceVersion
@@ -178,7 +178,7 @@ freshNameCache = ( create_fresh_nc , \_ -> return () )
        return (initNameCache u [])
 
 
--- | Read a Haddock (@.haddock@) interface file. Return either an 
+-- | Read a Haddock (@.haddock@) interface file. Return either an
 -- 'InterfaceFile' or an error message.
 --
 -- This function can be called in two ways.  Within a GHC session it will
@@ -206,7 +206,7 @@ readInterfaceFile (get_name_cache, set_name_cache) filename = do
       | otherwise -> with_name_cache $ \update_nc -> do
 
       dict  <- get_dictionary bh0
-  
+
       -- read the symbol table so we are capable of reading the actual data
       bh1 <- do
           let bh1 = setUserData bh0 $ newReadState (error "getSymtabName")
@@ -564,18 +564,22 @@ instance (Binary id) => Binary (Doc id) where
 instance Binary name => Binary (HaddockModInfo name) where
   put_ bh hmi = do
     put_ bh (hmi_description hmi)
-    put_ bh (hmi_portability hmi)
-    put_ bh (hmi_stability   hmi)
+    put_ bh (hmi_copyright   hmi)
+    put_ bh (hmi_license     hmi)
     put_ bh (hmi_maintainer  hmi)
+    put_ bh (hmi_stability   hmi)
+    put_ bh (hmi_portability hmi)
     put_ bh (hmi_safety      hmi)
 
   get bh = do
     descr <- get bh
-    porta <- get bh
-    stabi <- get bh
+    copyr <- get bh
+    licen <- get bh
     maint <- get bh
+    stabi <- get bh
+    porta <- get bh
     safet <- get bh
-    return (HaddockModInfo descr porta stabi maint safet)
+    return (HaddockModInfo descr copyr licen maint stabi porta safet)
 
 
 instance Binary DocName where
@@ -598,4 +602,3 @@ instance Binary DocName where
         name <- get bh
         return (Undocumented name)
       _ -> error "get DocName: Bad h"
-
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 181ea026..bd4f10fa 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -399,20 +399,24 @@ data DocMarkup id a = Markup
 
 
 data HaddockModInfo name = HaddockModInfo
-  { hmi_description :: (Maybe (Doc name))
-  , hmi_portability :: (Maybe String)
-  , hmi_stability   :: (Maybe String)
-  , hmi_maintainer  :: (Maybe String)
-  , hmi_safety      :: (Maybe String)
+  { hmi_description :: Maybe (Doc name)
+  , hmi_copyright   :: Maybe String
+  , hmi_license     :: Maybe String
+  , hmi_maintainer  :: Maybe String
+  , hmi_stability   :: Maybe String
+  , hmi_portability :: Maybe String
+  , hmi_safety      :: Maybe String
   }
 
 
 emptyHaddockModInfo :: HaddockModInfo a
 emptyHaddockModInfo = HaddockModInfo
   { hmi_description = Nothing
-  , hmi_portability = Nothing
-  , hmi_stability   = Nothing
+  , hmi_copyright   = Nothing
+  , hmi_license     = Nothing
   , hmi_maintainer  = Nothing
+  , hmi_stability   = Nothing
+  , hmi_portability = Nothing
   , hmi_safety      = Nothing
   }