{-# LANGUAGE BangPatterns #-}
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wwarn=x-partial #-}

-- |
-- 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
module Haddock.Backends.Xhtml
  ( ppHtml
  , copyHtmlBits
  , ppHtmlIndex
  , ppHtmlContents
  , ppJsonIndex
  ) where

import Control.DeepSeq (force)
import Control.Monad (unless, when)
import Data.Bifunctor (bimap)
import qualified Data.ByteString.Builder as Builder
import Data.Char (isSpace, toUpper)
import Data.Either (partitionEithers)
import Data.Foldable (traverse_)
import Data.List (intersperse, isPrefixOf, sortBy)
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Ord (comparing)
import qualified Data.Set as Set hiding (Set)
import GHC hiding (LexicalFixity (..), NoLink, anchor, moduleInfo)
import GHC.Types.Name
import GHC.Unit.State
import System.Directory
import System.FilePath hiding ((</>))
import qualified System.FilePath as FilePath
import qualified System.IO as IO
import Text.XHtml hiding (name, p, quote, title)
import qualified Text.XHtml as XHtml
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.GhcUtils
import Haddock.InterfaceFile (PackageInfo (..), PackageInterfaces (..), ppPackageInfo)
import Haddock.ModuleTree
import Haddock.Options (Visibility (..))
import Haddock.Types
import Haddock.Utils
import Haddock.Utils.Json
import Haddock.Version

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

-- * Generating HTML documentation

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

ppHtml
  :: UnitState
  -> 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)
  -> BaseURL
  -- ^ The base URL (--base-url)
  -> 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
  -> PackageInfo
  -- ^ Package info
  -> QualOption
  -- ^ How to qualify names
  -> Bool
  -- ^ Output pretty html (newlines and indenting)
  -> Bool
  -- ^ Also write Quickjump index
  -> IO ()
ppHtml :: UnitState
-> String
-> Maybe String
-> [Interface]
-> [InstalledInterface]
-> String
-> Maybe (MDoc RdrName)
-> Themes
-> Maybe String
-> SourceURLs
-> WikiURLs
-> Maybe String
-> Maybe String
-> Maybe String
-> Bool
-> Maybe String
-> PackageInfo
-> QualOption
-> Bool
-> Bool
-> IO ()
ppHtml
  UnitState
state
  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_base_url
  Maybe String
maybe_contents_url
  Maybe String
maybe_index_url
  Bool
unicode
  Maybe String
pkg
  PackageInfo
packageInfo
  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 :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`notElem` Interface -> [DocOption]
ifaceOptions Interface
i

    Bool -> IO () -> IO ()
forall (f :: Type -> Type). 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
$
      UnitState
-> String
-> String
-> Maybe String
-> Themes
-> Maybe String
-> Maybe String
-> SourceURLs
-> WikiURLs
-> [PackageInterfaces]
-> Bool
-> Maybe (MDoc RdrName)
-> Bool
-> Maybe String
-> Qualification
-> IO ()
ppHtmlContents
        UnitState
state
        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
        [ PackageInterfaces
            { piPackageInfo :: PackageInfo
piPackageInfo = PackageInfo
packageInfo
            , piVisibility :: Visibility
piVisibility = Visibility
Visible
            , piInstalledInterfaces :: [InstalledInterface]
piInstalledInterfaces =
                (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 :: Type -> Type). 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 :: Type -> Type). 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]
-> [String]
-> 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 :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      ( String
-> String
-> Themes
-> Maybe String
-> SourceURLs
-> WikiURLs
-> Maybe String
-> 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_base_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 :: Type -> Type) (m :: Type -> Type) 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 :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
withQuickjump (String -> IO ()
copyLibFile String
jsQuickJumpFile)
  () -> IO ()
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

headHtml :: String -> Themes -> Maybe String -> Maybe String -> Html
headHtml :: String -> Themes -> Maybe String -> Maybe String -> Html
headHtml String
docTitle Themes
themes Maybe String
mathjax_url Maybe String
base_url =
  Html -> Html
