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/Backends/LaTeX.hs | 3 ++- src/Haddock/Backends/Xhtml.hs | 44 ++++++++++++++++++++++++++++++------------- 2 files changed, 33 insertions(+), 14 deletions(-) (limited to 'src/Haddock/Backends') 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 - - -- cgit v1.2.3