From 45bcf701d8e99e86f28a966b31654c16a5ae6b42 Mon Sep 17 00:00:00 2001 From: David Terei Date: Thu, 18 Aug 2011 14:27:53 -0700 Subject: Add safe haskell indication to haddock output --- src/Haddock/Interface/LexParseRn.hs | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) (limited to 'src/Haddock/Interface/LexParseRn.hs') 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) -- cgit v1.2.3