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

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

-- |
-- 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
! [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
  , divPackageList
  , 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"
divPackageList :: Html -> Html
divPackageList = 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 :: forall a. HTML a => 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 :: Type -> Type}.
(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 a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) 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 :: 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 (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 a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) 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 :: 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 (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 a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) 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 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 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 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
! [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
"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
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 String
_, Maybe String
_, Map Unit String
sourceMap, Map Unit 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 = Unit -> Map Unit String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Unit
origPkg Map Unit String
sourceMap
          lineUrl :: Maybe String
lineUrl = Unit -> Map Unit String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Unit
origPkg Map Unit 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 Module -> Maybe Name -> Maybe SrcSpan -> String -> String
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) 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 Module -> Maybe Name -> Maybe SrcSpan -> String -> String
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) 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 :: Unit
origPkg = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
origMod
links LinksInfo
_ SrcSpan
_ Bool
_ Maybe Module
_ DocName
_ = Html
noHtml