Ticket #245: 0001-Output-Copright-and-License-keys-in-Xhtml-backend.patch

File 0001-Output-Copright-and-License-keys-in-Xhtml-backend.patch, 6.2 kB (added by mboes, 19 months ago)

Fix.

  • src/Haddock/Backends/Xhtml.hs

    From e49f9c96f3cff30c414b1d86e8103dce9f8ebbff Mon Sep 17 00:00:00 2001
    From: Mathieu Boespflug <mathieu.boespflug@parsci.com>
    Date: Mon, 20 May 2013 11:56:28 +0200
    Subject: [PATCH] Output Copright and License keys in Xhtml backend.
    
    This information is as relevant in the documentation as it is in the
    source files themselves.
    ---
     src/Haddock/Backends/Xhtml.hs              | 12 +++++++-----
     src/Haddock/Interface/ParseModuleHeader.hs | 13 ++++++++-----
     src/Haddock/InterfaceFile.hs               | 21 ++++++++++++---------
     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 fde2da6..96aea5e 100644
    a b  
    200200 
    201201      entries :: [HtmlTable] 
    202202      entries = mapMaybe doOneEntry [ 
    203          ("Portability",hmi_portability), 
    204          ("Stability",hmi_stability), 
    205          ("Maintainer",hmi_maintainer), 
    206          ("Safe Haskell",hmi_safety) 
    207          ] 
     203          ("Copyright",hmi_copyright), 
     204          ("License",hmi_copyright), 
     205          ("Maintainer",hmi_maintainer), 
     206          ("Stability",hmi_stability), 
     207          ("Portability",hmi_portability), 
     208          ("Safe Haskell",hmi_safety) 
     209          ] 
    208210   in 
    209211      case entries of 
    210212         [] -> noHtml 
  • src/Haddock/Interface/ParseModuleHeader.hs

    diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs
    index 18f4c76..5087aff 100644
    a b  
    1919import DynFlags 
    2020 
    2121import Data.Char 
     22import Control.Monad (mplus) 
    2223 
    2324-- ----------------------------------------------------------------------------- 
    2425-- Parsing module headers 
     
    3637 
    3738      (_moduleOpt,str1) = getKey "Module" str0 
    3839      (descriptionOpt,str2) = getKey "Description" str1 
    39       (_copyrightOpt,str3) = getKey "Copyright" str2 
    40       (_licenseOpt,str4) = getKey "License" str3 
    41       (_licenceOpt,str5) = getKey "Licence" str4 
     40      (copyrightOpt,str3) = getKey "Copyright" str2 
     41      (licenseOpt,str4) = getKey "License" str3 
     42      (licenceOpt,str5) = getKey "Licence" str4 
    4243      (maintainerOpt,str6) = getKey "Maintainer" str5 
    4344      (stabilityOpt,str7) = getKey "Stability" str6 
    4445      (portabilityOpt,str8) = getKey "Portability" str7 
     
    5859           Nothing -> Left "Cannot parse header documentation paragraphs" 
    5960           Just doc -> Right (HaddockModInfo { 
    6061            hmi_description = docOpt, 
    61             hmi_portability = portabilityOpt, 
    62             hmi_stability = stabilityOpt, 
     62            hmi_copyright = copyrightOpt, 
     63            hmi_license = licenseOpt `mplus` licenceOpt, 
    6364            hmi_maintainer = maintainerOpt, 
     65            hmi_stability = stabilityOpt, 
     66            hmi_portability = portabilityOpt, 
    6467            hmi_safety = Nothing 
    6568            }, doc) 
    6669 
  • src/Haddock/InterfaceFile.hs

    diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
    index ec7272e..27a176a 100644
    a b  
    9999 
    100100 
    101101writeInterfaceFile :: FilePath -> InterfaceFile -> IO () 
    102 writeInterfaceFile filename iface = do  
     102writeInterfaceFile filename iface = do 
    103103  bh0 <- openBinMem initBinMemSize 
    104104  put_ bh0 binaryInterfaceMagic 
    105105  put_ bh0 binaryInterfaceVersion 
     
    178178       return (initNameCache u []) 
    179179 
    180180 
    181 -- | Read a Haddock (@.haddock@) interface file. Return either an  
     181-- | Read a Haddock (@.haddock@) interface file. Return either an 
    182182-- 'InterfaceFile' or an error message. 
    183183-- 
    184184-- This function can be called in two ways.  Within a GHC session it will 
     
    206206      | otherwise -> with_name_cache $ \update_nc -> do 
    207207 
    208208      dict  <- get_dictionary bh0 
    209    
     209 
    210210      -- read the symbol table so we are capable of reading the actual data 
    211211      bh1 <- do 
    212212          let bh1 = setUserData bh0 $ newReadState (error "getSymtabName") 
     
    564564instance Binary name => Binary (HaddockModInfo name) where 
    565565  put_ bh hmi = do 
    566566    put_ bh (hmi_description hmi) 
    567     put_ bh (hmi_portability hmi) 
    568     put_ bh (hmi_stability   hmi) 
     567    put_ bh (hmi_copyright  hmi) 
     568    put_ bh (hmi_license     hmi) 
    569569    put_ bh (hmi_maintainer  hmi) 
     570    put_ bh (hmi_stability   hmi) 
     571    put_ bh (hmi_portability hmi) 
    570572    put_ bh (hmi_safety      hmi) 
    571573 
    572574  get bh = do 
    573575    descr <- get bh 
    574     porta <- get bh 
    575     stabi <- get bh 
     576    copyr <- get bh 
     577    licen <- get bh 
    576578    maint <- get bh 
     579    stabi <- get bh 
     580    porta <- get bh 
    577581    safet <- get bh 
    578     return (HaddockModInfo descr porta stabi maint safet) 
     582    return (HaddockModInfo descr copyr licen maint stabi porta safet) 
    579583 
    580584 
    581585instance Binary DocName where 
     
    598602        name <- get bh 
    599603        return (Undocumented name) 
    600604      _ -> error "get DocName: Bad h" 
    601  
  • src/Haddock/Types.hs

    diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
    index 181ea02..bd4f10f 100644
    a b  
    399399 
    400400 
    401401data HaddockModInfo name = HaddockModInfo 
    402   { hmi_description :: (Maybe (Doc name)) 
    403   , hmi_portability :: (Maybe String) 
    404   , hmi_stability   :: (Maybe String) 
    405   , hmi_maintainer  :: (Maybe String) 
    406   , hmi_safety      :: (Maybe String) 
     402  { hmi_description :: Maybe (Doc name) 
     403  , hmi_copyright   :: Maybe String 
     404  , hmi_license     :: Maybe String 
     405  , hmi_maintainer  :: Maybe String 
     406  , hmi_stability   :: Maybe String 
     407  , hmi_portability :: Maybe String 
     408  , hmi_safety      :: Maybe String 
    407409  } 
    408410 
    409411 
    410412emptyHaddockModInfo :: HaddockModInfo a 
    411413emptyHaddockModInfo = HaddockModInfo 
    412414  { hmi_description = Nothing 
    413   , hmi_portability = Nothing 
    414   , hmi_stability   = Nothing 
     415  , hmi_copyright  = Nothing 
     416  , hmi_license     = Nothing 
    415417  , hmi_maintainer  = Nothing 
     418  , hmi_stability   = Nothing 
     419  , hmi_portability = Nothing 
    416420  , hmi_safety      = Nothing 
    417421  } 
    418422