aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorDavid Terei <davidterei@gmail.com>2011-08-18 14:27:53 -0700
committerDavid Terei <davidterei@gmail.com>2011-10-12 14:06:58 -0700
commit0c16f3b04aadd0cc22fedbf123bae6369d1c445e (patch)
tree2c3b8045789334e9ac12b55a9f5de1d1c8dd8f7d /src
parent2eb873b5191eee0ffb5094068ab8f0d580453299 (diff)
Add safe haskell indication to haddock output
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Backends/Xhtml.hs3
-rw-r--r--src/Haddock/Interface/LexParseRn.hs27
-rw-r--r--src/Haddock/Interface/ParseModuleHeader.hs3
-rw-r--r--src/Haddock/Interface/Rn.hs5
-rw-r--r--src/Haddock/InterfaceFile.hs4
-rw-r--r--src/Haddock/Types.hs2
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 d337eefe..33f28d68 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -511,13 +511,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 d82e3efd..c0bf4ad7 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
}