Add safe haskell indication to haddock output

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 []    = []