diff options
Diffstat (limited to 'src/Haddock')
-rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 3 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 44 | ||||
-rw-r--r-- | src/Haddock/Interface/Create.hs | 25 | ||||
-rw-r--r-- | src/Haddock/Interface/LexParseRn.hs | 14 | ||||
-rw-r--r-- | src/Haddock/Interface/ParseModuleHeader.hs | 5 | ||||
-rw-r--r-- | src/Haddock/InterfaceFile.hs | 15 | ||||
-rw-r--r-- | src/Haddock/Options.hs | 8 | ||||
-rw-r--r-- | src/Haddock/Types.hs | 11 |
8 files changed, 89 insertions, 36 deletions
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index 5f00d784..4a30a168 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/src/Haddock/Backends/LaTeX.hs @@ -2,7 +2,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Haddock.Backends.LaTeX --- Copyright : (c) Simon Marlow 2010 +-- Copyright : (c) Simon Marlow 2010, +-- Mateusz Kowalczyk 2013 -- License : BSD-like -- -- Maintainer : haddock@projects.haskell.org diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index 96aea5e5..1b6d7fe5 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -1,9 +1,10 @@ ----------------------------------------------------------------------------- -- | -- Module : Haddock.Backends.Html --- Copyright : (c) Simon Marlow 2003-2006, --- David Waern 2006-2009, --- Mark Lentczner 2010 +-- Copyright : (c) Simon Marlow 2003-2006, +-- David Waern 2006-2009, +-- Mark Lentczner 2010, +-- Mateusz Kowalczyk 2013 -- License : BSD-like -- -- Maintainer : haddock@projects.haskell.org @@ -38,7 +39,8 @@ import Control.Monad ( when, unless ) import Control.Monad.Instances ( ) -- for Functor Either a #endif import Data.Char ( toUpper ) -import Data.List ( sortBy, groupBy, intercalate ) +import Data.Functor ( (<$>) ) +import Data.List ( sortBy, groupBy, intercalate, isPrefixOf ) import Data.Maybe import System.FilePath hiding ( (</>) ) import System.Directory @@ -48,11 +50,11 @@ import qualified Data.Set as Set hiding ( Set ) import Data.Function import Data.Ord ( comparing ) +import DynFlags (Language(..)) import GHC hiding ( NoLink, moduleInfo ) import Name import Module - -------------------------------------------------------------------------------- -- * Generating HTML documentation -------------------------------------------------------------------------------- @@ -174,7 +176,7 @@ bodyHtml doctitle iface divPackageHeader << [ unordList (catMaybes [ srcButton maybe_source_url iface, - wikiButton maybe_wiki_url (ifaceMod `fmap` iface), + wikiButton maybe_wiki_url (ifaceMod <$> iface), contentsButton maybe_contents_url, indexButton maybe_index_url]) ! [theclass "links", identifier "page-menu"], @@ -205,8 +207,26 @@ moduleInfo iface = ("Maintainer",hmi_maintainer), ("Stability",hmi_stability), ("Portability",hmi_portability), - ("Safe Haskell",hmi_safety) - ] + ("Safe Haskell",hmi_safety), + ("Language", lg) + ] ++ extsForm + where + lg inf = case hmi_language inf of + Nothing -> Nothing + Just Haskell98 -> Just "Haskell98" + Just Haskell2010 -> Just "Haskell2010" + + extsForm + | OptShowExtensions `elem` ifaceOptions iface = + let fs = map (dropOpt . show) (hmi_extensions info) + in case map stringToHtml fs of + [] -> [] + [x] -> extField x -- don't use a list for a single extension + xs -> extField $ unordList xs ! [theclass "extension-list"] + | otherwise = [] + where + extField x = return $ th << "Extensions" <-> td << x + dropOpt x = if "Opt_" `isPrefixOf` x then drop 4 x else x in case entries of [] -> noHtml @@ -283,7 +303,7 @@ mkNode qual ss p (Node s leaf pkg short ts) = -- We only need an explicit collapser button when the module name -- is also a leaf, and so is a link to a module page. Indeed, the -- spaceHtml is a minor hack and does upset the layout a fraction. - + htmlModule = thespan ! modAttrs << (cBtn +++ if leaf then ppModule (mkModule (stringToPackageId (fromMaybe "" pkg)) @@ -529,7 +549,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual | no_doc_at_all = noHtml | otherwise = divSynposis $ - paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++ + paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++ shortDeclList ( mapMaybe (processExport True linksInfo unicode qual) exports ) ! (collapseSection "syn" False "" ++ collapseToggle "syn") @@ -559,7 +579,7 @@ miniSynopsis mdl iface unicode qual = processForMiniSynopsis :: Module -> Bool -> Qualification -> ExportItem DocName -> [Html] processForMiniSynopsis mdl unicode qual (ExportDecl (L _loc decl0) _doc _ _insts) = - ((divTopDecl <<).(declElem <<)) `fmap` case decl0 of + ((divTopDecl <<).(declElem <<)) <$> case decl0 of TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of (FamDecl decl) -> [ppTyFamHeader True False decl unicode qual] (DataDecl{}) -> [keyword "data" <+> b] @@ -666,5 +686,3 @@ groupTag lev | lev == 2 = h2 | lev == 3 = h3 | otherwise = h4 - - 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 - diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs index 6bf22c9b..81ff17fd 100644 --- a/src/Haddock/InterfaceFile.hs +++ b/src/Haddock/InterfaceFile.hs @@ -3,7 +3,8 @@ ----------------------------------------------------------------------------- -- | -- Module : Haddock.InterfaceFile --- Copyright : (c) David Waern 2006-2009 +-- Copyright : (c) David Waern 2006-2009, +-- Mateusz Kowalczyk 2013 -- License : BSD-like -- -- Maintainer : haddock@projects.haskell.org @@ -24,6 +25,7 @@ import Haddock.Utils hiding (out) import Control.Monad import Data.Array +import Data.Functor ((<$>)) import Data.IORef import Data.List import qualified Data.Map as Map @@ -396,6 +398,8 @@ instance Binary DocOption where putByte bh 2 put_ bh OptNotHome = do putByte bh 3 + put_ bh OptShowExtensions = do + putByte bh 4 get bh = do h <- getByte bh case h of @@ -407,6 +411,8 @@ instance Binary DocOption where return OptIgnoreExports 3 -> do return OptNotHome + 4 -> do + return OptShowExtensions _ -> fail "invalid binary data found" @@ -590,6 +596,8 @@ instance Binary name => Binary (HaddockModInfo name) where put_ bh (hmi_stability hmi) put_ bh (hmi_portability hmi) put_ bh (hmi_safety hmi) + put_ bh (fromEnum <$> hmi_language hmi) + put_ bh (map fromEnum $ hmi_extensions hmi) get bh = do descr <- get bh @@ -599,8 +607,9 @@ instance Binary name => Binary (HaddockModInfo name) where stabi <- get bh porta <- get bh safet <- get bh - return (HaddockModInfo descr copyr licen maint stabi porta safet) - + langu <- fmap toEnum <$> get bh + exten <- map toEnum <$> get bh + return (HaddockModInfo descr copyr licen maint stabi porta safet langu exten) instance Binary DocName where put_ bh (Documented name modu) = do diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs index 751812d4..12c80b6e 100644 --- a/src/Haddock/Options.hs +++ b/src/Haddock/Options.hs @@ -1,8 +1,9 @@ ----------------------------------------------------------------------------- -- | -- Module : Haddock.Options --- 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 @@ -70,6 +71,7 @@ data Flag | Flag_GenIndex | Flag_IgnoreAllExports | Flag_HideModule String + | Flag_ShowExtensions String | Flag_OptGhc String | Flag_GhcLibDir String | Flag_GhcVersion @@ -151,6 +153,8 @@ options backwardsCompat = "behave as if all modules have the\nignore-exports atribute", Option [] ["hide"] (ReqArg Flag_HideModule "MODULE") "behave as if MODULE has the hide attribute", + Option [] ["show-extensions"] (ReqArg Flag_ShowExtensions "MODULE") + "behave as if MODULE has the show-extensions attribute", Option [] ["optghc"] (ReqArg Flag_OptGhc "OPTION") "option to be forwarded to GHC", Option [] ["ghc-version"] (NoArg Flag_GhcVersion) diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index 27a6201f..f90e5496 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -3,8 +3,9 @@ ----------------------------------------------------------------------------- -- | -- Module : Haddock.Types --- 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.haskellorg @@ -28,6 +29,7 @@ import Data.Typeable import Data.Map (Map) import qualified Data.Map as Map import GHC hiding (NoLink) +import DynFlags (ExtensionFlag, Language) import OccName import Control.Applicative (Applicative(..)) import Control.Monad (ap) @@ -422,6 +424,8 @@ data HaddockModInfo name = HaddockModInfo , hmi_stability :: Maybe String , hmi_portability :: Maybe String , hmi_safety :: Maybe String + , hmi_language :: Maybe Language + , hmi_extensions :: [ExtensionFlag] } @@ -434,6 +438,8 @@ emptyHaddockModInfo = HaddockModInfo , hmi_stability = Nothing , hmi_portability = Nothing , hmi_safety = Nothing + , hmi_language = Nothing + , hmi_extensions = [] } @@ -450,6 +456,7 @@ data DocOption | OptIgnoreExports -- ^ Pretend everything is exported. | OptNotHome -- ^ Not the best place to get docs for things -- exported by this module. + | OptShowExtensions -- ^ Render enabled extensions for this module. deriving (Eq, Show) |