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

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

-- |
-- Module      :  Haddock.Backends.Html.DocMarkup
-- 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.DocMarkup
  ( docToHtml
  , rdrDocToHtml
  , origDocToHtml
  , docToHtmlNoAnchors
  , docElement
  , docSection
  , docSection_
  ) where

import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import GHC
import GHC.Types.Name
import Text.XHtml hiding (name, p, quote)

import Documentation.Haddock.Markup
import Haddock.Backends.Xhtml.Names
import Haddock.Backends.Xhtml.Utils
import Haddock.Doc
  ( combineDocumentation
  , emptyMetaDoc
  , metaConcat
  , metaDocAppend
  )
import Haddock.Types
import Haddock.Utils

parHtmlMarkup
  :: Qualification
  -> Bool
  -> (Bool -> a -> Html)
  -> DocMarkup a Html
parHtmlMarkup :: forall a.
Qualification -> Bool -> (Bool -> a -> Html) -> DocMarkup a Html
parHtmlMarkup Qualification
qual Bool
insertAnchors Bool -> a -> Html
ppId =
  Markup
    { markupEmpty :: Html
markupEmpty = Html
noHtml
    , markupString :: [Char] -> Html
markupString = [Char] -> Html
forall a. HTML a => a -> Html
toHtml
    , markupParagraph :: Html -> Html
markupParagraph = Html -> Html
paragraph
    , markupAppend :: Html -> Html -> Html
markupAppend = Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
(+++)
    , markupIdentifier :: a -> Html
markupIdentifier = Html -> Html
thecode (Html -> Html) -> (a -> Html) -> a -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> Html
ppId Bool
insertAnchors
    , markupIdentifierUnchecked :: Wrap (ModuleName, OccName) -> Html
markupIdentifierUnchecked = Html -> Html
thecode (Html -> Html)
-> (Wrap (ModuleName, OccName) -> Html)
-> Wrap (ModuleName, OccName)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Qualification -> Wrap (ModuleName, OccName) -> Html
ppUncheckedLink Qualification
qual
    , markupModule :: ModLink Html -> Html
markupModule = \(ModLink [Char]
m Maybe Html
lbl) ->
        let ([Char]
mdl, [Char]
ref) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') [Char]
m
            -- Accommodate for old style
            -- foo\#bar anchors
            mdl' :: [Char]
mdl' = case [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
mdl of
              Char
'\\' : [Char]
_ -> [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init [Char]
mdl
              [Char]
_ -> [Char]
mdl
         in Maybe Html -> ModuleName -> [Char] -> Html
ppModuleRef Maybe Html
lbl ([Char] -> ModuleName
mkModuleName [Char]
mdl') [Char]
ref
    , markupWarning :: Html -> Html
markupWarning = Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"warning"]
    , markupEmphasis :: Html -> Html
markupEmphasis = Html -> Html
emphasize
    , markupBold :: Html -> Html
markupBold = Html -> Html
strong
    , markupMonospaced :: Html -> Html
markupMonospaced = Html -> Html
thecode (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"inline-code"]
    , markupUnorderedList :: [Html] -> Html
markupUnorderedList = [Html] -> Html
forall a. HTML a => [a] -> Html
unordList
    , markupOrderedList :: [(Int, Html)] -> Html
markupOrderedList = [(Int, Html)] -> Html
forall a. HTML a => [(Int, a)] -> Html
makeOrdList
    , markupDefList :: [(Html, Html)] -> Html
markupDefList = [(Html, Html)] -> Html
forall a b. (HTML a, HTML b) => [(a, b)] -> Html
defList
    , markupCodeBlock :: Html -> Html
markupCodeBlock = Html -> Html
pre
    , markupHyperlink :: Hyperlink Html -> Html
markupHyperlink = \(Hyperlink [Char]
url Maybe Html
mLabel) ->
        if Bool
insertAnchors
          then
            Html -> Html
anchor
              (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
href [Char]
url]
              (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Maybe Html -> Html
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
url) Maybe Html
mLabel
          else Html -> Maybe Html -> Html
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
url) Maybe Html
mLabel
    , markupAName :: [Char] -> Html
markupAName = \[Char]
aname ->
        if Bool
insertAnchors
          then [Char] -> Html -> Html
namedAnchor [Char]
aname (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
""
          else Html
noHtml
    , markupPic :: Picture -> Html
markupPic = \(Picture [Char]
uri Maybe [Char]
t) -> Html
image Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([[Char] -> HtmlAttr
src [Char]
uri] [HtmlAttr] -> [HtmlAttr] -> [HtmlAttr]
forall a. [a] -> [a] -> [a]
++ [HtmlAttr] -> Maybe [HtmlAttr] -> [HtmlAttr]
forall a. a -> Maybe a -> a
fromMaybe [] (HtmlAttr -> [HtmlAttr]
forall a. a -> [a]
forall (m :: Type -> Type) a. Monad m => a -> m a
return (HtmlAttr -> [HtmlAttr])
-> ([Char] -> HtmlAttr) -> [Char] -> [HtmlAttr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> HtmlAttr
title ([Char] -> [HtmlAttr]) -> Maybe [Char] -> Maybe [HtmlAttr]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
t))
    , markupMathInline :: [Char] -> Html
markupMathInline = \[Char]
mathjax -> Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"mathjax"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char] -> Html
forall a. HTML a => a -> Html
toHtml ([Char]
"\\(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
mathjax [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\)")
    , markupMathDisplay :: [Char] -> Html
markupMathDisplay = \[Char]
mathjax -> Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"mathjax"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char] -> Html
forall a. HTML a => a -> Html
toHtml ([Char]
"\\[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
mathjax [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\]")
    , markupProperty :: [Char] -> Html
markupProperty = Html -> Html
pre (Html -> Html) -> ([Char] -> Html) -> [Char] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Html
forall a. HTML a => a -> Html
toHtml
    , markupExample :: [Example] -> Html
markupExample = [Example] -> Html
examplesToHtml
    , markupHeader :: Header Html -> Html
markupHeader = \(Header Int
l Html
t) -> Int -> Html -> Html
makeHeader Int
l Html
t
    , markupTable :: Table Html -> Html
markupTable = \(Table [TableRow Html]
h [TableRow Html]
r) -> [TableRow Html] -> [TableRow Html] -> Html
makeTable [TableRow Html]
h [TableRow Html]
r
    }
  where
    makeHeader :: Int -> Html -> Html
    makeHeader :: Int -> Html -> Html
makeHeader Int
1 Html
mkup = Html -> Html
h1 Html
mkup
    makeHeader Int
2 Html
mkup = Html -> Html
h2 Html
mkup
    makeHeader Int
3 Html
mkup = Html -> Html
h3 Html
mkup
    makeHeader Int
4 Html
mkup = Html -> Html
h4 Html
mkup
    makeHeader Int
5 Html
mkup = Html -> Html
h5 Html
mkup
    makeHeader Int
6 Html
mkup = Html -> Html
h6 Html
mkup
    makeHeader Int
l Html
_ = [Char] -> Html
forall a. HasCallStack => [Char] -> a
error ([Char] -> Html) -> [Char] -> Html
forall a b. (a -> b) -> a -> b
$ [Char]
"Somehow got a header level `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' in DocMarkup!"

    makeTable :: [TableRow Html] -> [TableRow Html] -> Html
    makeTable :: [TableRow Html] -> [TableRow Html] -> Html
makeTable [TableRow Html]
hs [TableRow Html]
bs = Html -> Html
table ([Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ([Html]
hs' [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html]
bs'))
      where
        hs' :: [Html]
hs'
          | [TableRow Html] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [TableRow Html]
hs = []
          | Bool
otherwise = [Html -> Html
thead ([Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ((TableRow Html -> Html) -> [TableRow Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Html -> Html) -> TableRow Html -> Html
makeTableRow Html -> Html
th) [TableRow Html]
hs))]

        bs' :: [Html]
bs' = [Html -> Html
tbody ([Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ((TableRow Html -> Html) -> [TableRow Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Html -> Html) -> TableRow Html -> Html
makeTableRow Html -> Html
td) [TableRow Html]
bs))]

    makeTableRow :: (Html -> Html) -> TableRow Html -> Html
    makeTableRow :: (Html -> Html) -> TableRow Html -> Html
makeTableRow Html -> Html
thr (TableRow [TableCell Html]
cs) = Html -> Html
tr ([Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ((TableCell Html -> Html) -> [TableCell Html] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Html -> Html) -> TableCell Html -> Html
makeTableCell Html -> Html
thr) [TableCell Html]
cs))

    makeTableCell :: (Html -> Html) -> TableCell Html -> Html
    makeTableCell :: (Html -> Html) -> TableCell Html -> Html
makeTableCell Html -> Html
thr (TableCell Int
i Int
j Html
c) = Html -> Html
thr Html
c Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([HtmlAttr]
i' [HtmlAttr] -> [HtmlAttr] -> [HtmlAttr]
forall a. [a] -> [a] -> [a]
++ [HtmlAttr]
j')
      where
        i' :: [HtmlAttr]
i' = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then [] else [Int -> HtmlAttr
colspan Int
i]
        j' :: [HtmlAttr]
j' = if Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then [] else [Int -> HtmlAttr
rowspan Int
j]

    examplesToHtml :: [Example] -> Html
examplesToHtml [Example]
l = Html -> Html
pre ([Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (Example -> Html) -> [Example] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map Example -> Html
exampleToHtml [Example]
l) Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"screen"]

    exampleToHtml :: Example -> Html
exampleToHtml (Example [Char]
expression [[Char]]
result) = Html
htmlExample
      where
        htmlExample :: Html
htmlExample = Html
htmlPrompt Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
htmlExpression Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Char] -> Html
forall a. HTML a => a -> Html
toHtml ([[Char]] -> [Char]
unlines [[Char]]
result)
        htmlPrompt :: Html
htmlPrompt = (Html -> Html
thecode (Html -> Html) -> ([Char] -> Html) -> [Char] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Html
forall a. HTML a => a -> Html
toHtml ([Char] -> Html) -> [Char] -> Html
forall a b. (a -> b) -> a -> b
$ [Char]
">>> ") Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"prompt"]
        htmlExpression :: Html