header
    (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([HtmlAttr] -> (String -> [HtmlAttr]) -> Maybe String -> [HtmlAttr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
url -> [String -> HtmlAttr
identifier String
"head", String -> String -> HtmlAttr
strAttr String
"data-base-url" String
url]) Maybe String
base_url)
    (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
       , Maybe String -> Themes -> Html
styleSheet Maybe String
base_url 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 (Maybe String -> String -> String
withBaseURL Maybe String
base_url 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 (Maybe String -> String -> String
withBaseURL Maybe String
base_url 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 Unit String
_, Map Unit 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 Unit String
_, Map Unit String
_) (Just Interface
iface) =
  let url :: String
url = Maybe Module -> Maybe Name -> Maybe SrcSpan -> String -> String
spliceURL (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 Module -> Maybe Name -> Maybe SrcSpan -> String -> String
spliceURL (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 :: Type -> Type) 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
fldNm, HaddockModInfo Name -> Maybe String
fld) =
      HaddockModInfo Name -> Maybe String
fld HaddockModInfo Name
info Maybe String -> (String -> Maybe HtmlTable) -> Maybe HtmlTable
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
a -> HtmlTable -> Maybe HtmlTable
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Html -> Html
th (Html -> Html) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
fldNm 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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) 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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) 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 a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) 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 :: Type -> Type} {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 :: Type -> Type} {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 a. a -> m a
forall (m :: Type -> Type) 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
  :: UnitState
  -> FilePath
  -> String
  -> Maybe String
  -> Themes
  -> Maybe String
  -> Maybe String
  -> SourceURLs
  -> WikiURLs
  -> [PackageInterfaces]
  -> Bool
  -> Maybe (MDoc GHC.RdrName)
  -> Bool
  -> Maybe Package
  -- ^ Current package
  -> Qualification
  -- ^ How to qualify names
  -> IO ()
ppHtmlContents :: UnitState
-> String
-> String
-> Maybe String
-> Themes
-> Maybe String
-> Maybe String
-> SourceURLs
-> WikiURLs
-> [PackageInterfaces]
-> Bool
-> Maybe (MDoc RdrName)
-> Bool
-> Maybe String
-> Qualification
-> IO ()
ppHtmlContents
  UnitState
state
  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
  [PackageInterfaces]
packages
  Bool
showPkgs
  Maybe (MDoc RdrName)
prologue
  Bool
debug
  Maybe String
pkg
  Qualification
qual = do
    let trees :: [(PackageInfo, [ModuleTree])]
trees =
          [ ( PackageInterfaces -> PackageInfo
piPackageInfo PackageInterfaces
pinfo
            , UnitState -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]
mkModuleTree
                UnitState
state
                Bool
showPkgs
                [ (InstalledInterface -> Module
instMod InstalledInterface
iface, InstalledInterface -> Maybe (MDoc Name)
toInstalledDescription InstalledInterface
iface)
                | InstalledInterface
iface <- PackageInterfaces -> [InstalledInterface]
piInstalledInterfaces PackageInterfaces
pinfo
                , Bool -> Bool
not (InstalledInterface -> Bool
instIsSig InstalledInterface
iface)
                ]
            )
          | PackageInterfaces
pinfo <- [PackageInterfaces]
mergedPackages
          ]
        sig_trees :: [(PackageInfo, [ModuleTree])]
sig_trees =
          [ ( PackageInterfaces -> PackageInfo
piPackageInfo PackageInterfaces
pinfo
            , UnitState -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree]
mkModuleTree
                UnitState
state
                Bool
showPkgs
                [ (InstalledInterface -> Module
instMod InstalledInterface
iface, InstalledInterface -> Maybe (MDoc Name)
toInstalledDescription InstalledInterface
iface)
                | InstalledInterface
iface <- PackageInterfaces -> [InstalledInterface]
piInstalledInterfaces PackageInterfaces
pinfo
                , InstalledInterface -> Bool
instIsSig InstalledInterface
iface
                ]
            )
          | PackageInterfaces
pinfo <- [PackageInterfaces]
mergedPackages
          ]
        html :: Html
