aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Backends/LaTeX.hs3
-rw-r--r--src/Haddock/Backends/Xhtml.hs44
-rw-r--r--src/Haddock/Interface/Create.hs25
-rw-r--r--src/Haddock/Interface/LexParseRn.hs14
-rw-r--r--src/Haddock/Interface/ParseModuleHeader.hs5
-rw-r--r--src/Haddock/InterfaceFile.hs15
-rw-r--r--src/Haddock/Options.hs8
-rw-r--r--src/Haddock/Types.hs11
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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-24 03:14:38 +0000