From f1f94f2f634fb065f69ca2cc87a4a54f4e3a39ed Mon Sep 17 00:00:00 2001 From: Mateusz Kowalczyk Date: Fri, 30 Aug 2013 06:05:51 +0100 Subject: Per-module extension flags and language listing. Any extensions that are not enabled by a used language (Haskell2010 &c) will be shown. Furthermore, any implicitly enabled are also going to be shown. While we could eliminate this either by using the GHC API or a dirty hack, I opted not to: if a user doesn't want the implied flags to show, they are recommended to use enable extensions more carefully or individually. Perhaps this will encourage users to not enable the most powerful flags needlessly. Enabled with show-extensions. Conflicts: src/Haddock/InterfaceFile.hs --- src/Haddock/Interface/Create.hs | 25 +++++++++++++++---------- src/Haddock/Interface/LexParseRn.hs | 14 +++++++++++--- src/Haddock/Interface/ParseModuleHeader.hs | 5 +++-- 3 files changed, 29 insertions(+), 15 deletions(-) (limited to 'src/Haddock/Interface') diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 825e9624..6c20f00b 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -3,8 +3,9 @@ ----------------------------------------------------------------------------- -- | -- Module : Haddock.Interface.Create --- Copyright : (c) Simon Marlow 2003-2006, --- David Waern 2006-2009 +-- Copyright : (c) Simon Marlow 2003-2006, +-- David Waern 2006-2009, +-- Mateusz Kowalczyk 2013 -- License : BSD-like -- -- Maintainer : haddock@projects.haskell.org @@ -218,16 +219,20 @@ mkDocOpts mbOpts flags mdl = do [] -> tell ["No option supplied to DOC_OPTION/doc_option"] >> return [] xs -> liftM catMaybes (mapM parseOption xs) Nothing -> return [] - if Flag_HideModule (moduleString mdl) `elem` flags - then return $ OptHide : opts - else return opts + hm <- if Flag_HideModule (moduleString mdl) `elem` flags + then return $ OptHide : opts + else return opts + if Flag_ShowExtensions (moduleString mdl) `elem` flags + then return $ OptShowExtensions : hm + else return hm parseOption :: String -> ErrMsgM (Maybe DocOption) -parseOption "hide" = return (Just OptHide) -parseOption "prune" = return (Just OptPrune) -parseOption "ignore-exports" = return (Just OptIgnoreExports) -parseOption "not-home" = return (Just OptNotHome) +parseOption "hide" = return (Just OptHide) +parseOption "prune" = return (Just OptPrune) +parseOption "ignore-exports" = return (Just OptIgnoreExports) +parseOption "not-home" = return (Just OptNotHome) +parseOption "show-extensions" = return (Just OptShowExtensions) parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing @@ -649,7 +654,7 @@ lookupDocs n warnings docMap argMap subMap = -- 2) B is visible, but not all its exports are in scope in A, in which case we -- only return those that are. -- 3) B is visible and all its exports are in scope, in which case we return --- a single 'ExportModule' item. +-- a single 'ExportModule' item. moduleExports :: Module -- ^ Module A -> ModuleName -- ^ The real name of B, the exported module -> DynFlags -- ^ The flags used when typechecking A diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs index 73f2c165..c302e4f0 100644 --- a/src/Haddock/Interface/LexParseRn.hs +++ b/src/Haddock/Interface/LexParseRn.hs @@ -4,6 +4,7 @@ -- | -- Module : Haddock.Interface.LexParseRn -- Copyright : (c) Isaac Dupree 2009, +-- Mateusz Kowalczyk 2013 -- License : BSD-like -- -- Maintainer : haddock@projects.haskell.org @@ -17,7 +18,7 @@ module Haddock.Interface.LexParseRn , processModuleHeader ) where - +import qualified Data.IntSet as IS import Haddock.Types import Haddock.Parser import Haddock.Interface.ParseModuleHeader @@ -28,11 +29,11 @@ import Data.List import Data.Maybe import FastString import GHC +import DynFlags (ExtensionFlag(..), languageExtensions) import Name import Outputable import RdrName - processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (Doc Name)) processDocStrings dflags gre strs = do docs <- catMaybes <$> mapM (processDocStringParas dflags gre) strs @@ -82,7 +83,14 @@ processModuleHeader dflags gre safety mayStr = do hmi' = hmi { hmi_description = descr } doc' = rename dflags gre doc return (hmi', Just doc') - return (hmi { hmi_safety = Just $ showPpr dflags safety }, doc) + + let flags :: [ExtensionFlag] + -- We remove the flags implied by the language setting and we display the language instead + flags = map toEnum (IS.toList $ extensionFlags dflags) \\ languageExtensions (language dflags) + return (hmi { hmi_safety = Just $ showPpr dflags safety + , hmi_language = language dflags + , hmi_extensions = flags + } , doc) where failure = (emptyHaddockModInfo, Nothing) diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs index ade28728..0be2511f 100644 --- a/src/Haddock/Interface/ParseModuleHeader.hs +++ b/src/Haddock/Interface/ParseModuleHeader.hs @@ -61,7 +61,9 @@ parseModuleHeader dflags str0 = hmi_maintainer = maintainerOpt, hmi_stability = stabilityOpt, hmi_portability = portabilityOpt, - hmi_safety = Nothing + hmi_safety = Nothing, + hmi_language = Nothing, -- set in LexParseRn + hmi_extensions = [] -- also set in LexParseRn }, doc) -- | This function is how we read keys. @@ -158,4 +160,3 @@ parseKey key toParse0 = extractPrefix (c1:cs1) (c2:cs2) | toUpper c1 == toUpper c2 = extractPrefix cs1 cs2 | otherwise = Nothing - -- cgit v1.2.3