html =
          String -> Themes -> Maybe String -> Maybe String -> Html
headHtml String
doctitle Themes
themes Maybe String
mathjax_url Maybe String
forall a. Maybe a
Nothing
            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 -> [(PackageInfo, [ModuleTree])] -> Html
ppSignatureTrees Maybe String
pkg Qualification
qual [(PackageInfo, [ModuleTree])]
sig_trees
               , Maybe String
-> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppModuleTrees Maybe String
pkg Qualification
qual [(PackageInfo, [ModuleTree])]
trees
               ]
    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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) 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

      -- Merge package interfaces from the same package (f.e. like those generated by --incremental)
      mergedPackages :: [PackageInterfaces]
mergedPackages = Map (String, Visibility) PackageInterfaces -> [PackageInterfaces]
forall k a. Map k a -> [a]
Map.elems (Map (String, Visibility) PackageInterfaces -> [PackageInterfaces])
-> Map (String, Visibility) PackageInterfaces
-> [PackageInterfaces]
forall a b. (a -> b) -> a -> b
$ (PackageInterfaces -> PackageInterfaces -> PackageInterfaces)
-> [((String, Visibility), PackageInterfaces)]
-> Map (String, Visibility) PackageInterfaces
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith PackageInterfaces -> PackageInterfaces -> PackageInterfaces
merge ([((String, Visibility), PackageInterfaces)]
 -> Map (String, Visibility) PackageInterfaces)
-> [((String, Visibility), PackageInterfaces)]
-> Map (String, Visibility) PackageInterfaces
forall a b. (a -> b) -> a -> b
$ (PackageInterfaces -> ((String, Visibility), PackageInterfaces))
-> [PackageInterfaces]
-> [((String, Visibility), PackageInterfaces)]
forall a b. (a -> b) -> [a] -> [b]
map (\PackageInterfaces
p -> ((PackageInfo -> String
ppPackageInfo (PackageInterfaces -> PackageInfo
piPackageInfo PackageInterfaces
p), PackageInterfaces -> Visibility
piVisibility PackageInterfaces
p), PackageInterfaces
p)) [PackageInterfaces]
packages
      merge :: PackageInterfaces -> PackageInterfaces -> PackageInterfaces
merge PackageInterfaces
p1 PackageInterfaces
p2 = PackageInterfaces
p1{piInstalledInterfaces = piInstalledInterfaces p1 ++ piInstalledInterfaces p2}

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

ppSignatureTrees :: Maybe Package -> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppSignatureTrees :: Maybe String
-> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppSignatureTrees Maybe String
_ Qualification
_ [(PackageInfo, [ModuleTree])]
tss | ((PackageInfo, [ModuleTree]) -> Bool)
-> [(PackageInfo, [ModuleTree])] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all ([ModuleTree] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([ModuleTree] -> Bool)
-> ((PackageInfo, [ModuleTree]) -> [ModuleTree])
-> (PackageInfo, [ModuleTree])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageInfo, [ModuleTree]) -> [ModuleTree]
forall a b. (a, b) -> b
snd) [(PackageInfo, [ModuleTree])]
tss = Html
forall a. Monoid a => a
mempty
ppSignatureTrees Maybe String
pkg Qualification
qual [(PackageInfo
info, [ModuleTree]
ts)] =
  Html -> Html
divPackageList (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 -> PackageInfo -> [ModuleTree] -> Html
ppSignatureTree Maybe String
pkg Qualification
qual String
"n" PackageInfo
info [ModuleTree]
ts)
ppSignatureTrees Maybe String
pkg Qualification
qual [(PackageInfo, [ModuleTree])]
tss =
  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
