aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--html-test/ref/Extensions.html89
-rw-r--r--html-test/src/Extensions.hs7
-rw-r--r--resources/html/Classic.theme/xhaddock.css20
-rw-r--r--resources/html/Ocean.std-theme/ocean.css16
-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
12 files changed, 209 insertions, 48 deletions
diff --git a/html-test/ref/Extensions.html b/html-test/ref/Extensions.html
new file mode 100644
index 00000000..82fd732f
--- /dev/null
+++ b/html-test/ref/Extensions.html
@@ -0,0 +1,89 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><title
+ >Extensions</title
+ ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean"
+ /><script src="haddock-util.js" type="text/javascript"
+ ></script
+ ><script type="text/javascript"
+ >//<![CDATA[
+window.onload = function () {pageLoad();setSynopsis("mini_Extensions.html");};
+//]]>
+</script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href=""
+ >Contents</a
+ ></li
+ ><li
+ ><a href=""
+ >Index</a
+ ></li
+ ></ul
+ ><p class="caption empty"
+ >&nbsp;</p
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe-Inferred</td
+ ></tr
+ ><tr
+ ><th
+ >Language</th
+ ><td
+ >Haskell2010</td
+ ></tr
+ ><tr
+ ><th
+ >Extensions</th
+ ><td
+ >TypeHoles</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >Extensions</p
+ ></div
+ ><div id="synopsis"
+ ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')"
+ >Synopsis</p
+ ><ul id="section.syn" class="hide" onclick="toggleSection('syn')"
+ ><li class="src short"
+ ><a href=""
+ >foobar</a
+ > :: t</li
+ ></ul
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><a name="v:foobar" class="def"
+ >foobar</a
+ > :: t</p
+ ><div class="doc"
+ ><p
+ >Bar</p
+ ></div
+ ></div
+ ></div
+ ></div
+ ><div id="footer"
+ ><p
+ >Produced by <a href=""
+ >Haddock</a
+ > version 2.14.0</p
+ ></div
+ ></body
+ ></html
+>
diff --git a/html-test/src/Extensions.hs b/html-test/src/Extensions.hs
new file mode 100644
index 00000000..6b3535c9
--- /dev/null
+++ b/html-test/src/Extensions.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE Haskell2010, TypeHoles, MonomorphismRestriction #-}
+{-# OPTIONS_HADDOCK show-extensions #-}
+module Extensions where
+
+-- | Bar
+foobar :: t
+foobar = undefined
diff --git a/resources/html/Classic.theme/xhaddock.css b/resources/html/Classic.theme/xhaddock.css
index 40ea0d06..ed231b5a 100644
--- a/resources/html/Classic.theme/xhaddock.css
+++ b/resources/html/Classic.theme/xhaddock.css
@@ -3,7 +3,13 @@
padding: 0;
}
-body {
+.extension-list {
+ list-style-type: none;
+ margin-left: 0;
+ padding-left: 0;
+}
+
+body {
background-color: #ffffff;
color: #000000;
font-size: 100%;
@@ -53,7 +59,7 @@ h1, h2, h3, h4, h5 {
margin-bottom: 0.5em;
}
-p {
+p {
padding-top: 2px;
padding-left: 10px;
}
@@ -64,7 +70,7 @@ ul, ol, dl {
margin-left: 2.5em;
}
-pre {
+pre {
padding-top: 2px;
padding-left: 20px;
}
@@ -209,7 +215,7 @@ table.info {
#index .caption {
padding-top: 15px;
font-weight: bold;
- font-size: 150%
+ font-size: 150%
}
#synopsis {
@@ -357,7 +363,7 @@ p.arg {
margin-bottom: 0;
}
p.arg span {
- background-color: #f0f0f0;
+ background-color: #f0f0f0;
font-family: monospace;
white-space: nowrap;
float: none;
@@ -365,7 +371,7 @@ p.arg span {
img.coll {
- width : 0.75em; height: 0.75em; margin-bottom: 0; margin-right: 0.5em
+ width : 0.75em; height: 0.75em; margin-bottom: 0; margin-right: 0.5em
}
@@ -387,7 +393,7 @@ td.rdoc p {
color: #ffffff;
padding: 4px
}
-
+
#footer p {
padding: 1px;
margin: 0;
diff --git a/resources/html/Ocean.std-theme/ocean.css b/resources/html/Ocean.std-theme/ocean.css
index 42238709..b9ad560e 100644
--- a/resources/html/Ocean.std-theme/ocean.css
+++ b/resources/html/Ocean.std-theme/ocean.css
@@ -49,14 +49,14 @@ a[href]:hover { text-decoration:underline; }
For reasons, see:
http://yui.yahooapis.com/3.1.1/build/cssfonts/fonts.css
*/
-
+
body {
font:13px/1.4 sans-serif;
*font-size:small; /* for IE */
*font:x-small; /* for IE in quirks mode */
}
-h1 { font-size: 146.5%; /* 19pt */ }
+h1 { font-size: 146.5%; /* 19pt */ }
h2 { font-size: 131%; /* 17pt */ }
h3 { font-size: 116%; /* 15pt */ }
h4 { font-size: 100%; /* 13pt */ }
@@ -98,7 +98,7 @@ pre, code, kbd, samp, tt, .src {
/* @group Common */
-.caption, h1, h2, h3, h4, h5, h6 {
+.caption, h1, h2, h3, h4, h5, h6 {
font-weight: bold;
color: rgb(78,98,114);
margin: 0.8em 0 0.4em;
@@ -122,7 +122,7 @@ ul.links {
ul.links li {
display: inline;
- border-left: 1px solid #d5d5d5;
+ border-left: 1px solid #d5d5d5;
white-space: nowrap;
padding: 0;
}
@@ -457,13 +457,19 @@ div#style-menu-holder {
/* @group Auxillary Pages */
+
+.extension-list {
+ list-style-type: none;
+ margin-left: 0;
+}
+
#mini {
margin: 0 auto;
padding: 0 1em 1em;
}
#mini > * {
- font-size: 93%; /* 12pt */
+ font-size: 93%; /* 12pt */
}
#mini #module-list .caption,
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-11 06:42:43 +0000