-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- 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
  , divPackageList
  , divModuleList
  , divContentsList
  , sectionName
  , nonEmptySectionName
  , shortDeclList
  , shortSubDecls
  , divTopDecl
  , SubDecl
  , subArguments
  , subAssociatedTypes
  , subConstructors
  , subPatterns
  , subEquations
  , subFields
  , subInstances
  , subOrphanInstances
  , subInstHead
  , subInstDetails
  , subFamInstDetails
  , subMethods
  , subDefaults
  , subMinimal
  , subTableSrc
  , topDeclElem
  , declElem
  ) where

import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import GHC
import GHC.Types.Name (nameOccName)
import Text.XHtml hiding (name, quote, title)

import Haddock.Backends.Xhtml.DocMarkup
import Haddock.Backends.Xhtml.Types
import Haddock.Backends.Xhtml.Utils
import Haddock.Types
import Haddock.Utils (makeAnchorId, nameAnchorId)

--------------------------------------------------------------------------------

-- * 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
! [[Char] -> HtmlAttr
identifier [Char]
"mini"]

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

sectionName :: Html -> Html
sectionName :: Html -> Html
sectionName = Html -> Html
paragraph (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"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
! [[Char] -> HtmlAttr
theclass [Char]
"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
! [[Char] -> HtmlAttr
theclass [Char]
"caption"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
c

divPackageHeader
  , divContent
  , divModuleHeader
  , divFooter
  , divTableOfContents
  , divDescription
  , divSynopsis
  , divInterface
  , divIndex
  , divAlphabet
  , divPackageList
  , divModuleList
  , divContentsList
    :: Html -> Html
divPackageHeader :: Html -> Html
divPackageHeader = [Char] -> Html -> Html
sectionDiv [Char]
"package-header"
divContent :: Html -> Html
divContent = [Char] -> Html -> Html
sectionDiv [Char]
"content"
divModuleHeader :: Html -> Html
divModuleHeader = [Char] -> Html -> Html
sectionDiv [Char]
"module-header"
divFooter :: Html -> Html
divFooter = [Char] -> Html -> Html
sectionDiv [Char]
"footer"
divTableOfContents :: Html -> Html
divTableOfContents = [Char] -> Html -> Html
sectionDiv [Char]
"table-of-contents"
divContentsList :: Html -> Html
divContentsList = [Char] -> Html -> Html
sectionDiv [Char]
"contents-list"
divDescription :: Html -> Html
divDescription = [Char] -> Html -> Html
sectionDiv [Char]
"description"
divSynopsis :: Html -> Html
divSynopsis = [Char] -> Html -> Html
sectionDiv [Char]
"synopsis"
divInterface :: Html -> Html
divInterface = [Char] -> Html -> Html
sectionDiv [Char]
"interface"
divIndex :: Html -> Html
divIndex = [Char] -> Html -> Html
sectionDiv [Char]
"index"
divAlphabet :: Html -> Html
divAlphabet = [Char] -> Html -> Html
sectionDiv [Char]
"alphabet"
divModuleList :: Html -> Html
divModuleList = [Char] -> Html -> Html
sectionDiv [Char]
"module-list"
divPackageList :: Html -> Html
divPackageList = [Char] -> Html -> Html
sectionDiv [Char]
"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
! [[Char] -> HtmlAttr
theclass [Char]
"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
! [[Char] -> HtmlAttr
theclass [Char]
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
! [[Char] -> HtmlAttr
theclass [Char]
"inst"]
      | Bool
otherwise = Html -> Html
li
    c :: [Char]
c
      | Bool
inst = [Char]
"inst"
      | Bool
otherwise = [Char]
"subs"

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

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

divSubDecls :: HTML a => String -> a -> Maybe Html -> Html
divSubDecls :: forall a. HTML a => [Char] -> a -> Maybe Html -> Html
divSubDecls [Char]
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
! [[Char] -> HtmlAttr
theclass ([Char] -> HtmlAttr) -> [Char] -> HtmlAttr
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"subs", [Char]
cssClass]]
    subCaption :: Html
subCaption = Html -> Html
paragraph (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"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 [Char] -> Qualification -> [SubDecl] -> Maybe Html
subDlist Maybe [Char]
_ Qualification
_ [] = Maybe Html
forall a. Maybe a
Nothing
subDlist Maybe [Char]
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 :: Type -> Type}.
(HTML a, HTML b, HTML (f Html), Functor f) =>
(a, f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)), b)
-> Html
subEntry [SubDecl]
decls
  where
    subEntry :: (a, f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)), b)