+++ [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml
            [ Maybe String
-> Qualification -> String -> PackageInfo -> [ModuleTree] -> Html
ppSignatureTree Maybe String
pkg Qualification
qual (String
"n." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") PackageInfo
info [ModuleTree]
ts
            | (Int
i, (PackageInfo
info, [ModuleTree]
ts)) <- [Int]
-> [(PackageInfo, [ModuleTree])]
-> [(Int, (PackageInfo, [ModuleTree]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] [(PackageInfo, [ModuleTree])]
tss
            ]
       )

ppSignatureTree :: Maybe Package -> Qualification -> String -> PackageInfo -> [ModuleTree] -> Html
ppSignatureTree :: Maybe String
-> Qualification -> String -> PackageInfo -> [ModuleTree] -> Html
ppSignatureTree Maybe String
_ Qualification
_ String
_ PackageInfo
_ [] = Html
forall a. Monoid a => a
mempty
ppSignatureTree Maybe String
pkg Qualification
qual String
p PackageInfo
info [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
<< PackageInfo -> String
ppPackageInfo PackageInfo
info 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
p [ModuleTree]
ts)

ppModuleTrees :: Maybe Package -> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppModuleTrees :: Maybe String
-> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppModuleTrees Maybe String
_ Qualification
_ [(PackageInfo, [ModuleTree])]
tss | ((PackageInfo, [ModuleTree]) -> Bool)
-> [(PackageInfo, [ModuleTree])] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all ([ModuleTree] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([ModuleTree] -> Bool)
-> ((PackageInfo, [ModuleTree]) -> [ModuleTree])
-> (PackageInfo, [ModuleTree])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageInfo, [ModuleTree]) -> [ModuleTree]
forall a b. (a, b) -> b
snd) [(PackageInfo, [ModuleTree])]
tss = Html
forall a. Monoid a => a
mempty
ppModuleTrees Maybe String
pkg Qualification
qual [(PackageInfo
info, [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 -> PackageInfo -> [ModuleTree] -> Html
ppModuleTree Maybe String
pkg Qualification
qual String
"n" PackageInfo
info [ModuleTree]
ts)
ppModuleTrees Maybe String
pkg Qualification
qual [(PackageInfo, [ModuleTree])]
tss =
  Html -> Html
divPackageList
    (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
"Packages"
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml
            [ Maybe String
-> Qualification -> String -> PackageInfo -> [ModuleTree] -> Html
ppModuleTree Maybe String
pkg Qualification
qual (String
"n." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") PackageInfo
info [ModuleTree]
ts
            | (Int
i, (PackageInfo
info, [ModuleTree]
ts)) <- [Int]
-> [(PackageInfo, [ModuleTree])]
-> [(Int, (PackageInfo, [ModuleTree]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] [(PackageInfo, [ModuleTree])]
tss
            ]
       )

ppModuleTree :: Maybe Package -> Qualification -> String -> PackageInfo -> [ModuleTree] -> Html
ppModuleTree :: Maybe String
-> Qualification -> String -> PackageInfo -> [ModuleTree] -> Html
ppModuleTree Maybe String
_ Qualification
_ String
_ PackageInfo
_ [] = Html
forall a. Monoid a => a
mempty
ppModuleTree Maybe String
pkg Qualification
qual String
p PackageInfo
info [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
<< PackageInfo -> String
ppPackageInfo PackageInfo
info 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
p [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 a. [a] -> Bool
forall (t :: Type -> Type) 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
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ss) String
p [ModuleTree]
ts
            )

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

-- * Generate the index

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

data JsonIndexEntry = JsonIndexEntry
  { JsonIndexEntry -> String
jieHtmlFragment :: String
  , JsonIndexEntry -> String
jieName :: String
  , JsonIndexEntry -> String
jieModule :: String
  , JsonIndexEntry -> String
jieLink :: String
  }
  deriving (Int -> JsonIndexEntry -> String -> String
[JsonIndexEntry] -> String -> String
JsonIndexEntry -> String
(Int -> JsonIndexEntry -> String -> String)
-> (JsonIndexEntry -> String)
-> ([JsonIndexEntry] -> String -> String)
-> Show JsonIndexEntry
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> JsonIndexEntry -> String -> String
showsPrec :: Int -> JsonIndexEntry -> String -> String
$cshow :: JsonIndexEntry -> String
show :: JsonIndexEntry -> String
$cshowList :: [JsonIndexEntry] -> String -> String
showList :: [JsonIndexEntry] -> String -> String
Show)

instance ToJSON JsonIndexEntry where
  toJSON :: JsonIndexEntry -> Value
toJSON
    JsonIndexEntry
      { String
jieHtmlFragment :: JsonIndexEntry -> String
jieHtmlFragment :: String
jieHtmlFragment
      , String
jieName :: JsonIndexEntry -> String
jieName :: String
jieName
      , String
jieModule :: JsonIndexEntry -> String
jieModule :: String
jieModule
      , String
jieLink :: JsonIndexEntry -> String
jieLink :: String
jieLink
      } =
      Object -> Value
Object
        [ String
"display_html" String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
String String
jieHtmlFragment
        , String
"name" String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
String String
jieName
        , String
"module" String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
String String
jieModule
        , String
"link" String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
String String
jieLink
        ]

instance FromJSON JsonIndexEntry where
  parseJSON :: Value -> Parser JsonIndexEntry
parseJSON = String
-> (Object -> Parser JsonIndexEntry)
-> Value
-> Parser JsonIndexEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JsonIndexEntry" ((Object -> Parser JsonIndexEntry)
 -> Value -> Parser JsonIndexEntry)
-> (Object -> Parser JsonIndexEntry)
-> Value
-> Parser JsonIndexEntry
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    String -> String -> String -> String -> JsonIndexEntry
JsonIndexEntry
      (String -> String -> String -> String -> JsonIndexEntry)
-> Parser String
-> Parser (String -> String -> String -> JsonIndexEntry)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> String -> Parser String
forall a. FromJSON a => Object -> String -> Parser a
.: String
"display_html"
      Parser (String -> String -> String -> JsonIndexEntry)
-> Parser String -> Parser (String -> String -> JsonIndexEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
v Object -> String -> Parser String
forall a. FromJSON a => Object -> String -> Parser a
.: String
"name"
      Parser (String -> String -> JsonIndexEntry)
-> Parser String -> Parser (String -> JsonIndexEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
v Object -> String -> Parser String
forall a. FromJSON a => Object -> String -> Parser a
.: String
"module"
      Parser (String -> JsonIndexEntry)
-> Parser String -> Parser JsonIndexEntry
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
v Object -> String -> Parser String
forall a. FromJSON a => Object -> String -> Parser a
.: String
"link"

ppJsonIndex
  :: FilePath
  -> SourceURLs
  -- ^ The source URL (--source)
  -> WikiURLs
  -- ^ The wiki URL (--wiki)
  -> Bool
  -> Maybe Package
  -> QualOption
  -> [Interface]
  -> [FilePath]
  -- ^ file paths to interface files
  -- (--read-interface)
  -> IO ()
ppJsonIndex :: String
-> SourceURLs
-> WikiURLs
-> Bool
-> Maybe String
-> QualOption
-> [Interface]
-> [String]
-> IO ()
ppJsonIndex String
odir SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url Bool
unicode Maybe String
pkg QualOption
qual_opt [Interface]
ifaces [String]
installedIfacesPaths = do
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
odir
  (errors, installedIndexes) <-
    [Either (String, String) [JsonIndexEntry]]
-> ([(String, String)], [[JsonIndexEntry]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
      ([Either (String, String) [JsonIndexEntry]]
 -> ([(String, String)], [[JsonIndexEntry]]))
-> IO [Either (String, String) [JsonIndexEntry]]
-> IO ([(String, String)], [[JsonIndexEntry]])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Either (String, String) [JsonIndexEntry]))
-> [String] -> IO [Either (String, String) [JsonIndexEntry]]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
        ( \String
ifaceFile -> do
            let indexFile :: String
indexFile =
                  String -> String
takeDirectory String
ifaceFile
                    String -> String -> String
FilePath.</> String
"doc-index.json"
            a <- String -> IO Bool
doesFileExist String
indexFile
            if a
              then
                bimap (indexFile,) (map (fixLink ifaceFile))
                  <$> eitherDecodeFile @[JsonIndexEntry] indexFile
              else return (Right [])
        )
        [String]
installedIfacesPaths
  traverse_
    (\(String
indexFile, String
err) -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"haddock: Coudn't parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
indexFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
    errors
  IO.withBinaryFile (joinPath [odir, indexJsonFile]) IO.WriteMode $ \Handle
h ->
    Handle -> Builder -> IO ()
Builder.hPutBuilder
      Handle
h
      (Value -> Builder
forall a. ToJSON a => a -> Builder
encodeToBuilder ([JsonIndexEntry] -> Value
encodeIndexes ([[JsonIndexEntry]] -> [JsonIndexEntry]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[JsonIndexEntry]]
installedIndexes)))
  where
    encodeIndexes :: [JsonIndexEntry] -> Value
    encodeIndexes :: [JsonIndexEntry] -> Value
encodeIndexes [JsonIndexEntry]
installedIndexes =
      [JsonIndexEntry] -> Value
forall a. ToJSON a => a -> Value
toJSON
        ( (Interface -> [JsonIndexEntry]) -> [Interface] -> [JsonIndexEntry]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Interface -> [JsonIndexEntry]
fromInterface [Interface]
ifaces
            [JsonIndexEntry] -> [JsonIndexEntry] -> [JsonIndexEntry]
forall a. [a] -> [a] -> [a]
++ [JsonIndexEntry]
installedIndexes
        )

    fromInterface :: Interface -> [JsonIndexEntry]
    fromInterface :: Interface -> [JsonIndexEntry]
fromInterface Interface
iface =
      Module
-> Qualification -> ExportItem DocNameI -> Maybe JsonIndexEntry
mkIndex Module
mdl Qualification
qual (ExportItem DocNameI -> Maybe JsonIndexEntry)
-> [ExportItem DocNameI] -> [JsonIndexEntry]
forall a b. (a -> Maybe b) -> [a] -> [b]
`mapMaybe` Interface -> [ExportItem DocNameI]
ifaceRnExportItems Interface
iface
      where
        qual :: Qualification
qual = QualOption -> Module -> Qualification
makeModuleQual QualOption
qual_opt Module
mdl
        mdl :: Module
mdl = Interface -> Module
ifaceMod Interface
iface

    mkIndex :: Module -> Qualification -> ExportItem DocNameI -> Maybe JsonIndexEntry
    mkIndex :: Module
-> Qualification -> ExportItem DocNameI -> Maybe JsonIndexEntry
mkIndex 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 =
          JsonIndexEntry -> Maybe JsonIndexEntry
forall a. a -> Maybe a
Just
            JsonIndexEntry
              { jieHtmlFragment :: String
jieHtmlFragment = Html -> String
forall html. HTML html => html -> String
showHtmlFragment Html
item_html
              , jieName :: String
jieName = [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)
              , jieModule :: String
jieModule = Module -> String
moduleString Module
mdl
              , jieLink :: String
jieLink = 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 = Maybe JsonIndexEntry
forall a. Maybe a
Nothing
      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 (RnExportD{rnExpDExpD :: RnExportD -> ExportD DocNameI
rnExpDExpD = ExportD{[(IdP DocNameI, DocForDecl (IdP DocNameI))]
expDSubDocs :: [(IdP DocNameI, DocForDecl (IdP DocNameI))]
expDSubDocs :: forall name. ExportD name -> [(IdP name, DocForDecl (IdP name))]
expDSubDocs}})) = ((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)]
expDSubDocs
    exportSubs ExportItem DocNameI
_ = []

    exportName :: ExportItem DocNameI -> [IdP DocNameI]
    exportName :: ExportItem DocNameI -> [IdP DocNameI]
exportName (ExportDecl (RnExportD{rnExpDExpD :: RnExportD -> ExportD DocNameI
rnExpDExpD = ExportD{LHsDecl DocNameI
expDDecl :: LHsDecl DocNameI
expDDecl :: forall name. ExportD name -> LHsDecl name
expDDecl}})) = HsDecl DocNameI -> [IdP DocNameI]
getMainDeclBinderI (GenLocated SrcSpanAnnA (HsDecl DocNameI) -> HsDecl DocNameI
forall l e. GenLocated l e -> e
unLoc LHsDecl DocNameI
GenLocated SrcSpanAnnA (HsDecl DocNameI)
expDDecl)
    exportName ExportNoDecl{IdP DocNameI
expItemName :: IdP DocNameI
expItemName :: forall name. ExportItem name -> IdP name
expItemName} = [IdP DocNameI
expItemName]
    exportName ExportItem DocNameI
_ = []

    nameLink :: NamedThing name => Module -> name -> String
    nameLink :: forall name. NamedThing name => Module -> name -> String
nameLink Module
mdl = ModuleName -> OccName -> String
moduleNameUrl' (Module -> ModuleName
forall unit. GenModule unit -> 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)

    -- update link using relative path to output directory
    fixLink
      :: FilePath
      -> JsonIndexEntry
      -> JsonIndexEntry
    fixLink :: String -> JsonIndexEntry -> JsonIndexEntry
fixLink String
ifaceFile JsonIndexEntry
jie =
      JsonIndexEntry
jie
        { jieLink =
            makeRelative odir (takeDirectory ifaceFile)
              FilePath.</> jieLink jie
        }

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 :: Type -> Type). 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 :: Type -> Type) (m :: Type -> Type) 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 -> 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 Maybe String
forall a. Maybe a
Nothing
          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 a. [a] -> Bool
forall (t :: Type -> Type) 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 a. [a] -> Int
forall (t :: Type -> Type) 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 :: Type -> Type) 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. HasCallStack => [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 :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless ([(String, Map Name [(Module, Bool)])] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) 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. HasCallStack => [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 String (Map Name [(Module, Bool)])
 -> InstalledInterface -> Map String (Map Name [(Module, Bool)]))
-> Map String (Map Name [(Module, Bool)])
-> [InstalledInterface]
-> Map String (Map Name [(Module, Bool)])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map String (Map Name [(Module, Bool)])
-> InstalledInterface -> Map String (Map Name [(Module, Bool)])
f Map String (Map Name [(Module, Bool)])
forall k a. Map k a
Map.empty [InstalledInterface]
ifaces
        where
          f
            :: Map String (Map Name [(Module, Bool)])
            -> InstalledInterface
            -> Map String (Map Name [(Module, Bool)])
          f :: Map String (Map Name [(Module, Bool)])
-> InstalledInterface -> Map String (Map Name [(Module, Bool)])
f !Map String (Map Name [(Module, Bool)])
idx InstalledInterface
iface =
            (Map Name [(Module, Bool)]
 -> Map Name [(Module, Bool)] -> Map Name [(Module, Bool)])
-> Map String (Map Name [(Module, Bool)])
-> Map String (Map Name [(Module, Bool)])
-> Map String (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)])
-> 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)]
a [(Module, Bool)]
b -> let !x :: [(Module, Bool)]
x = [(Module, Bool)] -> [(Module, Bool)]
forall a. NFData a => a -> a
force ([(Module, Bool)] -> [(Module, Bool)])
-> [(Module, Bool)] -> [(Module, Bool)]
forall a b. (a -> b) -> a -> b
$ [(Module, Bool)]
a [(Module, Bool)] -> [(Module, Bool)] -> [(Module, Bool)]
forall a. [a] -> [a] -> [a]
++ [(Module, Bool)]
b in [(Module, Bool)]
x))
              Map String (Map Name [(Module, Bool)])
