-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.Backends.Html.Layout
-- Copyright   :  (c) Simon Marlow   2003-2006,
--                    David Waern    2006-2009,
--                    Mark Lentczner 2010
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
-----------------------------------------------------------------------------
module Haddock.Backends.Xhtml.Layout (
  miniBody,

  divPackageHeader, divContent, divModuleHeader, divFooter,
  divTableOfContents, divDescription, divSynopsis, divInterface,
  divIndex, divAlphabet, divModuleList, divContentsList,

  sectionName,
  nonEmptySectionName,

  shortDeclList,
  shortSubDecls,

  divTopDecl,

  SubDecl,
  subArguments,
  subAssociatedTypes,
  subConstructors,
  subPatterns,
  subEquations,
  subFields,
  subInstances, subOrphanInstances,
  subInstHead, subInstDetails, subFamInstDetails,
  subMethods,
  subDefaults,
  subMinimal,

  topDeclElem, declElem,
) where

import Haddock.Backends.Xhtml.DocMarkup
import Haddock.Backends.Xhtml.Types
import Haddock.Backends.Xhtml.Utils
import Haddock.Types
import Haddock.Utils (makeAnchorId, nameAnchorId)
import qualified Data.Map as Map
import Text.XHtml hiding ( name, title, quote )
import Data.Maybe (fromMaybe)

import FastString            ( unpackFS )
import GHC
import Name (nameOccName)

--------------------------------------------------------------------------------
-- * Sections of the document
--------------------------------------------------------------------------------


miniBody :: Html -> Html
miniBody :: Html -> Html
miniBody = Html -> Html
body (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
identifier String
"mini"]


sectionDiv :: String -> Html -> Html
sectionDiv :: String -> Html -> Html
sectionDiv String
i = Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
identifier String
i]


sectionName :: Html -> Html
sectionName :: Html -> Html
sectionName = Html -> Html
paragraph (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"caption"]


-- | Make an element that always has at least something (a non-breaking space).
-- If it would have otherwise been empty, then give it the class ".empty".
nonEmptySectionName :: Html -> Html
nonEmptySectionName :: Html -> Html
nonEmptySectionName Html
c
  | Html -> Bool
isNoHtml Html
c = Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"caption empty"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
spaceHtml
  | Bool
