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

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

-- |
-- 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)
import qualified Data.Text.Lazy as LText

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

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

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

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

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

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

divSubDecls :: LText -> LText -> Maybe Html -> Html
divSubDecls :: Text -> Text -> Maybe Html -> Html
divSubDecls Text
cssClass Text
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
! [Text -> HtmlAttr
theclass (Text -> HtmlAttr) -> Text -> HtmlAttr
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
LText.unwords [Text
"subs", Text
cssClass]]
    subCaption :: Html
subCaption = Html -> Html
paragraph (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [Text -> HtmlAttr
theclass Text
"caption"] (Html -> Html) -> Text -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Text
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
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
! [Text -> HtmlAttr
theclass Text
"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 String
-> Maybe String
-> Qualification
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)
-> Html
docToHtml Maybe String
forall a. Maybe a
Nothing Maybe String
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 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
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
! [Text -> HtmlAttr
theclass Text
"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 String
-> Maybe String
-> Qualification
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)
-> Html
docToHtml Maybe String
forall a. Maybe a
Nothing Maybe String
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 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
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
! [Text -> HtmlAttr
theclass Text
"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
! [Text -> HtmlAttr
theclass Text
"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 String
-> Maybe String
-> Qualification
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap DocName)
-> Html
docToHtml Maybe String
forall a. Maybe a
Nothing Maybe String
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
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 = Text -> Text -> Maybe Html -> Html
divSubDecls Text
"arguments" Text
"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 = Text -> Text -> Maybe Html -> Html
divSubDecls Text
"associated-types" Text
"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 = Text -> Text -> Maybe Html -> Html
divSubDecls Text
"constructors" Text
"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 = Text -> Text -> Maybe Html -> Html
divSubDecls Text
"bundled-patterns" Text
"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 = Text -> Text -> Maybe Html -> Html
divSubDecls Text
"fields" Text
"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 = Text -> Text -> Maybe Html -> Html
divSubDecls Text
"equations" Text
"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
+++ Text -> DetailsState -> Html -> Html
collapseDetails Text
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
! [Text -> HtmlAttr
theclass Text
"subs instances"]
    hdr :: Html
hdr = Html -> Html
h4 (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! Text -> Text -> [HtmlAttr]
collapseControl Text
id_ Text
"instances" (Html -> Html) -> Text -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Text
"Instances" :: LText)
    summary :: Html
summary = Html -> Html
thesummary (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [Text -> HtmlAttr
theclass Text
"hide-when-js-enabled"] (Html -> Html) -> Text -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Text
"Instances details" :: LText)
    id_ :: Text
id_ = Text -> Text
makeAnchorId (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"i:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
LText.pack 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) -> Text -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Text
"Orphan instances" :: LText)) 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
! [Text -> HtmlAttr
identifier (Text
"section." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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_ :: Text
id_ = Text -> Text
makeAnchorId Text
"orphans"

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

subInstDetails
  :: LText
  -- ^ Instance unique id (for anchor generation)
  -> [Html]
  -- ^ Associated type contents
  -> [Html]
  -- ^ Method contents (pretty-printed signatures)
  -> Html
  -- ^ Source module
  -> Html
subInstDetails :: Text -> [Html] -> [Html] -> Html -> Html
subInstDetails Text
iid [Html]
ats [Html]
mets Html
mdl =
  Text -> Html -> Html
subInstSection Text
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
  :: LText
  -- ^ Instance unique id (for anchor generation)
  -> Html
  -- ^ Type or data family instance
  -> Html
  -- ^ Source module TODO: use this
  -> Html
subFamInstDetails :: Text -> Html -> Html -> Html
subFamInstDetails Text
iid Html
fi Html
mdl =
  Text -> Html -> Html
subInstSection Text
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
! [Text -> HtmlAttr
theclass Text
"src"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
fi))

subInstSection
  :: LText
  -- ^ Instance unique id (for anchor generation)
  -> Html
  -> Html
subInstSection :: Text -> Html -> Html
subInstSection Text
iid Html
contents = Text -> DetailsState -> Html -> Html
collapseDetails (Text -> Text
instAnchorId Text
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
! [Text -> HtmlAttr
theclass Text
"hide-when-js-enabled"] (Html -> Html) -> Text -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Text
"Instance details" :: LText)

instAnchorId :: LText -> LText
instAnchorId :: Text -> Text
instAnchorId Text
iid = Text -> Text
makeAnchorId (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"i:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
iid

subMethods :: [Html] -> Html
subMethods :: [Html] -> Html
subMethods = Text -> Text -> Maybe Html -> Html
divSubDecls Text
"methods" Text
"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 = Text -> Text -> Maybe Html -> Html
divSubDecls Text
"default" Text
"" (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 = Text -> Text -> Maybe Html -> Html
divSubDecls Text
"minimal" Text
"Minimal complete definition" (Maybe Html -> Html) -> (Html -> Maybe Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Maybe Html
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
! [Text -> HtmlAttr
theclass Text
"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
! [Text -> HtmlAttr
theclass Text
"selflink"] (Html -> Html) -> Text -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Text
"#" :: LText))
  where
    selfLink :: Html -> Html
selfLink = Text -> Html -> Html
linkedAnchor (OccName -> Text
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
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' :: Text
url' = String -> Text
LText.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ 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
! [Text -> HtmlAttr
href Text
url', Text -> HtmlAttr
theclass Text
"link"] (Html -> Html) -> Text -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Text
"Source" :: LText)

    wikiLink :: Html
wikiLink =
      case Maybe String
maybe_wiki_url of
        Maybe String
Nothing -> Html
noHtml
        Just String
url ->
          let url' :: Text
url' = String -> Text
LText.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ 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
! [Text -> HtmlAttr
href Text
url', Text -> HtmlAttr
theclass Text
"link"] (Html -> Html) -> Text -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Text
"Comments" :: LText)

    -- 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