idx
              (InstalledInterface -> Map String (Map Name [(Module, Bool)])
getIfaceIndex InstalledInterface
iface)

      getIfaceIndex :: InstalledInterface -> Map String (Map Name [(Module, Bool)])
      getIfaceIndex :: InstalledInterface -> Map String (Map Name [(Module, Bool)])
getIfaceIndex InstalledInterface
iface =
        (Map String (Map Name [(Module, Bool)])
 -> Name -> Map String (Map Name [(Module, Bool)]))
-> Map String (Map Name [(Module, Bool)])
-> [Name]
-> Map String (Map Name [(Module, Bool)])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Map String (Map Name [(Module, Bool)])
-> Name -> Map String (Map Name [(Module, Bool)])
f Map String (Map Name [(Module, Bool)])
forall k a. Map k a
Map.empty (InstalledInterface -> [Name]
instExports InstalledInterface
iface)
        where
          f
            :: Map String (Map Name [(Module, Bool)])
            -> Name
            -> Map String (Map Name [(Module, Bool)])
          f :: Map String (Map Name [(Module, Bool)])
-> Name -> Map String (Map Name [(Module, Bool)])
f !Map String (Map Name [(Module, Bool)])
idx Name
name =
            let !vis :: Bool
vis = Name
name Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
visible
             in (Map Name [(Module, Bool)]
 -> Map Name [(Module, Bool)] -> Map Name [(Module, Bool)])
