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 :: String -> Html
markupString = String -> 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 String
m Maybe Html
lbl) ->
let (String
mdl, String
ref) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') String
m
mdl' :: String
mdl' = case String -> String
forall a. [a] -> [a]
reverse String
mdl of
Char
'\\' : String
_ -> String -> String
forall a. HasCallStack => [a] -> [a]
init String
mdl
String
_ -> String
mdl
in Maybe Html -> ModuleName -> String -> Html
ppModuleRef Maybe Html
lbl (String -> ModuleName
mkModuleName String
mdl') String
ref
, markupWarning :: Html -> Html
markupWarning = Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"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
! [String -> HtmlAttr
theclass String
"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 String
url Maybe Html
mLabel) ->
if Bool
insertAnchors
then
Html -> Html
anchor
(Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
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 (String -> Html
forall a. HTML a => a -> Html
toHtml String
url) Maybe Html
mLabel
else Html -> Maybe Html -> Html
forall a. a -> Maybe a -> a
fromMaybe (String -> Html
forall a. HTML a => a -> Html
toHtml String
url) Maybe Html
mLabel
, markupAName :: String -> Html
markupAName = \String
aname ->
if Bool
insertAnchors
then String -> Html -> Html
namedAnchor String
aname (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
""
else Html
noHtml
, markupPic :: Picture -> Html
markupPic = \(Picture String
uri Maybe String
t) -> Html
image Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([String -> HtmlAttr
src String
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])
-> (String -> HtmlAttr) -> String -> [HtmlAttr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HtmlAttr
title (String -> [HtmlAttr]) -> Maybe String -> Maybe [HtmlAttr]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
t))
, markupMathInline :: String -> Html
markupMathInline = \String
mathjax -> Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"mathjax"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String -> Html
forall a. HTML a => a -> Html
toHtml (String
"\\(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mathjax String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\)")
, markupMathDisplay :: String -> Html
markupMathDisplay = \String
mathjax -> Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"mathjax"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String -> Html
forall a. HTML a => a -> Html
toHtml (String
"\\[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mathjax String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\]")
, markupProperty :: String -> Html
markupProperty = Html -> Html
pre (Html -> Html) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> 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
_ = String -> Html
forall a. HasCallStack => String -> a
error (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
"Somehow got a header level `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' 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
! [String -> HtmlAttr
theclass String
"screen"]
exampleToHtml :: Example -> Html
exampleToHtml (Example String
expression [String]
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
+++ String -> Html
forall a. HTML a => a -> Html
toHtml ([String] -> String
unlines [String]
result)
htmlPrompt :: Html
htmlPrompt = (Html -> Html
thecode (Html -> Html) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. HTML a => a -> Html
toHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
">>> ") Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"prompt"]
htmlExpression :: Html
htmlExpression = (Html -> Html
strong (Html -> Html) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
thecode (Html -> Html) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. HTML a => a -> Html
toHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
expression String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"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
! [String -> Int -> HtmlAttr
intAttr String
"value" Int
index] (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< a
a) [(Int, a)]
items
data Hack a id
= UntouchedDoc (MetaDoc a id)
| (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)
toHack
:: Int
-> Maybe String
-> [MetaDoc a id]
-> Hack a id
toHack :: forall a id. Int -> Maybe String -> [MetaDoc a id] -> Hack a id
toHack Int
_ Maybe String
_ [] = 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 String
_ [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 String
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
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
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
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
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 String -> [MetaDoc a id] -> Hack a id
forall a id. Int -> Maybe String -> [MetaDoc a id] -> Hack a id
toHack (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe String
nm [MetaDoc a id]
ys)
in
case [MetaDoc a id]
r of
[] -> Header (DocH a id)
-> MetaDoc a id -> Int -> Maybe String -> Hack a id
forall a id.
Header (DocH a id)
-> MetaDoc a id -> Int -> Maybe String -> Hack a id
CollapsingHeader Header (DocH a id)
h MetaDoc a id
forall mod id. MetaDoc mod id
emptyMetaDoc Int
n Maybe String
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'
MetaDoc a id
y : [MetaDoc a id]
ys -> Header (DocH a id)
-> MetaDoc a id -> Int -> Maybe String -> Hack a id
forall a id.
Header (DocH a id)
-> MetaDoc a id -> Int -> Maybe String -> 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 String
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 String
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 String -> [MetaDoc a id] -> Hack a id
forall a id. Int -> Maybe String -> [MetaDoc a id] -> Hack a id
toHack Int
n Maybe String
nm [MetaDoc a id]
xs)
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]
hackMarkup :: DocMarkup id Html -> Maybe Package -> Hack (Wrap (ModuleName, OccName)) id -> Html
hackMarkup :: forall id.
DocMarkup id Html
-> Maybe String -> Hack (Wrap (ModuleName, OccName)) id -> Html
hackMarkup DocMarkup id Html
fmt' Maybe String
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 String -> Meta -> Html
forall id. DocMarkup id Html -> Maybe String -> Meta -> Html
renderMeta DocMarkup id Html
fmt' Maybe String
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 String
nm ->
let id_ :: String
id_ = String -> String
makeAnchorId (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"ch:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"noid:" Maybe String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
col' :: [HtmlAttr]
col' = String -> String -> [HtmlAttr]
collapseControl String
id_ String
"subheading"
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
"Expand"
instTable :: b -> Html
instTable b
contents = String -> DetailsState -> Html -> Html
collapseDetails String
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 String -> Meta -> Html
renderMeta DocMarkup id Html
fmt Maybe String
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 String -> MetaSince -> Html
forall id. DocMarkup id Html -> Maybe String -> MetaSince -> Html
renderMetaSince DocMarkup id Html
fmt Maybe String
currPkg) (Meta -> Maybe MetaSince
_metaSince Meta
m)
renderMetaSince :: DocMarkup id Html -> Maybe Package -> MetaSince -> Html
renderMetaSince :: forall id. DocMarkup id Html -> Maybe String -> MetaSince -> Html
renderMetaSince DocMarkup id Html
fmt Maybe String
currPkg (MetaSince{sincePackage :: MetaSince -> Maybe String
sincePackage = Maybe String
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) -> (String -> Html) -> String -> 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) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. HTML a => a -> Html
toHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$
String
"Since: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
formatPkgMaybe Maybe String
pkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall {a}. Show a => [a] -> String
formatVersion [Int]
ver
where
formatVersion :: [a] -> String
formatVersion [a]
v = [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
v
formatPkgMaybe :: Maybe String -> String
formatPkgMaybe (Just String
p) | String -> Maybe String
forall a. a -> Maybe a
Just String
p Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe String
currPkg = String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-"
formatPkgMaybe Maybe String
_ = String
""
markupHacked
:: DocMarkup (Wrap id) Html
-> Maybe Package
-> Maybe String
-> MDoc id
-> Html
markupHacked :: forall id.
DocMarkup (Wrap id) Html
-> Maybe String -> Maybe String -> MDoc id -> Html
markupHacked DocMarkup (Wrap id) Html
fmt Maybe String
currPkg Maybe String
n = DocMarkup (Wrap id) Html
-> Maybe String
-> Hack (Wrap (ModuleName, OccName)) (Wrap id)
-> Html
forall id.
DocMarkup id Html
-> Maybe String -> Hack (Wrap (ModuleName, OccName)) id -> Html
hackMarkup DocMarkup (Wrap id) Html
fmt Maybe String
currPkg (Hack (Wrap (ModuleName, OccName)) (Wrap id) -> Html)
-> (MDoc id -> Hack (Wrap (ModuleName, OccName)) (Wrap id))
-> MDoc id
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Maybe String
-> [MDoc id]
-> Hack (Wrap (ModuleName, OccName)) (Wrap id)
forall a id. Int -> Maybe String -> [MetaDoc a id] -> Hack a id
toHack Int
0 Maybe String
n ([MDoc id] -> Hack (Wrap (ModuleName, OccName)) (Wrap id))
-> (MDoc id -> [MDoc id])
-> MDoc id
-> Hack (Wrap (ModuleName, OccName)) (Wrap id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MDoc id -> [MDoc id]
forall a id. MetaDoc a id -> [MetaDoc a id]
flatten
docToHtml
:: Maybe String
-> Maybe Package
-> Qualification
-> MDoc DocName
-> Html
docToHtml :: Maybe String
-> Maybe String -> Qualification -> MDoc DocName -> Html
docToHtml Maybe String
n Maybe String
pkg Qualification
qual = DocMarkup (Wrap DocName) Html
-> Maybe String -> Maybe String -> MDoc DocName -> Html
forall id.
DocMarkup (Wrap id) Html
-> Maybe String -> Maybe String -> MDoc id -> Html
markupHacked DocMarkup (Wrap DocName) Html
fmt Maybe String
pkg Maybe String
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)
docToHtmlNoAnchors
:: Maybe String
-> Maybe Package
-> Qualification
-> MDoc DocName
-> Html
docToHtmlNoAnchors :: Maybe String
-> Maybe String -> Qualification -> MDoc DocName -> Html
docToHtmlNoAnchors Maybe String
n Maybe String
pkg Qualification
qual = DocMarkup (Wrap DocName) Html
-> Maybe String -> Maybe String -> MDoc DocName -> Html
forall id.
DocMarkup (Wrap id) Html
-> Maybe String -> Maybe String -> MDoc id -> Html
markupHacked DocMarkup (Wrap DocName) Html
fmt Maybe String
pkg Maybe String
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 String -> Qualification -> MDoc Name -> Html
origDocToHtml Maybe String
pkg Qualification
qual = DocMarkup (Wrap Name) Html
-> Maybe String -> Maybe String -> MDoc Name -> Html
forall id.
DocMarkup (Wrap id) Html
-> Maybe String -> Maybe String -> MDoc id -> Html
markupHacked DocMarkup (Wrap Name) Html
fmt Maybe String
pkg Maybe String
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 String -> Qualification -> MDoc RdrName -> Html
rdrDocToHtml Maybe String
pkg Qualification
qual = DocMarkup (Wrap RdrName) Html
-> Maybe String -> Maybe String -> MDoc RdrName -> Html
forall id.
DocMarkup (Wrap id) Html
-> Maybe String -> Maybe String -> MDoc id -> Html
markupHacked DocMarkup (Wrap RdrName) Html
fmt Maybe String
pkg Maybe String
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
! [String -> HtmlAttr
theclass String
"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
! [String -> HtmlAttr
theclass String
"doc"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
content_
docSection
:: Maybe Name
-> Maybe Package
-> Qualification
-> Documentation DocName
-> Html
docSection :: Maybe Name
-> Maybe String -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
n Maybe String
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 String -> Qualification -> MDoc DocName -> Html
docSection_ Maybe Name
n Maybe String
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
-> Maybe Package
-> Qualification
-> MDoc DocName
-> Html
docSection_ :: Maybe Name -> Maybe String -> Qualification -> MDoc DocName -> Html
docSection_ Maybe Name
n Maybe String
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 String
-> Maybe String -> Qualification -> MDoc DocName -> Html
docToHtml (Name -> String
forall a. NamedThing a => a -> String
getOccString (Name -> String) -> Maybe Name -> Maybe String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Name
n) Maybe String
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
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))
}