diff options
author | Mathieu Boespflug <mathieu.boespflug@parsci.com> | 2013-05-20 11:56:28 +0200 |
---|---|---|
committer | David Waern <david.waern@gmail.com> | 2013-08-04 10:39:43 -0700 |
commit | c33a0b2ef062ac19692a4b836d28d16b49aab995 (patch) | |
tree | ed1745e4dd3510a708df8b5a25d7662275fcfc0c /src | |
parent | 34d2aa54b95e8d261dc325393893d06f6a085130 (diff) |
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>
Diffstat (limited to 'src')
-rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 12 | ||||
-rw-r--r-- | src/Haddock/Interface/ParseModuleHeader.hs | 13 | ||||
-rw-r--r-- | src/Haddock/InterfaceFile.hs | 21 | ||||
-rw-r--r-- | src/Haddock/Types.hs | 18 |
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 } |