otherwise  = Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"caption"]       (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
c


divPackageHeader, divContent, divModuleHeader, divFooter,
  divTableOfContents, divDescription, divSynopsis, divInterface,
  divIndex, divAlphabet, divModuleList, divContentsList
    :: Html -> Html

divPackageHeader :: Html -> Html
divPackageHeader    = String -> Html -> Html
sectionDiv String
"package-header"
divContent :: Html -> Html
divContent          = String -> Html -> Html
sectionDiv String
"content"
divModuleHeader :: Html -> Html
divModuleHeader     = String -> Html -> Html
sectionDiv String
"module-header"
divFooter :: Html -> Html
divFooter           = String -> Html -> Html
sectionDiv String
"footer"
divTableOfContents :: Html -> Html
divTableOfContents  = String -> Html -> Html
sectionDiv String
"table-of-contents"
divContentsList :: Html -> Html
divContentsList     = String -> Html -> Html
sectionDiv String
"contents-list"
divDescription :: Html -> Html
divDescription      = String -> Html -> Html
sectionDiv String
"description"
divSynopsis :: Html -> Html
divSynopsis         = String -> Html -> Html
sectionDiv String
"synopsis"
divInterface :: Html -> Html
divInterface        = String -> Html -> Html
sectionDiv String
"interface"
divIndex :: Html -> Html
divIndex            = String -> Html -> Html
sectionDiv String
"index"
divAlphabet :: Html -> Html
divAlphabet         = String -> Html -> Html
sectionDiv String
"alphabet"
divModuleList :: Html -> Html
divModuleList       = String -> Html -> Html
sectionDiv String
"module-list"


--------------------------------------------------------------------------------
-- * Declaration containers
--------------------------------------------------------------------------------


shortDeclList :: [Html] -> Html
shortDeclList :: [Html] -> Html
shortDeclList [Html]
items = Html -> Html
ulist (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html -> Html) -> [Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
li (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"src short"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<) [Html]
items


shortSubDecls :: Bool -> [Html] -> Html
shortSubDecls :: Bool -> [Html] -> Html
shortSubDecls Bool
inst [Html]
items = Html -> Html
ulist (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
c] (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html -> Html) -> [Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> Html
i (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<) [Html]
items
  where i :: Html -> Html
i | Bool
inst      = Html -> Html
li (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"inst"]
          | Bool
otherwise = Html -> Html
li
        c :: String
c | Bool
inst      = String
"inst"
          | Bool
otherwise = String
"subs"


divTopDecl :: Html -> Html
divTopDecl :: Html -> Html
divTopDecl = Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"top"]


type SubDecl = (Html, Maybe (MDoc DocName), [Html])


divSubDecls :: (HTML a) => String -> a -> Maybe Html -> Html
divSubDecls :: String -> a -> Maybe Html -> Html
divSubDecls String
cssClass a
captionName = Html -> (Html -> Html) -> Maybe Html -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
noHtml Html -> Html
wrap
  where
    wrap :: Html -> Html
wrap = (Html -> Html
subSection (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<) (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html
subCaption Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++)
    subSection :: Html -> Html
subSection = Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass (String -> HtmlAttr) -> String -> HtmlAttr
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"subs", String
cssClass]]
    subCaption :: Html
subCaption = Html -> Html
paragraph (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"caption"] (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< a
captionName


subDlist :: Maybe Package -> Qualification -> [SubDecl] -> Maybe Html
subDlist :: Maybe String -> Qualification -> [SubDecl] -> Maybe Html
subDlist Maybe String
_ Qualification
_ [] = Maybe Html
forall a. Maybe a
Nothing
subDlist Maybe String
pkg Qualification
qual [SubDecl]
decls = Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
ulist (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (SubDecl -> Html) -> [SubDecl] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map SubDecl -> Html
forall a b (f :: * -> *).
(HTML a, HTML b, HTML (f Html), Functor f) =>
(a, f (MDoc DocName), b) -> Html
subEntry [SubDecl]
decls
  where
    subEntry :: (a, f (MDoc DocName), b) -> Html
subEntry (a
decl, f (MDoc DocName)
mdoc, b
subs) =
      Html -> Html
li (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<
        (Html -> Html
define (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"src"] (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< a
decl Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
         (Html -> Html) -> Html -> Html
docElement Html -> Html
thediv (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< ((MDoc DocName -> Html) -> f (MDoc DocName) -> f Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe String
-> Maybe String -> Qualification -> MDoc DocName -> Html
docToHtml Maybe String
forall a. Maybe a
Nothing Maybe String
pkg Qualification
qual) f (MDoc DocName)
mdoc f Html -> b -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ b
subs))


subTable :: Maybe Package -> Qualification -> [SubDecl] -> Maybe Html
subTable :: Maybe String -> Qualification -> [SubDecl] -> Maybe Html
subTable Maybe String
_ Qualification
_ [] = Maybe Html
forall a. Maybe a
Nothing
subTable Maybe String
pkg Qualification
qual [SubDecl]
decls = Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
table (Html -> Html) -> HtmlTable -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [HtmlTable] -> HtmlTable
forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves ((SubDecl -> [HtmlTable]) -> [SubDecl] -> [HtmlTable]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SubDecl -> [HtmlTable]
forall (f :: * -> *) a a.
(Functor f, HTML a, HTML a, HTML (f Html)) =>
(a, f (MDoc DocName), [a]) -> [HtmlTable]
subRow [SubDecl]
decls)
  where
    subRow :: (a, f (MDoc DocName), [a]) -> [HtmlTable]
subRow (a
decl, f (MDoc DocName)
mdoc, [a]
subs) =
      (Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"src"] (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< a
decl
       Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
<->
       (Html -> Html) -> Html -> Html
docElement Html -> Html
td (Html -> Html) -> f Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (MDoc DocName -> Html) -> f (MDoc DocName) -> f Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe String
-> Maybe String -> Qualification -> MDoc DocName -> Html
docToHtml Maybe String
forall a. Maybe a
Nothing Maybe String
pkg Qualification
qual) f (MDoc DocName)
mdoc)
      HtmlTable -> [HtmlTable] -> [HtmlTable]
forall a. a -> [a] -> [a]
: (a -> HtmlTable) -> [a] -> [HtmlTable]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> HtmlTable
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell (Html -> HtmlTable) -> (a -> Html) -> a -> HtmlTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html
td (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<)) [a]
subs


-- | Sub table with source information (optional).
subTableSrc :: Maybe Package -> Qualification -> LinksInfo -> Bool
            -> [(SubDecl, Maybe Module, Located DocName)] -> Maybe Html
subTableSrc :: Maybe String
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Maybe Html
subTableSrc Maybe String
_ Qualification
_ LinksInfo
_ Bool
_ [] = Maybe Html
forall a. Maybe a
Nothing
subTableSrc Maybe String
pkg Qualification
qual LinksInfo
lnks Bool
splice [(SubDecl, Maybe Module, Located DocName)]
decls = Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
table (Html -> Html) -> HtmlTable -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [HtmlTable] -> HtmlTable
forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves (((SubDecl, Maybe Module, Located DocName) -> [HtmlTable])
-> [(SubDecl, Maybe Module, Located DocName)] -> [HtmlTable]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SubDecl, Maybe Module, Located DocName) -> [HtmlTable]
forall (f :: * -> *) a a.
(Functor f, HTML a, HTML a, HTML (f Html)) =>
((a, f (MDoc DocName), [a]), Maybe Module, Located DocName)
-> [HtmlTable]
subRow [(SubDecl, Maybe Module, Located DocName)]
decls)
  where
    subRow :: ((a, f (MDoc DocName), [a]), Maybe Module, Located DocName)
-> [HtmlTable]
subRow ((a
decl, f (MDoc DocName)
mdoc, [a]
subs), Maybe Module
mdl, L SrcSpan
loc DocName
dn) =
      (Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"src clearfix"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<
        (Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"inst-left"] (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< a
decl)
        Html -> Html -> Html
<+> SrcSpan -> Maybe Module -> DocName -> Html
linkHtml SrcSpan
loc Maybe Module
mdl DocName
dn
      Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
<->
      (Html -> Html) -> Html -> Html
docElement Html -> Html
td (Html -> Html) -> f Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (MDoc DocName -> Html) -> f (MDoc DocName) -> f Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe String
-> Maybe String -> Qualification -> MDoc DocName -> Html
docToHtml Maybe String
forall a. Maybe a
Nothing Maybe String
pkg Qualification
qual) f (MDoc DocName)
mdoc
      )
      HtmlTable -> [HtmlTable] -> [HtmlTable]
forall a. a -> [a] -> [a]
: (a -> HtmlTable) -> [a] -> [HtmlTable]
forall a b. (a -> b) -> [a] -> [b]
map (Html -> HtmlTable
forall ht. HTMLTABLE ht => ht -> HtmlTable
cell (Html -> HtmlTable) -> (a -> Html) -> a -> HtmlTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html
td (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<)) [a]
subs

    linkHtml :: SrcSpan -> Maybe Module -> DocName -> Html
    linkHtml :: SrcSpan -> Maybe Module -> DocName -> Html
linkHtml loc :: SrcSpan
loc@(RealSrcSpan RealSrcSpan
_) Maybe Module
mdl DocName
dn = LinksInfo -> SrcSpan -> Bool -> Maybe Module -> DocName -> Html
links LinksInfo
lnks SrcSpan
loc Bool
splice Maybe Module
mdl DocName
dn
    linkHtml SrcSpan
_ Maybe Module
_ DocName
_ = Html
noHtml

subBlock :: [Html] -> Maybe Html
subBlock :: [Html] -> Maybe Html
subBlock [] = Maybe Html
forall a. Maybe a
Nothing
subBlock [Html]
hs = Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. HTML a => a -> Html
toHtml [Html]
hs


subArguments :: Maybe Package -> Qualification -> [SubDecl] -> Html
subArguments :: Maybe String -> Qualification -> [SubDecl] -> Html
subArguments Maybe String
pkg Qualification
qual = String -> String -> Maybe Html -> Html
forall a. HTML a => String -> a -> Maybe Html -> Html
divSubDecls String
"arguments" String
"Arguments" (Maybe Html -> Html)
-> ([SubDecl] -> Maybe Html) -> [SubDecl] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Qualification -> [SubDecl] -> Maybe Html
subTable Maybe String
pkg Qualification
qual


subAssociatedTypes :: [Html] -> Html
subAssociatedTypes :: [Html] -> Html
subAssociatedTypes = String -> String -> Maybe Html -> Html
forall a. HTML a => String -> a -> Maybe Html -> Html
divSubDecls String
"associated-types" String
"Associated Types" (Maybe Html -> Html) -> ([Html] -> Maybe Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Maybe Html
subBlock


subConstructors :: Maybe Package -> Qualification -> [SubDecl] -> Html
subConstructors :: Maybe String -> Qualification -> [SubDecl] -> Html
subConstructors Maybe String
pkg Qualification
qual = String -> String -> Maybe Html -> Html
forall a. HTML a => String -> a -> Maybe Html -> Html
divSubDecls String
"constructors" String
"Constructors" (Maybe Html -> Html)
-> ([SubDecl] -> Maybe Html) -> [SubDecl] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Qualification -> [SubDecl] -> Maybe Html
subTable Maybe String
pkg Qualification
qual

subPatterns :: Maybe Package -> Qualification -> [SubDecl] -> Html
subPatterns :: Maybe String -> Qualification -> [SubDecl] -> Html
subPatterns Maybe String
pkg Qualification
qual = String -> String -> Maybe Html -> Html
forall a. HTML a => String -> a -> Maybe Html -> Html
divSubDecls String
"bundled-patterns" String
"Bundled Patterns" (Maybe Html -> Html)
-> ([SubDecl] -> Maybe Html) -> [SubDecl] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Qualification -> [SubDecl] -> Maybe Html
subTable Maybe String
pkg Qualification
qual

subFields :: Maybe Package -> Qualification -> [SubDecl] -> Html
subFields :: Maybe String -> Qualification -> [SubDecl] -> Html
subFields Maybe String
pkg Qualification
qual = String -> String -> Maybe Html -> Html
forall a. HTML a => String -> a -> Maybe Html -> Html
divSubDecls String
"fields" String
"Fields" (Maybe Html -> Html)
-> ([SubDecl] -> Maybe Html) -> [SubDecl] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Qualification -> [SubDecl] -> Maybe Html
subDlist Maybe String
pkg Qualification
qual


subEquations :: Maybe Package -> Qualification -> [SubDecl] -> Html
subEquations :: Maybe String -> Qualification -> [SubDecl] -> Html
subEquations Maybe String
pkg Qualification
qual = String -> String -> Maybe Html -> Html
forall a. HTML a => String -> a -> Maybe Html -> Html
divSubDecls String
"equations" String
"Equations" (Maybe Html -> Html)
-> ([SubDecl] -> Maybe Html) -> [SubDecl] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Qualification -> [SubDecl] -> Maybe Html
subTable Maybe String
pkg Qualification
qual


-- | Generate collapsible sub table for instance declarations, with source
subInstances :: Maybe Package -> Qualification
             -> String -- ^ Class name, used for anchor generation
             -> LinksInfo -> Bool
             -> [(SubDecl, Maybe Module, Located DocName)] -> Html
subInstances :: Maybe String
-> Qualification
-> String
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
subInstances Maybe String
pkg Qualification
qual String
nm LinksInfo
lnks Bool
splice = Html -> (Html -> Html) -> Maybe Html -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
noHtml Html -> Html
forall a. HTML a => a -> Html
wrap (Maybe Html -> Html)
-> ([(SubDecl, Maybe Module, Located DocName)] -> Maybe Html)
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SubDecl, Maybe Module, Located DocName)] -> Maybe Html
instTable
  where
    wrap :: b -> Html
