{-# 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, 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
-> [Char]
-> Maybe [Char]
-> [Interface]
-> [InstalledInterface]
-> [Char]
-> Maybe (MDoc RdrName)
-> Themes
-> Maybe [Char]
-> SourceURLs
-> WikiURLs
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Bool
-> Maybe [Char]
-> PackageInfo
-> QualOption
-> Bool
-> Bool
-> IO ()
ppHtml
  UnitState
state
  [Char]
doctitle
  Maybe [Char]
maybe_package
  [Interface]
ifaces
  [InstalledInterface]
reexported_ifaces
  [Char]
odir
  Maybe (MDoc RdrName)
prologue
  Themes
themes
  Maybe [Char]
maybe_mathjax_url
  SourceURLs
maybe_source_url
  WikiURLs
maybe_wiki_url
  Maybe [Char]
maybe_base_url
  Maybe [Char]
maybe_contents_url
  Maybe [Char]
maybe_index_url
  Bool
unicode
  Maybe [Char]
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 [Char] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [Char]
maybe_contents_url) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      UnitState
-> [Char]
-> [Char]
-> Maybe [Char]
-> Themes
-> Maybe [Char]
-> Maybe [Char]
-> SourceURLs
-> WikiURLs
-> [PackageInterfaces]
-> Bool
-> Maybe (MDoc RdrName)
-> Bool
-> Maybe [Char]
-> Qualification
-> IO ()
ppHtmlContents
        UnitState
state
        [Char]
odir
        [Char]
doctitle
        Maybe [Char]
maybe_package
        Themes
themes
        Maybe [Char]
maybe_mathjax_url
        Maybe [Char]
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 [Char]
pkg
        (QualOption -> Qualification
makeContentsQual QualOption
qual)

    Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [Char]
maybe_index_url) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [Char]
-> [Char]
-> Maybe [Char]
-> Themes
-> Maybe [Char]
-> Maybe [Char]
-> SourceURLs
-> WikiURLs
-> [InstalledInterface]
-> Bool
-> IO ()
ppHtmlIndex
        [Char]
odir
        [Char]
doctitle
        Maybe [Char]
maybe_package
        Themes
themes
        Maybe [Char]
maybe_mathjax_url
        Maybe [Char]
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
$
      [Char]
-> SourceURLs
-> WikiURLs
-> Bool
-> Maybe [Char]
-> QualOption
-> [Interface]
-> [[Char]]
-> IO ()
ppJsonIndex
        [Char]
odir
        SourceURLs
maybe_source_url
        WikiURLs
maybe_wiki_url
        Bool
unicode
        Maybe [Char]
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_
      ( [Char]
-> [Char]
-> Themes
-> Maybe [Char]
-> SourceURLs
-> WikiURLs
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Bool
-> Maybe [Char]
-> QualOption
-> Bool
-> Interface
-> IO ()
ppHtmlModule
          [Char]
odir
          [Char]
doctitle
          Themes
themes
          Maybe [Char]
maybe_mathjax_url
          SourceURLs
maybe_source_url
          WikiURLs
maybe_wiki_url
          Maybe [Char]
maybe_base_url
          Maybe [Char]
maybe_contents_url
          Maybe [Char]
maybe_index_url
          Bool
unicode
          Maybe [Char]
pkg
          QualOption
qual
          Bool
debug
      )
      [Interface]
visible_ifaces

copyHtmlBits :: FilePath -> FilePath -> Themes -> Bool -> IO ()
copyHtmlBits :: [Char] -> [Char] -> Themes -> Bool -> IO ()
copyHtmlBits [Char]
odir [Char]
libdir Themes
themes Bool
withQuickjump = do
  let
    libhtmldir :: [Char]
libhtmldir = [[Char]] -> [Char]
joinPath [[Char]
libdir, [Char]
"html"]
    copyCssFile :: [Char] -> IO ()
copyCssFile [Char]
f = [Char] -> [Char] -> IO ()
copyFile [Char]
f ([Char] -> [Char] -> [Char]
combine [Char]
odir ([Char] -> [Char]
takeFileName [Char]
f))
    copyLibFile :: [Char] -> IO ()
copyLibFile [Char]
f = [Char] -> [Char] -> IO ()
copyFile ([[Char]] -> [Char]
joinPath [[Char]
libhtmldir, [Char]
f]) ([[Char]] -> [Char]
joinPath [[Char]
odir, [Char]
f])
  ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
copyCssFile (Themes -> [[Char]]
cssFiles Themes
themes)
  [Char] -> IO ()
copyLibFile [Char]
haddockJsFile
  [Char] -> IO ()
copyCssFile ([[Char]] -> [Char]
joinPath [[Char]
libhtmldir, [Char]
quickJumpCssFile])
  Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
