-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.Backends.Html
-- Copyright   :  (c) Simon Marlow      2003-2006,
--                    David Waern       2006-2009,
--                    Mark Lentczner    2010,
--                    Mateusz Kowalczyk 2013
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
-----------------------------------------------------------------------------
{-# LANGUAGE CPP, NamedFieldPuns #-}
module Haddock.Backends.Xhtml (
  ppHtml, copyHtmlBits,
  ppHtmlIndex, ppHtmlContents,
) where


import Prelude hiding (div)

import Haddock.Backends.Xhtml.Decl
import Haddock.Backends.Xhtml.DocMarkup
import Haddock.Backends.Xhtml.Layout
import Haddock.Backends.Xhtml.Names
import Haddock.Backends.Xhtml.Themes
import Haddock.Backends.Xhtml.Types
import Haddock.Backends.Xhtml.Utils
import Haddock.ModuleTree
import Haddock.Types
import Haddock.Version
import Haddock.Utils
import Haddock.Utils.Json
import Text.XHtml hiding ( name, title, p, quote )
import qualified Text.XHtml as XHtml
import Haddock.GhcUtils

import Control.Monad         ( when, unless )
import qualified Data.ByteString.Builder as Builder
import Data.Char             ( toUpper, isSpace )
import Data.List             ( sortBy, isPrefixOf, intersperse )
import Data.Maybe
import System.Directory
import System.FilePath hiding ( (</>) )
import qualified System.IO as IO
import Data.Map              ( Map )
import qualified Data.Map as Map hiding ( Map )
import qualified Data.Set as Set hiding ( Set )
import Data.Ord              ( comparing )

import DynFlags (Language(..))
import GHC hiding ( NoLink, moduleInfo,LexicalFixity(..) )
import Name

--------------------------------------------------------------------------------
-- * Generating HTML documentation
--------------------------------------------------------------------------------

ppHtml :: DynFlags
       -> String                       -- ^ Title
       -> Maybe String                 -- ^ Package
       -> [Interface]
       -> [InstalledInterface]         -- ^ Reexported interfaces
       -> FilePath                     -- ^ Destination directory
       -> Maybe (MDoc GHC.RdrName)     -- ^ Prologue text, maybe
       -> Themes                       -- ^ Themes
       -> Maybe String                 -- ^ The mathjax URL (--mathjax)
       -> SourceURLs                   -- ^ The source URL (--source)
       -> WikiURLs                     -- ^ The wiki URL (--wiki)
       -> Maybe String                 -- ^ The contents URL (--use-contents)
       -> Maybe String                 -- ^ The index URL (--use-index)
       -> Bool                         -- ^ Whether to use unicode in output (--use-unicode)
       -> Maybe String                 -- ^ Package name
       -> QualOption                   -- ^ How to qualify names
       -> Bool                         -- ^ Output pretty html (newlines and indenting)
       -> Bool                         -- ^ Also write Quickjump index
       -> IO ()

ppHtml :: DynFlags
-> String
-> Maybe String
-> [Interface]
-> [InstalledInterface]
-> String
-> Maybe (MDoc RdrName)
-> Themes
-> Maybe String
-> SourceURLs
-> WikiURLs
-> Maybe String
-> Maybe String
-> Bool
-> Maybe String
-> QualOption
-> Bool
-> Bool
-> IO ()
ppHtml DynFlags
dflags String
doctitle Maybe String
maybe_package [Interface]
ifaces [InstalledInterface]
reexported_ifaces String
odir Maybe (MDoc RdrName)
prologue
        Themes
themes Maybe String
maybe_mathjax_url SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url
        Maybe String
maybe_contents_url Maybe String
maybe_index_url Bool
unicode
        Maybe String
pkg QualOption
qual Bool
debug Bool
withQuickjump = do
  let
    visible_ifaces :: [Interface]
visible_ifaces = (Interface -> Bool) -> [Interface] -> [Interface]
forall a. (a -> Bool) -> [a] -> [a]
filter Interface -> Bool
visible [Interface]
ifaces
    visible :: Interface -> Bool
visible Interface
i = DocOption
OptHide DocOption -> [DocOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Interface -> [DocOption]
ifaceOptions Interface
i

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
maybe_contents_url) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    DynFlags
-> String
-> String
-> Maybe String
-> Themes
-> Maybe String
-> Maybe String
-> SourceURLs
-> WikiURLs
-> [InstalledInterface]
-> Bool
-> Maybe (MDoc RdrName)
-> Bool
-> Maybe String
-> Qualification
-> IO ()
ppHtmlContents DynFlags
dflags String
odir String
doctitle Maybe String
maybe_package
        Themes
themes Maybe String
maybe_mathjax_url Maybe String
maybe_index_url SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url
        ((Interface -> InstalledInterface)
-> [Interface] -> [InstalledInterface]
forall a b. (a -> b) -> [a] -> [b]
map Interface -> InstalledInterface
toInstalledIface [Interface]
visible_ifaces [InstalledInterface]
-> [InstalledInterface] -> [InstalledInterface]
forall a. [a] -> [a] -> [a]
++ [InstalledInterface]
reexported_ifaces)
        Bool
False -- we don't want to display the packages in a single-package contents
        Maybe (MDoc RdrName)
prologue Bool
debug Maybe String
pkg (QualOption -> Qualification
makeContentsQual QualOption
qual)

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
maybe_index_url) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String
-> String
-> Maybe String
-> Themes
-> Maybe String
-> Maybe String
-> SourceURLs
-> WikiURLs
-> [InstalledInterface]
-> Bool
-> IO ()
ppHtmlIndex String
odir String
doctitle Maybe String
maybe_package
      Themes
themes Maybe String
maybe_mathjax_url Maybe String
maybe_contents_url SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url
      ((Interface -> InstalledInterface)
-> [Interface] -> [InstalledInterface]
forall a b. (a -> b) -> [a] -> [b]
map Interface -> InstalledInterface
toInstalledIface [Interface]
visible_ifaces [InstalledInterface]
-> [InstalledInterface] -> [InstalledInterface]
forall a. [a] -> [a] -> [a]
++ [InstalledInterface]
reexported_ifaces) Bool
debug

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
withQuickjump (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String
-> SourceURLs
-> WikiURLs
-> Bool
-> Maybe String
-> QualOption
-> [Interface]
-> IO ()
ppJsonIndex String
odir SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url Bool
unicode Maybe String
pkg QualOption
qual
        [Interface]
visible_ifaces

  (Interface -> IO ()) -> [Interface] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String
-> String
-> Themes
-> Maybe String
-> SourceURLs
-> WikiURLs
-> Maybe String
-> Maybe String
-> Bool
-> Maybe String
-> QualOption
-> Bool
-> Interface
-> IO ()
ppHtmlModule String
odir String
doctitle Themes
themes
           Maybe String
maybe_mathjax_url SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url
           Maybe String
maybe_contents_url Maybe String
maybe_index_url Bool
unicode Maybe String
pkg QualOption
qual Bool
debug) [Interface]
visible_ifaces


copyHtmlBits :: FilePath -> FilePath -> Themes -> Bool -> IO ()
copyHtmlBits :: String -> String -> Themes -> Bool -> IO ()
copyHtmlBits String
odir String
libdir Themes
themes Bool
withQuickjump = do
  let
    libhtmldir :: String
libhtmldir = [String] -> String
joinPath [String
libdir, String
"html"]
    copyCssFile :: String -> IO ()
copyCssFile String
f = String -> String -> IO ()
copyFile String
f (String -> String -> String
combine String
odir (String -> String
takeFileName String
f))
    copyLibFile :: String -> IO ()
