[commit: haddock] master: Output Copright and License keys in Xhtml backend. (c33a0b2)

git at git.haskell.org git at git.haskell.org
Sat Aug 24 17:23:03 CEST 2013


Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/?p=haddock.git;a=commit;h=c33a0b2ef062ac19692a4b836d28d16b49aab995

>---------------------------------------------------------------

commit c33a0b2ef062ac19692a4b836d28d16b49aab995
Author: Mathieu Boespflug <mathieu.boespflug at parsci.com>
Date:   Mon May 20 11:56:28 2013 +0200

    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 at gmail.com>


>---------------------------------------------------------------

c33a0b2ef062ac19692a4b836d28d16b49aab995
 src/Haddock/Backends/Xhtml.hs              |   12 +++++++-----
 src/Haddock/Interface/ParseModuleHeader.hs |   13 ++++++++-----
 src/Haddock/InterfaceFile.hs               |   15 +++++++++------
 src/Haddock/Types.hs                       |   18 +++++++++++-------
 4 files changed, 35 insertions(+), 23 deletions(-)

diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index fde2da6..96aea5e 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 18f4c76..5087aff 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 ec7272e..27a176a 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -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 181ea02..bd4f10f 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
   }
 





More information about the ghc-commits mailing list