-> Html
subEntry (a
decl, f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap 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
! [[Char] -> HtmlAttr
theclass [Char]
"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
<< ((MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName) -> Html)
-> f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName))
-> f Html
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe [Char]
-> Maybe [Char]
-> Qualification
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)
-> Html
docToHtml Maybe [Char]
forall a. Maybe a
Nothing Maybe [Char]
pkg Qualification
qual) f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap 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 [Char] -> Qualification -> [SubDecl] -> Maybe Html
subTable Maybe [Char]
_ Qualification
_ [] = Maybe Html
forall a. Maybe a
Nothing
subTable Maybe [Char]
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 :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap SubDecl -> [HtmlTable]
forall {f :: Type -> Type} {a} {a}.
(Functor f, HTML a, HTML a, HTML (f Html)) =>
(a, f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)), [a])
-> [HtmlTable]
subRow [SubDecl]
decls)
  where
    subRow :: (a, f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)), [a])
-> [HtmlTable]
subRow (a
decl, f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName))
mdoc, [a]
subs) =
      ( Html -> Html
td
          (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"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
<< (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName) -> Html)
-> f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName))
-> f Html
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe [Char]
-> Maybe [Char]
-> Qualification
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)
-> Html
docToHtml Maybe [Char]
forall a. Maybe a
Nothing Maybe [Char]
pkg Qualification
qual) f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap 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 [Char]
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Maybe Html
subTableSrc Maybe [Char]
_ Qualification
_ LinksInfo
_ Bool
_ [] = Maybe Html
forall a. Maybe a
Nothing
subTableSrc Maybe [Char]
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 :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (SubDecl, Maybe Module, Located DocName) -> [HtmlTable]
forall {f :: Type -> Type} {a} {a}.
(Functor f, HTML a, HTML a, HTML (f Html)) =>
((a, f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)), [a]),
 Maybe Module, Located DocName)
-> [HtmlTable]
subRow [(SubDecl, Maybe Module, Located DocName)]
decls)
  where
    subRow :: ((a, f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)), [a]),
 Maybe Module, Located DocName)