wrap b
contents = Html -> Html
subSection (Html
hdr Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ String -> DetailsState -> Html -> Html
collapseDetails String
id_ DetailsState
DetailsOpen (Html
summary Html -> b -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ b
contents))
    instTable :: [(SubDecl, Maybe Module, Located DocName)] -> Maybe Html
instTable = Maybe String
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Maybe Html
subTableSrc Maybe String
pkg Qualification
qual LinksInfo
lnks Bool
splice
    subSection :: Html -> Html
subSection = Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"subs instances"]
    hdr :: Html
hdr = Html -> Html
h4 (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! String -> String -> [HtmlAttr]
collapseControl String
id_ String
"instances" (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Instances"
    summary :: Html
summary = Html -> Html
thesummary (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
theclass String
"hide-when-js-enabled" ] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Instances details"
    id_ :: String
id_ = String -> String
makeAnchorId (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"i:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm


subOrphanInstances :: Maybe Package -> Qualification
                   -> LinksInfo -> Bool
                   -> [(SubDecl, Maybe Module, Located DocName)] -> Html
subOrphanInstances :: Maybe String
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
subOrphanInstances Maybe String
pkg Qualification
qual LinksInfo
lnks Bool
splice  = Html -> (Html -> Html) -> Maybe Html -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
noHtml Html -> Html
wrap (Maybe Html -> Html)
-> ([(SubDecl, Maybe Module, Located DocName)] -> Maybe Html)
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SubDecl, Maybe Module, Located DocName)] -> Maybe Html
instTable
  where
    wrap :: Html -> Html
wrap = ((Html -> Html
h1 (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Orphan instances") Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++)
    instTable :: [(SubDecl, Maybe Module, Located DocName)] -> Maybe Html
instTable = (Html -> Html) -> Maybe Html -> Maybe Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
identifier (String
"section." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
id_) ] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<) (Maybe Html -> Maybe Html)
-> ([(SubDecl, Maybe Module, Located DocName)] -> Maybe Html)
-> [(SubDecl, Maybe Module, Located DocName)]
-> Maybe Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Maybe Html
subTableSrc Maybe String
pkg Qualification
qual LinksInfo
lnks Bool
splice
    id_ :: String
id_ = String -> String
makeAnchorId (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"orphans"


subInstHead :: String -- ^ Instance unique id (for anchor generation)
            -> Html -- ^ Header content (instance name and type)
            -> Html
subInstHead :: String -> Html -> Html
subInstHead String
iid Html
hdr =
    Html -> Html
expander Html
noHtml Html -> Html -> Html
<+> Html
hdr
  where
    expander :: Html -> Html
expander = Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! String -> String -> [HtmlAttr]
collapseControl (String -> String
instAnchorId String
iid) String
"instance"


subInstDetails :: String -- ^ Instance unique id (for anchor generation)
               -> [Html] -- ^ Associated type contents
               -> [Html] -- ^ Method contents (pretty-printed signatures)
               -> Html   -- ^ Source module
               -> Html
subInstDetails :: String -> [Html] -> [Html] -> Html -> Html
subInstDetails String
iid [Html]
ats [Html]
mets Html
mdl =
    String -> Html -> Html
subInstSection String
iid (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html -> Html
p Html
mdl Html -> Html -> Html
<+> [Html] -> Html
subAssociatedTypes [Html]
ats Html -> Html -> Html
<+> [Html] -> Html
subMethods [Html]
mets)

subFamInstDetails :: String -- ^ Instance unique id (for anchor generation)
                  -> Html   -- ^ Type or data family instance
                  -> Html   -- ^ Source module TODO: use this
                  -> Html
subFamInstDetails :: String -> Html -> Html -> Html
subFamInstDetails String
iid Html
fi Html
mdl =
    String -> Html -> Html
subInstSection String
iid (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html -> Html
p Html
mdl Html -> Html -> Html
<+> (Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"src"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
fi))

subInstSection :: String -- ^ Instance unique id (for anchor generation)
               -> Html
               -> Html
subInstSection :: String -> Html -> Html
subInstSection String
iid Html
contents = String -> DetailsState -> Html -> Html
collapseDetails (String -> String
instAnchorId String
iid) DetailsState
DetailsClosed (Html
summary Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
contents)
  where
    summary :: Html
summary = Html -> Html
thesummary (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
theclass String
"hide-when-js-enabled" ] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Instance details"

instAnchorId :: String -> String
instAnchorId :: String -> String
instAnchorId String
iid = String -> String
makeAnchorId (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"i:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
iid


subMethods :: [Html] -> Html
subMethods :: [Html] -> Html
subMethods = String -> String -> Maybe Html -> Html
forall a. HTML a => String -> a -> Maybe Html -> Html
divSubDecls String
"methods" String
"Methods" (Maybe Html -> Html) -> ([Html] -> Maybe Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Maybe Html
subBlock

subDefaults :: [Html] -> Html
subDefaults :: [Html] -> Html
subDefaults = String -> String -> Maybe Html -> Html
forall a. HTML a => String -> a -> Maybe Html -> Html
divSubDecls String
"default" String
"" (Maybe Html -> Html) -> ([Html] -> Maybe Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Maybe Html
subBlock

subMinimal :: Html -> Html
subMinimal :: Html -> Html
subMinimal = String -> String -> Maybe Html -> Html
forall a. HTML a => String -> a -> Maybe Html -> Html
divSubDecls String
"minimal" String
"Minimal complete definition" (Maybe Html -> Html) -> (Html -> Maybe Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> (Html -> Html) -> Html -> Maybe Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
declElem


-- a box for displaying code
declElem :: Html -> Html
declElem :: Html -> Html
declElem = Html -> Html
paragraph (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"src"]


-- a box for top level documented names
-- it adds a source and wiki link at the right hand side of the box
topDeclElem :: LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html
topDeclElem :: LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html
topDeclElem LinksInfo
lnks SrcSpan
loc Bool
splice [DocName]
names Html
html =
    Html -> Html
declElem (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html
html Html -> Html -> Html
<+> (LinksInfo -> SrcSpan -> Bool -> Maybe Module -> DocName -> Html
links LinksInfo
lnks SrcSpan
loc Bool
splice Maybe Module
forall a. Maybe a
Nothing (DocName -> Html) -> DocName -> Html
forall a b. (a -> b) -> a -> b
$ [DocName] -> DocName
forall a. [a] -> a
head [DocName]
names))
        -- FIXME: is it ok to simply take the first name?

-- | Adds a source and wiki link at the right hand side of the box.
-- Name must be documented, otherwise we wouldn't get here.
links :: LinksInfo -> SrcSpan -> Bool -> Maybe Module -> DocName -> Html
links :: LinksInfo -> SrcSpan -> Bool -> Maybe Module -> DocName -> Html
links ((Maybe String
_,Maybe String
_,Map UnitId String
sourceMap,Map UnitId String
lineMap), (Maybe String
_,Maybe String
_,Maybe String
maybe_wiki_url)) SrcSpan
loc Bool
splice Maybe Module
mdl' docName :: DocName
docName@(Documented Name
n Module
mdl) =
  Html
srcLink Html -> Html -> Html
<+> Html
wikiLink Html -> Html -> Html
<+> (Html -> Html
selfLink (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"selflink"] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"#")
  where selfLink :: Html -> Html
selfLink = String -> Html -> Html
linkedAnchor (OccName -> String
nameAnchorId (Name -> OccName
nameOccName (DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
docName)))

        srcLink :: Html
srcLink = let nameUrl :: Maybe String
nameUrl = UnitId -> Map UnitId String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
origPkg Map UnitId String
sourceMap
                      lineUrl :: Maybe String
lineUrl = UnitId -> Map UnitId String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
origPkg Map UnitId String
lineMap
                      mUrl :: Maybe String
mUrl | Bool
splice    = Maybe String
lineUrl
                                        -- Use the lineUrl as a backup
                           | Bool
otherwise = Maybe String
-> (String -> Maybe String) -> Maybe String -> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe String
lineUrl String -> Maybe String
forall a. a -> Maybe a
Just Maybe String
nameUrl in
          case Maybe String
mUrl of
            Maybe String
Nothing  -> Html
noHtml
            Just String
url -> let url' :: String
url' = Maybe String
-> Maybe Module -> Maybe Name -> Maybe SrcSpan -> String -> String
spliceURL (String -> Maybe String
forall a. a -> Maybe a
Just String
fname) (Module -> Maybe Module
forall a. a -> Maybe a
Just Module
origMod)
                                               (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n) (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
loc) String
url
                          in Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
url', String -> HtmlAttr
theclass String
"link"] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Source"

        wikiLink :: Html
wikiLink =
          case Maybe String
maybe_wiki_url of
            Maybe String
Nothing  -> Html
noHtml
            Just String
url -> let url' :: String
url' = Maybe String
-> Maybe Module -> Maybe Name -> Maybe SrcSpan -> String -> String
spliceURL (String -> Maybe String
forall a. a -> Maybe a
Just String
fname) (Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mdl)
                                               (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n) (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
loc) String
url
                          in Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
url', String -> HtmlAttr
theclass String
"link"] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Comments"

        -- For source links, we want to point to the original module,
        -- because only that will have the source.
        --
        -- 'mdl'' is a way of "overriding" the module. Without it, instances
        -- will point to the module defining the class/family, which is wrong.
        origMod :: Module
origMod = Module -> Maybe Module -> Module
forall a. a -> Maybe a -> a
fromMaybe (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
n) Maybe Module
mdl'
        origPkg :: UnitId
origPkg = Module -> UnitId
moduleUnitId Module
origMod

        fname :: String
fname = case SrcSpan
loc of
          RealSrcSpan RealSrcSpan
l -> FastString -> String
unpackFS (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
l)
          UnhelpfulSpan FastString
_ -> String -> String
forall a. HasCallStack => String -> a
error String
"links: UnhelpfulSpan"
links LinksInfo
_ SrcSpan
_ Bool
_ Maybe Module
_ DocName
_ = Html
noHtml