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

2 files changed, 33 insertions, 14 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
-
-