htmlExpression = (Html -> Html
strong (Html -> Html) -> ([Char] -> Html) -> [Char] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
thecode (Html -> Html) -> ([Char] -> Html) -> [Char] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Html
forall a. HTML a => a -> Html
toHtml ([Char] -> Html) -> [Char] -> Html
forall a b. (a -> b) -> a -> b
$ [Char]
expression [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n") Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"userinput"]

    makeOrdList :: HTML a => [(Int, a)] -> Html
    makeOrdList :: forall a. HTML a => [(Int, a)] -> Html
makeOrdList [(Int, a)]
items = Html -> Html
olist (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< ((Int, a) -> Html) -> [(Int, a)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
index, a
a) -> Html -> Html
li (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> Int -> HtmlAttr
intAttr [Char]
"value" Int
index] (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< a
a) [(Int, a)]
items

-- | We use this intermediate type to transform the input 'Doc' tree
-- in an arbitrary way before rendering, such as grouping some
-- elements. This is effectively a hack to prevent the 'Doc' type
-- from changing if it is possible to recover the layout information
-- we won't need after the fact.
data Hack a id
  = UntouchedDoc (MetaDoc a id)
  | CollapsingHeader (Header (DocH a id)) (MetaDoc a id) Int (Maybe String)
  | HackAppend (Hack a id) (Hack a id)
  deriving (Hack a id -> Hack a id -> Bool
(Hack a id -> Hack a id -> Bool)
-> (Hack a id -> Hack a id -> Bool) -> Eq (Hack a id)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a id. (Eq id, Eq a) => Hack a id -> Hack a id -> Bool
$c== :: forall a id. (Eq id, Eq a) => Hack a id -> Hack a id -> Bool
== :: Hack a id -> Hack a id -> Bool
$c/= :: forall a id. (Eq id, Eq a) => Hack a id -> Hack a id -> Bool
/= :: Hack a id -> Hack a id -> Bool
Eq)

-- | Group things under bold 'DocHeader's together.
toHack
  :: Int
  -- ^ Counter for header IDs which serves to assign
  -- unique identifiers within the comment scope
  -> Maybe String
  -- ^ It is not enough to have unique identifier within the
  -- scope of the comment: if two different comments have the
  -- same ID for headers, the collapse/expand behaviour will act
  -- on them both. This serves to make each header a little bit
  -- more unique. As we can't export things with the same names,
  -- this should work more or less fine: it is in fact the
  -- implicit assumption the collapse/expand mechanism makes for
  -- things like ‘Instances’ boxes.
  -> [MetaDoc a id]
  -> Hack a id
toHack :: forall a id. Int -> Maybe [Char] -> [MetaDoc a id] -> Hack a id
toHack Int
_ Maybe [Char]
_ [] = MetaDoc a id -> Hack a id
forall a id. MetaDoc a id -> Hack a id
UntouchedDoc MetaDoc a id
forall mod id. MetaDoc mod id
emptyMetaDoc
toHack Int
_ Maybe [Char]
_ [MetaDoc a id
x] = MetaDoc a id -> Hack a id
forall a id. MetaDoc a id -> Hack a id
UntouchedDoc MetaDoc a id
x
toHack Int
n Maybe [Char]
nm (MetaDoc{_doc :: forall mod id. MetaDoc mod id -> DocH mod id
_doc = DocHeader (Header Int
l (DocBold DocH a id
x))} : [MetaDoc a id]
xs) =
  let
    -- Header with dropped bold
    h :: Header (DocH a id)
h = Int -> DocH a id -> Header (DocH a id)
forall id. Int -> id -> Header id
Header Int
l DocH a id
x
    -- Predicate for takeWhile, grab everything including ‘smaller’
    -- headers
    p :: MetaDoc mod id -> Bool
p (MetaDoc{_doc :: forall mod id. MetaDoc mod id -> DocH mod id
_doc = DocHeader (Header Int
l' DocH mod id
_)}) = Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
l
    p MetaDoc mod id
_ = Bool
True
    -- Stuff ‘under’ this header
    r :: [MetaDoc a id]
r = (MetaDoc a id -> Bool) -> [MetaDoc a id] -> [MetaDoc a id]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile MetaDoc a id -> Bool
forall {mod} {id}. MetaDoc mod id -> Bool
p [MetaDoc a id]
xs
    -- Everything else that didn't make it under
    r' :: [MetaDoc a id]
r' = Int -> [MetaDoc a id] -> [MetaDoc a id]
forall a. Int -> [a] -> [a]
drop ([MetaDoc a id] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [MetaDoc a id]
r) [MetaDoc a id]
xs
    app :: Hack a id -> [MetaDoc a id] -> Hack a id
app Hack a id
y [] = Hack a id
y
    app Hack a id
y [MetaDoc a id]
ys = Hack a id -> Hack a id -> Hack a id
forall a id. Hack a id -> Hack a id -> Hack a id
HackAppend Hack a id
y (Int -> Maybe [Char] -> [MetaDoc a id] -> Hack a id
forall a id. Int -> Maybe [Char] -> [MetaDoc a id] -> Hack a id
toHack (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe [Char]
nm [MetaDoc a id]
ys)
   in
    case [MetaDoc a id]
r of
      -- No content under this header
      [] -> Header (DocH a id)
-> MetaDoc a id -> Int -> Maybe [Char] -> Hack a id
forall a id.
Header (DocH a id)
-> MetaDoc a id -> Int -> Maybe [Char] -> Hack a id
CollapsingHeader Header (DocH a id)
h MetaDoc a id
forall mod id. MetaDoc mod id
emptyMetaDoc Int
n Maybe [Char]
nm Hack a id -> [MetaDoc a id] -> Hack a id
forall {a} {id}. Hack a id -> [MetaDoc a id] -> Hack a id
`app` [MetaDoc a id]
r'
      -- We got something out, stitch it back together into one chunk
      MetaDoc a id
y : [MetaDoc a id]
ys -> Header (DocH a id)
-> MetaDoc a id -> Int -> Maybe [Char] -> Hack a id
forall a id.
Header (DocH a id)
-> MetaDoc a id -> Int -> Maybe [Char] -> Hack a id
CollapsingHeader Header (DocH a id)
h ((MetaDoc a id -> MetaDoc a id -> MetaDoc a id)
-> MetaDoc a id -> [MetaDoc a id] -> MetaDoc a id
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl MetaDoc a id -> MetaDoc a id -> MetaDoc a id
forall mod id. MetaDoc mod id -> MetaDoc mod id -> MetaDoc mod id
metaDocAppend MetaDoc a id
y [MetaDoc a id]
ys) Int
n Maybe [Char]
nm Hack a id -> [MetaDoc a id] -> Hack a id
forall {a} {id}. Hack a id -> [MetaDoc a id] -> Hack a id
`app` [MetaDoc a id]
r'
toHack Int
n Maybe [Char]
nm (MetaDoc a id
x : [MetaDoc a id]
xs) = Hack a id -> Hack a id -> Hack a id
forall a id. Hack a id -> Hack a id -> Hack a id
HackAppend (MetaDoc a id -> Hack a id
forall a id. MetaDoc a id -> Hack a id
UntouchedDoc MetaDoc a id
x) (Int -> Maybe [Char] -> [MetaDoc a id] -> Hack a id
forall a id. Int -> Maybe [Char] -> [MetaDoc a id] -> Hack a id
toHack Int
n Maybe [Char]
nm [MetaDoc a id]
xs)

-- | Remove ‘top-level’ 'DocAppend's turning them into a flat list.
-- This lends itself much better to processing things in order user
-- might look at them, such as in 'toHack'.
flatten :: MetaDoc a id -> [MetaDoc a id]
flatten :: forall a id. MetaDoc a id -> [MetaDoc a id]
flatten MetaDoc{_meta :: forall mod id. MetaDoc mod id -> Meta
_meta = Meta
m, _doc :: forall mod id. MetaDoc mod id -> DocH mod id
_doc = DocAppend DocH a id
x DocH a id
y} =
  let f :: DocH mod id -> MetaDoc mod id
f DocH mod id
z = MetaDoc{_meta :: Meta
_meta = Meta
m, _doc :: DocH mod id
_doc = DocH mod id
z}
   in MetaDoc a id -> [MetaDoc a id]
forall a id. MetaDoc a id -> [MetaDoc a id]
flatten (DocH a id -> MetaDoc a id
forall {mod} {id}. DocH mod id -> MetaDoc mod id
f DocH a id
x) [MetaDoc a id] -> [MetaDoc a id] -> [MetaDoc a id]
forall a. [a] -> [a] -> [a]
++ MetaDoc a id -> [MetaDoc a id]
forall a id. MetaDoc a id -> [MetaDoc a id]
flatten (DocH a id -> MetaDoc a id
forall {mod} {id}. DocH mod id -> MetaDoc mod id
f DocH a id
y)
flatten MetaDoc a id
x = [MetaDoc a id
x]

-- | Generate the markup needed for collapse to happen. For
-- 'UntouchedDoc' and 'HackAppend' we do nothing more but
-- extract/append the underlying 'Doc' and convert it to 'Html'. For
-- 'CollapsingHeader', we attach extra info to the generated 'Html'
-- that allows us to expand/collapse the content.
hackMarkup :: DocMarkup id Html -> Maybe Package -> Hack (Wrap (ModuleName, OccName)) id -> Html
hackMarkup :: forall id.
DocMarkup id Html
-> Maybe [Char] -> Hack (Wrap (ModuleName, OccName)) id -> Html
hackMarkup DocMarkup id Html
fmt' Maybe [Char]
currPkg Hack (Wrap (ModuleName, OccName)) id
h' =
  let (Html
html, [Meta]
ms) = DocMarkup id Html
-> Hack (Wrap (ModuleName, OccName)) id -> (Html, [Meta])
forall id.
DocMarkup id Html
-> Hack (Wrap (ModuleName, OccName)) id -> (Html, [Meta])
hackMarkup' DocMarkup id Html
fmt' Hack (Wrap (ModuleName, OccName)) id
h'
   in Html
html Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ DocMarkup id Html -> Maybe [Char] -> Meta -> Html
forall id. DocMarkup id Html -> Maybe [Char] -> Meta -> Html
renderMeta DocMarkup id Html
fmt' Maybe [Char]
currPkg ([Meta] -> Meta
metaConcat [Meta]
ms)
  where
    hackMarkup'
      :: DocMarkup id Html
      -> Hack (Wrap (ModuleName, OccName)) id
      -> (Html, [Meta])
    hackMarkup' :: forall id.
DocMarkup id Html
-> Hack (Wrap (ModuleName, OccName)) id -> (Html, [Meta])
hackMarkup' DocMarkup id Html
fmt Hack (Wrap (ModuleName, OccName)) id
h = case Hack (Wrap (ModuleName, OccName)) id
h of
      UntouchedDoc MetaDoc (Wrap (ModuleName, OccName)) id
d -> (DocMarkup id Html -> DocH (Wrap (ModuleName, OccName)) id -> Html
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup DocMarkup id Html
fmt (DocH (Wrap (ModuleName, OccName)) id -> Html)
-> DocH (Wrap (ModuleName, OccName)) id -> Html
forall a b. (a -> b) -> a -> b
$ MetaDoc (Wrap (ModuleName, OccName)) id
-> DocH (Wrap (ModuleName, OccName)) id
forall mod id. MetaDoc mod id -> DocH mod id
_doc MetaDoc (Wrap (ModuleName, OccName)) id
d, [MetaDoc (Wrap (ModuleName, OccName)) id -> Meta
forall mod id. MetaDoc mod id -> Meta
_meta MetaDoc (Wrap (ModuleName, OccName)) id
d])
      CollapsingHeader (Header Int
lvl DocH (Wrap (ModuleName, OccName)) id
titl) MetaDoc (Wrap (ModuleName, OccName)) id
par Int
n Maybe [Char]
nm ->
        let id_ :: [Char]
id_ = [Char] -> [Char]
makeAnchorId ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"ch:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"noid:" Maybe [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
            col' :: [HtmlAttr]
col' = [Char] -> [Char] -> [HtmlAttr]
collapseControl [Char]
id_ [Char]
"subheading"
            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]
"Expand"
            instTable :: b -> Html
instTable b
contents = [Char] -> DetailsState -> Html -> Html
collapseDetails [Char]
id_ DetailsState
DetailsClosed (Html
summary Html -> b -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ b
contents)
            lvs :: [(Int, Html -> Html)]
lvs = [Int] -> [Html -> Html] -> [(Int, Html -> Html)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [Html -> Html
h1, Html -> Html
h2, Html -> Html
h3, Html -> Html
h4, Html -> Html
h5, Html -> Html
h6]
            getHeader :: Html -> Html
getHeader = (Html -> Html) -> Maybe (Html -> Html) -> Html -> Html
forall a. a -> Maybe a -> a
fromMaybe Html -> Html
caption (Int -> [(Int, Html -> Html)] -> Maybe (Html -> Html)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
lvl [(Int, Html -> Html)]
lvs)
            subCaption :: Html
subCaption = Html -> Html
getHeader (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
col' (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< DocMarkup id Html -> DocH (Wrap (ModuleName, OccName)) id -> Html
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup DocMarkup id Html
fmt DocH (Wrap (ModuleName, OccName)) id
titl
         in ((Html
subCaption Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++) (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
forall a. HTML a => a -> Html
instTable (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ DocMarkup id Html -> DocH (Wrap (ModuleName, OccName)) id -> Html
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup DocMarkup id Html
fmt (MetaDoc (Wrap (ModuleName, OccName)) id
-> DocH (Wrap (ModuleName, OccName)) id
forall mod id. MetaDoc mod id -> DocH mod id
_doc MetaDoc (Wrap (ModuleName, OccName)) id
par), [MetaDoc (Wrap (ModuleName, OccName)) id -> Meta
forall mod id. MetaDoc mod id -> Meta
_meta MetaDoc (Wrap (ModuleName, OccName)) id
par])
      HackAppend Hack (Wrap (ModuleName, OccName)) id
d Hack (Wrap (ModuleName, OccName)) id
d' ->
        let (Html
x, [Meta]
m) = DocMarkup id Html
-> Hack (Wrap (ModuleName, OccName)) id -> (Html, [Meta])
forall id.
DocMarkup id Html
-> Hack (Wrap (ModuleName, OccName)) id -> (Html, [Meta])
hackMarkup' DocMarkup id Html
fmt Hack (Wrap (ModuleName, OccName)) id
d
            (Html
y, [Meta]
m') = DocMarkup id Html
-> Hack (Wrap (ModuleName, OccName)) id -> (Html, [Meta])
forall id.
DocMarkup id Html
-> Hack (Wrap (ModuleName, OccName)) id -> (Html, [Meta])
hackMarkup' DocMarkup id Html
fmt Hack (Wrap (ModuleName, OccName)) id
d'
         in (DocMarkup id Html -> Html -> Html -> Html
forall mod id a. DocMarkupH mod id a -> a -> a -> a
markupAppend DocMarkup id Html
fmt Html
x Html
y, [Meta]
m [Meta] -> [Meta] -> [Meta]
forall a. [a] -> [a] -> [a]
++ [Meta]
m')

renderMeta :: DocMarkup id Html -> Maybe Package -> Meta -> Html
renderMeta :: forall id. DocMarkup id Html -> Maybe [Char] -> Meta -> Html
renderMeta DocMarkup id Html
fmt Maybe [Char]
currPkg Meta
m =
  Html -> (MetaSince -> Html) -> Maybe MetaSince -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
noHtml (DocMarkup id Html -> Maybe [Char] -> MetaSince -> Html
forall id. DocMarkup id Html -> Maybe [Char] -> MetaSince -> Html
renderMetaSince DocMarkup id Html
fmt Maybe [Char]
currPkg) (Meta -> Maybe MetaSince
_metaSince Meta
m)

renderMetaSince :: DocMarkup id Html -> Maybe Package -> MetaSince -> Html
renderMetaSince :: forall id. DocMarkup id Html -> Maybe [Char] -> MetaSince -> Html
renderMetaSince DocMarkup id Html
fmt Maybe [Char]
currPkg (MetaSince{sincePackage :: MetaSince -> Maybe [Char]
sincePackage = Maybe [Char]
pkg, sinceVersion :: MetaSince -> [Int]
sinceVersion = [Int]
ver}) =
  DocMarkup id Html -> Html -> Html
forall mod id a. DocMarkupH mod id a -> a -> a
markupParagraph DocMarkup id Html
fmt (Html -> Html) -> ([Char] -> Html) -> [Char] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocMarkup id Html -> Html -> Html
forall mod id a. DocMarkupH mod id a -> a -> a
markupEmphasis DocMarkup id Html
fmt (Html -> Html) -> ([Char] -> Html) -> [Char] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Html
forall a. HTML a => a -> Html
toHtml ([Char] -> Html) -> [Char] -> Html
forall a b. (a -> b) -> a -> b
$
    [Char]
"Since: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [Char]
formatPkgMaybe Maybe [Char]
pkg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Char]
forall {a}. Show a => [a] -> [Char]
formatVersion [Int]
ver
  where
    formatVersion :: [a] -> [Char]
formatVersion [a]
v = [[Char]] -> [Char]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
"." ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
forall a. Show a => a -> [Char]
show [a]
v
    formatPkgMaybe :: Maybe [Char] -> [Char]
formatPkgMaybe (Just [Char]
p) | [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
p Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe [Char]
currPkg = [Char]
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-"
    formatPkgMaybe Maybe [Char]
_ = [Char]
""

-- | Goes through 'hackMarkup' to generate the 'Html' rather than
-- skipping straight to 'markup': this allows us to employ XHtml
-- specific hacks to the tree first.
markupHacked
  :: DocMarkup (Wrap id) Html
  -> Maybe Package -- this package
  -> Maybe String
  -> MDoc id
  -> Html
markupHacked :: forall id.
DocMarkup (Wrap id) Html
-> Maybe [Char] -> Maybe [Char] -> MDoc id -> Html
markupHacked DocMarkup (Wrap id) Html
fmt Maybe [Char]
currPkg Maybe [Char]
n = DocMarkup (Wrap id) Html
-> Maybe [Char]
-> Hack (Wrap (ModuleName, OccName)) (Wrap id)
-> Html
forall id.
DocMarkup id Html
-> Maybe [Char] -> Hack (Wrap (ModuleName, OccName)) id -> Html
hackMarkup DocMarkup (Wrap id) Html
fmt Maybe [Char]
currPkg (Hack (Wrap (ModuleName, OccName)) (Wrap id) -> Html)
-> (MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)
    -> Hack (Wrap (ModuleName, OccName)) (Wrap id))
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Maybe [Char]
-> [MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)]
-> Hack (Wrap (ModuleName, OccName)) (Wrap id)
forall a id. Int -> Maybe [Char] -> [MetaDoc a id] -> Hack a id
toHack Int
0 Maybe [Char]
n ([MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)]
 -> Hack (Wrap (ModuleName, OccName)) (Wrap id))
-> (MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)
    -> [MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)])
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)
-> Hack (Wrap (ModuleName, OccName)) (Wrap id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)
-> [MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)]
forall a id. MetaDoc a id -> [MetaDoc a id]
flatten

-- If the doc is a single paragraph, don't surround it with <P> (this causes
-- ugly extra whitespace with some browsers).  FIXME: Does this still apply?
docToHtml
  :: Maybe String
  -- ^ Name of the thing this doc is for. See
  -- comments on 'toHack' for details.
  -> Maybe Package
  -- ^ Current package
  -> Qualification
  -> MDoc DocName
  -> Html
docToHtml :: Maybe [Char]
-> Maybe [Char] -> Qualification -> MDoc DocName -> Html
docToHtml Maybe [Char]
n Maybe [Char]
pkg Qualification
qual = DocMarkup (Wrap DocName) Html
-> Maybe [Char] -> Maybe [Char] -> MDoc DocName -> Html
forall id.
DocMarkup (Wrap id) Html
-> Maybe [Char] -> Maybe [Char] -> MDoc id -> Html
markupHacked DocMarkup (Wrap DocName) Html
fmt Maybe [Char]
pkg Maybe [Char]
n (MDoc DocName -> Html)
-> (MDoc DocName -> MDoc DocName) -> MDoc DocName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MDoc DocName -> MDoc DocName
forall a. MDoc a -> MDoc a
cleanup
  where
    fmt :: DocMarkup (Wrap DocName) Html
fmt = Qualification
-> Bool
-> (Bool -> Wrap DocName -> Html)
-> DocMarkup (Wrap DocName) Html
forall a.
Qualification -> Bool -> (Bool -> a -> Html) -> DocMarkup a Html
parHtmlMarkup Qualification
qual Bool
True (Qualification -> Notation -> Bool -> Wrap DocName -> Html
ppWrappedDocName Qualification
qual Notation
Raw)

-- | Same as 'docToHtml' but it doesn't insert the 'anchor' element
-- in links. This is used to generate the Contents box elements.
docToHtmlNoAnchors
  :: Maybe String
  -- ^ See 'toHack'
  -> Maybe Package
  -- ^ Current package
  -> Qualification
  -> MDoc DocName
  -> Html
docToHtmlNoAnchors :: Maybe [Char]
-> Maybe [Char] -> Qualification -> MDoc DocName -> Html
docToHtmlNoAnchors Maybe [Char]
n Maybe [Char]
pkg Qualification
qual = DocMarkup (Wrap DocName) Html
-> Maybe [Char] -> Maybe [Char] -> MDoc DocName -> Html
forall id.
DocMarkup (Wrap id) Html
-> Maybe [Char] -> Maybe [Char] -> MDoc id -> Html
markupHacked DocMarkup (Wrap DocName) Html
fmt Maybe [Char]
pkg Maybe [Char]
n (MDoc DocName -> Html)
-> (MDoc DocName -> MDoc DocName) -> MDoc DocName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MDoc DocName -> MDoc DocName
forall a. MDoc a -> MDoc a
cleanup
  where
    fmt :: DocMarkup (Wrap DocName) Html
fmt = Qualification
-> Bool
-> (Bool -> Wrap DocName -> Html)
-> DocMarkup (Wrap DocName) Html
forall a.
Qualification -> Bool -> (Bool -> a -> Html) -> DocMarkup a Html
parHtmlMarkup Qualification
qual Bool
False (Qualification -> Notation -> Bool -> Wrap DocName -> Html
ppWrappedDocName Qualification
qual Notation
Raw)

origDocToHtml :: Maybe Package -> Qualification -> MDoc Name -> Html
origDocToHtml :: Maybe [Char] -> Qualification -> MDoc Name -> Html
origDocToHtml Maybe [Char]
pkg Qualification
qual = DocMarkup (Wrap Name) Html
-> Maybe [Char] -> Maybe [Char] -> MDoc Name -> Html
forall id.
DocMarkup (Wrap id) Html
-> Maybe [Char] -> Maybe [Char] -> MDoc id -> Html
markupHacked DocMarkup (Wrap Name) Html
fmt Maybe [Char]
pkg Maybe [Char]
forall a. Maybe a
Nothing (MDoc Name -> Html)
-> (MDoc Name -> MDoc Name) -> MDoc Name -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MDoc Name -> MDoc Name
forall a. MDoc a -> MDoc a
cleanup
  where
    fmt :: DocMarkup (Wrap Name) Html
fmt = Qualification
-> Bool
-> (Bool -> Wrap Name -> Html)
-> DocMarkup (Wrap Name) Html
forall a.
Qualification -> Bool -> (Bool -> a -> Html) -> DocMarkup a Html
parHtmlMarkup Qualification
qual Bool
True ((Wrap Name -> Html) -> Bool -> Wrap Name -> Html
forall a b. a -> b -> a
const (Notation -> Wrap Name -> Html
ppWrappedName Notation
Raw))

rdrDocToHtml :: Maybe Package -> Qualification -> MDoc RdrName -> Html
rdrDocToHtml :: Maybe [Char] -> Qualification -> MDoc RdrName -> Html
rdrDocToHtml Maybe [Char]
pkg Qualification
qual = DocMarkup (Wrap RdrName) Html
-> Maybe [Char] -> Maybe [Char] -> MDoc RdrName -> Html
forall id.
DocMarkup (Wrap id) Html
-> Maybe [Char] -> Maybe [Char] -> MDoc id -> Html
markupHacked DocMarkup (Wrap RdrName) Html
fmt Maybe [Char]
pkg Maybe [Char]
forall a. Maybe a
Nothing (MDoc RdrName -> Html)
-> (MDoc RdrName -> MDoc RdrName) -> MDoc RdrName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MDoc RdrName -> MDoc RdrName
forall a. MDoc a -> MDoc a
cleanup
  where
    fmt :: DocMarkup (Wrap RdrName) Html
fmt = Qualification
-> Bool
-> (Bool -> Wrap RdrName -> Html)
-> DocMarkup (Wrap RdrName) Html
forall a.
Qualification -> Bool -> (Bool -> a -> Html) -> DocMarkup a Html
parHtmlMarkup Qualification
qual Bool
True ((Wrap RdrName -> Html) -> Bool -> Wrap RdrName -> Html
forall a b. a -> b -> a
const (RdrName -> Html
ppRdrName (RdrName -> Html)
-> (Wrap RdrName -> RdrName) -> Wrap RdrName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrap RdrName -> RdrName
forall n. Wrap n -> n
unwrap))

docElement :: (Html -> Html) -> Html -> Html
docElement :: (Html -> Html) -> Html -> Html
docElement Html -> Html
el Html
content_ =
  if Html -> Bool
isNoHtml Html
content_
    then Html -> Html
el (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"doc empty"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
spaceHtml
    else Html -> Html
el (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"doc"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
content_

docSection
  :: Maybe Name
  -- ^ Name of the thing this doc is for
  -> Maybe Package
  -- ^ Current package
  -> Qualification
  -> Documentation DocName
  -> Html
docSection :: Maybe Name
-> Maybe [Char] -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
n Maybe [Char]
pkg Qualification
qual =
  Html -> (MDoc DocName -> Html) -> Maybe (MDoc DocName) -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
noHtml (Maybe Name -> Maybe [Char] -> Qualification -> MDoc DocName -> Html
docSection_ Maybe Name
n Maybe [Char]
pkg Qualification
qual) (Maybe (MDoc DocName) -> Html)
-> (Documentation DocName -> Maybe (MDoc DocName))
-> Documentation DocName
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Documentation DocName -> Maybe (MDoc DocName)
forall name. Documentation name -> Maybe (MDoc name)
combineDocumentation

docSection_
  :: Maybe Name
  -- ^ Name of the thing this doc is for
  -> Maybe Package
  -- ^ Current package
  -> Qualification
  -> MDoc DocName
  -> Html
docSection_ :: Maybe Name -> Maybe [Char] -> Qualification -> MDoc DocName -> Html
docSection_ Maybe Name
n Maybe [Char]
pkg Qualification
qual =
  ((Html -> Html) -> Html -> Html
docElement Html -> Html
thediv (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<) (Html -> Html) -> (MDoc DocName -> Html) -> MDoc DocName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char]
-> Maybe [Char] -> Qualification -> MDoc DocName -> Html
docToHtml (Name -> [Char]
forall a. NamedThing a => a -> [Char]
getOccString (Name -> [Char]) -> Maybe Name -> Maybe [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
n) Maybe [Char]
pkg Qualification
qual

cleanup :: MDoc a -> MDoc a
cleanup :: forall a. MDoc a -> MDoc a
cleanup = (DocH (Wrap (ModuleName, OccName)) (Wrap a)
 -> DocH (Wrap (ModuleName, OccName)) (Wrap a))
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap a)
-> MetaDoc (Wrap (ModuleName, OccName)) (Wrap a)
forall a b c d.
(DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d
overDoc (DocMarkupH
  (Wrap (ModuleName, OccName))
  (Wrap a)
  (DocH (Wrap (ModuleName, OccName)) (Wrap a))
-> DocH (Wrap (ModuleName, OccName)) (Wrap a)
-> DocH (Wrap (ModuleName, OccName)) (Wrap a)
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup DocMarkupH
  (Wrap (ModuleName, OccName))
  (Wrap a)
  (DocH (Wrap (ModuleName, OccName)) (Wrap a))
forall a. DocMarkup (Wrap a) (Doc a)
fmtUnParagraphLists)
  where
    -- If there is a single paragraph, then surrounding it with <P>..</P>
    -- can add too much whitespace in some browsers (eg. IE).  However if
    -- we have multiple paragraphs, then we want the extra whitespace to
    -- separate them.  So we catch the single paragraph case and transform it
    -- here. We don't do this in code blocks as it eliminates line breaks.
    unParagraph :: Doc a -> Doc a
    unParagraph :: forall a. Doc a -> Doc a
unParagraph (DocParagraph DocH (Wrap (ModuleName, OccName)) (Wrap a)
d) = DocH (Wrap (ModuleName, OccName)) (Wrap a)
d
    unParagraph DocH (Wrap (ModuleName, OccName)) (Wrap a)
doc = DocH (Wrap (ModuleName, OccName)) (Wrap a)
doc

    fmtUnParagraphLists :: DocMarkup (Wrap a) (Doc a)
    fmtUnParagraphLists :: forall a. DocMarkup (Wrap a) (Doc a)
fmtUnParagraphLists =
      DocMarkupH
  (Wrap (ModuleName, OccName))
  (Wrap a)
  (DocH (Wrap (ModuleName, OccName)) (Wrap a))
forall mod id. DocMarkupH mod id (DocH mod id)
idMarkup
        { markupUnorderedList = DocUnorderedList . map unParagraph
        , markupOrderedList = DocOrderedList . map (\(Int
index, DocH (Wrap (ModuleName, OccName)) (Wrap a)
a) -> (Int
index, DocH (Wrap (ModuleName, OccName)) (Wrap a)
-> DocH (Wrap (ModuleName, OccName)) (Wrap a)
forall a. Doc a -> Doc a
unParagraph DocH (Wrap (ModuleName, OccName)) (Wrap a)
a))
        }