withQuickjump ([Char] -> IO ()
copyLibFile [Char]
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 :: [Char] -> Themes -> Maybe [Char] -> Maybe [Char] -> Html
headHtml [Char]
docTitle Themes
themes Maybe [Char]
mathjax_url Maybe [Char]
base_url =
  Html -> Html
header
    (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! ([HtmlAttr] -> ([Char] -> [HtmlAttr]) -> Maybe [Char] -> [HtmlAttr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\[Char]
url -> [[Char] -> HtmlAttr
identifier [Char]
"head", [Char] -> [Char] -> HtmlAttr
strAttr [Char]
"data-base-url" [Char]
url]) Maybe [Char]
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
! [[Char] -> HtmlAttr
httpequiv [Char]
"Content-Type", [Char] -> HtmlAttr
content [Char]
"text/html; charset=UTF-8"]
       , Html
meta Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
XHtml.name [Char]
"viewport", [Char] -> HtmlAttr
content [Char]
"width=device-width, initial-scale=1"]
       , Html -> Html
thetitle (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
docTitle
       , Maybe [Char] -> Themes -> Html
styleSheet Maybe [Char]
base_url Themes
themes
       , Html -> Html
thelink
          (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [ [Char] -> HtmlAttr
rel [Char]
"stylesheet"
            , [Char] -> HtmlAttr
thetype [Char]
"text/css"
            , [Char] -> HtmlAttr
href (Maybe [Char] -> [Char] -> [Char]
withBaseURL Maybe [Char]
base_url [Char]
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
! [[Char] -> HtmlAttr
rel [Char]
"stylesheet", [Char] -> HtmlAttr
thetype [Char]
"text/css", [Char] -> HtmlAttr
href [Char]
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
! [ [Char] -> HtmlAttr
src (Maybe [Char] -> [Char] -> [Char]
withBaseURL Maybe [Char]
base_url [Char]
haddockJsFile)
            , [Char] -> HtmlAttr
emptyAttr [Char]
"async"
            , [Char] -> HtmlAttr
thetype [Char]
"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
! [[Char] -> HtmlAttr
thetype [Char]
"text/x-mathjax-config"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char] -> Html
primHtml [Char]
mjConf
       , Html -> Html
script (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
src [Char]
mjUrl, [Char] -> HtmlAttr
thetype [Char]
"text/javascript"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
noHtml
       ]
  where
    fontUrl :: [Char]
fontUrl = [Char]
"https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700"
    mjUrl :: [Char]
mjUrl = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" Maybe [Char]
mathjax_url
    mjConf :: [Char]
mjConf =
      [[Char]] -> [Char]
unwords
        [ [Char]
"MathJax.Hub.Config({"
        , [Char]
"tex2jax: {"
        , [Char]
"processClass: \"mathjax\","
        , [Char]
"ignoreClass: \".*\""
        , [Char]
"}"
        , [Char]
"});"
        ]

srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
srcButton (Just [Char]
src_base_url, Maybe [Char]
_, Map Unit [Char]
_, Map Unit [Char]
_) 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
! [[Char] -> HtmlAttr
href [Char]
src_base_url] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Source")
srcButton (Maybe [Char]
_, Just [Char]
src_module_url, Map Unit [Char]
_, Map Unit [Char]
_) (Just Interface
iface) =
  let url :: [Char]
url = Maybe Module -> Maybe Name -> Maybe SrcSpan -> [Char] -> [Char]
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 [Char]
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
! [[Char] -> HtmlAttr
href [Char]
url] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"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 [Char]
wiki_base_url, Maybe [Char]
_, Maybe [Char]
_) 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
! [[Char] -> HtmlAttr
href [Char]
wiki_base_url] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"User Comments")
wikiButton (Maybe [Char]
_, Just [Char]
wiki_module_url, Maybe [Char]
_) (Just Module
mdl) =
  let url :: [Char]
url = Maybe Module -> Maybe Name -> Maybe SrcSpan -> [Char] -> [Char]
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 [Char]
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
! [[Char] -> HtmlAttr
href [Char]
url] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"User Comments")
wikiButton WikiURLs
_ Maybe Module
_ =
  Maybe Html
forall a. Maybe a
Nothing

contentsButton :: Maybe String -> Maybe Html
contentsButton :: Maybe [Char] -> Maybe Html
contentsButton Maybe [Char]
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
! [[Char] -> HtmlAttr
href [Char]
url] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Contents")
  where
    url :: [Char]
url = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
contentsHtmlFile Maybe [Char]
maybe_contents_url

indexButton :: Maybe String -> Maybe Html
indexButton :: Maybe [Char] -> Maybe Html
indexButton Maybe [Char]
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
! [[Char] -> HtmlAttr
href [Char]
url] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Index")
  where
    url :: [Char]
url = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
indexHtmlFile Maybe [Char]
maybe_index_url

bodyHtml
  :: String
  -> Maybe Interface
  -> SourceURLs
  -> WikiURLs
  -> Maybe String
  -> Maybe String
  -> Html
  -> Html
bodyHtml :: [Char]
-> Maybe Interface
-> SourceURLs
-> WikiURLs
-> Maybe [Char]
-> Maybe [Char]
-> Html
-> Html
bodyHtml
  [Char]
doctitle
  Maybe Interface
iface
  SourceURLs
maybe_source_url
  WikiURLs
maybe_wiki_url
  Maybe [Char]
maybe_contents_url
  Maybe [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
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 [Char] -> Maybe Html
contentsButton Maybe [Char]
maybe_contents_url
                      , Maybe [Char] -> Maybe Html
indexButton Maybe [Char]
maybe_index_url
                      ]
                  )
                  Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"links", [Char] -> HtmlAttr
identifier [Char]
"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
<< ( [Char]
"Produced by "
                  [Char] -> 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
! [[Char] -> HtmlAttr
href [Char]
projectUrl] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
projectName)
                  Html -> [Char] -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ ([Char]
" version " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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 :: ([Char], HaddockModInfo Name -> Maybe [Char]) -> Maybe HtmlTable
doOneEntry ([Char]
fldNm, HaddockModInfo Name -> Maybe [Char]
fld) =
      HaddockModInfo Name -> Maybe [Char]
fld HaddockModInfo Name
info Maybe [Char] -> ([Char] -> 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
>>= \[Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
fldNm Html -> Html -> HtmlTable
forall ht1 ht2.
(HTMLTABLE ht1, HTMLTABLE ht2) =>
ht1 -> ht2 -> HtmlTable
<-> Html -> Html
td (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
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]
++ (([Char], HaddockModInfo Name -> Maybe [Char]) -> Maybe HtmlTable)
-> [([Char], HaddockModInfo Name -> Maybe [Char])] -> [HtmlTable]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
          ([Char], HaddockModInfo Name -> Maybe [Char]) -> Maybe HtmlTable
doOneEntry
          [ ([Char]
"License", HaddockModInfo Name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_license)
          , ([Char]
"Maintainer", HaddockModInfo Name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_maintainer)
          , ([Char]
"Stability", HaddockModInfo Name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_stability)
          , ([Char]
"Portability", HaddockModInfo Name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_portability)
          , ([Char]
"Safe Haskell", HaddockModInfo Name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_safety)
          , ([Char]
"Language", HaddockModInfo Name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
lg)
          ]
        [HtmlTable] -> [HtmlTable] -> [HtmlTable]
forall a. [a] -> [a] -> [a]
++ [HtmlTable]
extsForm
      where
        lg :: HaddockModInfo name -> Maybe [Char]
lg HaddockModInfo name
inf = (Language -> [Char]) -> Maybe Language -> Maybe [Char]
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 -> [Char]
forall a. Show a => a -> [Char]
show (HaddockModInfo name -> Maybe Language
forall name. HaddockModInfo name -> Maybe Language
hmi_language HaddockModInfo name
inf)

        multilineRow :: String -> [String] -> HtmlTable
        multilineRow :: [Char] -> [[Char]] -> HtmlTable
multilineRow [Char]
title [[Char]]
xs = (Html -> Html
th (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
valign [Char]
"top"]) (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
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
<< ([[Char]] -> Html
toLines [[Char]]
xs)
          where
            toLines :: [[Char]] -> Html
toLines = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([[Char]] -> [Html]) -> [[Char]] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse Html
br ([Html] -> [Html]) -> ([[Char]] -> [Html]) -> [[Char]] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Html) -> [[Char]] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Html
forall a. HTML a => a -> Html
toHtml

        copyrightsTable :: Maybe HtmlTable
        copyrightsTable :: Maybe HtmlTable
copyrightsTable = ([Char] -> HtmlTable) -> Maybe [Char] -> 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 ([Char] -> [[Char]] -> HtmlTable
multilineRow [Char]
"Copyright" ([[Char]] -> HtmlTable)
-> ([Char] -> [[Char]]) -> [Char] -> HtmlTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
split) (HaddockModInfo Name -> Maybe [Char]
forall name. HaddockModInfo name -> Maybe [Char]
hmi_copyright HaddockModInfo Name
info)
          where
            split :: [Char] -> [[Char]]
split = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
trim ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')) ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
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 :: [[Char]]
fs = (Extension -> [Char]) -> [Extension] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
dropOpt ([Char] -> [Char]) -> (Extension -> [Char]) -> Extension -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> [Char]
forall a. Show a => a -> [Char]
show) (HaddockModInfo Name -> [Extension]
forall name. HaddockModInfo name -> [Extension]
hmi_extensions HaddockModInfo Name
info)
               in case ([Char] -> Html) -> [[Char]] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Html
stringToHtml [[Char]]
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
! [[Char] -> HtmlAttr
theclass [Char]
"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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"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 :: [Char] -> [Char]
dropOpt [Char]
x = if [Char]
"Opt_" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
x then Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
4 [Char]
x else [Char]
x
   in
    case [HtmlTable]
entries of
      [] -> Html
noHtml
      [HtmlTable]
_ -> Html -> Html
table (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"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
-> [Char]
-> [Char]
-> Maybe [Char]
-> Themes
-> Maybe [Char]
-> Maybe [Char]
-> SourceURLs
-> WikiURLs
-> [PackageInterfaces]
-> Bool
-> Maybe (MDoc RdrName)
-> Bool
-> Maybe [Char]
-> Qualification
-> IO ()
ppHtmlContents
  UnitState
state
  [Char]
odir
  [Char]
doctitle
  Maybe [Char]
_maybe_package
  Themes
themes
  Maybe [Char]
mathjax_url
  Maybe [Char]
maybe_index_url
  SourceURLs
maybe_source_url
  WikiURLs
maybe_wiki_url
  [PackageInterfaces]
packages
  Bool
showPkgs
  Maybe (MDoc RdrName)
prologue
  Bool
debug
  Maybe [Char]
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 =
          [Char] -> Themes -> Maybe [Char] -> Maybe [Char] -> Html
headHtml [Char]
doctitle Themes
themes Maybe [Char]
mathjax_url Maybe [Char]
forall a. Maybe a
Nothing
            Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Char]
-> Maybe Interface
-> SourceURLs
-> WikiURLs
-> Maybe [Char]
-> Maybe [Char]
-> Html
-> Html
bodyHtml
              [Char]
doctitle
              Maybe Interface
forall a. Maybe a
Nothing
              SourceURLs
maybe_source_url
              WikiURLs
maybe_wiki_url
              Maybe [Char]
forall a. Maybe a
Nothing
              Maybe [Char]
maybe_index_url
            (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [ Maybe [Char]
-> Qualification -> [Char] -> Maybe (MDoc RdrName) -> Html
ppPrologue Maybe [Char]
pkg Qualification
qual [Char]
doctitle Maybe (MDoc RdrName)
prologue
               , Maybe [Char]
-> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppSignatureTrees Maybe [Char]
pkg Qualification
qual [(PackageInfo, [ModuleTree])]
sig_trees
               , Maybe [Char]
-> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppModuleTrees Maybe [Char]
pkg Qualification
qual [(PackageInfo, [ModuleTree])]
trees
               ]
    Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
odir
    [Char] -> [Char] -> IO ()
writeUtf8File ([[Char]] -> [Char]
joinPath [[Char]
odir, [Char]
contentsHtmlFile]) (Bool -> Html -> [Char]
renderToString Bool
debug Html
html)
    where
      -- Extract a module's short description.
      toInstalledDescription :: InstalledInterface -> Maybe (MDoc Name)
      toInstalledDescription :: InstalledInterface -> Maybe (MDoc Name)
toInstalledDescription = (DocH (Wrap (ModuleName, OccName)) (Wrap Name) -> MDoc Name)
-> Maybe (DocH (Wrap (ModuleName, OccName)) (Wrap 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 DocH (Wrap (ModuleName, OccName)) (Wrap Name) -> MDoc Name
forall a. Doc a -> MDoc a
mkMeta (Maybe (DocH (Wrap (ModuleName, OccName)) (Wrap Name))
 -> Maybe (MDoc Name))
-> (InstalledInterface
    -> Maybe (DocH (Wrap (ModuleName, OccName)) (Wrap Name)))
-> InstalledInterface
-> Maybe (MDoc Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HaddockModInfo Name
-> Maybe (DocH (Wrap (ModuleName, OccName)) (Wrap Name))
forall name. HaddockModInfo name -> Maybe (Doc name)
hmi_description (HaddockModInfo Name
 -> Maybe (DocH (Wrap (ModuleName, OccName)) (Wrap Name)))
-> (InstalledInterface -> HaddockModInfo Name)
-> InstalledInterface
-> Maybe (DocH (Wrap (ModuleName, OccName)) (Wrap 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 ([Char], Visibility) PackageInterfaces -> [PackageInterfaces]
forall k a. Map k a -> [a]
Map.elems (Map ([Char], Visibility) PackageInterfaces -> [PackageInterfaces])
-> Map ([Char], Visibility) PackageInterfaces
-> [PackageInterfaces]
forall a b. (a -> b) -> a -> b
$ (PackageInterfaces -> PackageInterfaces -> PackageInterfaces)
-> [(([Char], Visibility), PackageInterfaces)]
-> Map ([Char], Visibility) PackageInterfaces
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith PackageInterfaces -> PackageInterfaces -> PackageInterfaces
merge ([(([Char], Visibility), PackageInterfaces)]
 -> Map ([Char], Visibility) PackageInterfaces)
-> [(([Char], Visibility), PackageInterfaces)]
-> Map ([Char], Visibility) PackageInterfaces
forall a b. (a -> b) -> a -> b
$ (PackageInterfaces -> (([Char], Visibility), PackageInterfaces))
-> [PackageInterfaces]
-> [(([Char], Visibility), PackageInterfaces)]
forall a b. (a -> b) -> [a] -> [b]
map (\PackageInterfaces
p -> ((PackageInfo -> [Char]
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 [Char]
-> Qualification -> [Char] -> Maybe (MDoc RdrName) -> Html
ppPrologue Maybe [Char]
_ Qualification
_ [Char]
_ Maybe (MDoc RdrName)
Nothing = Html
noHtml
ppPrologue Maybe [Char]
pkg Qualification
qual [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
title Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ (Html -> Html) -> Html -> Html
docElement Html -> Html
thediv (Maybe [Char] -> Qualification -> MDoc RdrName -> Html
rdrDocToHtml Maybe [Char]
pkg Qualification
qual MDoc RdrName
doc))

ppSignatureTrees :: Maybe Package -> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppSignatureTrees :: Maybe [Char]
-> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppSignatureTrees Maybe [Char]
_ 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 [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Signatures" Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe [Char]
-> Qualification -> [Char] -> PackageInfo -> [ModuleTree] -> Html
ppSignatureTree Maybe [Char]
pkg Qualification
qual [Char]
"n" PackageInfo
info [ModuleTree]
ts)
ppSignatureTrees Maybe [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Signatures"
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml
            [ Maybe [Char]
-> Qualification -> [Char] -> PackageInfo -> [ModuleTree] -> Html
ppSignatureTree Maybe [Char]
pkg Qualification
qual ([Char]
"n." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".") 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 [Char]
-> Qualification -> [Char] -> PackageInfo -> [ModuleTree] -> Html
ppSignatureTree Maybe [Char]
_ Qualification
_ [Char]
_ PackageInfo
_ [] = Html
forall a. Monoid a => a
mempty
ppSignatureTree Maybe [Char]
pkg Qualification
qual [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< PackageInfo -> [Char]
ppPackageInfo PackageInfo
info Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe [Char]
-> Qualification -> [[Char]] -> [Char] -> [ModuleTree] -> Html
mkNodeList Maybe [Char]
pkg Qualification
qual [] [Char]
p [ModuleTree]
ts)

ppModuleTrees :: Maybe Package -> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppModuleTrees :: Maybe [Char]
-> Qualification -> [(PackageInfo, [ModuleTree])] -> Html
ppModuleTrees Maybe [Char]
_ 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 [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Modules" Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe [Char]
-> Qualification -> [Char] -> PackageInfo -> [ModuleTree] -> Html
ppModuleTree Maybe [Char]
pkg Qualification
qual [Char]
"n" PackageInfo
info [ModuleTree]
ts)
ppModuleTrees Maybe [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Packages"
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml
            [ Maybe [Char]
-> Qualification -> [Char] -> PackageInfo -> [ModuleTree] -> Html
ppModuleTree Maybe [Char]
pkg Qualification
qual ([Char]
"n." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".") 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 [Char]
-> Qualification -> [Char] -> PackageInfo -> [ModuleTree] -> Html
ppModuleTree Maybe [Char]
_ Qualification
_ [Char]
_ PackageInfo
_ [] = Html
forall a. Monoid a => a
mempty
ppModuleTree Maybe [Char]
pkg Qualification
qual [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< PackageInfo -> [Char]
ppPackageInfo PackageInfo
info Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe [Char]
-> Qualification -> [[Char]] -> [Char] -> [ModuleTree] -> Html
mkNodeList Maybe [Char]
pkg Qualification
qual [] [Char]
p [ModuleTree]
ts)

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

mkNode :: Maybe Package -> Qualification -> [String] -> String -> ModuleTree -> Html
mkNode :: Maybe [Char]
-> Qualification -> [[Char]] -> [Char] -> ModuleTree -> Html
mkNode Maybe [Char]
pkg Qualification
qual [[Char]]
ss [Char]
p (Node [Char]
s Maybe Module
leaf Maybe [Char]
_pkg Maybe [Char]
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) -> [Char] -> [Char] -> [HtmlAttr]
collapseControl [Char]
p [Char]
"module"
      ([ModuleTree]
_, Maybe Module
_) -> [[Char] -> HtmlAttr
theclass [Char]
"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
! [Char] -> [Char] -> [HtmlAttr]
collapseControl [Char]
p [Char]
"" (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
! [[Char] -> HtmlAttr
theclass [Char]
"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 -> [Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
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 [Char] -> Qualification -> MDoc Name -> Html
origDocToHtml Maybe [Char]
pkg Qualification
qual) Maybe (MDoc Name)
short
    htmlPkg :: Html
htmlPkg = Html -> ([Char] -> Html) -> Maybe [Char] -> 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
! [[Char] -> HtmlAttr
theclass [Char]
"package"] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<) Maybe [Char]
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
          [Char] -> DetailsState -> Html -> Html
collapseDetails
            [Char]
p
            DetailsState
DetailsOpen
            ( Html -> Html
thesummary
                (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
theclass [Char]
"hide-when-js-enabled"]
                (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Submodules"
                Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe [Char]
-> Qualification -> [[Char]] -> [Char] -> [ModuleTree] -> Html
mkNodeList Maybe [Char]
pkg Qualification
qual ([Char]
s [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
ss) [Char]
p [ModuleTree]
ts
            )

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

-- * Generate the index

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

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

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

instance FromJSON JsonIndexEntry where
  parseJSON :: Value -> Parser JsonIndexEntry
parseJSON = [Char]
-> (Object -> Parser JsonIndexEntry)
-> Value
-> Parser JsonIndexEntry
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"JsonIndexEntry" ((Object -> Parser JsonIndexEntry)
 -> Value -> Parser JsonIndexEntry)
-> (Object -> Parser JsonIndexEntry)
-> Value
-> Parser JsonIndexEntry
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    [Char] -> [Char] -> [Char] -> [Char] -> JsonIndexEntry
JsonIndexEntry
      ([Char] -> [Char] -> [Char] -> [Char] -> JsonIndexEntry)
-> Parser [Char]
-> Parser ([Char] -> [Char] -> [Char] -> JsonIndexEntry)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> [Char] -> Parser [Char]
forall a. FromJSON a => Object -> [Char] -> Parser a
.: [Char]
"display_html"
      Parser ([Char] -> [Char] -> [Char] -> JsonIndexEntry)
-> Parser [Char] -> Parser ([Char] -> [Char] -> 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 -> [Char] -> Parser [Char]
forall a. FromJSON a => Object -> [Char] -> Parser a
.: [Char]
"name"
      Parser ([Char] -> [Char] -> JsonIndexEntry)
-> Parser [Char] -> Parser ([Char] -> 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 -> [Char] -> Parser [Char]
forall a. FromJSON a => Object -> [Char] -> Parser a
.: [Char]
"module"
      Parser ([Char] -> JsonIndexEntry)
-> Parser [Char] -> 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 -> [Char] -> Parser [Char]
forall a. FromJSON a => Object -> [Char] -> Parser a
.: [Char]
"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 :: [Char]
-> SourceURLs
-> WikiURLs
-> Bool
-> Maybe [Char]
-> QualOption
-> [Interface]
-> [[Char]]
-> IO ()
ppJsonIndex [Char]
odir SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url Bool
unicode Maybe [Char]
pkg QualOption
qual_opt [Interface]
ifaces [[Char]]
installedIfacesPaths = do
  Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
odir
  (errors, installedIndexes) <-
    [Either ([Char], [Char]) [JsonIndexEntry]]
-> ([([Char], [Char])], [[JsonIndexEntry]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
      ([Either ([Char], [Char]) [JsonIndexEntry]]
 -> ([([Char], [Char])], [[JsonIndexEntry]]))
-> IO [Either ([Char], [Char]) [JsonIndexEntry]]
-> IO ([([Char], [Char])], [[JsonIndexEntry]])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO (Either ([Char], [Char]) [JsonIndexEntry]))
-> [[Char]] -> IO [Either ([Char], [Char]) [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
        ( \[Char]
ifaceFile -> do
            let indexFile :: [Char]
indexFile =
                  [Char] -> [Char]
takeDirectory [Char]
ifaceFile
                    [Char] -> [Char] -> [Char]
FilePath.</> [Char]
"doc-index.json"
            a <- [Char] -> IO Bool
doesFileExist [Char]
indexFile
            if a
              then
                bimap (indexFile,) (map (fixLink ifaceFile))
                  <$> eitherDecodeFile @[JsonIndexEntry] indexFile
              else return (Right [])
        )
        [[Char]]
installedIfacesPaths
  traverse_
    (\([Char]
indexFile, [Char]
err) -> [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"haddock: Coudn't parse " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
indexFile [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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 [Char]
-> Qualification
-> ExportItem DocNameI
-> Maybe Html
processExport Bool
True LinksInfo
links_info Bool
unicode Maybe [Char]
pkg Qualification
qual ExportItem DocNameI
item =
          JsonIndexEntry -> Maybe JsonIndexEntry
forall a. a -> Maybe a
Just
            JsonIndexEntry
              { jieHtmlFragment :: [Char]
jieHtmlFragment = Html -> [Char]
forall html. HTML html => html -> [Char]
showHtmlFragment Html
item_html
              , jieName :: [Char]
jieName = [[Char]] -> [Char]
unwords ((DocName -> [Char]) -> [DocName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> [Char]
forall a. NamedThing a => a -> [Char]
getOccString [DocName]
names)
              , jieModule :: [Char]
jieModule = Module -> [Char]
moduleString Module
mdl
              , jieLink :: [Char]
jieLink = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"" ([[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
listToMaybe ((DocName -> [Char]) -> [DocName] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> DocName -> [Char]
forall name. NamedThing name => Module -> name -> [Char]
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 -> [Char]
nameLink Module
mdl = ModuleName -> OccName -> [Char]
moduleNameUrl' (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mdl) (OccName -> [Char]) -> (name -> OccName) -> name -> [Char]
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 :: [Char] -> JsonIndexEntry -> JsonIndexEntry
fixLink [Char]
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 :: [Char]
-> [Char]
-> Maybe [Char]
-> Themes
-> Maybe [Char]
-> Maybe [Char]
-> SourceURLs
-> WikiURLs
-> [InstalledInterface]
-> Bool
-> IO ()
ppHtmlIndex
  [Char]
odir
  [Char]
doctitle
  Maybe [Char]
_maybe_package
  Themes
themes
  Maybe [Char]
maybe_mathjax_url
  Maybe [Char]
maybe_contents_url
  SourceURLs
maybe_source_url
  WikiURLs
maybe_wiki_url
  [InstalledInterface]
ifaces
  Bool
debug = do
    let html :: Html
html =
          Bool -> Maybe Char -> [([Char], Map Name [(Module, Bool)])] -> Html
indexPage
            Bool
split_indices
            Maybe Char
forall a. Maybe a
Nothing
            (if Bool
split_indices then [] else [([Char], Map Name [(Module, Bool)])]
index)

    Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
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 ()) -> [Char] -> IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([([Char], Map Name [(Module, Bool)])] -> Char -> IO ()
do_sub_index [([Char], Map Name [(Module, Bool)])]
index) [Char]
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 -> [([Char], Map Name [(Module, Bool)])] -> Html
indexPage Bool
False Maybe Char
forall a. Maybe a
Nothing [([Char], Map Name [(Module, Bool)])]
index
      [Char] -> [Char] -> IO ()
writeUtf8File ([[Char]] -> [Char]
joinPath [[Char]
odir, [Char] -> [Char]
subIndexHtmlFile [Char]
merged_name]) (Bool -> Html -> [Char]
renderToString Bool
debug Html
mergedhtml)

    [Char] -> [Char] -> IO ()
writeUtf8File ([[Char]] -> [Char]
joinPath [[Char]
odir, [Char]
indexHtmlFile]) (Bool -> Html -> [Char]
renderToString Bool
debug Html
html)
    where
      indexPage :: Bool -> Maybe Char -> [([Char], Map Name [(Module, Bool)])] -> Html
indexPage Bool
showLetters Maybe Char
ch [([Char], Map Name [(Module, Bool)])]
items =
        [Char] -> Themes -> Maybe [Char] -> Maybe [Char] -> Html
headHtml ([Char]
doctitle [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe Char -> [Char]
indexName Maybe Char
ch [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")") Themes
themes Maybe [Char]
maybe_mathjax_url Maybe [Char]
forall a. Maybe a
Nothing
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Char]
-> Maybe Interface
-> SourceURLs
-> WikiURLs
-> Maybe [Char]
-> Maybe [Char]
-> Html
-> Html
bodyHtml
            [Char]
doctitle
            Maybe Interface
forall a. Maybe a
Nothing
            SourceURLs
maybe_source_url
            WikiURLs
maybe_wiki_url
            Maybe [Char]
maybe_contents_url
            Maybe [Char]
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 [([Char], Map Name [(Module, Bool)])] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [([Char], 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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Maybe Char -> [Char]
indexName Maybe Char
ch, [([Char], Map Name [(Module, Bool)])] -> Html
buildIndex [([Char], Map Name [(Module, Bool)])]
items]
             ]

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

      buildIndex :: [([Char], Map Name [(Module, Bool)])] -> Html
buildIndex [([Char], 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 ((([Char], Map Name [(Module, Bool)]) -> HtmlTable)
-> [([Char], Map Name [(Module, Bool)])] -> [HtmlTable]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], Map Name [(Module, Bool)]) -> HtmlTable
indexElt [([Char], 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 = [([Char], Map Name [(Module, Bool)])] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [([Char], 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
            ( ([Char] -> Html) -> [[Char]] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
str -> Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> HtmlAttr
href ([Char] -> [Char]
subIndexHtmlFile [Char]
str)] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
str) ([[Char]] -> [Html]) -> [[Char]] -> [Html]
forall a b. (a -> b) -> a -> b
$
                [ [Char
c] | Char
c <- [Char]
initialChars, (([Char], Map Name [(Module, Bool)]) -> Bool)
-> [([Char], 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)
-> (([Char], Map Name [(Module, Bool)]) -> Char)
-> ([Char], Map Name [(Module, Bool)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toUpper (Char -> Char)
-> (([Char], Map Name [(Module, Bool)]) -> Char)
-> ([Char], Map Name [(Module, Bool)])
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Char
forall a. HasCallStack => [a] -> a
head ([Char] -> Char)
-> (([Char], Map Name [(Module, Bool)]) -> [Char])
-> ([Char], Map Name [(Module, Bool)])
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Map Name [(Module, Bool)]) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], Map Name [(Module, Bool)])]
index
                ]
                  [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
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 :: [Char]
initialChars = [Char
'A' .. Char
'Z'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":!#$%&*+./<=>?@\\^|-~" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_"

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

      index :: [(String, Map GHC.Name [(Module, Bool)])]
      index :: [([Char], Map Name [(Module, Bool)])]
index = (([Char], Map Name [(Module, Bool)])
 -> ([Char], Map Name [(Module, Bool)]) -> Ordering)
-> [([Char], Map Name [(Module, Bool)])]
-> [([Char], Map Name [(Module, Bool)])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ([Char], Map Name [(Module, Bool)])
-> ([Char], Map Name [(Module, Bool)]) -> Ordering
forall {b} {b}. ([Char], b) -> ([Char], b) -> Ordering
cmp (Map [Char] (Map Name [(Module, Bool)])
-> [([Char], Map Name [(Module, Bool)])]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map [Char] (Map Name [(Module, Bool)])
full_index)
        where
          cmp :: ([Char], b) -> ([Char], b) -> Ordering
cmp ([Char]
n1, b
_) ([Char]
n2, b
_) = ([Char] -> [Char]) -> [Char] -> [Char] -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper) [Char]
n1 [Char]
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 [Char] (Map Name [(Module, Bool)])
full_index = (Map [Char] (Map Name [(Module, Bool)])
 -> InstalledInterface -> Map [Char] (Map Name [(Module, Bool)]))
-> Map [Char] (Map Name [(Module, Bool)])
-> [InstalledInterface]
-> Map [Char] (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 [Char] (Map Name [(Module, Bool)])
-> InstalledInterface -> Map [Char] (Map Name [(Module, Bool)])
f Map [Char] (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 [Char] (Map Name [(Module, Bool)])
-> InstalledInterface -> Map [Char] (Map Name [(Module, Bool)])
f !Map [Char] (Map Name [(Module, Bool)])
idx InstalledInterface
iface =
            (Map Name [(Module, Bool)]
 -> Map Name [(Module, Bool)] -> Map Name [(Module, Bool)])
-> Map [Char] (Map Name [(Module, Bool)])
-> Map [Char] (Map Name [(Module, Bool)])
-> Map [Char] (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 [Char] (Map Name [(Module, Bool)])
idx
              (InstalledInterface -> Map [Char] (Map Name [(Module, Bool)])
getIfaceIndex InstalledInterface
iface)

      getIfaceIndex :: InstalledInterface -> Map String (Map Name [(Module, Bool)])
      getIfaceIndex :: InstalledInterface -> Map [Char] (Map Name [(Module, Bool)])
getIfaceIndex InstalledInterface
iface =
        (Map [Char] (Map Name [(Module, Bool)])
 -> Name -> Map [Char] (Map Name [(Module, Bool)]))
-> Map [Char] (Map Name [(Module, Bool)])
-> [Name]
-> Map [Char] (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 [Char] (Map Name [(Module, Bool)])
-> Name -> Map [Char] (Map Name [(Module, Bool)])
f Map [Char] (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 [Char] (Map Name [(Module, Bool)])
-> Name -> Map [Char] (Map Name [(Module, Bool)])
f !Map [Char] (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)])
-> [Char]
-> Map Name [(Module, Bool)]
-> Map [Char] (Map Name [(Module, Bool)])
-> Map [Char] (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 -> [Char]
forall a. NamedThing a => a -> [Char]
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 [Char] (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 :: ([Char], Map Name [(Module, Bool)]) -> HtmlTable
indexElt ([Char]
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
! [[Char] -> HtmlAttr
theclass [Char]
"src"]
              (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
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
! [[Char] -> HtmlAttr
theclass [Char]
"src"]
              (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
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
! [[Char] -> HtmlAttr
theclass [Char]
"alt"]
          (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char] -> Html
forall a. HTML a => a -> Html
toHtml (Integer -> [Char]
forall a. Show a => a -> [Char]
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) = [Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
"Type/Class"
        | OccName -> Bool
isDataOcc OccName
n = [Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
"Data Constructor"
        | Bool
otherwise = [Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
"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
! [[Char] -> HtmlAttr
theclass [Char]
"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
<< [Char] -> Html
forall a. HTML a => a -> Html
toHtml (Module -> [Char]
moduleString Module
mdl)
                  else [Char] -> Html
forall a. HTML a => a -> Html
toHtml (Module -> [Char]
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 :: [Char]
-> [Char]
-> Themes
-> Maybe [Char]
-> SourceURLs
-> WikiURLs
-> Maybe [Char]
-> Maybe [Char]
-> Maybe [Char]
-> Bool
-> Maybe [Char]
-> QualOption
-> Bool
-> Interface
-> IO ()
ppHtmlModule
  [Char]
odir
  [Char]
doctitle
  Themes
themes
  Maybe [Char]
maybe_mathjax_url
  SourceURLs
maybe_source_url
  WikiURLs
maybe_wiki_url
  Maybe [Char]
maybe_base_url
  Maybe [Char]
maybe_contents_url
  Maybe [Char]
maybe_index_url
  Bool
unicode
  Maybe [Char]
pkg
  QualOption
qual
  Bool
debug
  Interface
iface = do
    let
      mdl :: Module
mdl = Interface -> Module
ifaceMod Interface
iface
      mdl_str :: [Char]
mdl_str = Module -> [Char]
moduleString Module
mdl
      mdl_str_annot :: [Char]
mdl_str_annot =
        [Char]
mdl_str
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Interface -> Bool
ifaceIsSig Interface
iface
            then [Char]
" (signature)"
            else [Char]
""
      mdl_str_linked :: Html
mdl_str_linked
        | Interface -> Bool
ifaceIsSig Interface
iface =
            [Char]
mdl_str
              [Char] -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Char]
" (signature"
              [Char] -> 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
<< ([Char]
"[" [Char] -> 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
! [[Char] -> HtmlAttr
href [Char]
signatureDocURL] (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"?" Html -> [Char] -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Char]
"]")
              Html -> [Char] -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Char]
")"
        | Bool
otherwise =
            [Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
mdl_str
      real_qual :: Qualification
real_qual = QualOption -> Module -> Qualification
makeModuleQual QualOption
qual Module
mdl
      html :: Html
html =
        [Char] -> Themes -> Maybe [Char] -> Maybe [Char] -> Html
headHtml [Char]
mdl_str_annot Themes
themes Maybe [Char]
maybe_mathjax_url Maybe [Char]
maybe_base_url
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ [Char]
-> Maybe Interface
-> SourceURLs
-> WikiURLs
-> Maybe [Char]
-> Maybe [Char]
-> Html
-> Html
bodyHtml
            [Char]
doctitle
            (Interface -> Maybe Interface
forall a. a -> Maybe a
Just Interface
iface)
            SourceURLs
maybe_source_url
            WikiURLs
maybe_wiki_url
            Maybe [Char]
maybe_contents_url
            Maybe [Char]
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 [Char]
-> Qualification
-> Html
ifaceToHtml SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url Interface
iface Bool
unicode Maybe [Char]
pkg Qualification
real_qual
             ]

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

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

ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Maybe Package -> Qualification -> Html
ifaceToHtml :: SourceURLs
-> WikiURLs
-> Interface
-> Bool
-> Maybe [Char]
-> Qualification
-> Html
ifaceToHtml SourceURLs
maybe_source_url WikiURLs
maybe_wiki_url Interface
iface Bool
unicode Maybe [Char]
pkg Qualification
qual =
  Maybe [Char]
-> Qualification -> [ExportItem DocNameI] -> Bool -> Html
ppModuleContents Maybe [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Description" Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
doc
      where
        doc :: Html
doc = Maybe Name
-> Maybe [Char] -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
forall a. Maybe a
Nothing Maybe [Char]
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
$
            [Char] -> DetailsState -> Html -> Html
collapseDetails
              [Char]
"syn"
              DetailsState
DetailsClosed
              ( Html -> Html
thesummary
                  (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"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 [Char]
-> Qualification
-> ExportItem DocNameI
-> Maybe Html
processExport Bool
True LinksInfo
linksInfo Bool
unicode Maybe [Char]
pkg Qualification
qual) [ExportItem DocNameI]
exports
                    )
                  Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [Char] -> [Char] -> [HtmlAttr]
collapseToggle [Char]
"syn" [Char]
""
              )

    -- 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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"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 [Char]
-> Qualification
-> ExportItem DocNameI
-> Maybe Html
processExport Bool
False LinksInfo
linksInfo Bool
unicode Maybe [Char]
pkg Qualification
qual) [ExportItem DocNameI]
exports

    orphans :: Html
orphans =
      LinksInfo
-> [DocInstance DocNameI]
-> Bool
-> Bool
-> Maybe [Char]
-> Qualification
-> Html
ppOrphanInstances LinksInfo
linksInfo (Interface -> [DocInstance DocNameI]
ifaceRnOrphanInstances Interface
iface) Bool
False Bool
unicode Maybe [Char]
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 [Char]
-> Qualification -> [ExportItem DocNameI] -> Bool -> Html
ppModuleContents Maybe [Char]
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) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"Contents")
                    Html -> [HtmlAttr] -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [[Char] -> [Char] -> HtmlAttr
strAttr [Char]
"onclick" [Char]
"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 = [[Char] -> Html -> Html
linkedAnchor [Char]
"section.orphans" (Html -> Html) -> [Char] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< [Char]
"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 [Char]
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 =
          [Char] -> Html -> Html
linkedAnchor ([Char] -> [Char]
groupId [Char]
id0)
            (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Maybe [Char]
-> Maybe [Char] -> Qualification -> MDoc DocName -> Html
docToHtmlNoAnchors ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
id0) Maybe [Char]
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 [Char]
_ Doc (IdP DocNameI)
doc : [ExportItem DocNameI]
es) =
      case Doc DocName -> [[Char]]
collectAnchors Doc (IdP DocNameI)
Doc DocName
doc of
        [] -> Int -> [Char] -> Doc (IdP DocNameI) -> ExportItem DocNameI
forall name. Int -> [Char] -> Doc (IdP name) -> ExportItem name
ExportGroup Int
lev (Int -> [Char]
forall a. Show a => a -> [Char]
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
        ([Char]
a : [[Char]]
_) -> Int -> [Char] -> Doc (IdP DocNameI) -> ExportItem DocNameI
forall name. Int -> [Char] -> Doc (IdP name) -> ExportItem name
ExportGroup Int
lev [Char]
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 -> [[Char]]
collectAnchors (DocAppend Doc DocName
a Doc DocName
b) = Doc DocName -> [[Char]]
collectAnchors Doc DocName
a [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Doc DocName -> [[Char]]
collectAnchors Doc DocName
b
    collectAnchors (DocAName [Char]
a) = [[Char]
a]
    collectAnchors Doc DocName
_ = []

processExport
  :: Bool
  -> LinksInfo
  -> Bool
  -> Maybe Package
  -> Qualification
  -> ExportItem DocNameI
  -> Maybe Html
processExport :: Bool
-> LinksInfo
-> Bool
-> Maybe [Char]
-> Qualification
-> ExportItem DocNameI
-> Maybe Html
processExport
  Bool
_
  LinksInfo
_
  Bool
_
  Maybe [Char]
_
  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 [Char]
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 [Char]
-> 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 [Char]
pkg Qualification
qual
processExport Bool
summary LinksInfo
_ Bool
_ Maybe [Char]
pkg Qualification
qual (ExportGroup Int
lev [Char]
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 -> [Char] -> Html -> Html
groupHeading Int
lev [Char]
id0 (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Maybe [Char]
-> Maybe [Char] -> Qualification -> MDoc DocName -> Html
docToHtmlNoAnchors ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
id0) Maybe [Char]
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 [Char]
_ 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 [Char]
_ 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 [Char]
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 [Char] -> Qualification -> MDoc DocName -> Html
docSection_ Maybe Name
forall a. Maybe a
Nothing Maybe [Char]
pkg Qualification
qual MDoc (IdP DocNameI)
MDoc DocName
doc
processExport Bool
summary LinksInfo
_ Bool
_ Maybe [Char]
_ Qualification
_ (ExportModule Module
mdl) =
  Bool -> Html -> Maybe Html
processDeclOneLiner Bool
summary (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ [Char] -> Html
forall a. HTML a => a -> Html
toHtml [Char]
"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 :: [Char] -> [Char]
trim = [Char] -> [Char]
f ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
f
  where
    f :: [Char] -> [Char]
f = [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
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 -> [Char] -> Html -> Html
groupHeading Int
lev [Char]
id0 = [Char] -> Html -> Html
linkedAnchor [Char]
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
! [[Char] -> HtmlAttr
identifier [Char]
grpId]
  where
    grpId :: [Char]
grpId = [Char] -> [Char]
groupId [Char]
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