-> [HtmlTable]
subRow ((a
decl, f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap 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
! [[Char] -> HtmlAttr
theclass [Char]
"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
! [[Char] -> HtmlAttr
theclass [Char]
"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
<< (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName) -> Html)
-> f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName))
-> f Html
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe [Char]
-> Maybe [Char]
-> Qualification
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)
-> Html
docToHtml Maybe [Char]
forall a. Maybe a
Nothing Maybe [Char]
pkg Qualification
qual) f (MetaDoc (Wrap (ModuleName, OccName)) (Wrap 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 SrcSpan
loc Maybe Module
mdl DocName
dn = LinksInfo -> SrcSpan -> Bool -> Maybe Module -> DocName -> Html
links LinksInfo
lnks SrcSpan
loc Bool
splice Maybe Module
mdl DocName
dn

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 [Char] -> Qualification -> [SubDecl] -> Html
subArguments Maybe [Char]
pkg Qualification
qual = [Char] -> [Char] -> Maybe Html -> Html
forall a. HTML a => [Char] -> a -> Maybe Html -> Html
divSubDecls [Char]
"arguments" [Char]
"Arguments" (Maybe Html -> Html)
-> ([SubDecl] -> Maybe Html) -> [SubDecl] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> Qualification -> [SubDecl] -> Maybe Html
subTable Maybe [Char]
pkg Qualification
qual

subAssociatedTypes :: [Html] -> Html
subAssociatedTypes :: [Html] -> Html
subAssociatedTypes = [Char] -> [Char] -> Maybe Html -> Html
forall a. HTML a => [Char] -> a -> Maybe Html -> Html
divSubDecls [Char]
"associated-types" [Char]
"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 [Char] -> Qualification -> [SubDecl] -> Html
subConstructors Maybe [Char]
pkg Qualification
qual = [Char] -> [Char] -> Maybe Html -> Html
forall a. HTML a => [Char] -> a -> Maybe Html -> Html
divSubDecls [Char]
"constructors" [Char]
"Constructors" (Maybe Html -> Html)
-> ([SubDecl] -> Maybe Html) -> [SubDecl] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> Qualification -> [SubDecl] -> Maybe Html
subTable Maybe [Char]
pkg Qualification
qual

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

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

subEquations :: Maybe Package -> Qualification -> [SubDecl] -> Html
subEquations :: Maybe [Char] -> Qualification -> [SubDecl] -> Html
subEquations Maybe [Char]
pkg Qualification
qual = [Char] -> [Char] -> Maybe Html -> Html
forall a. HTML a => [Char] -> a -> Maybe Html -> Html
divSubDecls [Char]
"equations" [Char]
"Equations" (Maybe Html -> Html)
-> ([SubDecl] -> Maybe Html) -> [SubDecl] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> Qualification -> [SubDecl] -> Maybe Html
subTable Maybe [Char]
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 [Char]
-> Qualification
-> [Char]
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
subInstances Maybe [Char]
pkg Qualification
qual [Char]
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
+++ [Char] -> DetailsState -> Html -> Html
collapseDetails [Char]
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 [Char]
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Maybe Html
subTableSrc Maybe [Char]
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
! [[Char] -> HtmlAttr
theclass [Char]
"subs instances"]
    hdr :: Html
hdr = Html -> Html
h4 (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [Char] -> [Char] -> [HtmlAttr]
collapseControl [Char]
id_ [Char]
"instances" (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Instances"
    summary :: Html
summary = Html -> Html
thesummary (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"hide-when-js-enabled"] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Instances details"
    id_ :: [Char]
id_ = [Char] -> [Char]
makeAnchorId ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"i:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm

subOrphanInstances
  :: Maybe Package
  -> Qualification
  -> LinksInfo
  -> Bool
  -> [(SubDecl, Maybe Module, Located DocName)]
  -> Html
subOrphanInstances :: Maybe [Char]
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
subOrphanInstances Maybe [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) 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
! [[Char] -> HtmlAttr
identifier ([Char]
"section." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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 [Char]
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Maybe Html
subTableSrc Maybe [Char]
pkg Qualification
qual LinksInfo
lnks Bool
splice
    id_ :: [Char]
id_ = [Char] -> [Char]
makeAnchorId [Char]
"orphans"

subInstHead
  :: String
  -- ^ Instance unique id (for anchor generation)
  -> Html
  -- ^ Header content (instance name and type)
  -> Html
subInstHead :: [Char] -> Html -> Html
subInstHead [Char]
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
! [Char] -> [Char] -> [HtmlAttr]
collapseControl ([Char] -> [Char]
instAnchorId [Char]
iid) [Char]
"instance"

subInstDetails
  :: String
  -- ^ Instance unique id (for anchor generation)
  -> [Html]
  -- ^ Associated type contents
  -> [Html]
  -- ^ Method contents (pretty-printed signatures)
  -> Html
  -- ^ Source module
  -> Html
subInstDetails :: [Char] -> [Html] -> [Html] -> Html -> Html
subInstDetails [Char]
iid [Html]
ats [Html]
mets Html
mdl =
  [Char] -> Html -> Html
subInstSection [Char]
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 :: [Char] -> Html -> Html -> Html
subFamInstDetails [Char]
iid Html
fi Html
mdl =
  [Char] -> Html -> Html
subInstSection [Char]
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
! [[Char] -> HtmlAttr
theclass [Char]
"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 :: [Char] -> Html -> Html
subInstSection [Char]
iid Html
contents = [Char] -> DetailsState -> Html -> Html
collapseDetails ([Char] -> [Char]
instAnchorId [Char]
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
! [[Char] -> HtmlAttr
theclass [Char]
"hide-when-js-enabled"] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Instance details"

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

subMethods :: [Html] -> Html
subMethods :: [Html] -> Html
subMethods = [Char] -> [Char] -> Maybe Html -> Html
forall a. HTML a => [Char] -> a -> Maybe Html -> Html
divSubDecls [Char]
"methods" [Char]
"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 = [Char] -> [Char] -> Maybe Html -> Html
forall a. HTML a => [Char] -> a -> Maybe Html -> Html
divSubDecls [Char]
"default" [Char]
"" (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 = [Char] -> [Char] -> Maybe Html -> Html
forall a. HTML a => [Char] -> a -> Maybe Html -> Html
divSubDecls [Char]
"minimal" [Char]
"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
! [[Char] -> HtmlAttr
theclass [Char]
"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
name 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
name)

-- 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 [Char]
_, Maybe [Char]
_, Map Unit [Char]
sourceMap, Map Unit [Char]
lineMap), (Maybe [Char]
_, Maybe [Char]
_, Maybe [Char]
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
! [[Char] -> HtmlAttr
theclass [Char]
"selflink"] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"#")
  where
    selfLink :: Html -> Html
selfLink = [Char] -> Html -> Html
linkedAnchor (OccName -> [Char]
nameAnchorId (Name -> OccName
nameOccName (DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
docName)))

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

    wikiLink :: Html
wikiLink =
      case Maybe [Char]
maybe_wiki_url of
        Maybe [Char]
Nothing -> Html
noHtml
        Just [Char]
url ->
          let url' :: [Char]
url' = Maybe Module -> Maybe Name -> Maybe SrcSpan -> [Char] -> [Char]
spliceURL (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) [Char]
url
           in Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
href [Char]
url', [Char] -> HtmlAttr
theclass [Char]
"link"] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"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 :: Unit
origPkg = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
origMod
links LinksInfo
_ SrcSpan
_ Bool
_ Maybe Module
_ DocName
_ = Html
noHtml