copyLibFile String
f = String -> String -> IO ()
copyFile ([String] -> String
joinPath [String
libhtmldir, String
f]) ([String] -> String
joinPath [String
odir, String
f])
  (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
copyCssFile (Themes -> [String]
cssFiles Themes
themes)
  String -> IO ()
copyLibFile String
haddockJsFile
  String -> IO ()
copyCssFile ([String] -> String
joinPath [String
libhtmldir, String
quickJumpCssFile])
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
withQuickjump (String -> IO ()
copyLibFile String
jsQuickJumpFile)
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


headHtml :: String -> Themes -> Maybe String -> Html
headHtml :: String -> Themes -> Maybe String -> Html
headHtml String
docTitle Themes
themes Maybe String
mathjax_url =
  Html -> Html
header (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<
    [ Html
meta Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
httpequiv String
"Content-Type", String -> HtmlAttr
content String
"text/html; charset=UTF-8"]
    , Html
meta Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
XHtml.name String
"viewport", String -> HtmlAttr
content String
"width=device-width, initial-scale=1"]
    , Html -> Html
thetitle (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
docTitle
    , Themes -> Html
styleSheet Themes
themes
    , Html -> Html
thelink (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
rel String
"stylesheet", String -> HtmlAttr
thetype String
"text/css", String -> HtmlAttr
href String
quickJumpCssFile] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
noHtml
    , Html -> Html
thelink (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
rel String
"stylesheet", String -> HtmlAttr
thetype String
"text/css", String -> HtmlAttr
href String
fontUrl] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
noHtml
    , Html -> Html
script (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
src String
haddockJsFile, String -> HtmlAttr
emptyAttr String
"async", String -> HtmlAttr
thetype String
"text/javascript"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
noHtml
    , Html -> Html
script (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
thetype String
"text/x-mathjax-config"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String -> Html
primHtml String
mjConf
    , Html -> Html
script (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
src String
mjUrl, String -> HtmlAttr
thetype String
"text/javascript"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
noHtml
    ]
  where
    fontUrl :: String
fontUrl = String
"https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700"
    mjUrl :: String
mjUrl = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" Maybe String
mathjax_url
    mjConf :: String
mjConf = [String] -> String
unwords [ String
"MathJax.Hub.Config({"
                     ,   String
"tex2jax: {"
                     ,     String
"processClass: \"mathjax\","
                     ,     String
"ignoreClass: \".*\""
                     ,   String
"}"
                     , String
"});" ]

srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
srcButton (Just String
src_base_url, Maybe String
_, Map UnitId String
_, Map UnitId String
_) Maybe Interface
Nothing =
  Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
src_base_url] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Source")
srcButton (Maybe String
_, Just String
src_module_url, Map UnitId String
_, Map UnitId String
_) (Just Interface
iface) =
  let url :: String
url = Maybe String
-> Maybe Module -> Maybe Name -> Maybe SrcSpan -> String -> String
spliceURL (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Interface -> String
ifaceOrigFilename Interface
iface)
                      (Module -> Maybe Module
forall a. a -> Maybe a
Just (Module -> Maybe Module) -> Module -> Maybe Module
forall a b. (a -> b) -> a -> b
$ Interface -> Module
ifaceMod Interface
iface) Maybe Name
forall a. Maybe a
Nothing Maybe SrcSpan
forall a. Maybe a
Nothing String
src_module_url
   in Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
url] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Source")
srcButton SourceURLs
_ Maybe Interface
_ =
  Maybe Html
forall a. Maybe a
Nothing


wikiButton :: WikiURLs -> Maybe Module -> Maybe Html
wikiButton :: WikiURLs -> Maybe Module -> Maybe Html
wikiButton (Just String
wiki_base_url, Maybe String
_, Maybe String
_) Maybe Module
Nothing =
  Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
wiki_base_url] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"User Comments")

wikiButton (Maybe String
_, Just String
wiki_module_url, Maybe String
_) (Just Module
mdl) =
  let url :: String
url = Maybe String
-> Maybe Module -> Maybe Name -> Maybe SrcSpan -> String -> String
spliceURL Maybe String
forall a. Maybe a
Nothing (Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mdl) Maybe Name
forall a. Maybe a
Nothing Maybe SrcSpan
forall a. Maybe a
Nothing String
wiki_module_url
   in Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
url] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"User Comments")

wikiButton WikiURLs
_ Maybe Module
_ =
  Maybe Html
forall a. Maybe a
Nothing


contentsButton :: Maybe String -> Maybe Html
contentsButton :: Maybe String -> Maybe Html
contentsButton Maybe String
maybe_contents_url
  = Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
url] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Contents")
  where url :: String
url = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
contentsHtmlFile Maybe String
maybe_contents_url


indexButton :: Maybe String -> Maybe Html
indexButton :: Maybe String -> Maybe Html
indexButton Maybe String
maybe_index_url
  = Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
url] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Index")
  where url :: String
url = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
indexHtmlFile Maybe String
maybe_index_url


bodyHtml :: String -> Maybe Interface
    -> SourceURLs -> WikiURLs
    -> Maybe String -> Maybe String
    -> Html -> Html
bodyHtml :: String
-> Maybe Interface
-> SourceURLs
-> WikiURLs
-> Maybe String
-> Maybe String
-> Html
-> Html
bodyHtml String
doctitle Maybe Interface
iface
           SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url
           Maybe String
maybe_contents_url Maybe String
maybe_index_url
           Html
pageContent =
  Html -> Html