-> String
-> Map Name [(Module, Bool)]
-> Map 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 k a
Map.insertWith
                  (([(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]
(++))
                  (Name -> String
forall a. NamedThing a => a -> String
getOccString Name
name)
                  (Name -> [(Module, Bool)] -> Map Name [(Module, Bool)]
forall k a. k -> a -> Map k a
Map.singleton Name
name [(Module
mdl, Bool
vis)])
                  Map String (Map Name [(Module, Bool)])
idx

          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
  -> BaseURL
  -> Maybe String
  -> Maybe String
  -> Bool
  -> Maybe Package
  -> QualOption
  -> Bool
  -> Interface
  -> IO ()
ppHtmlModule :: String
-> String
-> Themes
-> Maybe String
-> SourceURLs
-> WikiURLs
-> Maybe String
-> 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_base_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
      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 -> Module -> Qualification
makeModuleQual QualOption
qual Module
mdl
      html :: Html
html =
        String -> Themes -> Maybe String -> Maybe String -> Html
headHtml String
mdl_str_annot Themes
themes Maybe String
maybe_mathjax_url Maybe String
maybe_base_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)
-> ([DocInstance DocNameI] -> Bool)
-> [DocInstance DocNameI]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DocInstance DocNameI] -> Bool
[(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)]
-> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([DocInstance DocNameI] -> Bool) -> [DocInstance DocNameI] -> 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
          ( RnExportD
              { rnExpDExpD :: RnExportD -> ExportD DocNameI
rnExpDExpD =
                ExportD
                  { expDMbDoc :: forall name. ExportD name -> DocForDecl (IdP name)
expDMbDoc =
                    (Documentation Maybe (MDoc (IdP DocNameI))
mDoc Maybe (Doc (IdP DocNameI))
mWarn, FnArgsDoc (IdP DocNameI)
_)
                  }
              }
            )
        ) = Maybe (MDoc DocName) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (MDoc (IdP DocNameI))
Maybe (MDoc DocName)
mDoc Bool -> Bool -> Bool
|| Maybe (Doc DocName) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Doc (IdP DocNameI))
Maybe (Doc DocName)
mWarn
    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 :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any ExportItem DocNameI -> Bool
forall {name}.
(XExportDecl name ~ RnExportD) =>
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 a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) 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 a. [a] -> Bool
forall (t :: Type -> Type) 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
html Html -> [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
n Int -> 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
n Int -> 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
      ( RnExportD
          { rnExpDExpD :: RnExportD -> ExportD DocNameI
rnExpDExpD =
            ExportD
              { expDDecl :: forall name. ExportD name -> LHsDecl name
expDDecl = L SrcSpanAnnA
_ (InstD{})
              }
          }
        )
    ) =
    Maybe Html
forall a. Maybe a
Nothing -- Hide empty instances
processExport
  Bool
summary
  LinksInfo
links
  Bool
unicode
  Maybe String
pkg
  Qualification
qual
  ( ExportDecl
      ( RnExportD
          { rnExpDExpD :: RnExportD -> ExportD DocNameI
rnExpDExpD =
            ExportD 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
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
_ 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 :: forall a. 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