diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 3 | ||||
| -rw-r--r-- | src/Haddock/Interface/LexParseRn.hs | 27 | ||||
| -rw-r--r-- | src/Haddock/Interface/ParseModuleHeader.hs | 3 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rn.hs | 5 | ||||
| -rw-r--r-- | src/Haddock/InterfaceFile.hs | 4 | ||||
| -rw-r--r-- | src/Haddock/Types.hs | 2 | 
6 files changed, 28 insertions, 16 deletions
| diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index b639760d..08e2fe07 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -200,7 +200,8 @@ moduleInfo iface =        entries = mapMaybe doOneEntry [           ("Portability",hmi_portability),           ("Stability",hmi_stability), -         ("Maintainer",hmi_maintainer) +         ("Maintainer",hmi_maintainer), +         ("Safe Haskell",hmi_safety)           ]     in        case entries of diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs index a92c9c46..d013ca27 100644 --- a/src/Haddock/Interface/LexParseRn.hs +++ b/src/Haddock/Interface/LexParseRn.hs @@ -25,6 +25,7 @@ import Haddock.Doc  import Data.Maybe  import FastString  import GHC +import Outputable ( showPpr )  import RdrName  data HaddockCommentType = NormalHaddockComment | DocSectionComment @@ -59,14 +60,18 @@ lexParseRnMbHaddockComment dflags hty gre (Just d) = lexParseRnHaddockComment df  -- yes, you always get a HaddockModInfo though it might be empty  lexParseRnHaddockModHeader :: DynFlags -> GlobalRdrEnv -> GhcDocHdr -> ErrMsgM (HaddockModInfo Name, Maybe (Doc Name))  lexParseRnHaddockModHeader dflags gre mbStr = do -  let failure = (emptyHaddockModInfo, Nothing) -  case mbStr of -    Nothing -> return failure -    Just (L _ (HsDocString fs)) -> do -      let str = unpackFS fs -      case parseModuleHeader dflags str of -        Left mess -> do -          tell ["haddock module header parse failed: " ++ mess] -          return failure -        Right (info, doc) -> -          return (rnHaddockModInfo gre info, Just (rnDoc gre doc)) +    (hmod, docn) <- case mbStr of +          Nothing -> return failure +          Just (L _ (HsDocString fs)) -> do +            let str = unpackFS fs +            case parseModuleHeader dflags str of +              Left mess -> do +                tell ["haddock module header parse failed: " ++ mess] +                return failure +              Right (info, doc) -> +                return (rnHaddockModInfo gre info, Just (rnDoc gre doc)) +    return (hmod { hmi_safety = safety }, docn) + +  where +    safety  = Just $ showPpr $ safeHaskell dflags +    failure = (emptyHaddockModInfo, Nothing) diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs index d0e3e5fb..35533d0d 100644 --- a/src/Haddock/Interface/ParseModuleHeader.hs +++ b/src/Haddock/Interface/ParseModuleHeader.hs @@ -59,7 +59,8 @@ parseModuleHeader dflags str0 =              hmi_description = docOpt,              hmi_portability = portabilityOpt,              hmi_stability = stabilityOpt, -            hmi_maintainer = maintainerOpt +            hmi_maintainer = maintainerOpt, +            hmi_safety = Nothing              }, doc)  -- | This function is how we read keys. diff --git a/src/Haddock/Interface/Rn.hs b/src/Haddock/Interface/Rn.hs index 6f7af908..d63524b6 100644 --- a/src/Haddock/Interface/Rn.hs +++ b/src/Haddock/Interface/Rn.hs @@ -9,8 +9,9 @@ import Name        ( Name )  import Outputable  ( ppr, showSDoc )  rnHaddockModInfo :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name -rnHaddockModInfo gre (HaddockModInfo desc port stab maint) = -  HaddockModInfo (fmap (rnDoc gre) desc) port stab maint +rnHaddockModInfo gre hmod = +  let desc = hmi_description hmod +  in hmod { hmi_description = fmap (rnDoc gre) desc }  ids2string :: [RdrName] -> String  ids2string []    = [] diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs index 57374b1d..8ff91e34 100644 --- a/src/Haddock/InterfaceFile.hs +++ b/src/Haddock/InterfaceFile.hs @@ -526,13 +526,15 @@ instance Binary name => Binary (HaddockModInfo name) where      put_ bh (hmi_portability hmi)      put_ bh (hmi_stability   hmi)      put_ bh (hmi_maintainer  hmi) +    put_ bh (hmi_safety      hmi)    get bh = do      descr <- get bh      porta <- get bh      stabi <- get bh      maint <- get bh -    return (HaddockModInfo descr porta stabi maint) +    safet <- get bh +    return (HaddockModInfo descr porta stabi maint safet)  instance Binary DocName where diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index fddafc1d..c9b29bd0 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -330,6 +330,7 @@ data HaddockModInfo name = HaddockModInfo    , hmi_portability :: Maybe String    , hmi_stability   :: Maybe String    , hmi_maintainer  :: Maybe String +  , hmi_safety      :: Maybe String    } @@ -339,6 +340,7 @@ emptyHaddockModInfo = HaddockModInfo    , hmi_portability = Nothing    , hmi_stability   = Nothing    , hmi_maintainer  = Nothing +  , hmi_safety      = Nothing    } | 
