aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Interface')
-rw-r--r--src/Haddock/Interface/LexParseRn.hs27
-rw-r--r--src/Haddock/Interface/ParseModuleHeader.hs3
-rw-r--r--src/Haddock/Interface/Rn.hs5
3 files changed, 21 insertions, 14 deletions
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 [] = []