body (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [
    Html -> Html
divPackageHeader (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [
      Html -> Html
nonEmptySectionName (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
doctitle,
      [Html] -> Html
forall a. HTML a => [a] -> Html
unordList ([Maybe Html] -> [Html]
forall a. [Maybe a] -> [a]
catMaybes [
        SourceURLs -> Maybe Interface -> Maybe Html
srcButton SourceURLs
maybe_source_url Maybe Interface
iface,
        WikiURLs -> Maybe Module -> Maybe Html
wikiButton WikiURLs
maybe_wiki_url (Interface -> Module
ifaceMod (Interface -> Module) -> Maybe Interface -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Interface
iface),
        Maybe String -> Maybe Html
contentsButton Maybe String
maybe_contents_url,
        Maybe String -> Maybe Html
indexButton Maybe String
maybe_index_url])
            Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"links", String -> HtmlAttr
identifier String
"page-menu"]
      ],
    Html -> Html
divContent (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
pageContent,
    Html -> Html
divFooter (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
paragraph (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (
      String
"Produced by " String -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
      (Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
projectUrl] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String -> Html
forall a. HTML a => a -> Html
toHtml String
projectName) Html -> String -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
      (String
" version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
projectVersion)
      )
    ]

moduleInfo :: Interface -> Html
moduleInfo :: Interface -> Html
moduleInfo Interface
iface =
   let
      info :: HaddockModInfo Name
info = Interface -> HaddockModInfo Name
ifaceInfo Interface
iface

      doOneEntry :: (String, HaddockModInfo GHC.Name -> Maybe String) -> Maybe HtmlTable
      doOneEntry :: (String, HaddockModInfo Name -> Maybe String) -> Maybe HtmlTable
doOneEntry (String
fieldName, HaddockModInfo Name -> Maybe String
field) =
        HaddockModInfo Name -> Maybe String
field HaddockModInfo Name
info Maybe String -> (String -> Maybe HtmlTable) -> Maybe HtmlTable
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
a -> HtmlTable -> Maybe HtmlTable
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> Html
th (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
fieldName Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
<-> Html -> Html
td (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
a)

      entries :: [HtmlTable]
      entries :: [HtmlTable]
entries = Maybe HtmlTable -> [HtmlTable]
forall a. Maybe a -> [a]
maybeToList Maybe HtmlTable
copyrightsTable [HtmlTable] -> [HtmlTable] -> [HtmlTable]
forall a. [a] -> [a] -> [a]
++ ((String, HaddockModInfo Name -> Maybe String) -> Maybe HtmlTable)
-> [(String, HaddockModInfo Name -> Maybe String)] -> [HtmlTable]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, HaddockModInfo Name -> Maybe String) -> Maybe HtmlTable
doOneEntry [
          (String
"License",HaddockModInfo Name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_license),
          (String
"Maintainer",HaddockModInfo Name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_maintainer),
          (String
"Stability",HaddockModInfo Name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_stability),
          (String
"Portability",HaddockModInfo Name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_portability),
          (String
"Safe Haskell",HaddockModInfo Name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_safety),
          (String
"Language", HaddockModInfo Name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
lg)
          ] [HtmlTable] -> [HtmlTable] -> [HtmlTable]
forall a. [a] -> [a] -> [a]
++ [HtmlTable]
extsForm
        where
          lg :: HaddockModInfo name -> Maybe String
lg HaddockModInfo name
inf = (Language -> String) -> Maybe Language -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Language -> String
forall a. Show a => a -> String
show (HaddockModInfo name -> Maybe Language
forall name. HaddockModInfo name -> Maybe Language
hmi_language HaddockModInfo name
inf)

          multilineRow :: String -> [String] -> HtmlTable
          multilineRow :: String -> [String] -> HtmlTable
multilineRow String
title [String]
xs = (Html -> Html
th (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
valign String
"top"]) (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
title Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
<-> Html -> Html
td (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< ([String] -> Html
toLines [String]
xs)
            where toLines :: [String] -> Html
toLines = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([String] -> [Html]) -> [String] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse Html
br ([Html] -> [Html]) -> ([String] -> [Html]) -> [String] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Html) -> [String] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map String -> Html
forall a. HTML a => a -> Html
toHtml

          copyrightsTable :: Maybe HtmlTable
          copyrightsTable :: Maybe HtmlTable
copyrightsTable = (String -> HtmlTable) -> Maybe String -> Maybe HtmlTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> HtmlTable
multilineRow String
"Copyright" ([String] -> HtmlTable)
-> (String -> [String]) -> String -> HtmlTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
split) (HaddockModInfo Name -> Maybe String
forall name. HaddockModInfo name -> Maybe String
hmi_copyright HaddockModInfo Name
info)
            where split :: String -> [String]
split = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
trim (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

          extsForm :: [HtmlTable]
extsForm
            | DocOption
OptShowExtensions DocOption -> [DocOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Interface -> [DocOption]
ifaceOptions Interface
iface =
              let fs :: [String]
fs = (Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
dropOpt (String -> String) -> (Extension -> String) -> Extension -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Show a => a -> String
show) (HaddockModInfo Name -> [Extension]
forall name. HaddockModInfo name -> [Extension]
hmi_extensions HaddockModInfo Name
info)
              in case (String -> Html) -> [String] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map String -> Html
stringToHtml [String]
fs of
                [] -> []
                [Html
x] -> Html -> [HtmlTable]
forall (m :: * -> *) a. (Monad m, HTML a) => a -> m HtmlTable
extField Html
x -- don't use a list for a single extension
                [Html]
xs -> Html -> [HtmlTable]
forall (m :: * -> *) a. (Monad m, HTML a) => a -> m HtmlTable
extField (Html -> [HtmlTable]) -> Html -> [HtmlTable]
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
forall a. HTML a => [a] -> Html
unordList [Html]
xs Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"extension-list"]
            | Bool
otherwise = []
            where
              extField :: a -> m HtmlTable
extField a
x = HtmlTable -> m HtmlTable
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlTable -> m HtmlTable) -> HtmlTable -> m HtmlTable
forall a b. (a -> b) -> a -> b
$ Html -> Html
th (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Extensions" Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
<-> Html -> Html
td (Html -> Html) -> a -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< a
x
              dropOpt :: String -> String
dropOpt String
x = if String
"Opt_" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
x else String
x
   in
      case [HtmlTable]
entries of
         [] -> Html
noHtml
         [HtmlTable]
_ -> Html -> Html
table (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"info"] (Html -> Html) -> HtmlTable -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [HtmlTable] -> HtmlTable
forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves [HtmlTable]
entries


--------------------------------------------------------------------------------
-- * Generate the module contents
--------------------------------------------------------------------------------


ppHtmlContents
   :: DynFlags
   -> FilePath
   -> String
   -> Maybe String
   -> Themes
   -> Maybe String
   -> Maybe String
   -> SourceURLs
   -> WikiURLs
   -> [InstalledInterface] -> Bool -> Maybe (MDoc GHC.RdrName)
   -> Bool
   -> Maybe Package  -- ^ Current package
   -> Qualification  -- ^ How to qualify names
   -> IO ()
ppHtmlContents :: DynFlags
-> String
-> String
-> Maybe String
-> Themes
-> Maybe String
-> Maybe String
-> SourceURLs
-> WikiURLs
-> [InstalledInterface]
-> Bool
-> Maybe (MDoc RdrName)
-> Bool
-> Maybe String
-> Qualification
-> IO ()
ppHtmlContents DynFlags
dflags String
odir String
doctitle Maybe String
_maybe_package
  Themes
themes Maybe String
mathjax_url Maybe String
maybe_index_url
  SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url [InstalledInterface]
ifaces Bool
showPkgs Maybe (MDoc RdrName)
prologue Bool
debug Maybe String
pkg Qualification
qual = do
  let tree :: [ModuleTree]
tree = DynFlags -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]
mkModuleTree DynFlags
dflags Bool
showPkgs
         [(InstalledInterface -> Module
instMod InstalledInterface
iface, InstalledInterface -> Maybe (MDoc Name)
toInstalledDescription InstalledInterface
iface)
         | InstalledInterface
iface <- [InstalledInterface]
ifaces
         , Bool -> Bool
not (InstalledInterface -> Bool
instIsSig InstalledInterface
iface)]
      sig_tree :: [ModuleTree]
sig_tree = DynFlags -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]
mkModuleTree DynFlags
dflags Bool
showPkgs
         [(InstalledInterface -> Module
instMod InstalledInterface
iface, InstalledInterface -> Maybe (MDoc Name)
toInstalledDescription InstalledInterface
iface)
         | InstalledInterface
iface <- [InstalledInterface]
ifaces
         , InstalledInterface -> Bool
instIsSig InstalledInterface
iface]
      html :: Html
html =
        String -> Themes -> Maybe String -> Html
headHtml String
doctitle Themes
themes Maybe String
mathjax_url Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
        String
-> Maybe Interface
-> SourceURLs
-> WikiURLs
-> Maybe String
-> Maybe String
-> Html
-> Html
bodyHtml String
doctitle Maybe Interface
forall a. Maybe a
Nothing
          SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url
          Maybe String
forall a. Maybe a
Nothing Maybe String
maybe_index_url (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [
            Maybe String
-> Qualification -> String -> Maybe (MDoc RdrName) -> Html
ppPrologue Maybe String
pkg Qualification
qual String
doctitle Maybe (MDoc RdrName)
prologue,
            Maybe String -> Qualification -> [ModuleTree] -> Html
ppSignatureTree Maybe String
pkg Qualification
qual [ModuleTree]
sig_tree,
            Maybe String -> Qualification -> [ModuleTree] -> Html
ppModuleTree Maybe String
pkg Qualification
qual [ModuleTree]
tree
          ]
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
odir
  String -> String -> IO ()
writeUtf8File ([String] -> String
joinPath [String
odir, String
contentsHtmlFile]) (Bool -> Html -> String
renderToString Bool
debug Html
html)
  where
    -- Extract a module's short description.
    toInstalledDescription :: InstalledInterface -> Maybe (MDoc Name)
    toInstalledDescription :: InstalledInterface -> Maybe (MDoc Name)
toInstalledDescription = (Doc Name -> MDoc Name) -> Maybe (Doc Name) -> Maybe (MDoc Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Name -> MDoc Name
forall a. Doc a -> MDoc a
mkMeta (Maybe (Doc Name) -> Maybe (MDoc Name))
-> (InstalledInterface -> Maybe (Doc Name))
-> InstalledInterface
-> Maybe (MDoc Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HaddockModInfo Name -> Maybe (Doc Name)
forall name. HaddockModInfo name -> Maybe (Doc name)
hmi_description (HaddockModInfo Name -> Maybe (Doc Name))
-> (InstalledInterface -> HaddockModInfo Name)
-> InstalledInterface
-> Maybe (Doc Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledInterface -> HaddockModInfo Name
instInfo


ppPrologue :: Maybe Package -> Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
ppPrologue :: Maybe String
-> Qualification -> String -> Maybe (MDoc RdrName) -> Html
ppPrologue Maybe String
_ Qualification
_ String
_ Maybe (MDoc RdrName)
Nothing = Html
noHtml
ppPrologue Maybe String
pkg Qualification
qual String
title (Just MDoc RdrName
doc) =
  Html -> Html
divDescription (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html -> Html
h1 (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
title Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ (Html -> Html) -> Html -> Html
docElement Html -> Html
thediv (Maybe String -> Qualification -> MDoc RdrName -> Html
rdrDocToHtml Maybe String
pkg Qualification
qual MDoc RdrName
doc))


ppSignatureTree :: Maybe Package -> Qualification -> [ModuleTree] -> Html
ppSignatureTree :: Maybe String -> Qualification -> [ModuleTree] -> Html
ppSignatureTree Maybe String
_ Qualification
_ [] = Html
forall a. Monoid a => a
mempty
ppSignatureTree Maybe String
pkg Qualification
qual [ModuleTree]
ts =
  Html -> Html
divModuleList (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html -> Html
sectionName (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Signatures" Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe String
-> Qualification -> [String] -> String -> [ModuleTree] -> Html
mkNodeList Maybe String
pkg Qualification
qual [] String
"n" [ModuleTree]
ts)


ppModuleTree :: Maybe Package -> Qualification -> [ModuleTree] -> Html
ppModuleTree :: Maybe String -> Qualification -> [ModuleTree] -> Html
ppModuleTree Maybe String
_ Qualification
_ [] = Html
forall a. Monoid a => a
mempty
ppModuleTree Maybe String
pkg Qualification
qual [ModuleTree]
ts =
  Html -> Html
divModuleList (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html -> Html
sectionName (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Modules" Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe String
-> Qualification -> [String] -> String -> [ModuleTree] -> Html
mkNodeList Maybe String
pkg Qualification
qual [] String
"n" [ModuleTree]
ts)


mkNodeList :: Maybe Package -> Qualification -> [String] -> String -> [ModuleTree] -> Html
mkNodeList :: Maybe String
-> Qualification -> [String] -> String -> [ModuleTree] -> Html
mkNodeList Maybe String
pkg Qualification
qual [String]
ss String
p [ModuleTree]
ts = case [ModuleTree]
ts of
  [] -> Html
noHtml
  [ModuleTree]
_ -> [Html] -> Html
forall a. HTML a => [a] -> Html
unordList ((String -> ModuleTree -> Html)
-> [String] -> [ModuleTree] -> [Html]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe String
-> Qualification -> [String] -> String -> ModuleTree -> Html
mkNode Maybe String
pkg Qualification
qual [String]
ss) [String]
ps [ModuleTree]
ts)
  where
    ps :: [String]
ps = [ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i | Int
i <- [(Int
1::Int)..]]


mkNode :: Maybe Package -> Qualification -> [String] -> String -> ModuleTree -> Html
mkNode :: Maybe String
-> Qualification -> [String] -> String -> ModuleTree -> Html
mkNode Maybe String
pkg Qualification
qual [String]
ss String
p (Node String
s Maybe Module
leaf Maybe String
_pkg Maybe String
srcPkg Maybe (MDoc Name)
short [ModuleTree]
ts) =
  Html
htmlModule Html -> Html -> Html
<+> Html
shortDescr Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
htmlPkg Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
subtree
  where
    modAttrs :: [HtmlAttr]
modAttrs = case ([ModuleTree]
ts, Maybe Module
leaf) of
      (ModuleTree
_:[ModuleTree]
_, Maybe Module
Nothing) -> String -> String -> [HtmlAttr]
collapseControl String
p String
"module"
      ([ModuleTree]
_,   Maybe Module
_    ) -> [String -> HtmlAttr
theclass String
"module"]

    cBtn :: Html
cBtn = case ([ModuleTree]
ts, Maybe Module
leaf) of
      (ModuleTree
_:[ModuleTree]
_, Just Module
_) -> Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! String -> String -> [HtmlAttr]
collapseControl String
p String
"" (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
spaceHtml
      ([] , Just Module
_) -> Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"noexpander"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
spaceHtml
      ([ModuleTree]
_,   Maybe Module
_   ) -> Html
noHtml
      -- We only need an explicit collapser button when the module name
      -- is also a leaf, and so is a link to a module page. Indeed, the
      -- spaceHtml is a minor hack and does upset the layout a fraction.

    htmlModule :: Html
htmlModule = Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [HtmlAttr]
modAttrs (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html
cBtn Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
      case Maybe Module
leaf of
        Just Module
m -> Module -> Html
ppModule Module
m
        Maybe Module
Nothing -> String -> Html
forall a. HTML a => a -> Html
toHtml String
s
      )

    shortDescr :: Html
shortDescr = Html -> (MDoc Name -> Html) -> Maybe (MDoc Name) -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
noHtml (Maybe String -> Qualification -> MDoc Name -> Html
origDocToHtml Maybe String
pkg Qualification
qual) Maybe (MDoc Name)
short
    htmlPkg :: Html
htmlPkg = Html -> (String -> Html) -> Maybe String -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
noHtml (Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"package"] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<) Maybe String
srcPkg

    subtree :: Html
subtree =
      if [ModuleTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ModuleTree]
ts then Html
noHtml else
      String -> DetailsState -> Html -> Html
collapseDetails String
p DetailsState
DetailsOpen (
        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
"Submodules" Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
        Maybe String
-> Qualification -> [String] -> String -> [ModuleTree] -> Html
mkNodeList Maybe String
pkg Qualification
qual (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ss) String
p [ModuleTree]
ts
      )



--------------------------------------------------------------------------------
-- * Generate the index
--------------------------------------------------------------------------------

ppJsonIndex :: FilePath
           -> SourceURLs                   -- ^ The source URL (--source)
           -> WikiURLs                     -- ^ The wiki URL (--wiki)
           -> Bool
           -> Maybe Package
           -> QualOption
           -> [Interface]
           -> IO ()
ppJsonIndex :: String
-> SourceURLs
-> WikiURLs
-> Bool
-> Maybe String
-> QualOption
-> [Interface]
-> IO ()
ppJsonIndex String
odir SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url Bool
unicode Maybe String
pkg QualOption
qual_opt [Interface]
ifaces = do
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
odir
  String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile ([String] -> String
joinPath [String
odir, String
indexJsonFile]) IOMode
IO.WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
    Handle -> Builder -> IO ()
Builder.hPutBuilder Handle
h (Value -> Builder
forall a. ToJSON a => a -> Builder
encodeToBuilder Value
modules)
  where
    modules :: Value
    modules :: Value
modules = [Value] -> Value
Array ((Interface -> [Value]) -> [Interface] -> [Value]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Interface -> [Value]
goInterface [Interface]
ifaces)

    goInterface :: Interface -> [Value]
    goInterface :: Interface -> [Value]
goInterface Interface
iface =
        (ExportItem DocNameI -> [Value])
-> [ExportItem DocNameI] -> [Value]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Module -> Qualification -> ExportItem DocNameI -> [Value]
goExport Module
mdl Qualification
qual) (Interface -> [ExportItem DocNameI]
ifaceRnExportItems Interface
iface)
      where
        aliases :: AliasMap
aliases = Interface -> AliasMap
ifaceModuleAliases Interface
iface
        qual :: Qualification
qual    = QualOption -> AliasMap -> Module -> Qualification
makeModuleQual QualOption
qual_opt AliasMap
aliases Module
mdl
        mdl :: Module
mdl     = Interface -> Module
ifaceMod Interface
iface

    goExport :: Module -> Qualification -> ExportItem DocNameI -> [Value]
    goExport :: Module -> Qualification -> ExportItem DocNameI -> [Value]
goExport Module
mdl Qualification
qual ExportItem DocNameI
item
      | Just Html
item_html <- Bool
-> LinksInfo
-> Bool
-> Maybe String
-> Qualification
-> ExportItem DocNameI
-> Maybe Html
processExport Bool
True LinksInfo
links_info Bool
unicode Maybe String
pkg Qualification
qual ExportItem DocNameI
item
      = [ Object -> Value
Object
            [ String
"display_html" String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
String (Html -> String
forall html. HTML html => html -> String
showHtmlFragment Html
item_html)
            , String
"name"         String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
String ([String] -> String
unwords ((DocName -> String) -> [DocName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> String
forall a. NamedThing a => a -> String
getOccString [DocName]
names))
            , String
"module"       String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
String (Module -> String
moduleString Module
mdl)
            , String
"link"         String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
String (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" ([String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ((DocName -> String) -> [DocName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> DocName -> String
forall name. NamedThing name => Module -> name -> String
nameLink Module
mdl) [DocName]
names)))
            ]
        ]
      | Bool
otherwise = []
      where
        names :: [DocName]
names = ExportItem DocNameI -> [IdP DocNameI]
exportName ExportItem DocNameI
item [DocName] -> [DocName] -> [DocName]
forall a. [a] -> [a] -> [a]
++ ExportItem DocNameI -> [IdP DocNameI]
exportSubs ExportItem DocNameI
item

    exportSubs :: ExportItem DocNameI -> [IdP DocNameI]
    exportSubs :: ExportItem DocNameI -> [IdP DocNameI]
exportSubs ExportDecl { [(IdP DocNameI, DocForDecl (IdP DocNameI))]
expItemSubDocs :: forall name. ExportItem name -> [(IdP name, DocForDecl (IdP name))]
expItemSubDocs :: [(IdP DocNameI, DocForDecl (IdP DocNameI))]
expItemSubDocs } = ((DocName, DocForDecl DocName) -> DocName)
-> [(DocName, DocForDecl DocName)] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map (DocName, DocForDecl DocName) -> DocName
forall a b. (a, b) -> a
fst [(IdP DocNameI, DocForDecl (IdP DocNameI))]
[(DocName, DocForDecl DocName)]
expItemSubDocs
    exportSubs ExportItem DocNameI
_ = []

    exportName :: ExportItem DocNameI -> [IdP DocNameI]
    exportName :: ExportItem DocNameI -> [IdP DocNameI]
exportName ExportDecl { LHsDecl DocNameI
expItemDecl :: forall name. ExportItem name -> LHsDecl name
expItemDecl :: LHsDecl DocNameI
expItemDecl } = HsDecl DocNameI -> [IdP DocNameI]
getMainDeclBinderI (LHsDecl DocNameI -> SrcSpanLess (LHsDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDecl DocNameI
expItemDecl)
    exportName ExportNoDecl { IdP DocNameI
expItemName :: forall name. ExportItem name -> IdP name
expItemName :: IdP DocNameI
expItemName } = [IdP DocNameI
expItemName]
    exportName ExportItem DocNameI
_ = []

    nameLink :: NamedThing name => Module -> name -> String
    nameLink :: Module -> name -> String
nameLink Module
mdl = ModuleName -> OccName -> String
moduleNameUrl' (Module -> ModuleName
moduleName Module
mdl) (OccName -> String) -> (name -> OccName) -> name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName (Name -> OccName) -> (name -> Name) -> name -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. name -> Name
forall a. NamedThing a => a -> Name
getName

    links_info :: LinksInfo
links_info = (SourceURLs
maybe_source_url, WikiURLs
maybe_wiki_url)

ppHtmlIndex :: FilePath
            -> String
            -> Maybe String
            -> Themes
            -> Maybe String
            -> Maybe String
            -> SourceURLs
            -> WikiURLs
            -> [InstalledInterface]
            -> Bool
            -> IO ()
ppHtmlIndex :: String
-> String
-> Maybe String
-> Themes
-> Maybe String
-> Maybe String
-> SourceURLs
-> WikiURLs
-> [InstalledInterface]
-> Bool
-> IO ()
ppHtmlIndex String
odir String
doctitle Maybe String
_maybe_package Themes
themes
  Maybe String
maybe_mathjax_url Maybe String
maybe_contents_url SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url [InstalledInterface]
ifaces Bool
debug = do
  let html :: Html
html = Bool -> Maybe Char -> [(String, Map Name [(Module, Bool)])] -> Html
indexPage Bool
split_indices Maybe Char
forall a. Maybe a
Nothing
              (if Bool
split_indices then [] else [(String, Map Name [(Module, Bool)])]
index)

  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
odir

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
split_indices (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (Char -> IO ()) -> String -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([(String, Map Name [(Module, Bool)])] -> Char -> IO ()
do_sub_index [(String, Map Name [(Module, Bool)])]
index) String
initialChars
    -- Let's add a single large index as well for those who don't know exactly what they're looking for:
    let mergedhtml :: Html
mergedhtml = Bool -> Maybe Char -> [(String, Map Name [(Module, Bool)])] -> Html
indexPage Bool
False Maybe Char
forall a. Maybe a
Nothing [(String, Map Name [(Module, Bool)])]
index
    String -> String -> IO ()
writeUtf8File ([String] -> String
joinPath [String
odir, String -> String
subIndexHtmlFile String
merged_name]) (Bool -> Html -> String
renderToString Bool
debug Html
mergedhtml)

  String -> String -> IO ()
writeUtf8File ([String] -> String
joinPath [String
odir, String
indexHtmlFile]) (Bool -> Html -> String
renderToString Bool
debug Html
html)

  where
    indexPage :: Bool -> Maybe Char -> [(String, Map Name [(Module, Bool)])] -> Html
indexPage Bool
showLetters Maybe Char
ch [(String, Map Name [(Module, Bool)])]
items =
      String -> Themes -> Maybe String -> Html
headHtml (String
doctitle String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe Char -> String
indexName Maybe Char
ch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") Themes
themes Maybe String
maybe_mathjax_url Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
      String
-> Maybe Interface
-> SourceURLs
-> WikiURLs
-> Maybe String
-> Maybe String
-> Html
-> Html
bodyHtml String
doctitle Maybe Interface
forall a. Maybe a
Nothing
        SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url
        Maybe String
maybe_contents_url Maybe String
forall a. Maybe a
Nothing (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [
          if Bool
showLetters then Html
indexInitialLetterLinks else Html
noHtml,
          if [(String, Map Name [(Module, Bool)])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Map Name [(Module, Bool)])]
items then Html
noHtml else
            Html -> Html
divIndex (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Html -> Html
sectionName (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Maybe Char -> String
indexName Maybe Char
ch, [(String, Map Name [(Module, Bool)])] -> Html
buildIndex [(String, Map Name [(Module, Bool)])]
items]
          ]

    indexName :: Maybe Char -> String
indexName Maybe Char
ch = String
"Index" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (Char -> String) -> Maybe Char -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Char
c -> String
" - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]) Maybe Char
ch
    merged_name :: String
merged_name = String
"All"

    buildIndex :: [(String, Map Name [(Module, Bool)])] -> Html
buildIndex [(String, Map Name [(Module, Bool)])]
items = 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 (((String, Map Name [(Module, Bool)]) -> HtmlTable)
-> [(String, Map Name [(Module, Bool)])] -> [HtmlTable]
forall a b. (a -> b) -> [a] -> [b]
map (String, Map Name [(Module, Bool)]) -> HtmlTable
indexElt [(String, Map Name [(Module, Bool)])]
items)

    -- an arbitrary heuristic:
    -- too large, and a single-page will be slow to load
    -- too small, and we'll have lots of letter-indexes with only one
    --   or two members in them, which seems inefficient or
    --   unnecessarily hard to use.
    split_indices :: Bool
split_indices = [(String, Map Name [(Module, Bool)])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Map Name [(Module, Bool)])]
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
150

    indexInitialLetterLinks :: Html
indexInitialLetterLinks =
      Html -> Html
divAlphabet (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<
         [Html] -> Html
forall a. HTML a => [a] -> Html
unordList ((String -> Html) -> [String] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (\String
str -> Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href (String -> String
subIndexHtmlFile String
str)] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
str) ([String] -> [Html]) -> [String] -> [Html]
forall a b. (a -> b) -> a -> b
$
                        [ [Char
c] | Char
c <- String
initialChars
                              , ((String, Map Name [(Module, Bool)]) -> Bool)
-> [(String, Map Name [(Module, Bool)])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) (Char -> Bool)
-> ((String, Map Name [(Module, Bool)]) -> Char)
-> (String, Map Name [(Module, Bool)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper (Char -> Char)
-> ((String, Map Name [(Module, Bool)]) -> Char)
-> (String, Map Name [(Module, Bool)])
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. [a] -> a
head (String -> Char)
-> ((String, Map Name [(Module, Bool)]) -> String)
-> (String, Map Name [(Module, Bool)])
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Map Name [(Module, Bool)]) -> String
forall a b. (a, b) -> a
fst) [(String, Map Name [(Module, Bool)])]
index ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                        [String
merged_name])

    -- todo: what about names/operators that start with Unicode
    -- characters?
    -- Exports beginning with '_' can be listed near the end,
    -- presumably they're not as important... but would be listed
    -- with non-split index!
    initialChars :: String
initialChars = [ Char
'A'..Char
'Z' ] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":!#$%&*+./<=>?@\\^|-~" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"

    do_sub_index :: [(String, Map Name [(Module, Bool)])] -> Char -> IO ()
do_sub_index [(String, Map Name [(Module, Bool)])]
this_ix Char
c
      = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(String, Map Name [(Module, Bool)])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Map Name [(Module, Bool)])]
index_part) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          String -> String -> IO ()
writeUtf8File ([String] -> String
joinPath [String
odir, String -> String
subIndexHtmlFile [Char
c]]) (Bool -> Html -> String
renderToString Bool
debug Html
html)
      where
        html :: Html
html = Bool -> Maybe Char -> [(String, Map Name [(Module, Bool)])] -> Html
indexPage Bool
True (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c) [(String, Map Name [(Module, Bool)])]
index_part
        index_part :: [(String, Map Name [(Module, Bool)])]
index_part = [(String
n,Map Name [(Module, Bool)]
stuff) | (String
n,Map Name [(Module, Bool)]
stuff) <- [(String, Map Name [(Module, Bool)])]
this_ix, Char -> Char
toUpper (String -> Char
forall a. [a] -> a
head String
n) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c]


    index :: [(String, Map GHC.Name [(Module,Bool)])]
    index :: [(String, Map Name [(Module, Bool)])]
index = ((String, Map Name [(Module, Bool)])
 -> (String, Map Name [(Module, Bool)]) -> Ordering)
-> [(String, Map Name [(Module, Bool)])]
-> [(String, Map Name [(Module, Bool)])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (String, Map Name [(Module, Bool)])
-> (String, Map Name [(Module, Bool)]) -> Ordering
forall b b. (String, b) -> (String, b) -> Ordering
cmp (Map String (Map Name [(Module, Bool)])
-> [(String, Map Name [(Module, Bool)])]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map String (Map Name [(Module, Bool)])
full_index)
      where cmp :: (String, b) -> (String, b) -> Ordering
cmp (String
n1,b
_) (String
n2,b
_) = (String -> String) -> String -> String -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper) String
n1 String
n2

    -- for each name (a plain string), we have a number of original HsNames that
    -- it can refer to, and for each of those we have a list of modules
    -- that export that entity.  Each of the modules exports the entity
    -- in a visible or invisible way (hence the Bool).
    full_index :: Map String (Map GHC.Name [(Module,Bool)])
    full_index :: Map String (Map Name [(Module, Bool)])
full_index = (Map Name [(Module, Bool)]
 -> Map Name [(Module, Bool)] -> Map Name [(Module, Bool)])
-> [(String, Map Name [(Module, Bool)])]
-> Map String (Map Name [(Module, Bool)])
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((Map Name [(Module, Bool)]
 -> Map Name [(Module, Bool)] -> Map Name [(Module, Bool)])
-> Map Name [(Module, Bool)]
-> Map Name [(Module, Bool)]
-> Map Name [(Module, Bool)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([(Module, Bool)] -> [(Module, Bool)] -> [(Module, Bool)])
-> Map Name [(Module, Bool)]
-> Map Name [(Module, Bool)]
-> Map Name [(Module, Bool)]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [(Module, Bool)] -> [(Module, Bool)] -> [(Module, Bool)]
forall a. [a] -> [a] -> [a]
(++)))
                 ((InstalledInterface -> [(String, Map Name [(Module, Bool)])])
-> [InstalledInterface] -> [(String, Map Name [(Module, Bool)])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstalledInterface -> [(String, Map Name [(Module, Bool)])]
getIfaceIndex [InstalledInterface]
ifaces)

    getIfaceIndex :: InstalledInterface -> [(String, Map Name [(Module, Bool)])]
getIfaceIndex InstalledInterface
iface =
      [ (Name -> String
forall a. NamedThing a => a -> String
getOccString Name
name
         , [(Name, [(Module, Bool)])] -> Map Name [(Module, Bool)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name
name, [(Module
mdl, Name
name Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
visible)])])
         | Name
name <- InstalledInterface -> [Name]
instExports InstalledInterface
iface ]
      where
        mdl :: Module
mdl = InstalledInterface -> Module
instMod InstalledInterface
iface
        visible :: Set Name
visible = [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList (InstalledInterface -> [Name]
instVisibleExports InstalledInterface
iface)

    indexElt :: (String, Map GHC.Name [(Module,Bool)]) -> HtmlTable
    indexElt :: (String, Map Name [(Module, Bool)]) -> HtmlTable
indexElt (String
str, Map Name [(Module, Bool)]
entities) =
       case Map Name [(Module, Bool)] -> [(Name, [(Module, Bool)])]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Name [(Module, Bool)]
entities of
          [(Name
nm,[(Module, Bool)]
entries)] ->
              Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
theclass String
"src" ] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String -> Html
forall a. HTML a => a -> Html
toHtml String
str Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
<->
                          Name -> [(Module, Bool)] -> Html
indexLinks Name
nm [(Module, Bool)]
entries
          [(Name, [(Module, Bool)])]
many_entities ->
              Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
theclass String
"src" ] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String -> Html
forall a. HTML a => a -> Html
toHtml String
str Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
<-> Html -> Html
td (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
spaceHtml HtmlTable -> HtmlTable -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
</>
                  [HtmlTable] -> HtmlTable
forall ht. HTMLTABLE ht => [ht] -> HtmlTable
aboves ((Integer -> (Name, [(Module, Bool)]) -> HtmlTable)
-> [Integer] -> [(Name, [(Module, Bool)])] -> [HtmlTable]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Integer, (Name, [(Module, Bool)])) -> HtmlTable)
-> Integer -> (Name, [(Module, Bool)]) -> HtmlTable
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Integer, (Name, [(Module, Bool)])) -> HtmlTable
doAnnotatedEntity) [Integer
1..] [(Name, [(Module, Bool)])]
many_entities)

    doAnnotatedEntity :: (Integer, (Name, [(Module, Bool)])) -> HtmlTable
    doAnnotatedEntity :: (Integer, (Name, [(Module, Bool)])) -> HtmlTable
doAnnotatedEntity (Integer
j,(Name
nm,[(Module, Bool)]
entries))
          = Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
theclass String
"alt" ] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<
                  String -> Html
forall a. HTML a => a -> Html
toHtml (Integer -> String
forall a. Show a => a -> String
show Integer
j) Html -> Html -> Html
<+> Html -> Html
parens (OccName -> Html
ppAnnot (Name -> OccName
nameOccName Name
nm)) Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
<->
                   Name -> [(Module, Bool)] -> Html
indexLinks Name
nm [(Module, Bool)]
entries

    ppAnnot :: OccName -> Html
ppAnnot OccName
n | Bool -> Bool
not (OccName -> Bool
isValOcc OccName
n) = String -> Html
forall a. HTML a => a -> Html
toHtml String
"Type/Class"
              | OccName -> Bool
isDataOcc OccName
n      = String -> Html
forall a. HTML a => a -> Html
toHtml String
"Data Constructor"
              | Bool
otherwise        = String -> Html
forall a. HTML a => a -> Html
toHtml String
"Function"

    indexLinks :: Name -> [(Module, Bool)] -> Html
indexLinks Name
nm [(Module, Bool)]
entries =
       Html -> Html
td (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> HtmlAttr
theclass String
"module" ] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<
          [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma
          [ if Bool
visible then
               Module -> Maybe Name -> Html -> Html
linkId Module
mdl (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
nm) (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String -> Html
forall a. HTML a => a -> Html
toHtml (Module -> String
moduleString Module
mdl)
            else
               String -> Html
forall a. HTML a => a -> Html
toHtml (Module -> String
moduleString Module
mdl)
          | (Module
mdl, Bool
visible) <- [(Module, Bool)]
entries ])


--------------------------------------------------------------------------------
-- * Generate the HTML page for a module
--------------------------------------------------------------------------------


ppHtmlModule
        :: FilePath -> String -> Themes
        -> Maybe String -> SourceURLs -> WikiURLs
        -> Maybe String -> Maybe String -> Bool -> Maybe Package -> QualOption
        -> Bool -> Interface -> IO ()
ppHtmlModule :: String
-> String
-> Themes
-> Maybe String
-> SourceURLs
-> WikiURLs
-> Maybe String
-> Maybe String
-> Bool
-> Maybe String
-> QualOption
-> Bool
-> Interface
-> IO ()
ppHtmlModule String
odir String
doctitle Themes
themes
  Maybe String
maybe_mathjax_url SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url
  Maybe String
maybe_contents_url Maybe String
maybe_index_url Bool
unicode Maybe String
pkg QualOption
qual Bool
debug Interface
iface = do
  let
      mdl :: Module
mdl = Interface -> Module
ifaceMod Interface
iface
      aliases :: AliasMap
aliases = Interface -> AliasMap
ifaceModuleAliases Interface
iface
      mdl_str :: String
mdl_str = Module -> String
moduleString Module
mdl
      mdl_str_annot :: String
mdl_str_annot = String
mdl_str String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Interface -> Bool
ifaceIsSig Interface
iface
                                    then String
" (signature)"
                                    else String
""
      mdl_str_linked :: Html
mdl_str_linked
        | Interface -> Bool
ifaceIsSig Interface
iface
        = String
mdl_str String -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ String
" (signature" String -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
                       Html -> Html
sup (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (String
"[" String -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
signatureDocURL] (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"?" Html -> String -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ String
"]" ) Html -> String -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
                       String
")"
        | Bool
otherwise
        = String -> Html
forall a. HTML a => a -> Html
toHtml String
mdl_str
      real_qual :: Qualification
real_qual = QualOption -> AliasMap -> Module -> Qualification
makeModuleQual QualOption
qual AliasMap
aliases Module
mdl
      html :: Html
html =
        String -> Themes -> Maybe String -> Html
headHtml String
mdl_str_annot Themes
themes Maybe String
maybe_mathjax_url Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
        String
-> Maybe Interface
-> SourceURLs
-> WikiURLs
-> Maybe String
-> Maybe String
-> Html
-> Html
bodyHtml String
doctitle (Interface -> Maybe Interface
forall a. a -> Maybe a
Just Interface
iface)
          SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url
          Maybe String
maybe_contents_url Maybe String
maybe_index_url (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [
            Html -> Html
divModuleHeader (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Interface -> Html
moduleInfo Interface
iface Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ (Html -> Html
sectionName (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
mdl_str_linked)),
            SourceURLs
-> WikiURLs
-> Interface
-> Bool
-> Maybe String
-> Qualification
-> Html
ifaceToHtml SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url Interface
iface Bool
unicode Maybe String
pkg Qualification
real_qual
          ]

  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
odir
  String -> String -> IO ()
writeUtf8File ([String] -> String
joinPath [String
odir, Module -> String
moduleHtmlFile Module
mdl]) (Bool -> Html -> String
renderToString Bool
debug Html
html)

signatureDocURL :: String
signatureDocURL :: String
signatureDocURL = String
"https://wiki.haskell.org/Module_signature"


ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Maybe Package -> Qualification -> Html
ifaceToHtml :: SourceURLs
-> WikiURLs
-> Interface
-> Bool
-> Maybe String
-> Qualification
-> Html
ifaceToHtml SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url Interface
iface Bool
unicode Maybe String
pkg Qualification
qual
  = Maybe String
-> Qualification -> [ExportItem DocNameI] -> Bool -> Html
ppModuleContents Maybe String
pkg Qualification
qual [ExportItem DocNameI]
exports (Bool -> Bool
not (Bool -> Bool)
-> ([(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
      Maybe Module)]
    -> Bool)
-> [(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
     Maybe Module)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
   Maybe Module)]
 -> Bool)
-> [(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
     Maybe Module)]
-> Bool
forall a b. (a -> b) -> a -> b
$ Interface -> [DocInstance DocNameI]
ifaceRnOrphanInstances Interface
iface) Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
    Html
description Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
    Html
synopsis Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
    Html -> Html
divInterface (Html
maybe_doc_hdr Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
bdy Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
orphans)
  where
    exports :: [ExportItem DocNameI]
exports = [ExportItem DocNameI] -> [ExportItem DocNameI]
numberSectionHeadings (Interface -> [ExportItem DocNameI]
ifaceRnExportItems Interface
iface)

    -- todo: if something has only sub-docs, or fn-args-docs, should
    -- it be measured here and thus prevent omitting the synopsis?
    has_doc :: ExportItem name -> Bool
has_doc ExportDecl { expItemMbDoc :: forall name. ExportItem name -> DocForDecl (IdP name)
expItemMbDoc = (Documentation Maybe (MDoc (IdP name))
mDoc Maybe (Doc (IdP name))
mWarning, FnArgsDoc (IdP name)
_) } = Maybe (MDoc (IdP name)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (MDoc (IdP name))
mDoc Bool -> Bool -> Bool
|| Maybe (Doc (IdP name)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Doc (IdP name))
mWarning
    has_doc (ExportNoDecl IdP name
_ [IdP name]
_) = Bool
False
    has_doc (ExportModule Module
_) = Bool
False
    has_doc ExportItem name
_ = Bool
True

    no_doc_at_all :: Bool
no_doc_at_all = Bool -> Bool
not ((ExportItem DocNameI -> Bool) -> [ExportItem DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ExportItem DocNameI -> Bool
forall name. ExportItem name -> Bool
has_doc [ExportItem DocNameI]
exports)

    description :: Html
description | Html -> Bool
isNoHtml Html
doc = Html
doc
                | Bool
otherwise    = Html -> Html
divDescription (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
sectionName (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Description" Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
doc
                where doc :: Html
doc = Maybe Name
-> Maybe String -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
forall a. Maybe a
Nothing Maybe String
pkg Qualification
qual (Interface -> Documentation DocName
ifaceRnDoc Interface
iface)

        -- omit the synopsis if there are no documentation annotations at all
    synopsis :: Html
synopsis
      | Bool
no_doc_at_all = Html
noHtml
      | Bool
otherwise
      = Html -> Html
divSynopsis (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
            String -> DetailsState -> Html -> Html
collapseDetails String
"syn" DetailsState
DetailsClosed (
              Html -> Html
thesummary (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Synopsis" Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
              [Html] -> Html
shortDeclList (
                  (ExportItem DocNameI -> Maybe Html)
-> [ExportItem DocNameI] -> [Html]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bool
-> LinksInfo
-> Bool
-> Maybe String
-> Qualification
-> ExportItem DocNameI
-> Maybe Html
processExport Bool
True LinksInfo
linksInfo Bool
unicode Maybe String
pkg Qualification
qual) [ExportItem DocNameI]
exports
              ) Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! String -> String -> [HtmlAttr]
collapseToggle String
"syn" String
""
            )

        -- if the documentation doesn't begin with a section header, then
        -- add one ("Documentation").
    maybe_doc_hdr :: Html
maybe_doc_hdr
      = case [ExportItem DocNameI]
exports of
          [] -> Html
noHtml
          ExportGroup {} : [ExportItem DocNameI]
_ -> Html
noHtml
          [ExportItem DocNameI]
_ -> Html -> Html
h1 (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Documentation"

    bdy :: Html
bdy =
      (Html -> Html -> Html) -> Html -> [Html] -> Html
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
(+++) Html
noHtml ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$
        (ExportItem DocNameI -> Maybe Html)
-> [ExportItem DocNameI] -> [Html]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bool
-> LinksInfo
-> Bool
-> Maybe String
-> Qualification
-> ExportItem DocNameI
-> Maybe Html
processExport Bool
False LinksInfo
linksInfo Bool
unicode Maybe String
pkg Qualification
qual) [ExportItem DocNameI]
exports

    orphans :: Html
orphans =
      LinksInfo
-> [DocInstance DocNameI]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppOrphanInstances LinksInfo
linksInfo (Interface -> [DocInstance DocNameI]
ifaceRnOrphanInstances Interface
iface) Bool
False Bool
unicode Maybe String
pkg Qualification
qual

    linksInfo :: LinksInfo
linksInfo = (SourceURLs
maybe_source_url, WikiURLs
maybe_wiki_url)


ppModuleContents :: Maybe Package -- ^ This package
                 -> Qualification
                 -> [ExportItem DocNameI]
                 -> Bool          -- ^ Orphans sections
                 -> Html
ppModuleContents :: Maybe String
-> Qualification -> [ExportItem DocNameI] -> Bool -> Html
ppModuleContents Maybe String
pkg Qualification
qual [ExportItem DocNameI]
exports Bool
orphan
  | [Html] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Html]
sections Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
orphan  = Html
noHtml
  | Bool
otherwise                    = Html
contentsDiv
 where
  contentsDiv :: Html
contentsDiv = Html -> Html
divTableOfContents (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (Html -> Html
divContentsList (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (
    (Html -> Html
sectionName (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Contents") Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ String -> String -> HtmlAttr
strAttr String
"onclick" String
"window.scrollTo(0,0)" ] Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++
    [Html] -> Html
forall a. HTML a => [a] -> Html
unordList ([Html]
sections [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html]
orphanSection)))

  ([Html]
sections, [ExportItem DocNameI]
_leftovers{-should be []-}) = Int -> [ExportItem DocNameI] -> ([Html], [ExportItem DocNameI])
process Int
0 [ExportItem DocNameI]
exports
  orphanSection :: [Html]
orphanSection
    | Bool
orphan =  [ String -> Html -> Html
linkedAnchor String
"section.orphans" (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
"Orphan instances" ]
    | Bool
otherwise = []

  process :: Int -> [ExportItem DocNameI] -> ([Html],[ExportItem DocNameI])
  process :: Int -> [ExportItem DocNameI] -> ([Html], [ExportItem DocNameI])
process Int
_ [] = ([], [])
  process Int
n items :: [ExportItem DocNameI]
items@(ExportGroup Int
lev String
id0 Doc (IdP DocNameI)
doc : [ExportItem DocNameI]
rest)
    | Int
lev Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n  = ( [], [ExportItem DocNameI]
items )
    | Bool
otherwise = ( Html
htmlHtml -> [Html] -> [Html]
forall a. a -> [a] -> [a]
:[Html]
secs, [ExportItem DocNameI]
rest2 )
    where
      html :: Html
html = String -> Html -> Html
linkedAnchor (String -> String
groupId String
id0)
             (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Maybe String
-> Maybe String -> Qualification -> MDoc DocName -> Html
docToHtmlNoAnchors (String -> Maybe String
forall a. a -> Maybe a
Just String
id0) Maybe String
pkg Qualification
qual (Doc DocName -> MDoc DocName
forall a. Doc a -> MDoc a
mkMeta Doc (IdP DocNameI)
Doc DocName
doc) Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Html] -> Html
forall a. HTML a => [a] -> Html
mk_subsections [Html]
ssecs
      ([Html]
ssecs, [ExportItem DocNameI]
rest1) = Int -> [ExportItem DocNameI] -> ([Html], [ExportItem DocNameI])
process Int
lev [ExportItem DocNameI]
rest
      ([Html]
secs,  [ExportItem DocNameI]
rest2) = Int -> [ExportItem DocNameI] -> ([Html], [ExportItem DocNameI])
process Int
n   [ExportItem DocNameI]
rest1
  process Int
n (ExportItem DocNameI
_ : [ExportItem DocNameI]
rest) = Int -> [ExportItem DocNameI] -> ([Html], [ExportItem DocNameI])
process Int
n [ExportItem DocNameI]
rest

  mk_subsections :: [a] -> Html
mk_subsections [] = Html
noHtml
  mk_subsections [a]
ss = [a] -> Html
forall a. HTML a => [a] -> Html
unordList [a]
ss

-- we need to assign a unique id to each section heading so we can hyperlink
-- them from the contents:
numberSectionHeadings :: [ExportItem DocNameI] -> [ExportItem DocNameI]
numberSectionHeadings :: [ExportItem DocNameI] -> [ExportItem DocNameI]
numberSectionHeadings = Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]
go Int
1
  where go :: Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]
        go :: Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]
go Int
_ [] = []
        go Int
n (ExportGroup Int
lev String
_ Doc (IdP DocNameI)
doc : [ExportItem DocNameI]
es)
          = case Doc DocName -> [String]
collectAnchors Doc (IdP DocNameI)
Doc DocName
doc of
              [] -> Int -> String -> Doc (IdP DocNameI) -> ExportItem DocNameI
forall name. Int -> String -> Doc (IdP name) -> ExportItem name
ExportGroup Int
lev (Int -> String
forall a. Show a => a -> String
show Int
n) Doc (IdP DocNameI)
doc ExportItem DocNameI
-> [ExportItem DocNameI] -> [ExportItem DocNameI]
forall a. a -> [a] -> [a]
: Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [ExportItem DocNameI]
es
              (String
a:[String]
_) -> Int -> String -> Doc (IdP DocNameI) -> ExportItem DocNameI
forall name. Int -> String -> Doc (IdP name) -> ExportItem name
ExportGroup Int
lev String
a Doc (IdP DocNameI)
doc ExportItem DocNameI
-> [ExportItem DocNameI] -> [ExportItem DocNameI]
forall a. a -> [a] -> [a]
: Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [ExportItem DocNameI]
es
        go Int
n (ExportItem DocNameI
other:[ExportItem DocNameI]
es)
          = ExportItem DocNameI
other ExportItem DocNameI
-> [ExportItem DocNameI] -> [ExportItem DocNameI]
forall a. a -> [a] -> [a]
: Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]
go Int
n [ExportItem DocNameI]
es

        collectAnchors :: DocH (Wrap (ModuleName, OccName)) (Wrap DocName) -> [String]
        collectAnchors :: Doc DocName -> [String]
collectAnchors (DocAppend Doc DocName
a Doc DocName
b) = Doc DocName -> [String]
collectAnchors Doc DocName
a [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Doc DocName -> [String]
collectAnchors Doc DocName
b
        collectAnchors (DocAName String
a) = [String
a]
        collectAnchors Doc DocName
_ = []

processExport :: Bool -> LinksInfo -> Bool -> Maybe Package -> Qualification
              -> ExportItem DocNameI -> Maybe Html
processExport :: Bool
-> LinksInfo
-> Bool
-> Maybe String
-> Qualification
-> ExportItem DocNameI
-> Maybe Html
processExport Bool
_ LinksInfo
_ Bool
_ Maybe String
_ Qualification
_ ExportDecl { expItemDecl :: forall name. ExportItem name -> LHsDecl name
expItemDecl = L SrcSpan
_ (InstD {}) } = Maybe Html
forall a. Maybe a
Nothing -- Hide empty instances
processExport Bool
summary LinksInfo
_ Bool
_ Maybe String
pkg Qualification
qual (ExportGroup Int
lev String
id0 Doc (IdP DocNameI)
doc)
  = Bool -> Html -> Maybe Html
forall a. Bool -> a -> Maybe a
nothingIf Bool
summary (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Int -> String -> Html -> Html
groupHeading Int
lev String
id0 (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Maybe String
-> Maybe String -> Qualification -> MDoc DocName -> Html
docToHtmlNoAnchors (String -> Maybe String
forall a. a -> Maybe a
Just String
id0) Maybe String
pkg Qualification
qual (Doc DocName -> MDoc DocName
forall a. Doc a -> MDoc a
mkMeta Doc (IdP DocNameI)
Doc DocName
doc)
processExport Bool
summary LinksInfo
links Bool
unicode Maybe String
pkg Qualification
qual (ExportDecl LHsDecl DocNameI
decl [(HsDecl DocNameI, DocForDecl (IdP DocNameI))]
pats DocForDecl (IdP DocNameI)
doc [(IdP DocNameI, DocForDecl (IdP DocNameI))]
subdocs [DocInstance DocNameI]
insts [(IdP DocNameI, Fixity)]
fixities Bool
splice)
  = Bool -> Html -> Maybe Html
processDecl Bool
summary (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Bool
-> LinksInfo
-> LHsDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> DocForDecl DocName
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> [(DocName, DocForDecl DocName)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppDecl Bool
summary LinksInfo
links LHsDecl DocNameI
decl [(HsDecl DocNameI, DocForDecl (IdP DocNameI))]
[(HsDecl DocNameI, DocForDecl DocName)]
pats DocForDecl (IdP DocNameI)
DocForDecl DocName
doc [DocInstance DocNameI]
insts [(IdP DocNameI, Fixity)]
[(DocName, Fixity)]
fixities [(IdP DocNameI, DocForDecl (IdP DocNameI))]
[(DocName, DocForDecl DocName)]
subdocs Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
processExport Bool
summary LinksInfo
_ Bool
_ Maybe String
_ Qualification
qual (ExportNoDecl IdP DocNameI
y [])
  = Bool -> Html -> Maybe Html
processDeclOneLiner Bool
summary (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Prefix Bool
True IdP DocNameI
DocName
y
processExport Bool
summary LinksInfo
_ Bool
_ Maybe String
_ Qualification
qual (ExportNoDecl IdP DocNameI
y [IdP DocNameI]
subs)
  = Bool -> Html -> Maybe Html
processDeclOneLiner Bool
summary (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$
      Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Prefix Bool
True IdP DocNameI
DocName
y
      Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Html] -> Html
parenList ((DocName -> Html) -> [DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Prefix Bool
True) [IdP DocNameI]
[DocName]
subs)
processExport Bool
summary LinksInfo
_ Bool
_ Maybe String
pkg Qualification
qual (ExportDoc MDoc (IdP DocNameI)
doc)
  = Bool -> Html -> Maybe Html
forall a. Bool -> a -> Maybe a
nothingIf Bool
summary (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Maybe String -> Qualification -> MDoc DocName -> Html
docSection_ Maybe Name
forall a. Maybe a
Nothing Maybe String
pkg Qualification
qual MDoc (IdP DocNameI)
MDoc DocName
doc
processExport Bool
summary LinksInfo
_ Bool
_ Maybe String
_ Qualification
_ (ExportModule Module
mdl)
  = Bool -> Html -> Maybe Html
processDeclOneLiner Bool
summary (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. HTML a => a -> Html
toHtml String
"module" Html -> Html -> Html
<+> Module -> Html
ppModule Module
mdl


nothingIf :: Bool -> a -> Maybe a
nothingIf :: Bool -> a -> Maybe a
nothingIf Bool
True a
_ = Maybe a
forall a. Maybe a
Nothing
nothingIf Bool
False a
a = a -> Maybe a
forall a. a -> Maybe a
Just a
a


processDecl :: Bool -> Html -> Maybe Html
processDecl :: Bool -> Html -> Maybe Html
processDecl Bool
True = Html -> Maybe Html
forall a. a -> Maybe a
Just
processDecl Bool
False = 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
divTopDecl

trim :: String -> String
trim :: String -> String
trim = String -> String
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
  where f :: String -> String
f = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

processDeclOneLiner :: Bool -> Html -> Maybe Html
processDeclOneLiner :: Bool -> Html -> Maybe Html
processDeclOneLiner Bool
True = Html -> Maybe Html
forall a. a -> Maybe a
Just
processDeclOneLiner Bool
False = 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
divTopDecl (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
declElem

groupHeading :: Int -> String -> Html -> Html
groupHeading :: Int -> String -> Html -> Html
groupHeading Int
lev String
id0 = String -> Html -> Html
linkedAnchor String
grpId (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Html -> Html
groupTag Int
lev (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
identifier String
grpId]
  where grpId :: String
grpId = String -> String
groupId String
id0

groupTag :: Int -> Html -> Html
groupTag :: Int -> Html -> Html
groupTag Int
lev
  | Int
lev Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1  = Html -> Html
h1
  | Int
lev Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2  = Html -> Html
h2
  | Int
lev Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3  = Html -> Html
h3
  | Bool
otherwise = Html -> Html
h4