{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TransformListComp #-}
{-# LANGUAGE TypeFamilies #-}

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

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

-- |
-- Module      :  Haddock.Backends.Xhtml.Decl
-- Copyright   :  (c) Simon Marlow   2003-2006,
--                    David Waern    2006-2009,
--                    Mark Lentczner 2010
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
module Haddock.Backends.Xhtml.Decl
  ( ppDecl
  , ppOrphanInstances
  ) where

import Data.Foldable (toList)
import Data.List (intersperse, sort)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import GHC hiding (LexicalFixity (..), fromMaybeContext)
import GHC.Core.Type (Specificity (..))
import GHC.Data.BooleanFormula
import GHC.Exts hiding (toList)
import GHC.Types.Name
import GHC.Types.Name.Reader (rdrNameOcc)
import Text.XHtml hiding (name, p, quote, title)

import Haddock.Backends.Xhtml.DocMarkup
import Haddock.Backends.Xhtml.Layout
import Haddock.Backends.Xhtml.Names
import Haddock.Backends.Xhtml.Types
import Haddock.Backends.Xhtml.Utils
import Haddock.Doc (combineDocumentation)
import Haddock.GhcUtils
import Haddock.Types

-- | Pretty print a declaration
ppDecl
  :: Bool
  -- ^ print summary info only
  -> LinksInfo
  -- ^ link information
  -> LHsDecl DocNameI
  -- ^ declaration to print
  -> [(HsDecl DocNameI, DocForDecl DocName)]
  -- ^ relevant pattern synonyms
  -> DocForDecl DocName
  -- ^ documentation for this decl
  -> [DocInstance DocNameI]
  -- ^ relevant instances
  -> [(DocName, Fixity)]
  -- ^ relevant fixities
  -> [(DocName, DocForDecl DocName)]
  -- ^ documentation for all decls
  -> Splice
  -> Unicode
  -- ^ unicode output
  -> Maybe Package
  -> Qualification
  -> Html
ppDecl :: Bool
-> LinksInfo
-> LHsDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> DocForDecl DocName
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> [(DocName, DocForDecl DocName)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppDecl Bool
summ LinksInfo
links (L SrcSpanAnnA
loc HsDecl DocNameI
decl) [(HsDecl DocNameI, DocForDecl DocName)]
pats (Documentation DocName
mbDoc, FnArgsDoc DocName
fnArgsDoc) [DocInstance DocNameI]
instances [(DocName, Fixity)]
fixities [(DocName, DocForDecl DocName)]
subdocs Bool
splice Bool
unicode Maybe String
pkg Qualification
qual = case HsDecl DocNameI
decl of
  TyClD XTyClD DocNameI
_ (FamDecl XFamDecl DocNameI
_ FamilyDecl DocNameI
d) -> Bool
-> Bool
-> LinksInfo
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> SrcSpan
-> Documentation DocName
-> FamilyDecl DocNameI
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFamDecl Bool
summ Bool
False LinksInfo
links [DocInstance DocNameI]
instances [(DocName, Fixity)]
fixities (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) Documentation DocName
mbDoc FamilyDecl DocNameI
d Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
  TyClD XTyClD DocNameI
_ d :: TyClDecl DocNameI
d@(DataDecl{}) -> Bool
-> LinksInfo
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> [(DocName, DocForDecl DocName)]
-> SrcSpan
-> Documentation DocName
-> TyClDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppDataDecl Bool
summ LinksInfo
links [DocInstance DocNameI]
instances [(DocName, Fixity)]
fixities [(DocName, DocForDecl DocName)]
subdocs (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) Documentation DocName
mbDoc TyClDecl DocNameI
d [(HsDecl DocNameI, DocForDecl DocName)]
pats Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
  TyClD XTyClD DocNameI
_ d :: TyClDecl DocNameI
d@(SynDecl{}) -> Bool
-> LinksInfo
-> [(DocName, Fixity)]
-> SrcSpan
-> DocForDecl DocName
-> TyClDecl DocNameI
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppTySyn Bool
summ LinksInfo
links [(DocName, Fixity)]
fixities (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (Documentation DocName
mbDoc, FnArgsDoc DocName
fnArgsDoc) TyClDecl DocNameI
d Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
  TyClD XTyClD DocNameI
_ d :: TyClDecl DocNameI
d@(ClassDecl{}) -> Bool
-> LinksInfo
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> SrcSpan
-> Documentation DocName
-> [(DocName, DocForDecl DocName)]
-> TyClDecl DocNameI
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppClassDecl Bool
summ LinksInfo
links [DocInstance DocNameI]
instances [(DocName, Fixity)]
fixities (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) Documentation DocName
mbDoc [(DocName, DocForDecl DocName)]
subdocs TyClDecl DocNameI
d Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
  SigD XSigD DocNameI
_ (TypeSig XTypeSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigWcType DocNameI
lty) ->
    Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> [GenLocated SrcSpanAnnN DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppLFunSig
      Bool
summ
      LinksInfo
links
      (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc)
      (Documentation DocName
mbDoc, FnArgsDoc DocName
fnArgsDoc)
      [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames
      (LHsSigWcType DocNameI -> LHsSigType DocNameI
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType DocNameI
lty)
      [(DocName, Fixity)]
fixities
      Bool
splice
      Bool
unicode
      Maybe String
pkg
      Qualification
qual
  SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigType DocNameI
lty) ->
    Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> [GenLocated SrcSpanAnnN DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppLPatSig
      Bool
summ
      LinksInfo
links
      (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc)
      (Documentation DocName
mbDoc, FnArgsDoc DocName
fnArgsDoc)
      [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames
      LHsSigType DocNameI
lty
      [(DocName, Fixity)]
fixities
      Bool
splice
      Bool
unicode
      Maybe String
pkg
      Qualification
qual
  ForD XForD DocNameI
_ ForeignDecl DocNameI
d -> Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> ForeignDecl DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFor Bool
summ LinksInfo
links (SrcSpanAnnA -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnA
loc) (Documentation DocName
mbDoc, FnArgsDoc DocName
fnArgsDoc) ForeignDecl DocNameI
d [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
  InstD XInstD DocNameI
_ InstDecl DocNameI
_ -> Html
noHtml
  DerivD XDerivD DocNameI
_ DerivDecl DocNameI
_ -> Html
noHtml
  HsDecl DocNameI
_ -> String -> Html
forall a. HasCallStack => String -> a
error String
"declaration not supported by ppDecl"

ppLFunSig
  :: Bool
  -> LinksInfo
  -> SrcSpan
  -> DocForDecl DocName
  -> [LocatedN DocName]
  -> LHsSigType DocNameI
  -> [(DocName, Fixity)]
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppLFunSig :: Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> [GenLocated SrcSpanAnnN DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppLFunSig Bool
summary LinksInfo
links SrcSpan
loc DocForDecl DocName
doc [GenLocated SrcSpanAnnN DocName]
lnames LHsSigType DocNameI
lty [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe String
pkg Qualification
qual =
  Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFunSig
    Bool
summary
    LinksInfo
links
    SrcSpan
loc
    Html
noHtml
    DocForDecl DocName
doc
    ((GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [GenLocated SrcSpanAnnN DocName]
lnames)
    LHsSigType DocNameI
lty
    [(DocName, Fixity)]
fixities
    Bool
splice
    Bool
unicode
    Maybe String
pkg
    Qualification
qual

ppFunSig
  :: Bool
  -> LinksInfo
  -> SrcSpan
  -> Html
  -> DocForDecl DocName
  -> [DocName]
  -> LHsSigType DocNameI
  -> [(DocName, Fixity)]
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppFunSig :: Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFunSig Bool
summary LinksInfo
links SrcSpan
loc Html
leader DocForDecl DocName
doc [DocName]
docnames LHsSigType DocNameI
typ [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe String
pkg Qualification
qual =
  Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> [(DocName, Fixity)]
-> (HsSigType DocNameI, Html)
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> HideEmptyContexts
-> Html
ppSigLike
    Bool
summary
    LinksInfo
links
    SrcSpan
loc
    Html
leader
    DocForDecl DocName
doc
    [DocName]
docnames
    [(DocName, Fixity)]
fixities
    (GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsSigType DocNameI
GenLocated SrcSpanAnnA (HsSigType DocNameI)
typ, Html
pp_typ)
    Bool
splice
    Bool
unicode
    Maybe String
pkg
    Qualification
qual
    HideEmptyContexts
HideEmptyContexts
  where
    pp_typ :: Html
pp_typ = Bool
-> Qualification
-> HideEmptyContexts
-> LHsSigType DocNameI
-> Html
ppLSigType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts LHsSigType DocNameI
typ

-- | Pretty print a pattern synonym
ppLPatSig
  :: Bool
  -> LinksInfo
  -> SrcSpan
  -> DocForDecl DocName
  -> [LocatedN DocName]
  -- ^ names of patterns in declaration
  -> LHsSigType DocNameI
  -- ^ type of patterns in declaration
  -> [(DocName, Fixity)]
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppLPatSig :: Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> [GenLocated SrcSpanAnnN DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppLPatSig Bool
summary LinksInfo
links SrcSpan
loc DocForDecl DocName
doc [GenLocated SrcSpanAnnN DocName]
lnames LHsSigType DocNameI
typ [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe String
pkg Qualification
qual =
  Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> [(DocName, Fixity)]
-> (HsSigType DocNameI, Html)
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> HideEmptyContexts
-> Html
ppSigLike
    Bool
summary
    LinksInfo
links
    SrcSpan
loc
    (String -> Html
keyword String
"pattern")
    DocForDecl DocName
doc
    ((GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [GenLocated SrcSpanAnnN DocName]
lnames)
    [(DocName, Fixity)]
fixities
    (GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsSigType DocNameI
GenLocated SrcSpanAnnA (HsSigType DocNameI)
typ, Html
pp_typ)
    Bool
splice
    Bool
unicode
    Maybe String
pkg
    Qualification
qual
    (LHsSigType DocNameI -> HideEmptyContexts
patSigContext LHsSigType DocNameI
typ)
  where
    pp_typ :: Html
pp_typ = Bool -> Qualification -> LHsSigType DocNameI -> Html
ppPatSigType Bool
unicode Qualification
qual LHsSigType DocNameI
typ

ppSigLike
  :: Bool
  -> LinksInfo
  -> SrcSpan
  -> Html
  -> DocForDecl DocName
  -> [DocName]
  -> [(DocName, Fixity)]
  -> (HsSigType DocNameI, Html)
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> HideEmptyContexts
  -> Html
ppSigLike :: Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> [(DocName, Fixity)]
-> (HsSigType DocNameI, Html)
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> HideEmptyContexts
-> Html
ppSigLike
  Bool
summary
  LinksInfo
links
  SrcSpan
loc
  Html
leader
  DocForDecl DocName
doc
  [DocName]
docnames
  [(DocName, Fixity)]
fixities
  (HsSigType DocNameI
typ, Html
pp_typ)
  Bool
splice
  Bool
unicode
  Maybe String
pkg
  Qualification
qual
  HideEmptyContexts
emptyCtxts =
    Bool
-> LinksInfo
-> SrcSpan
-> [DocName]
-> HsSigType DocNameI
-> DocForDecl DocName
-> (Html, Html, Html)
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> HideEmptyContexts
-> Html
ppTypeOrFunSig
      Bool
summary
      LinksInfo
links
      SrcSpan
loc
      [DocName]
docnames
      HsSigType DocNameI
typ
      DocForDecl DocName
doc
      ( Html -> Html
addFixities (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
leader Html -> Html -> Html
<+> Bool -> [OccName] -> Html -> Bool -> Html
ppTypeSig Bool
summary [OccName]
occnames Html
pp_typ Bool
unicode
      , (Html
leader Html -> Html -> Html
<+>) (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
addFixities (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ([Html] -> Html) -> ([Html] -> [Html]) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Html] -> [Html]
punctuate Html
comma ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (OccName -> Html) -> [OccName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinder Bool
False) [OccName]
occnames
      , Bool -> Html
dcolon Bool
unicode
      )
      Bool
splice
      Bool
unicode
      Maybe String
pkg
      Qualification
qual
      HideEmptyContexts
emptyCtxts
    where
      occnames :: [OccName]
occnames = (DocName -> OccName) -> [DocName] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> OccName
nameOccName (Name -> OccName) -> (DocName -> Name) -> DocName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName) [DocName]
docnames
      addFixities :: Html -> Html
addFixities Html
html
        | Bool
summary = Html
html
        | Bool
otherwise = Html
html Html -> Html -> Html
<+> [(DocName, Fixity)] -> Qualification -> Html
ppFixities [(DocName, Fixity)]
fixities Qualification
qual

ppTypeOrFunSig
  :: Bool
  -> LinksInfo
  -> SrcSpan
  -> [DocName]
  -> HsSigType DocNameI
  -> DocForDecl DocName
  -> (Html, Html, Html)
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> HideEmptyContexts
  -> Html
ppTypeOrFunSig :: Bool
-> LinksInfo
-> SrcSpan
-> [DocName]
-> HsSigType DocNameI
-> DocForDecl DocName
-> (Html, Html, Html)
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> HideEmptyContexts
-> Html
ppTypeOrFunSig
  Bool
summary
  LinksInfo
links
  SrcSpan
loc
  [DocName]
docnames
  HsSigType DocNameI
typ
  (Documentation DocName
doc, FnArgsDoc DocName
argDocs)
  (Html
pref1, Html
pref2, Html
sep)
  Bool
splice
  Bool
unicode
  Maybe String
pkg
  Qualification
qual
  HideEmptyContexts
emptyCtxts
    | Bool
summary = Html
pref1
    | FnArgsDoc DocName -> Bool
forall k a. Map k a -> Bool
Map.null FnArgsDoc DocName
argDocs = LinksInfo -> SrcSpan -> Bool -> DocName -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice DocName
docName Html
pref1 Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe Name
-> Maybe String -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe String
pkg Qualification
qual Documentation DocName
doc
    | Bool
otherwise =
        LinksInfo -> SrcSpan -> Bool -> DocName -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice DocName
docName Html
pref2
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe String -> Qualification -> [SubDecl] -> Html
subArguments Maybe String
pkg Qualification
qual (Bool
-> Qualification
-> HsSigType DocNameI
-> FnArgsDoc DocName
-> [(DocName, DocForDecl DocName)]
-> Html
-> HideEmptyContexts
-> [SubDecl]
ppSubSigLike Bool
unicode Qualification
qual HsSigType DocNameI
typ FnArgsDoc DocName
argDocs [] Html
sep HideEmptyContexts
emptyCtxts)
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe Name
-> Maybe String -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe String
pkg Qualification
qual Documentation DocName
doc
    where
      curname :: Maybe Name
curname = DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name) -> Maybe DocName -> Maybe Name
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [DocName] -> Maybe DocName
forall a. [a] -> Maybe a
Maybe.listToMaybe [DocName]
docnames
      docName :: DocName
docName =
        case [DocName] -> Maybe DocName
forall a. [a] -> Maybe a
Maybe.listToMaybe [DocName]
docnames of
          Maybe DocName
Nothing -> String -> DocName
forall a. HasCallStack => String -> a
error String
"No docnames. An invariant was broken. Please report this to the Haddock project"
          Just DocName
hd -> DocName
hd

-- | This splits up a type signature along @->@ and adds docs (when they exist)
-- to the arguments.
--
-- If one passes in a list of the available subdocs, any top-level `HsRecTy`
-- found will be expanded out into their fields.
ppSubSigLike
  :: Unicode
  -> Qualification
  -> HsSigType DocNameI
  -- ^ type signature
  -> FnArgsDoc DocName
  -- ^ docs to add
  -> [(DocName, DocForDecl DocName)]
  -- ^ all subdocs (useful when
  -- we expand an `HsRecTy`)
  -> Html
  -> HideEmptyContexts
  -> [SubDecl]
ppSubSigLike :: Bool
-> Qualification
-> HsSigType DocNameI
-> FnArgsDoc DocName
-> [(DocName, DocForDecl DocName)]
-> Html
-> HideEmptyContexts
-> [SubDecl]
ppSubSigLike Bool
unicode Qualification
qual HsSigType DocNameI
typ FnArgsDoc DocName
argDocs [(DocName, DocForDecl DocName)]
subdocs Html
sep HideEmptyContexts
emptyCtxts = Int -> Html -> HsSigType DocNameI -> [SubDecl]
do_sig_args Int
0 Html
sep HsSigType DocNameI
typ
  where
    do_sig_args :: Int -> Html -> HsSigType DocNameI -> [SubDecl]
    do_sig_args :: Int -> Html -> HsSigType DocNameI -> [SubDecl]
do_sig_args Int
n Html
leader (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs DocNameI
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = XRec DocNameI (HsType DocNameI)
ltype}) =
      case HsOuterSigTyVarBndrs DocNameI
outer_bndrs of
        HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc DocNameI)]
bndrs} -> Int -> Html -> XRec DocNameI (HsType DocNameI) -> [SubDecl]
do_largs Int
n ([GenLocated SrcSpanAnnA (HsTyVarBndr Specificity DocNameI)] -> Html
leader' [LHsTyVarBndr Specificity (NoGhcTc DocNameI)]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity DocNameI)]
bndrs) XRec DocNameI (HsType DocNameI)
ltype
        HsOuterImplicit{} -> Int -> Html -> XRec DocNameI (HsType DocNameI) -> [SubDecl]
do_largs Int
n Html
leader XRec DocNameI (HsType DocNameI)
ltype
      where
        leader' :: [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity DocNameI)] -> Html
leader' [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity DocNameI)]
bndrs = Html
leader Html -> Html -> Html
<+> Bool -> Qualification -> HsForAllTelescope DocNameI -> Html
ppForAllPart Bool
unicode Qualification
qual ([LHsTyVarBndr Specificity DocNameI] -> HsForAllTelescope DocNameI
mkHsForAllInvisTeleI [LHsTyVarBndr Specificity DocNameI]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity DocNameI)]
bndrs)

    argDoc :: Int -> Maybe (MDoc DocName)
argDoc Int
n = Int -> FnArgsDoc DocName -> Maybe (MDoc DocName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
n FnArgsDoc DocName
argDocs

    do_largs :: Int -> Html -> LHsType DocNameI -> [SubDecl]
    do_largs :: Int -> Html -> XRec DocNameI (HsType DocNameI) -> [SubDecl]
do_largs Int
n Html
leader (L SrcSpanAnnA
_ HsType DocNameI
t) = Int -> Html -> HsType DocNameI -> [SubDecl]
do_args Int
n Html
leader HsType DocNameI
t

    do_args :: Int -> Html -> HsType DocNameI -> [SubDecl]
    do_args :: Int -> Html -> HsType DocNameI -> [SubDecl]
do_args Int
n Html
leader (HsForAllTy XForAllTy DocNameI
_ HsForAllTelescope DocNameI
tele XRec DocNameI (HsType DocNameI)
ltype) =
      Int -> Html -> XRec DocNameI (HsType DocNameI) -> [SubDecl]
do_largs Int
n Html
leader' XRec DocNameI (HsType DocNameI)
ltype
      where
        leader' :: Html
leader' = Html
leader Html -> Html -> Html
<+> Bool -> Qualification -> HsForAllTelescope DocNameI -> Html
ppForAllPart Bool
unicode Qualification
qual HsForAllTelescope DocNameI
tele
    do_args Int
n Html
leader (HsQualTy XQualTy DocNameI
_ LHsContext DocNameI
lctxt XRec DocNameI (HsType DocNameI)
ltype)
      | [GenLocated SrcSpanAnnA (HsType DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
-> [GenLocated SrcSpanAnnA (HsType DocNameI)]
forall l e. GenLocated l e -> e
unLoc LHsContext DocNameI
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
lctxt) =
          Int -> Html -> XRec DocNameI (HsType DocNameI) -> [SubDecl]
do_largs Int
n Html
leader XRec DocNameI (HsType DocNameI)
ltype
      | Bool
otherwise =
          (Html
leader Html -> Html -> Html
<+> LHsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContextNoArrow LHsContext DocNameI
lctxt Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts, Maybe (MDoc DocName)
forall a. Maybe a
Nothing, [])
            SubDecl -> [SubDecl] -> [SubDecl]
forall a. a -> [a] -> [a]
: Int -> Html -> XRec DocNameI (HsType DocNameI) -> [SubDecl]
do_largs Int
n (Bool -> Html
darrow Bool
unicode) XRec DocNameI (HsType DocNameI)
ltype
    do_args Int
n Html
leader (HsFunTy XFunTy DocNameI
_ HsArrow DocNameI
_w (L SrcSpanAnnA
_ (HsRecTy XRecTy DocNameI
_ [LConDeclField DocNameI]
fields)) XRec DocNameI (HsType DocNameI)
r) =
      [ (Html
ldr Html -> Html -> Html
<+> Html
html, Maybe (MDoc DocName)
mdoc, [Html]
subs)
      | (L SrcSpan
_ ConDeclField DocNameI
field, Html
ldr) <- [GenLocated SrcSpan (ConDeclField DocNameI)]
-> [Html] -> [(GenLocated SrcSpan (ConDeclField DocNameI), Html)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LConDeclField DocNameI]
[GenLocated SrcSpan (ConDeclField DocNameI)]
fields (Html
leader Html -> Html -> Html
<+> Html
gadtOpen Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Html -> [Html]
forall a. a -> [a]
repeat Html
gadtComma)
      , let (Html
html, Maybe (MDoc DocName)
mdoc, [Html]
subs) = [(DocName, DocForDecl DocName)]
-> Bool -> Qualification -> ConDeclField DocNameI -> SubDecl
ppSideBySideField [(DocName, DocForDecl DocName)]
subdocs Bool
unicode Qualification
qual ConDeclField DocNameI
field
      ]
        [SubDecl] -> [SubDecl] -> [SubDecl]
forall a. [a] -> [a] -> [a]
++ Int -> Html -> XRec DocNameI (HsType DocNameI) -> [SubDecl]
do_largs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Html
gadtEnd Html -> Html -> Html
<+> Bool -> Html
arrow Bool
unicode) XRec DocNameI (HsType DocNameI)
r
    do_args Int
n Html
leader (HsFunTy XFunTy DocNameI
_ HsArrow DocNameI
_w XRec DocNameI (HsType DocNameI)
lt XRec DocNameI (HsType DocNameI)
r) =
      (Html
leader Html -> Html -> Html
<+> Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLFunLhType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts XRec DocNameI (HsType DocNameI)
lt, Int -> Maybe (MDoc DocName)
argDoc Int
n, [])
        SubDecl -> [SubDecl] -> [SubDecl]
forall a. a -> [a] -> [a]
: Int -> Html -> XRec DocNameI (HsType DocNameI) -> [SubDecl]
do_largs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Bool -> Html
arrow Bool
unicode) XRec DocNameI (HsType DocNameI)
r
    do_args Int
n Html
leader HsType DocNameI
t =
      [(Html
leader Html -> Html -> Html
<+> Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts HsType DocNameI
t, Int -> Maybe (MDoc DocName)
argDoc Int
n, [])]

    -- FIXME: this should be done more elegantly
    --
    -- We need 'gadtComma' and 'gadtEnd' to line up with the `{` from
    -- 'gadtOpen', so we add 3 spaces to cover for `-> `/`:: ` (3 in unicode
    -- mode since `->` and `::` are rendered as single characters.
    gadtComma :: Html
gadtComma = [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml (Int -> Html -> [Html]
forall a. Int -> a -> [a]
replicate (if Bool
unicode then Int
2 else Int
3) Html
spaceHtml) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. HTML a => a -> Html
toHtml String
","
    gadtEnd :: Html
gadtEnd = [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml (Int -> Html -> [Html]
forall a. Int -> a -> [a]
replicate (if Bool
unicode then Int
2 else Int
3) Html
spaceHtml) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. HTML a => a -> Html
toHtml String
"}"
    gadtOpen :: Html
gadtOpen = String -> Html
forall a. HTML a => a -> Html
toHtml String
"{"

ppFixities :: [(DocName, Fixity)] -> Qualification -> Html
ppFixities :: [(DocName, Fixity)] -> Qualification -> Html
ppFixities [] Qualification
_ = Html
noHtml
ppFixities [(DocName, Fixity)]
fs Qualification
qual = (Html -> Html -> Html) -> [Html] -> Html
forall a. (a -> a -> a) -> [a] -> a
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldr1 Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
(+++) ((([DocName], Int, String) -> Html)
-> [([DocName], Int, String)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ([DocName], Int, String) -> Html
ppFix [([DocName], Int, String)]
uniq_fs) Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
rightEdge
  where
    ppFix :: ([DocName], Int, String) -> Html
ppFix ([DocName]
ns, Int
p, String
d) =
      Html -> Html
thespan
        (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"fixity"]
        (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (String -> Html
forall a. HTML a => a -> Html
toHtml String
d Html -> Html -> Html
<+> String -> Html
forall a. HTML a => a -> Html
toHtml (Int -> String
forall a. Show a => a -> String
show Int
p) Html -> Html -> Html
<+> [DocName] -> Html
ppNames [DocName]
ns)

    ppDir :: FixityDirection -> String
ppDir FixityDirection
InfixR = String
"infixr"
    ppDir FixityDirection
InfixL = String
"infixl"
    ppDir FixityDirection
InfixN = String
"infix"

    ppNames :: [DocName] -> Html
ppNames = case [(DocName, Fixity)]
fs of
      (DocName, Fixity)
_ : [] -> Html -> [DocName] -> Html
forall a b. a -> b -> a
const Html
noHtml -- Don't display names for fixities on single names
      [(DocName, Fixity)]
_ -> [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml ([Html] -> Html) -> ([DocName] -> [Html]) -> [DocName] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse (String -> Html
stringToHtml String
", ") ([Html] -> [Html]) -> ([DocName] -> [Html]) -> [DocName] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocName -> Html) -> [DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Infix Bool
False)

    uniq_fs :: [([DocName], Int, String)]
uniq_fs =
      [ ([DocName]
n, [Int] -> Int
forall a. Eq a => [a] -> a
the [Int]
p, [String] -> String
forall a. Eq a => [a] -> a
the [String]
d')
      | (DocName
n, Fixity Int
p FixityDirection
d) <- [(DocName, Fixity)]
fs
      , let d' :: String
d' = FixityDirection -> String
ppDir FixityDirection
d
      , then group by
          (Int, String) -> Down (Int, String)
forall a. a -> Down a
Down (Int
p, String
d')
        using
          (a -> Down (Int, String)) -> [a] -> [[a]]
((DocName, Int, String) -> Down (Int, String))
-> [(DocName, Int, String)] -> [[(DocName, Int, String)]]
forall {a}. (a -> Down (Int, String)) -> [a] -> [[a]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith
      ]

    rightEdge :: Html
rightEdge = Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"rightedge"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
noHtml

-- | Pretty-print type variables.
ppTyVars
  :: RenderableBndrFlag flag
  => Unicode
  -> Qualification
  -> [LHsTyVarBndr flag DocNameI]
  -> [Html]
ppTyVars :: forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> [LHsTyVarBndr flag DocNameI] -> [Html]
ppTyVars Bool
unicode Qualification
qual [LHsTyVarBndr flag DocNameI]
tvs = (GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI) -> Html)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Qualification -> HsTyVarBndr flag DocNameI -> Html
forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> HsTyVarBndr flag DocNameI -> Html
ppHsTyVarBndr Bool
unicode Qualification
qual (HsTyVarBndr flag DocNameI -> Html)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
    -> HsTyVarBndr flag DocNameI)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
-> HsTyVarBndr flag DocNameI
forall l e. GenLocated l e -> e
unLoc) [LHsTyVarBndr flag DocNameI]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)]
tvs

ppFor
  :: Bool
  -> LinksInfo
  -> SrcSpan
  -> DocForDecl DocName
  -> ForeignDecl DocNameI
  -> [(DocName, Fixity)]
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppFor :: Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> ForeignDecl DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFor
  Bool
summary
  LinksInfo
links
  SrcSpan
loc
  DocForDecl DocName
doc
  (ForeignImport XForeignImport DocNameI
_ (L SrcSpanAnnN
_ DocName
name) LHsSigType DocNameI
typ ForeignImport DocNameI
_)
  [(DocName, Fixity)]
fixities
  Bool
splice
  Bool
unicode
  Maybe String
pkg
  Qualification
qual =
    Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFunSig Bool
summary LinksInfo
links SrcSpan
loc Html
noHtml DocForDecl DocName
doc [DocName
name] LHsSigType DocNameI
typ [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
ppFor Bool
_ LinksInfo
_ SrcSpan
_ DocForDecl DocName
_ ForeignDecl DocNameI
_ [(DocName, Fixity)]
_ Bool
_ Bool
_ Maybe String
_ Qualification
_ = String -> Html
forall a. HasCallStack => String -> a
error String
"ppFor"

-- we skip type patterns for now
ppTySyn
  :: Bool
  -> LinksInfo
  -> [(DocName, Fixity)]
  -> SrcSpan
  -> DocForDecl DocName
  -> TyClDecl DocNameI
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppTySyn :: Bool
-> LinksInfo
-> [(DocName, Fixity)]
-> SrcSpan
-> DocForDecl DocName
-> TyClDecl DocNameI
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppTySyn
  Bool
summary
  LinksInfo
links
  [(DocName, Fixity)]
fixities
  SrcSpan
loc
  DocForDecl DocName
doc
  ( SynDecl
      { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = L SrcSpanAnnN
_ DocName
name
      , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
ltyvars
      , tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = XRec DocNameI (HsType DocNameI)
ltype
      }
    )
  Bool
splice
  Bool
unicode
  Maybe String
pkg
  Qualification
qual =
    Bool
-> LinksInfo
-> SrcSpan
-> [DocName]
-> HsSigType DocNameI
-> DocForDecl DocName
-> (Html, Html, Html)
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> HideEmptyContexts
-> Html
ppTypeOrFunSig
      Bool
summary
      LinksInfo
links
      SrcSpan
loc
      [DocName
name]
      HsSigType DocNameI
sig_type
      DocForDecl DocName
doc
      (Html
full Html -> Html -> Html
<+> Html
fixs, Html
hdr Html -> Html -> Html
<+> Html
fixs, Html
spaceHtml Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
equals)
      Bool
splice
      Bool
unicode
      Maybe String
pkg
      Qualification
qual
      HideEmptyContexts
ShowEmptyToplevelContexts
    where
      sig_type :: HsSigType DocNameI
sig_type = XRec DocNameI (HsType DocNameI) -> HsSigType DocNameI
mkHsImplicitSigTypeI XRec DocNameI (HsType DocNameI)
ltype
      hdr :: Html
hdr =
        [Html] -> Html
hsep
          ( [String -> Html
keyword String
"type", Bool -> OccName -> Html
ppBinder Bool
summary OccName
occ]
              [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ Bool
-> Qualification
-> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
-> [Html]
forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> [LHsTyVarBndr flag DocNameI] -> [Html]
ppTyVars Bool
unicode Qualification
qual (LHsQTyVars DocNameI -> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsQTvExplicit LHsQTyVars DocNameI
ltyvars)
          )
      full :: Html
full = Html
hdr Html -> Html -> Html
<+> Html
equals Html -> Html -> Html
<+> Bool -> Qualification -> LHsSigType DocNameI -> Html
ppPatSigType Bool
unicode Qualification
qual (HsSigType DocNameI -> GenLocated SrcSpanAnnA (HsSigType DocNameI)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsSigType DocNameI
sig_type)
      occ :: OccName
occ = Name -> OccName
nameOccName (Name -> OccName) -> (DocName -> Name) -> DocName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> OccName) -> DocName -> OccName
forall a b. (a -> b) -> a -> b
$ DocName
name
      fixs :: Html
fixs
        | Bool
summary = Html
noHtml
        | Bool
otherwise = [(DocName, Fixity)] -> Qualification -> Html
ppFixities [(DocName, Fixity)]
fixities Qualification
qual
ppTySyn Bool
_ LinksInfo
_ [(DocName, Fixity)]
_ SrcSpan
_ DocForDecl DocName
_ TyClDecl DocNameI
_ Bool
_ Bool
_ Maybe String
_ Qualification
_ = String -> Html
forall a. HasCallStack => String -> a
error String
"declaration not supported by ppTySyn"

ppTypeSig :: Bool -> [OccName] -> Html -> Unicode -> Html
ppTypeSig :: Bool -> [OccName] -> Html -> Bool -> Html
ppTypeSig Bool
summary [OccName]
nms Html
pp_ty Bool
unicode =
  [Html] -> Html
forall a. HTML a => [a] -> Html
concatHtml [Html]
htmlNames Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
unicode Html -> Html -> Html
<+> Html
pp_ty
  where
    htmlNames :: [Html]
htmlNames = Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse (String -> Html
stringToHtml String
", ") ([Html] -> [Html]) -> [Html] -> [Html]
forall a b. (a -> b) -> a -> b
$ (OccName -> Html) -> [OccName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinder Bool
summary) [OccName]
nms

ppSimpleSig
  :: LinksInfo
  -> Splice
  -> Unicode
  -> Qualification
  -> HideEmptyContexts
  -> SrcSpan
  -> [DocName]
  -> HsSigType DocNameI
  -> Html
ppSimpleSig :: LinksInfo
-> Bool
-> Bool
-> Qualification
-> HideEmptyContexts
-> SrcSpan
-> [DocName]
-> HsSigType DocNameI
-> Html
ppSimpleSig LinksInfo
links Bool
splice Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts SrcSpan
loc [DocName]
names HsSigType DocNameI
typ =
  DocName -> Html -> Html
topDeclElem' DocName
docName (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Bool -> [OccName] -> Html -> Bool -> Html
ppTypeSig Bool
True [OccName]
occNames Html
ppTyp Bool
unicode
  where
    topDeclElem' :: DocName -> Html -> Html
topDeclElem' = LinksInfo -> SrcSpan -> Bool -> DocName -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice
    ppTyp :: Html
ppTyp = Bool
-> Qualification -> HideEmptyContexts -> HsSigType DocNameI -> Html
ppSigType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts HsSigType DocNameI
typ
    occNames :: [OccName]
occNames = (DocName -> OccName) -> [DocName] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> OccName
forall a. NamedThing a => a -> OccName
getOccName [DocName]
names
    docName :: DocName
docName =
      case [DocName] -> Maybe DocName
forall a. [a] -> Maybe a
Maybe.listToMaybe [DocName]
names of
        Maybe DocName
Nothing -> String -> DocName
forall a. HasCallStack => String -> a
error String
"No names. An invariant was broken. Please report this to the Haddock project"
        Just DocName
hd -> DocName
hd

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

-- * Type families

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

-- | Print a data\/type family declaration
ppFamDecl
  :: Bool
  -- ^ is a summary
  -> Bool
  -- ^ is an associated type
  -> LinksInfo
  -> [DocInstance DocNameI]
  -- ^ relevant instances
  -> [(DocName, Fixity)]
  -- ^ relevant fixities
  -> SrcSpan
  -> Documentation DocName
  -- ^ this decl's documentation
  -> FamilyDecl DocNameI
  -- ^ this decl
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppFamDecl :: Bool
-> Bool
-> LinksInfo
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> SrcSpan
-> Documentation DocName
-> FamilyDecl DocNameI
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFamDecl Bool
summary Bool
associated LinksInfo
links [DocInstance DocNameI]
instances [(DocName, Fixity)]
fixities SrcSpan
loc Documentation DocName
doc FamilyDecl DocNameI
decl Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
  | Bool
summary = Bool
-> Bool -> FamilyDecl DocNameI -> Bool -> Qualification -> Html
ppFamHeader Bool
True Bool
associated FamilyDecl DocNameI
decl Bool
unicode Qualification
qual
  | Bool
otherwise = Html
header_ Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe Name
-> Maybe String -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe String
pkg Qualification
qual Documentation DocName
doc Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
instancesBit
  where
    docname :: DocName
docname = GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName -> DocName
forall a b. (a -> b) -> a -> b
$ FamilyDecl DocNameI -> LIdP DocNameI
forall pass. FamilyDecl pass -> LIdP pass
fdLName FamilyDecl DocNameI
decl
    curname :: Maybe Name
curname = Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
docname

    header_ :: Html
header_ =
      LinksInfo -> SrcSpan -> Bool -> DocName -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice DocName
docname (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        Bool
-> Bool -> FamilyDecl DocNameI -> Bool -> Qualification -> Html
ppFamHeader Bool
summary Bool
associated FamilyDecl DocNameI
decl Bool
unicode Qualification
qual Html -> Html -> Html
<+> [(DocName, Fixity)] -> Qualification -> Html
ppFixities [(DocName, Fixity)]
fixities Qualification
qual

    instancesBit :: Html
instancesBit
      | FamilyDecl{fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = ClosedTypeFamily Maybe [LTyFamInstEqn DocNameI]
mb_eqns} <- FamilyDecl DocNameI
decl
      , Bool -> Bool
not Bool
summary =
          Maybe String -> Qualification -> [SubDecl] -> Html
subEquations Maybe String
pkg Qualification
qual ([SubDecl] -> Html) -> [SubDecl] -> Html
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))
 -> SubDecl)
-> [GenLocated
      SrcSpanAnnA
      (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
-> [SubDecl]
forall a b. (a -> b) -> [a] -> [b]
map (TyFamInstEqn DocNameI -> SubDecl
FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> SubDecl
ppFamDeclEqn (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
 -> SubDecl)
-> (GenLocated
      SrcSpanAnnA
      (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))
    -> FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))
-> GenLocated
     SrcSpanAnnA
     (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))
-> SubDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))
-> FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
forall l e. GenLocated l e -> e
unLoc) ([GenLocated
    SrcSpanAnnA
    (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
 -> [SubDecl])
-> [GenLocated
      SrcSpanAnnA
      (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
-> [SubDecl]
forall a b. (a -> b) -> a -> b
$ [GenLocated
   SrcSpanAnnA
   (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
-> Maybe
     [GenLocated
        SrcSpanAnnA
        (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
-> [GenLocated
      SrcSpanAnnA
      (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
forall a. a -> Maybe a -> a
Maybe.fromMaybe [] Maybe [LTyFamInstEqn DocNameI]
Maybe
  [GenLocated
     SrcSpanAnnA
     (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
mb_eqns
      | Bool
otherwise =
          LinksInfo
-> InstOrigin DocName
-> [DocInstance DocNameI]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppInstances LinksInfo
links (DocName -> InstOrigin DocName
forall name. name -> InstOrigin name
OriginFamily DocName
docname) [DocInstance DocNameI]
instances Bool
splice Bool
unicode Maybe String
pkg Qualification
qual

    -- Individual equation of a closed type family
    ppFamDeclEqn :: TyFamInstEqn DocNameI -> SubDecl
    ppFamDeclEqn :: TyFamInstEqn DocNameI -> SubDecl
ppFamDeclEqn
      ( FamEqn
          { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = L SrcSpanAnnN
_ DocName
n
          , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = XRec DocNameI (HsType DocNameI)
rhs
          , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_pats = HsFamEqnPats DocNameI
ts
          }
        ) =
        ( DocName -> HsFamEqnPats DocNameI -> Bool -> Qualification -> Html
ppAppNameTypeArgs DocName
n HsFamEqnPats DocNameI
ts Bool
unicode Qualification
qual
            Html -> Html -> Html
<+> Html
equals
            Html -> Html -> Html
<+> Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
rhs)
        , Maybe (MDoc DocName)
forall a. Maybe a
Nothing
        , []
        )

-- | Print the LHS of a type\/data family declaration
ppFamHeader
  :: Bool
  -- ^ is a summary
  -> Bool
  -- ^ is an associated type
  -> FamilyDecl DocNameI
  -- ^ family declaration
  -> Unicode
  -> Qualification
  -> Html
ppFamHeader :: Bool
-> Bool -> FamilyDecl DocNameI -> Bool -> Qualification -> Html
ppFamHeader
  Bool
summary
  Bool
associated
  ( FamilyDecl
      { fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = FamilyInfo DocNameI
info
      , fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdResultSig = L EpAnn NoEpAnns
_ FamilyResultSig DocNameI
result
      , fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn DocNameI)
injectivity
      , fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName = L SrcSpanAnnN
_ DocName
name
      , fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars = LHsQTyVars DocNameI
tvs
      }
    )
  Bool
unicode
  Qualification
qual =
    [Html] -> Html
hsep
      [ Bool -> FamilyInfo DocNameI -> Html
ppFamilyLeader Bool
associated FamilyInfo DocNameI
info
      , Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
-> Html
forall flag.
RenderableBndrFlag flag =>
Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr flag DocNameI]
-> Html
ppAppDocNameTyVarBndrs Bool
summary Bool
unicode Qualification
qual DocName
name (LHsQTyVars DocNameI -> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsq_explicit LHsQTyVars DocNameI
tvs)
      , FamilyResultSig DocNameI -> Bool -> Qualification -> Html
ppResultSig FamilyResultSig DocNameI
result Bool
unicode Qualification
qual
      , Html
injAnn
      , Html
whereBit
      ]
    where
      whereBit :: Html
whereBit = case FamilyInfo DocNameI
info of
        ClosedTypeFamily Maybe [LTyFamInstEqn DocNameI]
_ -> String -> Html
keyword String
"where ..."
        FamilyInfo DocNameI
_ -> Html
noHtml

      injAnn :: Html
injAnn = case Maybe (LInjectivityAnn DocNameI)
injectivity of
        Maybe (LInjectivityAnn DocNameI)
Nothing -> Html
noHtml
        Just (L EpAnn NoEpAnns
_ (InjectivityAnn XCInjectivityAnn DocNameI
_ LIdP DocNameI
lhs [LIdP DocNameI]
rhs)) ->
          [Html] -> Html
hsep
            ( String -> Html
keyword String
"|"
                Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Qualification -> Notation -> GenLocated SrcSpanAnnN DocName -> Html
forall l. Qualification -> Notation -> GenLocated l DocName -> Html
ppLDocName Qualification
qual Notation
Raw LIdP DocNameI
GenLocated SrcSpanAnnN DocName
lhs
                Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Bool -> Html
arrow Bool
unicode
                Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnN DocName -> Html)
-> [GenLocated SrcSpanAnnN DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Qualification -> Notation -> GenLocated SrcSpanAnnN DocName -> Html
forall l. Qualification -> Notation -> GenLocated l DocName -> Html
ppLDocName Qualification
qual Notation
Raw) [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
rhs
            )
        Just LInjectivityAnn DocNameI
_ -> String -> Html
forall a. HasCallStack => String -> a
error String
"ppFamHeader:XInjectivityAnn"

-- | Print the keywords that begin the family declaration
ppFamilyLeader :: Bool -> FamilyInfo DocNameI -> Html
ppFamilyLeader :: Bool -> FamilyInfo DocNameI -> Html
ppFamilyLeader Bool
assoc FamilyInfo DocNameI
info = String -> Html
keyword (String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
assoc then String
"" else String
" family")
  where
    typ :: String
typ = case FamilyInfo DocNameI
info of
      FamilyInfo DocNameI
OpenTypeFamily -> String
"type"
      ClosedTypeFamily Maybe [LTyFamInstEqn DocNameI]
_ -> String
"type"
      FamilyInfo DocNameI
DataFamily -> String
"data"

-- | Print the signature attached to a family
ppResultSig :: FamilyResultSig DocNameI -> Unicode -> Qualification -> Html
ppResultSig :: FamilyResultSig DocNameI -> Bool -> Qualification -> Html
ppResultSig FamilyResultSig DocNameI
result Bool
unicode Qualification
qual = case FamilyResultSig DocNameI
result of
  NoSig XNoSig DocNameI
_ -> Html
noHtml
  KindSig XCKindSig DocNameI
_ XRec DocNameI (HsType DocNameI)
kind -> Bool -> Html
dcolon Bool
unicode Html -> Html -> Html
<+> Bool -> Qualification -> XRec DocNameI (HsType DocNameI) -> Html
ppLKind Bool
unicode Qualification
qual XRec DocNameI (HsType DocNameI)
kind
  TyVarSig XTyVarSig DocNameI
_ (L SrcSpanAnnA
_ HsTyVarBndr () DocNameI
bndr) -> Html
equals Html -> Html -> Html
<+> Bool -> Qualification -> HsTyVarBndr () DocNameI -> Html
forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> HsTyVarBndr flag DocNameI -> Html
ppHsTyVarBndr Bool
unicode Qualification
qual HsTyVarBndr () DocNameI
bndr

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

-- * Associated Types

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

ppAssocType
  :: Bool
  -> LinksInfo
  -> DocForDecl DocName
  -> LFamilyDecl DocNameI
  -> [(DocName, Fixity)]
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppAssocType :: Bool
-> LinksInfo
-> DocForDecl DocName
-> LFamilyDecl DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppAssocType Bool
summ LinksInfo
links DocForDecl DocName
doc (L SrcSpan
loc FamilyDecl DocNameI
decl) [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe String
pkg Qualification
qual =
  Bool
-> Bool
-> LinksInfo
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> SrcSpan
-> Documentation DocName
-> FamilyDecl DocNameI
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFamDecl Bool
summ Bool
True LinksInfo
links [] [(DocName, Fixity)]
fixities SrcSpan
loc (DocForDecl DocName -> Documentation DocName
forall a b. (a, b) -> a
fst DocForDecl DocName
doc) FamilyDecl DocNameI
decl Bool
splice Bool
unicode Maybe String
pkg Qualification
qual

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

-- * Type applications

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

ppAppDocNameTyVarBndrs
  :: RenderableBndrFlag flag
  => Bool
  -> Unicode
  -> Qualification
  -> DocName
  -> [LHsTyVarBndr flag DocNameI]
  -> Html
ppAppDocNameTyVarBndrs :: forall flag.
RenderableBndrFlag flag =>
Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr flag DocNameI]
-> Html
ppAppDocNameTyVarBndrs Bool
summ Bool
unicode Qualification
qual DocName
n [LHsTyVarBndr flag DocNameI]
vs =
  DocName
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)]
-> (Notation -> DocName -> Html)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI) -> Html)
-> Html
forall a.
DocName
-> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
ppTypeApp DocName
n [LHsTyVarBndr flag DocNameI]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)]
vs Notation -> DocName -> Html
ppDN (Bool -> Qualification -> HsTyVarBndr flag DocNameI -> Html
forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> HsTyVarBndr flag DocNameI -> Html
ppHsTyVarBndr Bool
unicode Qualification
qual (HsTyVarBndr flag DocNameI -> Html)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
    -> HsTyVarBndr flag DocNameI)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
-> HsTyVarBndr flag DocNameI
forall l e. GenLocated l e -> e
unLoc)
  where
    ppDN :: Notation -> DocName -> Html
ppDN Notation
notation = Notation -> Bool -> OccName -> Html
ppBinderFixity Notation
notation Bool
summ (OccName -> Html) -> (DocName -> OccName) -> DocName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName (Name -> OccName) -> (DocName -> Name) -> DocName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName
    ppBinderFixity :: Notation -> Bool -> OccName -> Html
ppBinderFixity Notation
Infix = Bool -> OccName -> Html
ppBinderInfix
    ppBinderFixity Notation
_ = Bool -> OccName -> Html
ppBinder

-- | Print an application of a 'DocName' to its list of 'HsType's
ppAppNameTypes :: DocName -> [HsType DocNameI] -> Unicode -> Qualification -> Html
ppAppNameTypes :: DocName -> [HsType DocNameI] -> Bool -> Qualification -> Html
ppAppNameTypes DocName
n [HsType DocNameI]
ts Bool
unicode Qualification
qual =
  DocName
-> [HsType DocNameI]
-> (Notation -> DocName -> Html)
-> (HsType DocNameI -> Html)
-> Html
forall a.
DocName
-> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
ppTypeApp DocName
n [HsType DocNameI]
ts (\Notation
p -> Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
p Bool
True) (Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts)

ppAppNameTypeArgs :: DocName -> [LHsTypeArg DocNameI] -> Unicode -> Qualification -> Html
ppAppNameTypeArgs :: DocName -> HsFamEqnPats DocNameI -> Bool -> Qualification -> Html
ppAppNameTypeArgs DocName
n args :: HsFamEqnPats DocNameI
args@(HsValArg XValArg DocNameI
_ XRec DocNameI (HsType DocNameI)
_ : HsValArg XValArg DocNameI
_ XRec DocNameI (HsType DocNameI)
_ : HsFamEqnPats DocNameI
_) Bool
u Qualification
q =
  DocName
-> [HsArg
      DocNameI
      (GenLocated SrcSpanAnnA (HsType DocNameI))
      (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> (Notation -> DocName -> Html)
-> (HsArg
      DocNameI
      (GenLocated SrcSpanAnnA (HsType DocNameI))
      (GenLocated SrcSpanAnnA (HsType DocNameI))
    -> Html)
-> Html
forall a.
DocName
-> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
ppTypeApp DocName
n HsFamEqnPats DocNameI
[HsArg
   DocNameI
   (GenLocated SrcSpanAnnA (HsType DocNameI))
   (GenLocated SrcSpanAnnA (HsType DocNameI))]
args (\Notation
p -> Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
q Notation
p Bool
True) (Bool
-> Qualification
-> HideEmptyContexts
-> HsArg
     DocNameI
     (XRec DocNameI (HsType DocNameI))
     (XRec DocNameI (HsType DocNameI))
-> Html
ppLHsTypeArg Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts)
ppAppNameTypeArgs DocName
n HsFamEqnPats DocNameI
args Bool
u Qualification
q =
  (Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
q Notation
Prefix Bool
True DocName
n) Html -> Html -> Html
<+> [Html] -> Html
hsep ((HsArg
   DocNameI
   (GenLocated SrcSpanAnnA (HsType DocNameI))
   (GenLocated SrcSpanAnnA (HsType DocNameI))
 -> Html)
-> [HsArg
      DocNameI
      (GenLocated SrcSpanAnnA (HsType DocNameI))
      (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> HsArg
     DocNameI
     (XRec DocNameI (HsType DocNameI))
     (XRec DocNameI (HsType DocNameI))
-> Html
ppLHsTypeArg Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) HsFamEqnPats DocNameI
[HsArg
   DocNameI
   (GenLocated SrcSpanAnnA (HsType DocNameI))
   (GenLocated SrcSpanAnnA (HsType DocNameI))]
args)

-- | General printing of type applications
ppTypeApp :: DocName -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
ppTypeApp :: forall a.
DocName
-> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
ppTypeApp DocName
n (a
t1 : a
t2 : [a]
rest) Notation -> DocName -> Html
ppDN a -> Html
ppT
  | Bool
operator, Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ [a]
rest = Html -> Html
parens Html
opApp Html -> Html -> Html
<+> [Html] -> Html
hsep ((a -> Html) -> [a] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map a -> Html
ppT [a]
rest)
  | Bool
operator = Html
opApp
  where
    operator :: Bool
operator = Name -> Bool
isNameSym (Name -> Bool) -> (DocName -> Name) -> DocName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Bool) -> DocName -> Bool
forall a b. (a -> b) -> a -> b
$ DocName
n
    opApp :: Html
opApp = a -> Html
ppT a
t1 Html -> Html -> Html
<+> Notation -> DocName -> Html
ppDN Notation
Infix DocName
n Html -> Html -> Html
<+> a -> Html
ppT a
t2
ppTypeApp DocName
n [a]
ts Notation -> DocName -> Html
ppDN a -> Html
ppT = Notation -> DocName -> Html
ppDN Notation
Prefix DocName
n Html -> Html -> Html
<+> [Html] -> Html
hsep ((a -> Html) -> [a] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map a -> Html
ppT [a]
ts)

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

-- * Contexts

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

ppLContext
  :: Maybe (LHsContext DocNameI)
  -> Unicode
  -> Qualification
  -> HideEmptyContexts
  -> Html
ppLContext :: Maybe (LHsContext DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContext Maybe (LHsContext DocNameI)
Nothing Bool
u Qualification
q HideEmptyContexts
h = HsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContext [] Bool
u Qualification
q HideEmptyContexts
h
ppLContext (Just LHsContext DocNameI
c) Bool
u Qualification
q HideEmptyContexts
h = HsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContext (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
-> [GenLocated SrcSpanAnnA (HsType DocNameI)]
forall l e. GenLocated l e -> e
unLoc LHsContext DocNameI
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
c) Bool
u Qualification
q HideEmptyContexts
h

ppLContextNoArrow
  :: LHsContext DocNameI
  -> Unicode
  -> Qualification
  -> HideEmptyContexts
  -> Html
ppLContextNoArrow :: LHsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContextNoArrow LHsContext DocNameI
c Bool
u Qualification
q HideEmptyContexts
h = HsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoArrow (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
-> [GenLocated SrcSpanAnnA (HsType DocNameI)]
forall l e. GenLocated l e -> e
unLoc LHsContext DocNameI
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
c) Bool
u Qualification
q HideEmptyContexts
h

ppContextNoArrow :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppContextNoArrow :: HsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoArrow HsContext DocNameI
cxt Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts =
  Html -> Maybe Html -> Html
forall a. a -> Maybe a -> a
Maybe.fromMaybe Html
noHtml (Maybe Html -> Html) -> Maybe Html -> Html
forall a b. (a -> b) -> a -> b
$
    [HsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Maybe Html
ppContextNoLocsMaybe ((GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [HsType DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc HsContext DocNameI
[GenLocated SrcSpanAnnA (HsType DocNameI)]
cxt) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts

ppContextNoLocs :: [HsType DocNameI] -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppContextNoLocs :: [HsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoLocs [HsType DocNameI]
cxt Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts =
  Html -> (Html -> Html) -> Maybe Html -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
noHtml (Html -> Html -> Html
<+> Bool -> Html
darrow Bool
unicode) (Maybe Html -> Html) -> Maybe Html -> Html
forall a b. (a -> b) -> a -> b
$
    [HsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Maybe Html
ppContextNoLocsMaybe [HsType DocNameI]
cxt Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts

ppContextNoLocsMaybe :: [HsType DocNameI] -> Unicode -> Qualification -> HideEmptyContexts -> Maybe Html
ppContextNoLocsMaybe :: [HsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Maybe Html
ppContextNoLocsMaybe [] Bool
_ Qualification
_ HideEmptyContexts
emptyCtxts =
  case HideEmptyContexts
emptyCtxts of
    HideEmptyContexts
HideEmptyContexts -> Maybe Html
forall a. Maybe a
Nothing
    HideEmptyContexts
ShowEmptyToplevelContexts -> Html -> Maybe Html
forall a. a -> Maybe a
Just (String -> Html
forall a. HTML a => a -> Html
toHtml String
"()")
ppContextNoLocsMaybe [HsType DocNameI]
cxt Bool
unicode Qualification
qual HideEmptyContexts
_ = Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$ [HsType DocNameI] -> Bool -> Qualification -> Html
ppHsContext [HsType DocNameI]
cxt Bool
unicode Qualification
qual

ppContext :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppContext :: HsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContext HsContext DocNameI
cxt Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts = [HsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoLocs ((GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [HsType DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc HsContext DocNameI
[GenLocated SrcSpanAnnA (HsType DocNameI)]
cxt) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts

ppHsContext :: [HsType DocNameI] -> Unicode -> Qualification -> Html
ppHsContext :: [HsType DocNameI] -> Bool -> Qualification -> Html
ppHsContext [] Bool
_ Qualification
_ = Html
noHtml
ppHsContext [HsType DocNameI
p] Bool
unicode Qualification
qual = Bool -> Qualification -> HsType DocNameI -> Html
ppCtxType Bool
unicode Qualification
qual HsType DocNameI
p
ppHsContext [HsType DocNameI]
cxt Bool
unicode Qualification
qual = [Html] -> Html
parenList ((HsType DocNameI -> Html) -> [HsType DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts) [HsType DocNameI]
cxt)

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

-- * Class declarations

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

ppClassHdr
  :: Bool
  -> Maybe (LocatedC [LHsType DocNameI])
  -> DocName
  -> LHsQTyVars DocNameI
  -> [LHsFunDep DocNameI]
  -> Unicode
  -> Qualification
  -> Html
ppClassHdr :: Bool
-> Maybe (LocatedC (HsContext DocNameI))
-> DocName
-> LHsQTyVars DocNameI
-> [LHsFunDep DocNameI]
-> Bool
-> Qualification
-> Html
ppClassHdr Bool
summ Maybe (LocatedC (HsContext DocNameI))
lctxt DocName
n LHsQTyVars DocNameI
tvs [LHsFunDep DocNameI]
fds Bool
unicode Qualification
qual =
  String -> Html
keyword String
"class"
    Html -> Html -> Html
<+> (if Bool -> Bool
not (HsContext DocNameI -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null (HsContext DocNameI -> Bool) -> HsContext DocNameI -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (LHsContext DocNameI) -> HsContext DocNameI
fromMaybeContext Maybe (LHsContext DocNameI)
Maybe (LocatedC (HsContext DocNameI))
lctxt) then Maybe (LHsContext DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContext Maybe (LHsContext DocNameI)
Maybe (LocatedC (HsContext DocNameI))
lctxt Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts else Html
noHtml)
    Html -> Html -> Html
<+> Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
-> Html
forall flag.
RenderableBndrFlag flag =>
Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr flag DocNameI]
-> Html
ppAppDocNameTyVarBndrs Bool
summ Bool
unicode Qualification
qual DocName
n (LHsQTyVars DocNameI -> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsQTvExplicit LHsQTyVars DocNameI
tvs)
    Html -> Html -> Html
<+> [LHsFunDep DocNameI] -> Bool -> Qualification -> Html
ppFds [LHsFunDep DocNameI]
fds Bool
unicode Qualification
qual

ppFds :: [LHsFunDep DocNameI] -> Unicode -> Qualification -> Html
ppFds :: [LHsFunDep DocNameI] -> Bool -> Qualification -> Html
ppFds [LHsFunDep DocNameI]
fds Bool
unicode Qualification
qual =
  if [GenLocated SrcSpan (FunDep DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LHsFunDep DocNameI]
[GenLocated SrcSpan (FunDep DocNameI)]
fds
    then Html
noHtml
    else Char -> Html
char Char
'|' Html -> Html -> Html
<+> [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma ((GenLocated SrcSpan (FunDep DocNameI) -> Html)
-> [GenLocated SrcSpan (FunDep DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (FunDep DocNameI -> Html
fundep (FunDep DocNameI -> Html)
-> (GenLocated SrcSpan (FunDep DocNameI) -> FunDep DocNameI)
-> GenLocated SrcSpan (FunDep DocNameI)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (FunDep DocNameI) -> FunDep DocNameI
forall l e. GenLocated l e -> e
unLoc) [LHsFunDep DocNameI]
[GenLocated SrcSpan (FunDep DocNameI)]
fds))
  where
    fundep :: FunDep DocNameI -> Html
fundep (FunDep XCFunDep DocNameI
_ [LIdP DocNameI]
vars1 [LIdP DocNameI]
vars2) = [GenLocated SrcSpanAnnN DocName] -> Html
ppVars [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
vars1 Html -> Html -> Html
<+> Bool -> Html
arrow Bool
unicode Html -> Html -> Html
<+> [GenLocated SrcSpanAnnN DocName] -> Html
ppVars [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
vars2
    fundep (XFunDep XXFunDep DocNameI
_) = String -> Html
forall a. HasCallStack => String -> a
error String
"ppFds"
    ppVars :: [GenLocated SrcSpanAnnN DocName] -> Html
ppVars = [Html] -> Html
hsep ([Html] -> Html)
-> ([GenLocated SrcSpanAnnN DocName] -> [Html])
-> [GenLocated SrcSpanAnnN DocName]
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnN DocName -> Html)
-> [GenLocated SrcSpanAnnN DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Prefix Bool
True) (DocName -> Html)
-> (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc)

ppShortClassDecl
  :: Bool
  -> LinksInfo
  -> TyClDecl DocNameI
  -> SrcSpan
  -> [(DocName, DocForDecl DocName)]
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppShortClassDecl :: Bool
-> LinksInfo
-> TyClDecl DocNameI
-> SrcSpan
-> [(DocName, DocForDecl DocName)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppShortClassDecl
  Bool
summary
  LinksInfo
links
  ( ClassDecl
      { tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCtxt = Maybe (LHsContext DocNameI)
lctxt
      , tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP DocNameI
lname
      , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
tvs
      , tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdFDs = [LHsFunDep DocNameI]
fds
      , tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig DocNameI]
sigs
      , tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs = [LFamilyDecl DocNameI]
ats
      }
    )
  SrcSpan
loc
  [(DocName, DocForDecl DocName)]
subdocs
  Bool
splice
  Bool
unicode
  Maybe String
pkg
  Qualification
qual =
    if Bool -> Bool
not ((LSig DocNameI -> Bool) -> [LSig DocNameI] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any LSig DocNameI -> Bool
forall p. UnXRec p => LSig p -> Bool
isUserLSig [LSig DocNameI]
sigs) Bool -> Bool -> Bool
&& [GenLocated SrcSpan (FamilyDecl DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LFamilyDecl DocNameI]
[GenLocated SrcSpan (FamilyDecl DocNameI)]
ats
      then (if Bool
summary then Html -> Html
forall a. a -> a
id else LinksInfo -> SrcSpan -> Bool -> DocName -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice DocName
nm) Html
hdr
      else
        (if Bool
summary then Html -> Html
forall a. a -> a
id else LinksInfo -> SrcSpan -> Bool -> DocName -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice DocName
nm) (Html
hdr Html -> Html -> Html
<+> String -> Html
keyword String
"where")
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Bool -> [Html] -> Html
shortSubDecls
            Bool
False
            ( [ Bool
-> LinksInfo
-> DocForDecl DocName
-> LFamilyDecl DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppAssocType Bool
summary LinksInfo
links DocForDecl DocName
doc LFamilyDecl DocNameI
GenLocated SrcSpan (FamilyDecl DocNameI)
at [] Bool
splice Bool
unicode Maybe String
pkg Qualification
qual | GenLocated SrcSpan (FamilyDecl DocNameI)
at <- [LFamilyDecl DocNameI]
[GenLocated SrcSpan (FamilyDecl DocNameI)]
ats, let doc :: DocForDecl DocName
doc = DocName -> [(DocName, DocForDecl DocName)] -> DocForDecl DocName
forall id1 id2.
Eq id1 =>
id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc (GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unL (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName -> DocName
forall a b. (a -> b) -> a -> b
$ FamilyDecl DocNameI -> LIdP DocNameI
forall pass. FamilyDecl pass -> LIdP pass
fdLName (FamilyDecl DocNameI -> LIdP DocNameI)
-> FamilyDecl DocNameI -> LIdP DocNameI
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (FamilyDecl DocNameI) -> FamilyDecl DocNameI
forall l e. GenLocated l e -> e
unL GenLocated SrcSpan (FamilyDecl DocNameI)
at) [(DocName, DocForDecl DocName)]
subdocs
              ]
                [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++
                -- ToDo: add associated type defaults

                [ Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFunSig
                  Bool
summary
                  LinksInfo
links
                  SrcSpan
loc
                  Html
noHtml
                  DocForDecl DocName
doc
                  [DocName]
names
                  LHsSigType DocNameI
typ
                  []
                  Bool
splice
                  Bool
unicode
                  Maybe String
pkg
                  Qualification
qual
                | L SrcSpan
_ (ClassOpSig XClassOpSig DocNameI
_ Bool
False [LIdP DocNameI]
lnames LHsSigType DocNameI
typ) <- [LSig DocNameI]
[GenLocated SrcSpan (Sig DocNameI)]
sigs
                , let names :: [DocName]
names = (GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames
                      subdocName :: DocName
subdocName =
                        case [DocName] -> Maybe DocName
forall a. [a] -> Maybe a
Maybe.listToMaybe [DocName]
names of
                          Maybe DocName
Nothing -> String -> DocName
forall a. HasCallStack => String -> a
error String
"No names. An invariant was broken. Please report this to the Haddock project"
                          Just DocName
hd -> DocName
hd
                      doc :: DocForDecl DocName
doc = DocName -> [(DocName, DocForDecl DocName)] -> DocForDecl DocName
forall id1 id2.
Eq id1 =>
id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc DocName
subdocName [(DocName, DocForDecl DocName)]
subdocs
                ]
                -- FIXME: is taking just the first name ok? Is it possible that
                -- there are different subdocs for different names in a single
                -- type signature?
            )
    where
      hdr :: Html
hdr = Bool
-> Maybe (LocatedC (HsContext DocNameI))
-> DocName
-> LHsQTyVars DocNameI
-> [LHsFunDep DocNameI]
-> Bool
-> Qualification
-> Html
ppClassHdr Bool
summary Maybe (LHsContext DocNameI)
Maybe (LocatedC (HsContext DocNameI))
lctxt (GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc LIdP DocNameI
GenLocated SrcSpanAnnN DocName
lname) LHsQTyVars DocNameI
tvs [LHsFunDep DocNameI]
fds Bool
unicode Qualification
qual
      nm :: DocName
nm = GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc LIdP DocNameI
GenLocated SrcSpanAnnN DocName
lname
ppShortClassDecl Bool
_ LinksInfo
_ TyClDecl DocNameI
_ SrcSpan
_ [(DocName, DocForDecl DocName)]
_ Bool
_ Bool
_ Maybe String
_ Qualification
_ = String -> Html
forall a. HasCallStack => String -> a
error String
"declaration type not supported by ppShortClassDecl"

ppClassDecl
  :: Bool
  -> LinksInfo
  -> [DocInstance DocNameI]
  -> [(DocName, Fixity)]
  -> SrcSpan
  -> Documentation DocName
  -> [(DocName, DocForDecl DocName)]
  -> TyClDecl DocNameI
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppClassDecl :: Bool
-> LinksInfo
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> SrcSpan
-> Documentation DocName
-> [(DocName, DocForDecl DocName)]
-> TyClDecl DocNameI
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppClassDecl
  Bool
summary
  LinksInfo
links
  [DocInstance DocNameI]
instances
  [(DocName, Fixity)]
fixities
  SrcSpan
loc
  Documentation DocName
d
  [(DocName, DocForDecl DocName)]
subdocs
  decl :: TyClDecl DocNameI
decl@( ClassDecl
          { tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCtxt = Maybe (LHsContext DocNameI)
lctxt
          , tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP DocNameI
lname
          , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
ltyvars
          , tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdFDs = [LHsFunDep DocNameI]
lfds
          , tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig DocNameI]
lsigs
          , tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs = [LFamilyDecl DocNameI]
ats
          , tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs = [LTyFamDefltDecl DocNameI]
atsDefs
          }
        )
  Bool
splice
  Bool
unicode
  Maybe String
pkg
  Qualification
qual
    | Bool
summary = Bool
-> LinksInfo
-> TyClDecl DocNameI
-> SrcSpan
-> [(DocName, DocForDecl DocName)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppShortClassDecl Bool
summary LinksInfo
links TyClDecl DocNameI
decl SrcSpan
loc [(DocName, DocForDecl DocName)]
subdocs Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
    | Bool
otherwise =
        Html
classheader
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe Name
-> Maybe String -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe String
pkg Qualification
qual Documentation DocName
d
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
minimalBit
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
atBit
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
methodBit
          Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
instancesBit
    where
      curname :: Maybe Name
curname = Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
nm

      sigs :: [Sig DocNameI]
sigs = (GenLocated SrcSpan (Sig DocNameI) -> Sig DocNameI)
-> [GenLocated SrcSpan (Sig DocNameI)] -> [Sig DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (Sig DocNameI) -> Sig DocNameI
forall l e. GenLocated l e -> e
unLoc [LSig DocNameI]
[GenLocated SrcSpan (Sig DocNameI)]
lsigs

      classheader :: Html
classheader
        | (LSig DocNameI -> Bool) -> [LSig DocNameI] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any LSig DocNameI -> Bool
forall p. UnXRec p => LSig p -> Bool
isUserLSig [LSig DocNameI]
lsigs = LinksInfo -> SrcSpan -> Bool -> DocName -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice DocName
nm (Bool -> Qualification -> Html
hdr Bool
unicode Qualification
qual Html -> Html -> Html
<+> String -> Html
keyword String
"where" Html -> Html -> Html
<+> Html
fixs)
        | Bool
otherwise = LinksInfo -> SrcSpan -> Bool -> DocName -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice DocName
nm (Bool -> Qualification -> Html
hdr Bool
unicode Qualification
qual Html -> Html -> Html
<+> Html
fixs)

      -- Only the fixity relevant to the class header
      fixs :: Html
fixs = [(DocName, Fixity)] -> Qualification -> Html
ppFixities [(DocName, Fixity)
f | f :: (DocName, Fixity)
f@(DocName
n, Fixity
_) <- [(DocName, Fixity)]
fixities, DocName
n DocName -> DocName -> Bool
forall a. Eq a => a -> a -> Bool
== GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc LIdP DocNameI
GenLocated SrcSpanAnnN DocName
lname] Qualification
qual

      nm :: DocName
nm = TyClDecl DocNameI -> DocName
tcdNameI TyClDecl DocNameI
decl

      hdr :: Bool -> Qualification -> Html
hdr = Bool
-> Maybe (LocatedC (HsContext DocNameI))
-> DocName
-> LHsQTyVars DocNameI
-> [LHsFunDep DocNameI]
-> Bool
-> Qualification
-> Html
ppClassHdr Bool
summary Maybe (LHsContext DocNameI)
Maybe (LocatedC (HsContext DocNameI))
lctxt (GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc LIdP DocNameI
GenLocated SrcSpanAnnN DocName
lname) LHsQTyVars DocNameI
ltyvars [LHsFunDep DocNameI]
lfds

      -- Associated types
      atBit :: Html
atBit =
        [Html] -> Html
subAssociatedTypes
          [ Bool
-> LinksInfo
-> DocForDecl DocName
-> LFamilyDecl DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppAssocType Bool
summary LinksInfo
links DocForDecl DocName
doc LFamilyDecl DocNameI
GenLocated SrcSpan (FamilyDecl DocNameI)
at [(DocName, Fixity)]
subfixs Bool
splice Bool
unicode Maybe String
pkg Qualification
qual
            Html -> Html -> Html
<+> [Html] -> Html
subDefaults (Maybe Html -> [Html]
forall a. Maybe a -> [a]
Maybe.maybeToList Maybe Html
defTys)
          | GenLocated SrcSpan (FamilyDecl DocNameI)
at <- [LFamilyDecl DocNameI]
[GenLocated SrcSpan (FamilyDecl DocNameI)]
ats
          , let name :: DocName
name = GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN DocName -> DocName)
-> (FamilyDecl DocNameI -> GenLocated SrcSpanAnnN DocName)
-> FamilyDecl DocNameI
-> DocName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamilyDecl DocNameI -> LIdP DocNameI
FamilyDecl DocNameI -> GenLocated SrcSpanAnnN DocName
forall pass. FamilyDecl pass -> LIdP pass
fdLName (FamilyDecl DocNameI -> DocName) -> FamilyDecl DocNameI -> DocName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (FamilyDecl DocNameI) -> FamilyDecl DocNameI
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (FamilyDecl DocNameI)
at
                doc :: DocForDecl DocName
doc = DocName -> [(DocName, DocForDecl DocName)] -> DocForDecl DocName
forall id1 id2.
Eq id1 =>
id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc DocName
name [(DocName, DocForDecl DocName)]
subdocs
                subfixs :: [(DocName, Fixity)]
subfixs = ((DocName, Fixity) -> Bool)
-> [(DocName, Fixity)] -> [(DocName, Fixity)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((DocName -> DocName -> Bool
forall a. Eq a => a -> a -> Bool
== DocName
name) (DocName -> Bool)
-> ((DocName, Fixity) -> DocName) -> (DocName, Fixity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocName, Fixity) -> DocName
forall a b. (a, b) -> a
fst) [(DocName, Fixity)]
fixities
                defTys :: Maybe Html
defTys = (Html -> Html
declElem (Html -> Html)
-> (([HsArg
        DocNameI
        (GenLocated SrcSpanAnnA (HsType DocNameI))
        (GenLocated SrcSpanAnnA (HsType DocNameI))],
     GenLocated SrcSpanAnnA (HsType DocNameI))
    -> Html)
-> ([HsArg
       DocNameI
       (GenLocated SrcSpanAnnA (HsType DocNameI))
       (GenLocated SrcSpanAnnA (HsType DocNameI))],
    GenLocated SrcSpanAnnA (HsType DocNameI))
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName
-> ([HsArg
       DocNameI
       (GenLocated SrcSpanAnnA (HsType DocNameI))
       (GenLocated SrcSpanAnnA (HsType DocNameI))],
    GenLocated SrcSpanAnnA (HsType DocNameI))
-> Html
ppDefaultAssocTy DocName
name) (([HsArg
     DocNameI
     (GenLocated SrcSpanAnnA (HsType DocNameI))
     (GenLocated SrcSpanAnnA (HsType DocNameI))],
  GenLocated SrcSpanAnnA (HsType DocNameI))
 -> Html)
-> Maybe
     ([HsArg
         DocNameI
         (GenLocated SrcSpanAnnA (HsType DocNameI))
         (GenLocated SrcSpanAnnA (HsType DocNameI))],
      GenLocated SrcSpanAnnA (HsType DocNameI))
-> Maybe Html
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DocName
-> Maybe
     ([HsArg
         DocNameI
         (GenLocated SrcSpanAnnA (HsType DocNameI))
         (GenLocated SrcSpanAnnA (HsType DocNameI))],
      GenLocated SrcSpanAnnA (HsType DocNameI))
lookupDAT DocName
name
          ]

      -- Default associated types
      ppDefaultAssocTy :: DocName
-> ([HsArg
       DocNameI
       (GenLocated SrcSpanAnnA (HsType DocNameI))
       (GenLocated SrcSpanAnnA (HsType DocNameI))],
    GenLocated SrcSpanAnnA (HsType DocNameI))
-> Html
ppDefaultAssocTy DocName
n ([HsArg
   DocNameI
   (GenLocated SrcSpanAnnA (HsType DocNameI))
   (GenLocated SrcSpanAnnA (HsType DocNameI))]
vs, GenLocated SrcSpanAnnA (HsType DocNameI)
rhs) =
        [Html] -> Html
hsep
          [ String -> Html
keyword String
"type"
          , DocName -> HsFamEqnPats DocNameI -> Bool -> Qualification -> Html
ppAppNameTypeArgs DocName
n HsFamEqnPats DocNameI
[HsArg
   DocNameI
   (GenLocated SrcSpanAnnA (HsType DocNameI))
   (GenLocated SrcSpanAnnA (HsType DocNameI))]
vs Bool
unicode Qualification
qual
          , Html
equals
          , Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType DocNameI)
rhs)
          ]

      lookupDAT :: DocName
-> Maybe
     ([HsArg
         DocNameI
         (GenLocated SrcSpanAnnA (HsType DocNameI))
         (GenLocated SrcSpanAnnA (HsType DocNameI))],
      GenLocated SrcSpanAnnA (HsType DocNameI))
lookupDAT DocName
name = Name
-> Map
     Name
     ([HsArg
         DocNameI
         (GenLocated SrcSpanAnnA (HsType DocNameI))
         (GenLocated SrcSpanAnnA (HsType DocNameI))],
      GenLocated SrcSpanAnnA (HsType DocNameI))
-> Maybe
     ([HsArg
         DocNameI
         (GenLocated SrcSpanAnnA (HsType DocNameI))
         (GenLocated SrcSpanAnnA (HsType DocNameI))],
      GenLocated SrcSpanAnnA (HsType DocNameI))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
name) Map
  Name
  ([HsArg
      DocNameI
      (GenLocated SrcSpanAnnA (HsType DocNameI))
      (GenLocated SrcSpanAnnA (HsType DocNameI))],
   GenLocated SrcSpanAnnA (HsType DocNameI))
defaultAssocTys
      defaultAssocTys :: Map
  Name
  ([HsArg
      DocNameI
      (GenLocated SrcSpanAnnA (HsType DocNameI))
      (GenLocated SrcSpanAnnA (HsType DocNameI))],
   GenLocated SrcSpanAnnA (HsType DocNameI))
defaultAssocTys =
        [(Name,
  ([HsArg
      DocNameI
      (GenLocated SrcSpanAnnA (HsType DocNameI))
      (GenLocated SrcSpanAnnA (HsType DocNameI))],
   GenLocated SrcSpanAnnA (HsType DocNameI)))]
-> Map
     Name
     ([HsArg
         DocNameI
         (GenLocated SrcSpanAnnA (HsType DocNameI))
         (GenLocated SrcSpanAnnA (HsType DocNameI))],
      GenLocated SrcSpanAnnA (HsType DocNameI))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
name, (HsFamEqnPats DocNameI
[HsArg
   DocNameI
   (GenLocated SrcSpanAnnA (HsType DocNameI))
   (GenLocated SrcSpanAnnA (HsType DocNameI))]
vs, XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
typ))
          | L
              SrcSpanAnnA
_
              ( TyFamInstDecl
                  XCTyFamInstDecl DocNameI
_
                  ( FamEqn
                      { feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = XRec DocNameI (HsType DocNameI)
typ
                      , feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = L SrcSpanAnnN
_ DocName
name
                      , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_pats = HsFamEqnPats DocNameI
vs
                      }
                    )
                ) <-
              [LTyFamDefltDecl DocNameI]
[GenLocated SrcSpanAnnA (TyFamInstDecl DocNameI)]
atsDefs
          ]

      -- Methods
      methodBit :: Html
methodBit =
        [Html] -> Html
subMethods
          [ Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFunSig
            Bool
summary
            LinksInfo
links
            SrcSpan
loc
            Html
noHtml
            DocForDecl DocName
doc
            [DocName
name]
            LHsSigType DocNameI
typ
            [(DocName, Fixity)]
subfixs
            Bool
splice
            Bool
unicode
            Maybe String
pkg
            Qualification
qual
            Html -> Html -> Html
<+> [Html] -> Html
subDefaults (Maybe Html -> [Html]
forall a. Maybe a -> [a]
Maybe.maybeToList Maybe Html
defSigs)
          | ClassOpSig XClassOpSig DocNameI
_ Bool
False [LIdP DocNameI]
lnames LHsSigType DocNameI
typ <- [Sig DocNameI]
sigs
          , DocName
name <- (GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames
          , let doc :: DocForDecl DocName
doc = DocName -> [(DocName, DocForDecl DocName)] -> DocForDecl DocName
forall id1 id2.
Eq id1 =>
id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc DocName
name [(DocName, DocForDecl DocName)]
subdocs
                subfixs :: [(DocName, Fixity)]
subfixs = ((DocName, Fixity) -> Bool)
-> [(DocName, Fixity)] -> [(DocName, Fixity)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((DocName -> DocName -> Bool
forall a. Eq a => a -> a -> Bool
== DocName
name) (DocName -> Bool)
-> ((DocName, Fixity) -> DocName) -> (DocName, Fixity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocName, Fixity) -> DocName
forall a b. (a, b) -> a
fst) [(DocName, Fixity)]
fixities
                defSigs :: Maybe Html
defSigs = DocName
-> (GenLocated SrcSpanAnnA (HsSigType DocNameI),
    DocForDecl DocName)
-> Html
ppDefaultFunSig DocName
name ((GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName)
 -> Html)
-> Maybe
     (GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName)
-> Maybe Html
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DocName
-> Maybe
     (GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName)
lookupDM DocName
name
          ]
      -- N.B. taking just the first name is ok. Signatures with multiple names
      -- are expanded so that each name gets its own signature.

      -- Default methods
      ppDefaultFunSig :: DocName
-> (GenLocated SrcSpanAnnA (HsSigType DocNameI),
    DocForDecl DocName)
-> Html
ppDefaultFunSig DocName
n (GenLocated SrcSpanAnnA (HsSigType DocNameI)
t, DocForDecl DocName
d') =
        Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppFunSig
          Bool
summary
          LinksInfo
links
          SrcSpan
loc
          (String -> Html
keyword String
"default")
          DocForDecl DocName
d'
          [DocName
n]
          LHsSigType DocNameI
GenLocated SrcSpanAnnA (HsSigType DocNameI)
t
          []
          Bool
splice
          Bool
unicode
          Maybe String
pkg
          Qualification
qual

      lookupDM :: DocName
-> Maybe
     (GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName)
lookupDM DocName
name = String
-> Map
     String
     (GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName)
-> Maybe
     (GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ OccName -> OccName
mkDefaultMethodOcc (OccName -> OccName) -> OccName -> OccName
forall a b. (a -> b) -> a -> b
$ DocName -> OccName
forall a. NamedThing a => a -> OccName
getOccName DocName
name) Map
  String
  (GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName)
defaultMethods
      defaultMethods :: Map
  String
  (GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName)
defaultMethods =
        [(String,
  (GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName))]
-> Map
     String
     (GenLocated SrcSpanAnnA (HsSigType DocNameI), DocForDecl DocName)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (String
nameStr, (LHsSigType DocNameI
GenLocated SrcSpanAnnA (HsSigType DocNameI)
typ, DocForDecl DocName
doc))
          | ClassOpSig XClassOpSig DocNameI
_ Bool
True [LIdP DocNameI]
lnames LHsSigType DocNameI
typ <- [Sig DocNameI]
sigs
          , DocName
name <- (GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames
          , let doc :: DocForDecl DocName
doc = DocName -> [(DocName, DocForDecl DocName)] -> DocForDecl DocName
forall id1 id2.
Eq id1 =>
id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc DocName
name [(DocName, DocForDecl DocName)]
subdocs
                nameStr :: String
nameStr = DocName -> String
forall a. NamedThing a => a -> String
getOccString DocName
name
          ]

      -- Minimal complete definition
      minimalBit :: Html
minimalBit = case [BooleanFormula (LIdP DocNameI)
BooleanFormula (GenLocated SrcSpanAnnN DocName)
s | MinimalSig XMinimalSig DocNameI
_ (L SrcSpanAnnL
_ BooleanFormula (LIdP DocNameI)
s) <- [Sig DocNameI]
sigs] of
        -- Miminal complete definition = every shown method
        And [LBooleanFormula (GenLocated SrcSpanAnnN DocName)]
xs : [BooleanFormula (GenLocated SrcSpanAnnN DocName)]
_
          | [Name] -> [Name]
forall a. Ord a => [a] -> [a]
sort [DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
n | L SrcSpanAnnL
_ (Var (L SrcSpanAnnN
_ DocName
n)) <- [LBooleanFormula (GenLocated SrcSpanAnnN DocName)]
xs]
              [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name] -> [Name]
forall a. Ord a => [a] -> [a]
sort [DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
n | ClassOpSig XClassOpSig DocNameI
_ Bool
_ [LIdP DocNameI]
ns LHsSigType DocNameI
_ <- [Sig DocNameI]
sigs, L SrcSpanAnnN
_ DocName
n <- [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
ns] ->
              Html
noHtml
        -- Minimal complete definition = the only shown method
        Var (L SrcSpanAnnN
_ DocName
n) : [BooleanFormula (GenLocated SrcSpanAnnN DocName)]
_
          | [DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
n]
              [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
n' | ClassOpSig XClassOpSig DocNameI
_ Bool
_ [LIdP DocNameI]
ns LHsSigType DocNameI
_ <- [Sig DocNameI]
sigs, L SrcSpanAnnN
_ DocName
n' <- [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
ns] ->
              Html
noHtml
        -- Minimal complete definition = nothing
        And [] : [BooleanFormula (GenLocated SrcSpanAnnN DocName)]
_ -> Html -> Html
subMinimal (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. HTML a => a -> Html
toHtml String
"Nothing"
        BooleanFormula (GenLocated SrcSpanAnnN DocName)
m : [BooleanFormula (GenLocated SrcSpanAnnN DocName)]
_ -> Html -> Html
subMinimal (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Bool -> BooleanFormula (GenLocated SrcSpanAnnN DocName) -> Html
ppMinimal Bool
False BooleanFormula (GenLocated SrcSpanAnnN DocName)
m
        [BooleanFormula (GenLocated SrcSpanAnnN DocName)]
_ -> Html
noHtml

      ppMinimal :: Bool -> BooleanFormula (GenLocated SrcSpanAnnN DocName) -> Html
ppMinimal Bool
_ (Var (L SrcSpanAnnN
_ DocName
n)) = Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Prefix Bool
True DocName
n
      ppMinimal Bool
_ (And [LBooleanFormula (GenLocated SrcSpanAnnN DocName)]
fs) = (Html -> Html -> Html) -> [Html] -> Html
forall a. (a -> a -> a) -> [a] -> a
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldr1 (\Html
a Html
b -> Html
a Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ String
", " String -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
b) ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (LBooleanFormula (GenLocated SrcSpanAnnN DocName) -> Html)
-> [LBooleanFormula (GenLocated SrcSpanAnnN DocName)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BooleanFormula (GenLocated SrcSpanAnnN DocName) -> Html
ppMinimal Bool
True (BooleanFormula (GenLocated SrcSpanAnnN DocName) -> Html)
-> (LBooleanFormula (GenLocated SrcSpanAnnN DocName)
    -> BooleanFormula (GenLocated SrcSpanAnnN DocName))
-> LBooleanFormula (GenLocated SrcSpanAnnN DocName)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LBooleanFormula (GenLocated SrcSpanAnnN DocName)
-> BooleanFormula (GenLocated SrcSpanAnnN DocName)
forall l e. GenLocated l e -> e
unLoc) [LBooleanFormula (GenLocated SrcSpanAnnN DocName)]
fs
      ppMinimal Bool
p (Or [LBooleanFormula (GenLocated SrcSpanAnnN DocName)]
fs) = Html -> Html
wrap (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (Html -> Html -> Html) -> [Html] -> Html
forall a. (a -> a -> a) -> [a] -> a
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldr1 (\Html
a Html
b -> Html
a Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ String
" | " String -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
b) ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (LBooleanFormula (GenLocated SrcSpanAnnN DocName) -> Html)
-> [LBooleanFormula (GenLocated SrcSpanAnnN DocName)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BooleanFormula (GenLocated SrcSpanAnnN DocName) -> Html
ppMinimal Bool
False (BooleanFormula (GenLocated SrcSpanAnnN DocName) -> Html)
-> (LBooleanFormula (GenLocated SrcSpanAnnN DocName)
    -> BooleanFormula (GenLocated SrcSpanAnnN DocName))
-> LBooleanFormula (GenLocated SrcSpanAnnN DocName)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LBooleanFormula (GenLocated SrcSpanAnnN DocName)
-> BooleanFormula (GenLocated SrcSpanAnnN DocName)
forall l e. GenLocated l e -> e
unLoc) [LBooleanFormula (GenLocated SrcSpanAnnN DocName)]
fs
        where
          wrap :: Html -> Html
wrap | Bool
p = Html -> Html
parens | Bool
otherwise = Html -> Html
forall a. a -> a
id
      ppMinimal Bool
p (Parens LBooleanFormula (GenLocated SrcSpanAnnN DocName)
x) = Bool -> BooleanFormula (GenLocated SrcSpanAnnN DocName) -> Html
ppMinimal Bool
p (LBooleanFormula (GenLocated SrcSpanAnnN DocName)
-> BooleanFormula (GenLocated SrcSpanAnnN DocName)
forall l e. GenLocated l e -> e
unLoc LBooleanFormula (GenLocated SrcSpanAnnN DocName)
x)

      -- Instances
      instancesBit :: Html
instancesBit =
        LinksInfo
-> InstOrigin DocName
-> [DocInstance DocNameI]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppInstances
          LinksInfo
links
          (DocName -> InstOrigin DocName
forall name. name -> InstOrigin name
OriginClass DocName
nm)
          [DocInstance DocNameI]
instances
          Bool
splice
          Bool
unicode
          Maybe String
pkg
          Qualification
qual
ppClassDecl Bool
_ LinksInfo
_ [DocInstance DocNameI]
_ [(DocName, Fixity)]
_ SrcSpan
_ Documentation DocName
_ [(DocName, DocForDecl DocName)]
_ TyClDecl DocNameI
_ Bool
_ Bool
_ Maybe String
_ Qualification
_ = String -> Html
forall a. HasCallStack => String -> a
error String
"declaration type not supported by ppShortClassDecl"

ppInstances
  :: LinksInfo
  -> InstOrigin DocName
  -> [DocInstance DocNameI]
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppInstances :: LinksInfo
-> InstOrigin DocName
-> [DocInstance DocNameI]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppInstances LinksInfo
links InstOrigin DocName
origin [DocInstance DocNameI]
instances Bool
splice Bool
unicode Maybe String
pkg Qualification
qual =
  Maybe String
-> Qualification
-> String
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
subInstances Maybe String
pkg Qualification
qual String
instName LinksInfo
links Bool
True ((Int
 -> (InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
     Maybe Module)
 -> (SubDecl, Maybe Module, Located DocName))
-> [Int]
-> [(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
     Maybe Module)]
-> [(SubDecl, Maybe Module, Located DocName)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int
-> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)
Int
-> (InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
    Maybe Module)
-> (SubDecl, Maybe Module, Located DocName)
instDecl [Int
1 ..] [DocInstance DocNameI]
[(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)]
instances)
  where
    -- force Splice = True to use line URLs

    instName :: String
instName = InstOrigin DocName -> String
forall a. NamedThing a => a -> String
getOccString InstOrigin DocName
origin
    instDecl :: Int -> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)
    instDecl :: Int
-> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)
instDecl Int
no (InstHead DocNameI
inst, Maybe (MDoc (IdP DocNameI))
mdoc, Located (IdP DocNameI)
loc, Maybe Module
mdl) =
      ((LinksInfo
-> Bool
-> Bool
-> Qualification
-> Maybe (MDoc DocName)
-> InstOrigin DocName
-> Bool
-> Int
-> InstHead DocNameI
-> Maybe Module
-> SubDecl
ppInstHead LinksInfo
links Bool
splice Bool
unicode Qualification
qual Maybe (MDoc (IdP DocNameI))
Maybe (MDoc DocName)
mdoc InstOrigin DocName
origin Bool
False Int
no InstHead DocNameI
inst Maybe Module
mdl), Maybe Module
mdl, Located (IdP DocNameI)
Located DocName
loc)

ppOrphanInstances
  :: LinksInfo
  -> [DocInstance DocNameI]
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppOrphanInstances :: LinksInfo
-> [DocInstance DocNameI]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppOrphanInstances LinksInfo
links [DocInstance DocNameI]
instances Bool
splice Bool
unicode Maybe String
pkg Qualification
qual =
  Maybe String
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
subOrphanInstances Maybe String
pkg Qualification
qual LinksInfo
links Bool
True ((Int
 -> (InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
     Maybe Module)
 -> (SubDecl, Maybe Module, Located DocName))
-> [Int]
-> [(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
     Maybe Module)]
-> [(SubDecl, Maybe Module, Located DocName)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int
-> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)
Int
-> (InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
    Maybe Module)
-> (SubDecl, Maybe Module, Located DocName)
instDecl [Int
1 ..] [DocInstance DocNameI]
[(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)]
instances)
  where
    instOrigin :: InstHead name -> InstOrigin (IdP name)
    instOrigin :: forall name. InstHead name -> InstOrigin (IdP name)
instOrigin InstHead name
inst = IdP name -> InstOrigin (IdP name)
forall name. name -> InstOrigin name
OriginClass (InstHead name -> IdP name
forall name. InstHead name -> IdP name
ihdClsName InstHead name
inst)

    instDecl :: Int -> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)
    instDecl :: Int
-> DocInstance DocNameI -> (SubDecl, Maybe Module, Located DocName)
instDecl Int
no (InstHead DocNameI
inst, Maybe (MDoc (IdP DocNameI))
mdoc, Located (IdP DocNameI)
loc, Maybe Module
mdl) =
      ((LinksInfo
-> Bool
-> Bool
-> Qualification
-> Maybe (MDoc DocName)
-> InstOrigin DocName
-> Bool
-> Int
-> InstHead DocNameI
-> Maybe Module
-> SubDecl
ppInstHead LinksInfo
links Bool
splice Bool
unicode Qualification
qual Maybe (MDoc (IdP DocNameI))
Maybe (MDoc DocName)
mdoc (InstHead DocNameI -> InstOrigin (IdP DocNameI)
forall name. InstHead name -> InstOrigin (IdP name)
instOrigin InstHead DocNameI
inst) Bool
True Int
no InstHead DocNameI
inst Maybe Module
forall a. Maybe a
Nothing), Maybe Module
mdl, Located (IdP DocNameI)
Located DocName
loc)

ppInstHead
  :: LinksInfo
  -> Splice
  -> Unicode
  -> Qualification
  -> Maybe (MDoc DocName)
  -> InstOrigin DocName
  -> Bool
  -- ^ Is instance orphan
  -> Int
  -- ^ Normal
  -> InstHead DocNameI
  -> Maybe Module
  -> SubDecl
ppInstHead :: LinksInfo
-> Bool
-> Bool
-> Qualification
-> Maybe (MDoc DocName)
-> InstOrigin DocName
-> Bool
-> Int
-> InstHead DocNameI
-> Maybe Module
-> SubDecl
ppInstHead LinksInfo
links Bool
splice Bool
unicode Qualification
qual Maybe (MDoc DocName)
mdoc InstOrigin DocName
origin Bool
orphan Int
no ihd :: InstHead DocNameI
ihd@(InstHead{[HsType DocNameI]
IdP DocNameI
InstType DocNameI
ihdClsName :: forall name. InstHead name -> IdP name
ihdClsName :: IdP DocNameI
ihdTypes :: [HsType DocNameI]
ihdInstType :: InstType DocNameI
ihdInstType :: forall name. InstHead name -> InstType name
ihdTypes :: forall name. InstHead name -> [HsType name]
..}) Maybe Module
mdl =
  case InstType DocNameI
ihdInstType of
    ClassInst{[DocInstance DocNameI]
[HsType DocNameI]
[Sig DocNameI]
LHsQTyVars DocNameI
clsiCtx :: [HsType DocNameI]
clsiTyVars :: LHsQTyVars DocNameI
clsiSigs :: [Sig DocNameI]
clsiAssocTys :: [DocInstance DocNameI]
clsiAssocTys :: forall name. InstType name -> [DocInstance name]
clsiSigs :: forall name. InstType name -> [Sig name]
clsiTyVars :: forall name. InstType name -> LHsQTyVars name
clsiCtx :: forall name. InstType name -> [HsType name]
..} ->
      ( String -> Html -> Html
subInstHead String
iid (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [HsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoLocs [HsType DocNameI]
clsiCtx Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts Html -> Html -> Html
<+> Html
typ
      , Maybe (MDoc DocName)
mdoc
      , [String -> [Html] -> [Html] -> Html -> Html
subInstDetails String
iid [Html]
ats [Html]
sigs Html
mname]
      )
      where
        sigs :: [Html]
sigs = LinksInfo
-> Bool -> Bool -> Qualification -> [Sig DocNameI] -> [Html]
ppInstanceSigs LinksInfo
links Bool
splice Bool
unicode Qualification
qual [Sig DocNameI]
clsiSigs
        ats :: [Html]
ats = LinksInfo
-> Bool
-> Bool
-> Qualification
-> Bool
-> [DocInstance DocNameI]
-> [Html]
ppInstanceAssocTys LinksInfo
links Bool
splice Bool
unicode Qualification
qual Bool
orphan [DocInstance DocNameI]
clsiAssocTys
    TypeInst Maybe (HsType DocNameI)
rhs ->
      ( String -> Html -> Html
subInstHead String
iid Html
ptype
      , Maybe (MDoc DocName)
mdoc
      , [String -> Html -> Html -> Html
subFamInstDetails String
iid Html
prhs Html
mname]
      )
      where
        ptype :: Html
ptype = String -> Html
keyword String
"type" Html -> Html -> Html
<+> Html
typ
        prhs :: Html
prhs =
          Html
ptype
            Html -> Html -> Html
<+> Html
-> (HsType DocNameI -> Html) -> Maybe (HsType DocNameI) -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              Html
noHtml
              (\HsType DocNameI
t -> Html
equals Html -> Html -> Html
<+> Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts HsType DocNameI
t)
              Maybe (HsType DocNameI)
rhs
    DataInst TyClDecl DocNameI
dd ->
      ( String -> Html -> Html
subInstHead String
iid Html
pdata
      , Maybe (MDoc DocName)
mdoc
      , [String -> Html -> Html -> Html
subFamInstDetails String
iid Html
pdecl Html
mname]
      )
      where
        cons :: DataDefnCons (LConDecl DocNameI)
cons = HsDataDefn DocNameI -> DataDefnCons (LConDecl DocNameI)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dd)
        pref :: Html
pref = case DataDefnCons (LConDecl DocNameI)
cons of NewTypeCon LConDecl DocNameI
_ -> String -> Html
keyword String
"newtype"; DataTypeCons Bool
_ [LConDecl DocNameI]
_ -> String -> Html
keyword String
"data"
        pdata :: Html
pdata = Html
pref Html -> Html -> Html
<+> Html
typ
        pdecl :: Html
pdecl = Html
pdata Html -> Html -> Html
<+> Bool
-> Bool
-> TyClDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> Bool
-> Qualification
-> Html
ppShortDataDecl Bool
False Bool
True TyClDecl DocNameI
dd [] Bool
unicode Qualification
qual
  where
    mname :: Html
mname = Html -> (Module -> Html) -> Maybe Module -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Html
noHtml (\Module
m -> String -> Html
forall a. HTML a => a -> Html
toHtml String
"Defined in" Html -> Html -> Html
<+> Module -> Html
ppModule Module
m) Maybe Module
mdl
    iid :: String
iid = InstOrigin DocName -> Int -> Bool -> InstHead DocNameI -> String
instanceId InstOrigin DocName
origin Int
no Bool
orphan InstHead DocNameI
ihd
    typ :: Html
typ = DocName -> [HsType DocNameI] -> Bool -> Qualification -> Html
ppAppNameTypes IdP DocNameI
DocName
ihdClsName [HsType DocNameI]
ihdTypes Bool
unicode Qualification
qual

ppInstanceAssocTys
  :: LinksInfo
  -> Splice
  -> Unicode
  -> Qualification
  -> Bool
  -> [DocInstance DocNameI]
  -> [Html]
ppInstanceAssocTys :: LinksInfo
-> Bool
-> Bool
-> Qualification
-> Bool
-> [DocInstance DocNameI]
-> [Html]
ppInstanceAssocTys LinksInfo
links Bool
splice Bool
unicode Qualification
qual Bool
orphan [DocInstance DocNameI]
insts =
  Maybe Html -> [Html]
forall a. Maybe a -> [a]
Maybe.maybeToList (Maybe Html -> [Html]) -> Maybe Html -> [Html]
forall a b. (a -> b) -> a -> b
$
    Maybe String
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Maybe Html
subTableSrc Maybe String
forall a. Maybe a
Nothing Qualification
qual LinksInfo
links Bool
True ([(SubDecl, Maybe Module, Located DocName)] -> Maybe Html)
-> [(SubDecl, Maybe Module, Located DocName)] -> Maybe Html
forall a b. (a -> b) -> a -> b
$
      ((InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)
 -> Int -> (SubDecl, Maybe Module, Located DocName))
-> [(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
     Maybe Module)]
-> [Int]
-> [(SubDecl, Maybe Module, Located DocName)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
 Maybe Module)
-> Int -> (SubDecl, Maybe Module, Located DocName)
mkInstHead
        [DocInstance DocNameI]
[(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)]
insts
        [Int
1 ..]
  where
    mkInstHead :: (InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
 Maybe Module)
-> Int -> (SubDecl, Maybe Module, Located DocName)
mkInstHead (InstHead DocNameI
inst, Maybe (MDoc DocName)
doc, Located DocName
name, Maybe Module
mdl) Int
no =
      ( LinksInfo
-> Bool
-> Bool
-> Qualification
-> Maybe (MDoc DocName)
-> InstOrigin DocName
-> Bool
-> Int
-> InstHead DocNameI
-> Maybe Module
-> SubDecl
ppInstHead LinksInfo
links Bool
splice Bool
unicode Qualification
qual Maybe (MDoc DocName)
doc (DocName -> InstOrigin DocName
forall name. name -> InstOrigin name
OriginFamily (Located DocName -> DocName
forall l e. GenLocated l e -> e
unLoc Located DocName
name)) Bool
orphan Int
no InstHead DocNameI
inst Maybe Module
mdl
      , Maybe Module
mdl
      , Located DocName
name
      )

ppInstanceSigs
  :: LinksInfo
  -> Splice
  -> Unicode
  -> Qualification
  -> [Sig DocNameI]
  -> [Html]
ppInstanceSigs :: LinksInfo
-> Bool -> Bool -> Qualification -> [Sig DocNameI] -> [Html]
ppInstanceSigs LinksInfo
links Bool
splice Bool
unicode Qualification
qual [Sig DocNameI]
sigs = do
  TypeSig _ lnames typ <- [Sig DocNameI]
sigs
  let names = (GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames
      L _ rtyp = dropWildCards typ
  -- Instance methods signatures are synified and thus don't have a useful
  -- SrcSpan value. Use the methods name location instead.
  let lname =
        case [GenLocated SrcSpanAnnN DocName]
-> Maybe (GenLocated SrcSpanAnnN DocName)
forall a. [a] -> Maybe a
Maybe.listToMaybe [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames of
          Maybe (GenLocated SrcSpanAnnN DocName)
Nothing -> String -> GenLocated SrcSpanAnnN DocName
forall a. HasCallStack => String -> a
error String
"No names. An invariant was broken. Please report this to the Haddock project"
          Just GenLocated SrcSpanAnnN DocName
hd -> GenLocated SrcSpanAnnN DocName
hd
  return $ ppSimpleSig links splice unicode qual HideEmptyContexts (getLocA lname) names rtyp

lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc :: forall id1 id2.
Eq id1 =>
id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc id1
n = DocForDecl id2 -> Maybe (DocForDecl id2) -> DocForDecl id2
forall a. a -> Maybe a -> a
Maybe.fromMaybe DocForDecl id2
forall name. DocForDecl name
noDocForDecl (Maybe (DocForDecl id2) -> DocForDecl id2)
-> ([(id1, DocForDecl id2)] -> Maybe (DocForDecl id2))
-> [(id1, DocForDecl id2)]
-> DocForDecl id2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. id1 -> [(id1, DocForDecl id2)] -> Maybe (DocForDecl id2)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup id1
n

instanceId :: InstOrigin DocName -> Int -> Bool -> InstHead DocNameI -> String
instanceId :: InstOrigin DocName -> Int -> Bool -> InstHead DocNameI -> String
instanceId InstOrigin DocName
origin Int
no Bool
orphan InstHead DocNameI
ihd =
  [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [String
"o:" | Bool
orphan]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ InstOrigin DocName -> String
forall {name}. InstOrigin name -> String
qual InstOrigin DocName
origin
         , String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ InstOrigin DocName -> String
forall a. NamedThing a => a -> String
getOccString InstOrigin DocName
origin
         , String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ DocName -> String
forall a. NamedThing a => a -> String
getOccString (InstHead DocNameI -> IdP DocNameI
forall name. InstHead name -> IdP name
ihdClsName InstHead DocNameI
ihd)
         , String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
no
         ]
  where
    qual :: InstOrigin name -> String
qual (OriginClass name
_) = String
"ic"
    qual (OriginData name
_) = String
"id"
    qual (OriginFamily name
_) = String
"if"

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

-- * Data & newtype declarations

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

-- TODO: print contexts
ppShortDataDecl
  :: Bool
  -> Bool
  -> TyClDecl DocNameI
  -> [(HsDecl DocNameI, DocForDecl DocName)]
  -> Unicode
  -> Qualification
  -> Html
ppShortDataDecl :: Bool
-> Bool
-> TyClDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> Bool
-> Qualification
-> Html
ppShortDataDecl Bool
summary Bool
dataInst TyClDecl DocNameI
dataDecl [(HsDecl DocNameI, DocForDecl DocName)]
pats Bool
unicode Qualification
qual
  | [] <- DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
-> [GenLocated SrcSpan (ConDecl DocNameI)]
forall a. DataDefnCons a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons
  , [] <- [(HsDecl DocNameI, DocForDecl DocName)]
pats =
      Html
dataHeader
  | [GenLocated SrcSpan (ConDecl DocNameI)
lcon] <- DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
-> [GenLocated SrcSpan (ConDecl DocNameI)]
forall a. DataDefnCons a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons
  , [] <- [(HsDecl DocNameI, DocForDecl DocName)]
pats
  , Bool
isH98
  , (Html
cHead, Html
cBody, Html
cFoot) <- Bool
-> Bool
-> ConDecl DocNameI
-> Bool
-> Qualification
-> (Html, Html, Html)
ppShortConstrParts Bool
summary Bool
dataInst (GenLocated SrcSpan (ConDecl DocNameI) -> ConDecl DocNameI
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (ConDecl DocNameI)
lcon) Bool
unicode Qualification
qual =
      (Html
dataHeader Html -> Html -> Html
<+> Html
equals Html -> Html -> Html
<+> Html
cHead) Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
cBody Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
cFoot
  | [] <- [(HsDecl DocNameI, DocForDecl DocName)]
pats
  , Bool
isH98 =
      Html
dataHeader
        Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Bool -> [Html] -> Html
shortSubDecls Bool
dataInst ((Char -> GenLocated SrcSpan (ConDecl DocNameI) -> Html)
-> String -> [GenLocated SrcSpan (ConDecl DocNameI)] -> [Html]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> GenLocated SrcSpan (ConDecl DocNameI) -> Html
doConstr (Char
'=' Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> String
forall a. a -> [a]
repeat Char
'|') (DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
-> [GenLocated SrcSpan (ConDecl DocNameI)]
forall a. DataDefnCons a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons) [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html]
pats1)
  | Bool
otherwise =
      (Html
dataHeader Html -> Html -> Html
<+> String -> Html
keyword String
"where")
        Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Bool -> [Html] -> Html
shortSubDecls Bool
dataInst ((GenLocated SrcSpan (ConDecl DocNameI) -> Html)
-> [GenLocated SrcSpan (ConDecl DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (ConDecl DocNameI) -> Html
doGADTConstr (DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
-> [GenLocated SrcSpan (ConDecl DocNameI)]
forall a. DataDefnCons a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons) [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html]
pats1)
  where
    dataHeader :: Html
dataHeader
      | Bool
dataInst = Html
noHtml
      | Bool
otherwise = Bool -> TyClDecl DocNameI -> Bool -> Qualification -> Html
ppDataHeader Bool
summary TyClDecl DocNameI
dataDecl Bool
unicode Qualification
qual
    doConstr :: Char -> GenLocated SrcSpan (ConDecl DocNameI) -> Html
doConstr Char
c GenLocated SrcSpan (ConDecl DocNameI)
con = String -> Html
forall a. HTML a => a -> Html
toHtml [Char
c] Html -> Html -> Html
<+> Bool -> ConDecl DocNameI -> Bool -> Qualification -> Html
ppShortConstr Bool
summary (GenLocated SrcSpan (ConDecl DocNameI) -> ConDecl DocNameI
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (ConDecl DocNameI)
con) Bool
unicode Qualification
qual
    doGADTConstr :: GenLocated SrcSpan (ConDecl DocNameI) -> Html
doGADTConstr GenLocated SrcSpan (ConDecl DocNameI)
con = Bool -> ConDecl DocNameI -> Bool -> Qualification -> Html
ppShortConstr Bool
summary (GenLocated SrcSpan (ConDecl DocNameI) -> ConDecl DocNameI
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (ConDecl DocNameI)
con) Bool
unicode Qualification
qual

    cons :: DataDefnCons (LConDecl DocNameI)
cons = HsDataDefn DocNameI -> DataDefnCons (LConDecl DocNameI)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dataDecl)
    isH98 :: Bool
isH98 = ((ConDecl DocNameI -> Bool)
 -> DataDefnCons (ConDecl DocNameI) -> Bool)
-> DataDefnCons (ConDecl DocNameI)
-> (ConDecl DocNameI -> Bool)
-> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ConDecl DocNameI -> Bool)
-> DataDefnCons (ConDecl DocNameI) -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (GenLocated SrcSpan (ConDecl DocNameI) -> ConDecl DocNameI
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (ConDecl DocNameI) -> ConDecl DocNameI)
-> DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
-> DataDefnCons (ConDecl DocNameI)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons) ((ConDecl DocNameI -> Bool) -> Bool)
-> (ConDecl DocNameI -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \case
      ConDeclH98{} -> Bool
True
      ConDeclGADT{} -> Bool
False

    pats1 :: [Html]
pats1 =
      [ [Html] -> Html
hsep
        [ String -> Html
keyword String
"pattern"
        , [Html] -> Html
hsep ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ Html -> [Html] -> [Html]
punctuate Html
comma ([Html] -> [Html]) -> [Html] -> [Html]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN DocName -> Html)
-> [GenLocated SrcSpanAnnN DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinder Bool
summary (OccName -> Html)
-> (GenLocated SrcSpanAnnN DocName -> OccName)
-> GenLocated SrcSpanAnnN DocName
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> OccName
forall a. NamedThing a => a -> OccName
getOccName) [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames
        , Bool -> Html
dcolon Bool
unicode
        , Bool -> Qualification -> LHsSigType DocNameI -> Html
ppPatSigType Bool
unicode Qualification
qual LHsSigType DocNameI
typ
        ]
      | (SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigType DocNameI
typ), DocForDecl DocName
_) <- [(HsDecl DocNameI, DocForDecl DocName)]
pats
      ]

-- | Pretty-print a data declaration
ppDataDecl
  :: Bool
  -> LinksInfo
  -> [DocInstance DocNameI]
  -- ^ relevant instances
  -> [(DocName, Fixity)]
  -- ^ relevant fixities
  -> [(DocName, DocForDecl DocName)]
  -- ^ all decl documentation
  -> SrcSpan
  -> Documentation DocName
  -- ^ this decl's documentation
  -> TyClDecl DocNameI
  -- ^ this decl
  -> [(HsDecl DocNameI, DocForDecl DocName)]
  -- ^ relevant patterns
  -> Splice
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> Html
ppDataDecl :: Bool
-> LinksInfo
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> [(DocName, DocForDecl DocName)]
-> SrcSpan
-> Documentation DocName
-> TyClDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppDataDecl
  Bool
summary
  LinksInfo
links
  [DocInstance DocNameI]
instances
  [(DocName, Fixity)]
fixities
  [(DocName, DocForDecl DocName)]
subdocs
  SrcSpan
loc
  Documentation DocName
doc
  TyClDecl DocNameI
dataDecl
  [(HsDecl DocNameI, DocForDecl DocName)]
pats
  Bool
splice
  Bool
unicode
  Maybe String
pkg
  Qualification
qual
    | Bool
summary = Bool
-> Bool
-> TyClDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> Bool
-> Qualification
-> Html
ppShortDataDecl Bool
summary Bool
False TyClDecl DocNameI
dataDecl [(HsDecl DocNameI, DocForDecl DocName)]
pats Bool
unicode Qualification
qual
    | Bool
otherwise = Html
header_ Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe Name
-> Maybe String -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe String
pkg Qualification
qual Documentation DocName
doc Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
constrBit Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
patternBit Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
instancesBit
    where
      docname :: DocName
docname = TyClDecl DocNameI -> DocName
tcdNameI TyClDecl DocNameI
dataDecl
      curname :: Maybe Name
curname = Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
docname
      cons :: DataDefnCons (LConDecl DocNameI)
cons = HsDataDefn DocNameI -> DataDefnCons (LConDecl DocNameI)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dataDecl)
      isH98 :: Bool
isH98 = ((ConDecl DocNameI -> Bool)
 -> DataDefnCons (ConDecl DocNameI) -> Bool)
-> DataDefnCons (ConDecl DocNameI)
-> (ConDecl DocNameI -> Bool)
-> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ConDecl DocNameI -> Bool)
-> DataDefnCons (ConDecl DocNameI) -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any (GenLocated SrcSpan (ConDecl DocNameI) -> ConDecl DocNameI
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan (ConDecl DocNameI) -> ConDecl DocNameI)
-> DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
-> DataDefnCons (ConDecl DocNameI)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons) ((ConDecl DocNameI -> Bool) -> Bool)
-> (ConDecl DocNameI -> Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ \case
        ConDeclH98{} -> Bool
True
        ConDeclGADT{} -> Bool
False

      header_ :: Html
header_ =
        LinksInfo -> SrcSpan -> Bool -> DocName -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice DocName
docname (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
          Bool -> TyClDecl DocNameI -> Bool -> Qualification -> Html
ppDataHeader Bool
summary TyClDecl DocNameI
dataDecl Bool
unicode Qualification
qual Html -> Html -> Html
<+> Html
whereBit Html -> Html -> Html
<+> Html
fix

      fix :: Html
fix = [(DocName, Fixity)] -> Qualification -> Html
ppFixities (((DocName, Fixity) -> Bool)
-> [(DocName, Fixity)] -> [(DocName, Fixity)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(DocName
n, Fixity
_) -> DocName
n DocName -> DocName -> Bool
forall a. Eq a => a -> a -> Bool
== DocName
docname) [(DocName, Fixity)]
fixities) Qualification
qual

      whereBit :: Html
whereBit
        | DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI)) -> Bool
forall a. DataDefnCons a -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons
        , [(HsDecl DocNameI, DocForDecl DocName)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(HsDecl DocNameI, DocForDecl DocName)]
pats =
            Html
noHtml
        | Bool
isH98 = Html
noHtml
        | Bool
otherwise = String -> Html
keyword String
"where"

      constrBit :: Html
constrBit =
        Maybe String -> Qualification -> [SubDecl] -> Html
subConstructors
          Maybe String
pkg
          Qualification
qual
          [ [(DocName, DocForDecl DocName)]
-> [(DocName, Fixity)]
-> Bool
-> Maybe String
-> Qualification
-> LConDecl DocNameI
-> SubDecl
ppSideBySideConstr [(DocName, DocForDecl DocName)]
subdocs [(DocName, Fixity)]
subfixs Bool
unicode Maybe String
pkg Qualification
qual LConDecl DocNameI
GenLocated SrcSpan (ConDecl DocNameI)
c
          | GenLocated SrcSpan (ConDecl DocNameI)
c <- DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
-> [GenLocated SrcSpan (ConDecl DocNameI)]
forall a. DataDefnCons a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons
          , let subfixs :: [(DocName, Fixity)]
subfixs =
                  ((DocName, Fixity) -> Bool)
-> [(DocName, Fixity)] -> [(DocName, Fixity)]
forall a. (a -> Bool) -> [a] -> [a]
filter
                    ( \(DocName
n, Fixity
_) ->
                        (DocName -> Bool) -> NonEmpty DocName -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any
                          (\DocName
cn -> DocName
cn DocName -> DocName -> Bool
forall a. Eq a => a -> a -> Bool
== DocName
n)
                          (GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unL (GenLocated SrcSpanAnnN DocName -> DocName)
-> NonEmpty (GenLocated SrcSpanAnnN DocName) -> NonEmpty DocName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ConDecl DocNameI -> NonEmpty (GenLocated SrcSpanAnnN DocName)
getConNamesI (GenLocated SrcSpan (ConDecl DocNameI) -> ConDecl DocNameI
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (ConDecl DocNameI)
c))
                    )
                    [(DocName, Fixity)]
fixities
          ]

      patternBit :: Html
patternBit =
        Maybe String -> Qualification -> [SubDecl] -> Html
subPatterns
          Maybe String
pkg
          Qualification
qual
          [ [(DocName, Fixity)]
-> Bool
-> Qualification
-> [GenLocated SrcSpanAnnN DocName]
-> LHsSigType DocNameI
-> DocForDecl DocName
-> SubDecl
ppSideBySidePat [(DocName, Fixity)]
subfixs Bool
unicode Qualification
qual [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames LHsSigType DocNameI
typ DocForDecl DocName
d
          | (SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigType DocNameI
typ), DocForDecl DocName
d) <- [(HsDecl DocNameI, DocForDecl DocName)]
pats
          , let subfixs :: [(DocName, Fixity)]
subfixs =
                  ((DocName, Fixity) -> Bool)
-> [(DocName, Fixity)] -> [(DocName, Fixity)]
forall a. (a -> Bool) -> [a] -> [a]
filter
                    ( \(DocName
n, Fixity
_) ->
                        (DocName -> Bool) -> [DocName] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any
                          (\DocName
cn -> DocName
cn DocName -> DocName -> Bool
forall a. Eq a => a -> a -> Bool
== DocName
n)
                          ((GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames)
                    )
                    [(DocName, Fixity)]
fixities
          ]

      instancesBit :: Html
instancesBit =
        LinksInfo
-> InstOrigin DocName
-> [DocInstance DocNameI]
-> Bool
-> Bool
-> Maybe String
-> Qualification
-> Html
ppInstances
          LinksInfo
links
          (DocName -> InstOrigin DocName
forall name. name -> InstOrigin name
OriginData DocName
docname)
          [DocInstance DocNameI]
instances
          Bool
splice
          Bool
unicode
          Maybe String
pkg
          Qualification
qual

ppShortConstr :: Bool -> ConDecl DocNameI -> Unicode -> Qualification -> Html
ppShortConstr :: Bool -> ConDecl DocNameI -> Bool -> Qualification -> Html
ppShortConstr Bool
summary ConDecl DocNameI
con Bool
unicode Qualification
qual = Html
cHead Html -> Html -> Html
<+> Html
cBody Html -> Html -> Html
<+> Html
cFoot
  where
    (Html
cHead, Html
cBody, Html
cFoot) = Bool
-> Bool
-> ConDecl DocNameI
-> Bool
-> Qualification
-> (Html, Html, Html)
ppShortConstrParts Bool
summary Bool
False ConDecl DocNameI
con Bool
unicode Qualification
qual

-- returns three pieces: header, body, footer so that header & footer can be
-- incorporated into the declaration
ppShortConstrParts :: Bool -> Bool -> ConDecl DocNameI -> Unicode -> Qualification -> (Html, Html, Html)
ppShortConstrParts :: Bool
-> Bool
-> ConDecl DocNameI
-> Bool
-> Qualification
-> (Html, Html, Html)
ppShortConstrParts Bool
summary Bool
dataInst ConDecl DocNameI
con Bool
unicode Qualification
qual =
  case ConDecl DocNameI
con of
    ConDeclH98
      { con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details DocNameI
det
      , con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs = [LHsTyVarBndr Specificity DocNameI]
tyVars
      , con_forall :: forall pass. ConDecl pass -> Bool
con_forall = Bool
forall_
      , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext DocNameI)
cxt
      } ->
        let context :: HsContext DocNameI
context = Maybe (LHsContext DocNameI) -> HsContext DocNameI
fromMaybeContext Maybe (LHsContext DocNameI)
cxt
            header_ :: Html
header_ = Bool
-> [LHsTyVarBndr Specificity DocNameI]
-> HsContext DocNameI
-> Bool
-> Qualification
-> Html
ppConstrHdr Bool
forall_ [LHsTyVarBndr Specificity DocNameI]
tyVars HsContext DocNameI
context Bool
unicode Qualification
qual
         in case HsConDeclH98Details DocNameI
det of
              -- Prefix constructor, e.g. 'Just a'
              PrefixCon [Void]
_ [HsScaled DocNameI (XRec DocNameI (HsType DocNameI))]
args ->
                ( Html
header_ Html -> Html -> Html
<+> [Html] -> Html
hsep (Html
ppOcc Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: (HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
 -> Html)
-> [HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (GenLocated SrcSpanAnnA (HsType DocNameI) -> Html)
-> (HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
    -> GenLocated SrcSpanAnnA (HsType DocNameI))
-> HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> GenLocated SrcSpanAnnA (HsType DocNameI)
forall pass a. HsScaled pass a -> a
hsScaledThing) [HsScaled DocNameI (XRec DocNameI (HsType DocNameI))]
[HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
args)
                , Html
noHtml
                , Html
noHtml
                )
              -- Record constructor, e.g. 'Identity { runIdentity :: a }'
              RecCon (L SrcSpan
_ [GenLocated SrcSpan (ConDeclField DocNameI)]
fields) ->
                ( Html
header_ Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
ppOcc Html -> Html -> Html
<+> Char -> Html
char Char
'{'
                , Bool -> [Html] -> Html
shortSubDecls
                    Bool
dataInst
                    [ Bool -> Bool -> Qualification -> ConDeclField DocNameI -> Html
ppShortField Bool
summary Bool
unicode Qualification
qual ConDeclField DocNameI
field
                    | L SrcSpan
_ ConDeclField DocNameI
field <- [GenLocated SrcSpan (ConDeclField DocNameI)]
fields
                    ]
                , Char -> Html
char Char
'}'
                )
              -- Infix constructor, e.g. 'a :| [a]'
              InfixCon HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
arg1 HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
arg2 ->
                ( Html
header_
                    Html -> Html -> Html
<+> [Html] -> Html
hsep
                      [ Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> GenLocated SrcSpanAnnA (HsType DocNameI)
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
arg1)
                      , Html
ppOccInfix
                      , Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> GenLocated SrcSpanAnnA (HsType DocNameI)
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
arg2)
                      ]
                , Html
noHtml
                , Html
noHtml
                )
    -- GADT constructor, e.g. 'Foo :: Int -> Foo'
    ConDeclGADT{} ->
      ( [Html] -> Html
hsep [Html
ppOcc, Bool -> Html
dcolon Bool
unicode, Bool
-> Qualification
-> HideEmptyContexts
-> LHsSigType DocNameI
-> Html
ppLSigType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (ConDecl DocNameI -> LHsSigType DocNameI
getGADTConType ConDecl DocNameI
con)]
      , Html
noHtml
      , Html
noHtml
      )
  where
    occ :: [OccName]
occ = NonEmpty OccName -> [OccName]
forall a. NonEmpty a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (NonEmpty OccName -> [OccName]) -> NonEmpty OccName -> [OccName]
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName (Name -> OccName)
-> (GenLocated SrcSpanAnnN DocName -> Name)
-> GenLocated SrcSpanAnnN DocName
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name)
-> (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unL (GenLocated SrcSpanAnnN DocName -> OccName)
-> NonEmpty (GenLocated SrcSpanAnnN DocName) -> NonEmpty OccName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ConDecl DocNameI -> NonEmpty (GenLocated SrcSpanAnnN DocName)
getConNamesI ConDecl DocNameI
con
    ppOcc :: Html
ppOcc = [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma ((OccName -> Html) -> [OccName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinder Bool
summary) [OccName]
occ))
    ppOccInfix :: Html
ppOccInfix = [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma ((OccName -> Html) -> [OccName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinderInfix Bool
summary) [OccName]
occ))

-- | Pretty print an expanded constructor
ppSideBySideConstr
  :: [(DocName, DocForDecl DocName)]
  -> [(DocName, Fixity)]
  -> Unicode
  -> Maybe Package
  -> Qualification
  -> LConDecl DocNameI
  -- ^ constructor declaration to print
  -> SubDecl
ppSideBySideConstr :: [(DocName, DocForDecl DocName)]
-> [(DocName, Fixity)]
-> Bool
-> Maybe String
-> Qualification
-> LConDecl DocNameI
-> SubDecl
ppSideBySideConstr [(DocName, DocForDecl DocName)]
subdocs [(DocName, Fixity)]
fixities Bool
unicode Maybe String
pkg Qualification
qual (L SrcSpan
_ ConDecl DocNameI
con) =
  ( Html
decl -- Constructor header (name, fixity)
  , Maybe (MDoc DocName)
mbDoc -- Docs on the whole constructor
  , [Html]
fieldPart -- Information on the fields (or arguments, if they have docs)
  )
  where
    -- Find the name of a constructors in the decl (`getConName` always returns a non-empty list)
    L SrcSpanAnnN
_ DocName
aConName :| [GenLocated SrcSpanAnnN DocName]
_ = ConDecl DocNameI -> NonEmpty (GenLocated SrcSpanAnnN DocName)
getConNamesI ConDecl DocNameI
con

    fixity :: Html
fixity = [(DocName, Fixity)] -> Qualification -> Html
ppFixities [(DocName, Fixity)]
fixities Qualification
qual
    occ :: [OccName]
occ = NonEmpty OccName -> [OccName]
forall a. NonEmpty a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (NonEmpty OccName -> [OccName]) -> NonEmpty OccName -> [OccName]
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName (Name -> OccName)
-> (GenLocated SrcSpanAnnN DocName -> Name)
-> GenLocated SrcSpanAnnN DocName
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name)
-> (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unL (GenLocated SrcSpanAnnN DocName -> OccName)
-> NonEmpty (GenLocated SrcSpanAnnN DocName) -> NonEmpty OccName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ConDecl DocNameI -> NonEmpty (GenLocated SrcSpanAnnN DocName)
getConNamesI ConDecl DocNameI
con

    ppOcc :: Html
ppOcc = [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma ((OccName -> Html) -> [OccName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinder Bool
False) [OccName]
occ))
    ppOccInfix :: Html
ppOccInfix = [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma ((OccName -> Html) -> [OccName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinderInfix Bool
False) [OccName]
occ))

    -- Extract out the map of of docs corresponding to the constructors arguments
    argDocs :: FnArgsDoc DocName
argDocs = FnArgsDoc DocName
-> (DocForDecl DocName -> FnArgsDoc DocName)
-> Maybe (DocForDecl DocName)
-> FnArgsDoc DocName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FnArgsDoc DocName
forall k a. Map k a
Map.empty DocForDecl DocName -> FnArgsDoc DocName
forall a b. (a, b) -> b
snd (DocName
-> [(DocName, DocForDecl DocName)] -> Maybe (DocForDecl DocName)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DocName
aConName [(DocName, DocForDecl DocName)]
subdocs)
    hasArgDocs :: Bool
hasArgDocs = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FnArgsDoc DocName -> Bool
forall k a. Map k a -> Bool
Map.null FnArgsDoc DocName
argDocs

    decl :: Html
decl = case ConDecl DocNameI
con of
      ConDeclH98
        { con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details DocNameI
det
        , con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs = [LHsTyVarBndr Specificity DocNameI]
tyVars
        , con_forall :: forall pass. ConDecl pass -> Bool
con_forall = Bool
forall_
        , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext DocNameI)
cxt
        } ->
          let context :: HsContext DocNameI
context = Maybe (LHsContext DocNameI) -> HsContext DocNameI
fromMaybeContext Maybe (LHsContext DocNameI)
cxt
              header_ :: Html
header_ = Bool
-> [LHsTyVarBndr Specificity DocNameI]
-> HsContext DocNameI
-> Bool
-> Qualification
-> Html
ppConstrHdr Bool
forall_ [LHsTyVarBndr Specificity DocNameI]
tyVars HsContext DocNameI
context Bool
unicode Qualification
qual
           in case HsConDeclH98Details DocNameI
det of
                -- Prefix constructor, e.g. 'Just a'
                PrefixCon [Void]
_ [HsScaled DocNameI (XRec DocNameI (HsType DocNameI))]
args
                  | Bool
hasArgDocs -> Html
header_ Html -> Html -> Html
<+> Html
ppOcc Html -> Html -> Html
<+> Html
fixity
                  | Bool
otherwise ->
                      [Html] -> Html
hsep
                        [ Html
header_ Html -> Html -> Html
<+> Html
ppOcc
                        , [Html] -> Html
hsep ((HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
 -> Html)
-> [HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (GenLocated SrcSpanAnnA (HsType DocNameI) -> Html)
-> (HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
    -> GenLocated SrcSpanAnnA (HsType DocNameI))
-> HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> GenLocated SrcSpanAnnA (HsType DocNameI)
forall pass a. HsScaled pass a -> a
hsScaledThing) [HsScaled DocNameI (XRec DocNameI (HsType DocNameI))]
[HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
args)
                        , Html
fixity
                        ]
                -- Record constructor, e.g. 'Identity { runIdentity :: a }'
                RecCon XRec DocNameI [LConDeclField DocNameI]
_ -> Html
header_ Html -> Html -> Html
<+> Html
ppOcc Html -> Html -> Html
<+> Html
fixity
                -- Infix constructor, e.g. 'a :| [a]'
                InfixCon HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
arg1 HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
arg2
                  | Bool
hasArgDocs -> Html
header_ Html -> Html -> Html
<+> Html
ppOcc Html -> Html -> Html
<+> Html
fixity
                  | Bool
otherwise ->
                      [Html] -> Html
hsep
                        [ Html
header_ Html -> Html -> Html
<+> Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> GenLocated SrcSpanAnnA (HsType DocNameI)
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
arg1)
                        , Html
ppOccInfix
                        , Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> GenLocated SrcSpanAnnA (HsType DocNameI)
forall pass a. HsScaled pass a -> a
hsScaledThing HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
arg2)
                        , Html
fixity
                        ]
      -- GADT constructor, e.g. 'Foo :: Int -> Foo'
      ConDeclGADT{}
        | Bool
hasArgDocs Bool -> Bool -> Bool
|| Bool -> Bool
not ([Html] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Html]
fieldPart) -> Html
ppOcc Html -> Html -> Html
<+> Html
fixity
        | Bool
otherwise ->
            [Html] -> Html
hsep
              [ Html
ppOcc
              , Bool -> Html
dcolon Bool
unicode
              , -- ++AZ++ make this prepend "{..}" when it is a record style GADT
                Bool
-> Qualification
-> HideEmptyContexts
-> LHsSigType DocNameI
-> Html
ppLSigType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (ConDecl DocNameI -> LHsSigType DocNameI
getGADTConType ConDecl DocNameI
con)
              , Html
fixity
              ]

    fieldPart :: [Html]
fieldPart = case ConDecl DocNameI
con of
      ConDeclGADT{con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails DocNameI
con_args'} -> case HsConDeclGADTDetails DocNameI
con_args' of
        -- GADT record declarations
        RecConGADT XRecConGADT DocNameI
_ XRec DocNameI [LConDeclField DocNameI]
_ -> [[HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> Html
doConstrArgsWithDocs []]
        -- GADT prefix data constructors
        PrefixConGADT XPrefixConGADT DocNameI
_ [HsScaled DocNameI (XRec DocNameI (HsType DocNameI))]
args | Bool
hasArgDocs -> [[HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> Html
doConstrArgsWithDocs [HsScaled DocNameI (XRec DocNameI (HsType DocNameI))]
[HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
args]
        HsConDeclGADTDetails DocNameI
_ -> []
      ConDeclH98{con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details DocNameI
con_args'} -> case HsConDeclH98Details DocNameI
con_args' of
        -- H98 record declarations
        RecCon (L SrcSpan
_ [GenLocated SrcSpan (ConDeclField DocNameI)]
fields) -> [[GenLocated SrcSpan (ConDeclField DocNameI)] -> Html
doRecordFields [GenLocated SrcSpan (ConDeclField DocNameI)]
fields]
        -- H98 prefix data constructors
        PrefixCon [Void]
_ [HsScaled DocNameI (XRec DocNameI (HsType DocNameI))]
args | Bool
hasArgDocs -> [[HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> Html
doConstrArgsWithDocs [HsScaled DocNameI (XRec DocNameI (HsType DocNameI))]
[HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
args]
        -- H98 infix data constructor
        InfixCon HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
arg1 HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
arg2 | Bool
hasArgDocs -> [[HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> Html
doConstrArgsWithDocs [HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
arg1, HsScaled DocNameI (XRec DocNameI (HsType DocNameI))
HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
arg2]]
        HsConDeclH98Details DocNameI
_ -> []

    doRecordFields :: [GenLocated SrcSpan (ConDeclField DocNameI)] -> Html
doRecordFields [GenLocated SrcSpan (ConDeclField DocNameI)]
fields =
      Maybe String -> Qualification -> [SubDecl] -> Html
subFields
        Maybe String
pkg
        Qualification
qual
        ((ConDeclField DocNameI -> SubDecl)
-> [ConDeclField DocNameI] -> [SubDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([(DocName, DocForDecl DocName)]
-> Bool -> Qualification -> ConDeclField DocNameI -> SubDecl
ppSideBySideField [(DocName, DocForDecl DocName)]
subdocs Bool
unicode Qualification
qual) ((GenLocated SrcSpan (ConDeclField DocNameI)
 -> ConDeclField DocNameI)
-> [GenLocated SrcSpan (ConDeclField DocNameI)]
-> [ConDeclField DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (ConDeclField DocNameI) -> ConDeclField DocNameI
forall l e. GenLocated l e -> e
unLoc [GenLocated SrcSpan (ConDeclField DocNameI)]
fields))

    doConstrArgsWithDocs :: [HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> Html
doConstrArgsWithDocs [HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
args = Maybe String -> Qualification -> [SubDecl] -> Html
subFields Maybe String
pkg Qualification
qual ([SubDecl] -> Html) -> [SubDecl] -> Html
forall a b. (a -> b) -> a -> b
$ case ConDecl DocNameI
con of
      ConDeclH98{} ->
        [ (Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
arg, Maybe (MDoc DocName)
mdoc, [])
        | (Int
i, GenLocated SrcSpanAnnA (HsType DocNameI)
arg) <- [Int]
-> [GenLocated SrcSpanAnnA (HsType DocNameI)]
-> [(Int, GenLocated SrcSpanAnnA (HsType DocNameI))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ((HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
 -> GenLocated SrcSpanAnnA (HsType DocNameI))
-> [HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> [GenLocated SrcSpanAnnA (HsType DocNameI)]
forall a b. (a -> b) -> [a] -> [b]
map HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
-> GenLocated SrcSpanAnnA (HsType DocNameI)
forall pass a. HsScaled pass a -> a
hsScaledThing [HsScaled DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))]
args)
        , let mdoc :: Maybe (MDoc DocName)
mdoc = Int -> FnArgsDoc DocName -> Maybe (MDoc DocName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
i FnArgsDoc DocName
argDocs
        ]
      ConDeclGADT{} ->
        Bool
-> Qualification
-> HsSigType DocNameI
-> FnArgsDoc DocName
-> [(DocName, DocForDecl DocName)]
-> Html
-> HideEmptyContexts
-> [SubDecl]
ppSubSigLike
          Bool
unicode
          Qualification
qual
          (GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc (ConDecl DocNameI -> LHsSigType DocNameI
getGADTConType ConDecl DocNameI
con))
          FnArgsDoc DocName
argDocs
          [(DocName, DocForDecl DocName)]
subdocs
          (Bool -> Html
dcolon Bool
unicode)
          HideEmptyContexts
HideEmptyContexts

    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
    -- or also because we want Haddock to do the doc-parsing, not GHC.
    mbDoc :: Maybe (MDoc DocName)
mbDoc =
      DocName
-> [(DocName, DocForDecl DocName)] -> Maybe (DocForDecl DocName)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup DocName
aConName [(DocName, DocForDecl DocName)]
subdocs
        Maybe (DocForDecl DocName)
-> (DocForDecl DocName -> Maybe (MDoc DocName))
-> Maybe (MDoc DocName)
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
>>= Documentation DocName -> Maybe (MDoc DocName)
forall name. Documentation name -> Maybe (MDoc name)
combineDocumentation (Documentation DocName -> Maybe (MDoc DocName))
-> (DocForDecl DocName -> Documentation DocName)
-> DocForDecl DocName
-> Maybe (MDoc DocName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocForDecl DocName -> Documentation DocName
forall a b. (a, b) -> a
fst

-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
ppConstrHdr
  :: Bool
  -- ^ print explicit foralls
  -> [LHsTyVarBndr Specificity DocNameI]
  -- ^ type variables
  -> HsContext DocNameI
  -- ^ context
  -> Unicode
  -> Qualification
  -> Html
ppConstrHdr :: Bool
-> [LHsTyVarBndr Specificity DocNameI]
-> HsContext DocNameI
-> Bool
-> Qualification
-> Html
ppConstrHdr Bool
forall_ [LHsTyVarBndr Specificity DocNameI]
tvs HsContext DocNameI
ctxt Bool
unicode Qualification
qual = Html
ppForall Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
ppCtxt
  where
    ppForall :: Html
ppForall
      | [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity DocNameI]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity DocNameI)]
tvs Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
forall_ = Html
noHtml
      | Bool
otherwise = Bool -> Qualification -> HsForAllTelescope DocNameI -> Html
ppForAllPart Bool
unicode Qualification
qual (XHsForAllInvis DocNameI
-> [LHsTyVarBndr Specificity DocNameI]
-> HsForAllTelescope DocNameI
forall pass.
XHsForAllInvis pass
-> [LHsTyVarBndr Specificity pass] -> HsForAllTelescope pass
HsForAllInvis XHsForAllInvis DocNameI
NoExtField
noExtField [LHsTyVarBndr Specificity DocNameI]
tvs)

    ppCtxt :: Html
ppCtxt
      | [GenLocated SrcSpanAnnA (HsType DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null HsContext DocNameI
[GenLocated SrcSpanAnnA (HsType DocNameI)]
ctxt = Html
noHtml
      | Bool
otherwise =
          HsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoArrow HsContext DocNameI
ctxt Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
            Html -> Html -> Html
<+> Bool -> Html
darrow Bool
unicode
            Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ String -> Html
forall a. HTML a => a -> Html
toHtml String
" "

-- | Pretty-print a record field
ppSideBySideField
  :: [(DocName, DocForDecl DocName)]
  -> Unicode
  -> Qualification
  -> ConDeclField DocNameI
  -> SubDecl
ppSideBySideField :: [(DocName, DocForDecl DocName)]
-> Bool -> Qualification -> ConDeclField DocNameI -> SubDecl
ppSideBySideField [(DocName, DocForDecl DocName)]
subdocs Bool
unicode Qualification
qual (ConDeclField XConDeclField DocNameI
_ [LFieldOcc DocNameI]
names XRec DocNameI (HsType DocNameI)
ltype Maybe (LHsDoc DocNameI)
_) =
  ( [Html] -> Html
hsep
      ( Html -> [Html] -> [Html]
punctuate
          Html
comma
          [ Bool -> OccName -> Html
ppBinder Bool
False (RdrName -> OccName
rdrNameOcc XCFieldOcc DocNameI
RdrName
field)
          | L SrcSpanAnnA
_ FieldOcc DocNameI
name <- [LFieldOcc DocNameI]
[GenLocated SrcSpanAnnA (FieldOcc DocNameI)]
names
          , let field :: XCFieldOcc DocNameI
field = (forall pass. FieldOcc pass -> XCFieldOcc pass
foExt) FieldOcc DocNameI
name
          ]
      )
      Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
unicode
      Html -> Html -> Html
<+> Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts XRec DocNameI (HsType DocNameI)
ltype
  , Maybe (MDoc DocName)
mbDoc
  , []
  )
  where
    -- don't use cd_fld_doc for same reason we don't use con_doc above
    -- Where there is more than one name, they all have the same documentation
    mbDoc :: Maybe (MDoc DocName)
mbDoc = DocName
-> [(DocName, DocForDecl DocName)] -> Maybe (DocForDecl DocName)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN DocName -> DocName)
-> (FieldOcc DocNameI -> GenLocated SrcSpanAnnN DocName)
-> FieldOcc DocNameI
-> DocName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc DocNameI -> LIdP DocNameI
FieldOcc DocNameI -> GenLocated SrcSpanAnnN DocName
forall pass. FieldOcc pass -> LIdP pass
foLabel (FieldOcc DocNameI -> DocName) -> FieldOcc DocNameI -> DocName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> FieldOcc DocNameI
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (FieldOcc DocNameI)
declName) [(DocName, DocForDecl DocName)]
subdocs Maybe (DocForDecl DocName)
-> (DocForDecl DocName -> Maybe (MDoc DocName))
-> Maybe (MDoc DocName)
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
>>= Documentation DocName -> Maybe (MDoc DocName)
forall name. Documentation name -> Maybe (MDoc name)
combineDocumentation (Documentation DocName -> Maybe (MDoc DocName))
-> (DocForDecl DocName -> Documentation DocName)
-> DocForDecl DocName
-> Maybe (MDoc DocName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocForDecl DocName -> Documentation DocName
forall a b. (a, b) -> a
fst
    declName :: GenLocated SrcSpanAnnA (FieldOcc DocNameI)
declName = case [GenLocated SrcSpanAnnA (FieldOcc DocNameI)]
-> Maybe (GenLocated SrcSpanAnnA (FieldOcc DocNameI))
forall a. [a] -> Maybe a
Maybe.listToMaybe [LFieldOcc DocNameI]
[GenLocated SrcSpanAnnA (FieldOcc DocNameI)]
names of
      Maybe (GenLocated SrcSpanAnnA (FieldOcc DocNameI))
Nothing -> String -> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
forall a. HasCallStack => String -> a
error String
"No names. An invariant was broken. Please report this to the Haddock project"
      Just GenLocated SrcSpanAnnA (FieldOcc DocNameI)
hd -> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
hd

ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html
ppShortField :: Bool -> Bool -> Qualification -> ConDeclField DocNameI -> Html
ppShortField Bool
summary Bool
unicode Qualification
qual (ConDeclField XConDeclField DocNameI
_ [LFieldOcc DocNameI]
names XRec DocNameI (HsType DocNameI)
ltype Maybe (LHsDoc DocNameI)
_) =
  [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma ((GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> Html)
-> [GenLocated SrcSpanAnnA (FieldOcc DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Bool -> OccName -> Html
ppBinder Bool
summary) (OccName -> Html)
-> (GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> OccName)
-> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> RdrName)
-> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc DocNameI -> XCFieldOcc DocNameI
FieldOcc DocNameI -> RdrName
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt (FieldOcc DocNameI -> RdrName)
-> (GenLocated SrcSpanAnnA (FieldOcc DocNameI)
    -> FieldOcc DocNameI)
-> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> FieldOcc DocNameI
forall l e. GenLocated l e -> e
unLoc) [LFieldOcc DocNameI]
[GenLocated SrcSpanAnnA (FieldOcc DocNameI)]
names))
    Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
unicode
    Html -> Html -> Html
<+> Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts XRec DocNameI (HsType DocNameI)
ltype

-- | Pretty print an expanded pattern (for bundled patterns)
ppSideBySidePat
  :: [(DocName, Fixity)]
  -> Unicode
  -> Qualification
  -> [LocatedN DocName]
  -- ^ pattern name(s)
  -> LHsSigType DocNameI
  -- ^ type of pattern(s)
  -> DocForDecl DocName
  -- ^ doc map
  -> SubDecl
ppSideBySidePat :: [(DocName, Fixity)]
-> Bool
-> Qualification
-> [GenLocated SrcSpanAnnN DocName]
-> LHsSigType DocNameI
-> DocForDecl DocName
-> SubDecl
ppSideBySidePat [(DocName, Fixity)]
fixities Bool
unicode Qualification
qual [GenLocated SrcSpanAnnN DocName]
lnames LHsSigType DocNameI
typ (Documentation DocName
doc, FnArgsDoc DocName
argDocs) =
  ( Html
decl
  , Documentation DocName -> Maybe (MDoc DocName)
forall name. Documentation name -> Maybe (MDoc name)
combineDocumentation Documentation DocName
doc
  , [Html]
fieldPart
  )
  where
    hasArgDocs :: Bool
hasArgDocs = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FnArgsDoc DocName -> Bool
forall k a. Map k a -> Bool
Map.null FnArgsDoc DocName
argDocs
    fixity :: Html
fixity = [(DocName, Fixity)] -> Qualification -> Html
ppFixities [(DocName, Fixity)]
fixities Qualification
qual
    ppOcc :: Html
ppOcc = [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma ((GenLocated SrcSpanAnnN DocName -> Html)
-> [GenLocated SrcSpanAnnN DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinder Bool
False (OccName -> Html)
-> (GenLocated SrcSpanAnnN DocName -> OccName)
-> GenLocated SrcSpanAnnN DocName
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> OccName
forall a. NamedThing a => a -> OccName
getOccName) [GenLocated SrcSpanAnnN DocName]
lnames))

    decl :: Html
decl
      | Bool
hasArgDocs = String -> Html
keyword String
"pattern" Html -> Html -> Html
<+> Html
ppOcc Html -> Html -> Html
<+> Html
fixity
      | Bool
otherwise =
          [Html] -> Html
hsep
            [ String -> Html
keyword String
"pattern"
            , Html
ppOcc
            , Bool -> Html
dcolon Bool
unicode
            , Bool -> Qualification -> LHsSigType DocNameI -> Html
ppPatSigType Bool
unicode Qualification
qual LHsSigType DocNameI
typ
            , Html
fixity
            ]

    fieldPart :: [Html]
fieldPart
      | Bool -> Bool
not Bool
hasArgDocs = []
      | Bool
otherwise =
          [ Maybe String -> Qualification -> [SubDecl] -> Html
subFields
              Maybe String
forall a. Maybe a
Nothing
              Qualification
qual
              ( Bool
-> Qualification
-> HsSigType DocNameI
-> FnArgsDoc DocName
-> [(DocName, DocForDecl DocName)]
-> Html
-> HideEmptyContexts
-> [SubDecl]
ppSubSigLike
                  Bool
unicode
                  Qualification
qual
                  (GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsSigType DocNameI
GenLocated SrcSpanAnnA (HsSigType DocNameI)
typ)
                  FnArgsDoc DocName
argDocs
                  []
                  (Bool -> Html
dcolon Bool
unicode)
                  HideEmptyContexts
emptyCtxt
              )
          ]

    emptyCtxt :: HideEmptyContexts
emptyCtxt = LHsSigType DocNameI -> HideEmptyContexts
patSigContext LHsSigType DocNameI
typ

-- | Print the LHS of a data\/newtype declaration.
-- Currently doesn't handle 'data instance' decls or kind signatures
ppDataHeader :: Bool -> TyClDecl DocNameI -> Unicode -> Qualification -> Html
ppDataHeader :: Bool -> TyClDecl DocNameI -> Bool -> Qualification -> Html
ppDataHeader
  Bool
summary
  ( DataDecl
      { tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn =
        HsDataDefn
          { dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons = DataDefnCons (LConDecl DocNameI)
cons
          , dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ctxt = Maybe (LHsContext DocNameI)
ctxt
          , dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (XRec DocNameI (HsType DocNameI))
ks
          }
      , tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = L SrcSpanAnnN
_ DocName
name
      , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
tvs
      }
    )
  Bool
unicode
  Qualification
qual =
    -- newtype or data
    ( case DataDefnCons (LConDecl DocNameI)
cons of
        NewTypeCon LConDecl DocNameI
_ -> String -> Html
keyword String
"newtype"
        DataTypeCons Bool
False [LConDecl DocNameI]
_ -> String -> Html
keyword String
"data"
        DataTypeCons Bool
True [LConDecl DocNameI]
_ -> String -> Html
keyword String
"type" Html -> Html -> Html
<+> String -> Html
keyword String
"data"
    )
      Html -> Html -> Html
<+>
      -- context
      Maybe (LHsContext DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContext Maybe (LHsContext DocNameI)
ctxt Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
      Html -> Html -> Html
<+>
      -- T a b c ..., or a :+: b
      Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
-> Html
forall flag.
RenderableBndrFlag flag =>
Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr flag DocNameI]
-> Html
ppAppDocNameTyVarBndrs Bool
summary Bool
unicode Qualification
qual DocName
name (LHsQTyVars DocNameI -> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsQTvExplicit LHsQTyVars DocNameI
tvs)
      Html -> Html -> Html
<+> case Maybe (XRec DocNameI (HsType DocNameI))
ks of
        Maybe (XRec DocNameI (HsType DocNameI))
Nothing -> Html
forall a. Monoid a => a
mempty
        Just (L SrcSpanAnnA
_ HsType DocNameI
x) -> Bool -> Html
dcolon Bool
unicode Html -> Html -> Html
<+> Bool -> Qualification -> HsType DocNameI -> Html
ppKind Bool
unicode Qualification
qual HsType DocNameI
x
ppDataHeader Bool
_ TyClDecl DocNameI
_ Bool
_ Qualification
_ = String -> Html
forall a. HasCallStack => String -> a
error String
"ppDataHeader: illegal argument"

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

-- * Types and contexts

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

ppBang :: HsBang -> Html
ppBang :: HsBang -> Html
ppBang (HsBang SrcUnpackedness
_ SrcStrictness
SrcStrict) = String -> Html
forall a. HTML a => a -> Html
toHtml String
"!"
ppBang (HsBang SrcUnpackedness
_ SrcStrictness
SrcLazy) = String -> Html
forall a. HTML a => a -> Html
toHtml String
"~"
ppBang HsBang
_ = Html
noHtml

tupleParens :: HsTupleSort -> [Html] -> Html
tupleParens :: HsTupleSort -> [Html] -> Html
tupleParens HsTupleSort
HsUnboxedTuple = [Html] -> Html
ubxParenList
tupleParens HsTupleSort
_ = [Html] -> Html
parenList

sumParens :: [Html] -> Html
sumParens :: [Html] -> Html
sumParens = [Html] -> Html
ubxSumList

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

-- * Rendering of HsType

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

ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType :: Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts XRec DocNameI (HsType DocNameI)
y = Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
y)
ppLParendType :: Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts XRec DocNameI (HsType DocNameI)
y = Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppParendType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
y)
ppLFunLhType :: Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLFunLhType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts XRec DocNameI (HsType DocNameI)
y = Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppFunLhType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
y)

ppLSigType :: Unicode -> Qualification -> HideEmptyContexts -> LHsSigType DocNameI -> Html
ppLSigType :: Bool
-> Qualification
-> HideEmptyContexts
-> LHsSigType DocNameI
-> Html
ppLSigType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts LHsSigType DocNameI
y = Bool
-> Qualification -> HideEmptyContexts -> HsSigType DocNameI -> Html
ppSigType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsSigType DocNameI
GenLocated SrcSpanAnnA (HsSigType DocNameI)
y)

ppCtxType :: Unicode -> Qualification -> HsType DocNameI -> Html
ppCtxType :: Bool -> Qualification -> HsType DocNameI -> Html
ppCtxType Bool
unicode Qualification
qual HsType DocNameI
ty = HsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_CTX HsType DocNameI
ty) Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts

ppType, ppParendType, ppFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType :: Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts HsType DocNameI
ty = HsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_TOP HsType DocNameI
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts
ppParendType :: Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppParendType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts HsType DocNameI
ty = HsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_CON HsType DocNameI
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts
ppFunLhType :: Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppFunLhType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts HsType DocNameI
ty = HsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_FUN HsType DocNameI
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts

ppSigType :: Unicode -> Qualification -> HideEmptyContexts -> HsSigType DocNameI -> Html
ppSigType :: Bool
-> Qualification -> HideEmptyContexts -> HsSigType DocNameI -> Html
ppSigType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts HsSigType DocNameI
sig_ty = HsSigType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_sig_ty (HsSigType DocNameI -> HsSigType DocNameI
forall a. XRecCond a => HsSigType a -> HsSigType a
reparenSigType HsSigType DocNameI
sig_ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts

ppLHsTypeArg :: Unicode -> Qualification -> HideEmptyContexts -> LHsTypeArg DocNameI -> Html
ppLHsTypeArg :: Bool
-> Qualification
-> HideEmptyContexts
-> HsArg
     DocNameI
     (XRec DocNameI (HsType DocNameI))
     (XRec DocNameI (HsType DocNameI))
-> Html
ppLHsTypeArg Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (HsValArg XValArg DocNameI
_ XRec DocNameI (HsType DocNameI)
ty) = Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts XRec DocNameI (HsType DocNameI)
ty
ppLHsTypeArg Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (HsTypeArg XTypeArg DocNameI
_ XRec DocNameI (HsType DocNameI)
ki) = Html
atSign Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts XRec DocNameI (HsType DocNameI)
ki
ppLHsTypeArg Bool
_ Qualification
_ HideEmptyContexts
_ (HsArgPar XArgPar DocNameI
_) = String -> Html
forall a. HTML a => a -> Html
toHtml String
""

class RenderableBndrFlag flag where
  ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr flag DocNameI -> Html

instance RenderableBndrFlag () where
  ppHsTyVarBndr :: Bool -> Qualification -> HsTyVarBndr () DocNameI -> Html
ppHsTyVarBndr Bool
unicode Qualification
qual (HsTvb XTyVarBndr DocNameI
_ ()
_ HsBndrVar DocNameI
bvar HsBndrKind DocNameI
bkind) =
    Html -> Html
decorate (Bool
-> Qualification
-> HsBndrVar DocNameI
-> HsBndrKind DocNameI
-> Html
pp_hs_tvb Bool
unicode Qualification
qual HsBndrVar DocNameI
bvar HsBndrKind DocNameI
bkind)
    where decorate :: Html -> Html
          decorate :: Html -> Html
decorate Html
d = HsBndrKind DocNameI -> Html -> Html
parens_if_kind HsBndrKind DocNameI
bkind Html
d

instance RenderableBndrFlag Specificity where
  ppHsTyVarBndr :: Bool -> Qualification -> HsTyVarBndr Specificity DocNameI -> Html
ppHsTyVarBndr Bool
unicode Qualification
qual (HsTvb XTyVarBndr DocNameI
_ Specificity
spec HsBndrVar DocNameI
bvar HsBndrKind DocNameI
bkind) =
    Html -> Html
decorate (Bool
-> Qualification
-> HsBndrVar DocNameI
-> HsBndrKind DocNameI
-> Html
pp_hs_tvb Bool
unicode Qualification
qual HsBndrVar DocNameI
bvar HsBndrKind DocNameI
bkind)
    where decorate :: Html -> Html
          decorate :: Html -> Html
decorate Html
d = case Specificity
spec of
            Specificity
InferredSpec  -> Html -> Html
braces Html
d
            Specificity
SpecifiedSpec -> HsBndrKind DocNameI -> Html -> Html
parens_if_kind HsBndrKind DocNameI
bkind Html
d

instance RenderableBndrFlag (HsBndrVis DocNameI) where
  ppHsTyVarBndr :: Bool
-> Qualification
-> HsTyVarBndr (HsBndrVis DocNameI) DocNameI
-> Html
ppHsTyVarBndr Bool
unicode Qualification
qual (HsTvb XTyVarBndr DocNameI
_ HsBndrVis DocNameI
bvis HsBndrVar DocNameI
bvar HsBndrKind DocNameI
bkind) =
    Html -> Html
decorate (Bool
-> Qualification
-> HsBndrVar DocNameI
-> HsBndrKind DocNameI
-> Html
pp_hs_tvb Bool
unicode Qualification
qual HsBndrVar DocNameI
bvar HsBndrKind DocNameI
bkind)
    where decorate :: Html -> Html
          decorate :: Html -> Html
decorate Html
d = case HsBndrVis DocNameI
bvis of
            HsBndrRequired  XBndrRequired DocNameI
_ -> HsBndrKind DocNameI -> Html -> Html
parens_if_kind HsBndrKind DocNameI
bkind Html
d
            HsBndrInvisible XBndrInvisible DocNameI
_ -> Html
atSign Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> HsBndrKind DocNameI -> Html -> Html
parens_if_kind HsBndrKind DocNameI
bkind Html
d

ppHsBndrVar :: Qualification -> HsBndrVar DocNameI -> Html
ppHsBndrVar :: Qualification -> HsBndrVar DocNameI -> Html
ppHsBndrVar Qualification
qual (HsBndrVar XBndrVar DocNameI
_ LIdP DocNameI
name) = Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Raw Bool
False (GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc LIdP DocNameI
GenLocated SrcSpanAnnN DocName
name)
ppHsBndrVar Qualification
_    (HsBndrWildCard XBndrWildCard DocNameI
_) = Char -> Html
char Char
'_'

pp_hs_tvb :: Unicode -> Qualification -> HsBndrVar DocNameI -> HsBndrKind DocNameI -> Html
pp_hs_tvb :: Bool
-> Qualification
-> HsBndrVar DocNameI
-> HsBndrKind DocNameI
-> Html
pp_hs_tvb Bool
_       Qualification
qual HsBndrVar DocNameI
bvar (HsBndrNoKind XBndrNoKind DocNameI
_) = Qualification -> HsBndrVar DocNameI -> Html
ppHsBndrVar Qualification
qual HsBndrVar DocNameI
bvar
pp_hs_tvb Bool
unicode Qualification
qual HsBndrVar DocNameI
bvar (HsBndrKind XBndrKind DocNameI
_ XRec DocNameI (HsType DocNameI)
k) =
  Qualification -> HsBndrVar DocNameI -> Html
ppHsBndrVar Qualification
qual HsBndrVar DocNameI
bvar Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
unicode
                        Html -> Html -> Html
<+> Bool -> Qualification -> XRec DocNameI (HsType DocNameI) -> Html
ppLKind Bool
unicode Qualification
qual XRec DocNameI (HsType DocNameI)
k

parens_if_kind :: HsBndrKind DocNameI -> Html -> Html
parens_if_kind :: HsBndrKind DocNameI -> Html -> Html
parens_if_kind (HsBndrNoKind XBndrNoKind DocNameI
_) Html
d = Html
d
parens_if_kind (HsBndrKind XBndrKind DocNameI
_ XRec DocNameI (HsType DocNameI)
_) Html
d = Html -> Html
parens Html
d

ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html
ppLKind :: Bool -> Qualification -> XRec DocNameI (HsType DocNameI) -> Html
ppLKind Bool
unicode Qualification
qual XRec DocNameI (HsType DocNameI)
y = Bool -> Qualification -> HsType DocNameI -> Html
ppKind Bool
unicode Qualification
qual (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
y)

ppKind :: Unicode -> Qualification -> HsKind DocNameI -> Html
ppKind :: Bool -> Qualification -> HsType DocNameI -> Html
ppKind Bool
unicode Qualification
qual HsType DocNameI
ki = HsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_TOP HsType DocNameI
ki) Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts

patSigContext :: LHsSigType DocNameI -> HideEmptyContexts
patSigContext :: LHsSigType DocNameI -> HideEmptyContexts
patSigContext LHsSigType DocNameI
sig_typ
  | GenLocated SrcSpanAnnA (HsType DocNameI) -> Bool
forall {pass} {l} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass),
 XRec pass [GenLocated l (HsType pass)]
 ~ GenLocated l [GenLocated l (HsType pass)]) =>
GenLocated l (HsType pass) -> Bool
hasNonEmptyContext XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
typ Bool -> Bool -> Bool
&& GenLocated SrcSpanAnnA (HsType DocNameI) -> Bool
forall {pass} {l} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass),
 XRec pass [GenLocated l (HsType pass)]
 ~ GenLocated l [GenLocated l (HsType pass)]) =>
GenLocated l (HsType pass) -> Bool
isFirstContextEmpty XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
typ = HideEmptyContexts
ShowEmptyToplevelContexts
  | Bool
otherwise = HideEmptyContexts
HideEmptyContexts
  where
    typ :: XRec DocNameI (HsType DocNameI)
typ = HsSigType DocNameI -> XRec DocNameI (HsType DocNameI)
forall pass. HsSigType pass -> LHsType pass
sig_body (GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsSigType DocNameI
GenLocated SrcSpanAnnA (HsSigType DocNameI)
sig_typ)

    hasNonEmptyContext :: GenLocated l (HsType pass) -> Bool
hasNonEmptyContext GenLocated l (HsType pass)
t =
      case GenLocated l (HsType pass) -> HsType pass
forall l e. GenLocated l e -> e
unLoc GenLocated l (HsType pass)
t of
        HsForAllTy XForAllTy pass
_ HsForAllTelescope pass
_ XRec pass (HsType pass)
s -> GenLocated l (HsType pass) -> Bool
hasNonEmptyContext XRec pass (HsType pass)
GenLocated l (HsType pass)
s
        HsQualTy XQualTy pass
_ LHsContext pass
cxt XRec pass (HsType pass)
s -> if [GenLocated l (HsType pass)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null (GenLocated l [GenLocated l (HsType pass)]
-> [GenLocated l (HsType pass)]
forall l e. GenLocated l e -> e
unLoc LHsContext pass
GenLocated l [GenLocated l (HsType pass)]
cxt) then GenLocated l (HsType pass) -> Bool
hasNonEmptyContext XRec pass (HsType pass)
GenLocated l (HsType pass)
s else Bool
True
        HsFunTy XFunTy pass
_ HsArrow pass
_ XRec pass (HsType pass)
_ XRec pass (HsType pass)
s -> GenLocated l (HsType pass) -> Bool
hasNonEmptyContext XRec pass (HsType pass)
GenLocated l (HsType pass)
s
        HsType pass
_ -> Bool
False
    isFirstContextEmpty :: GenLocated l (HsType pass) -> Bool
isFirstContextEmpty GenLocated l (HsType pass)
t =
      case GenLocated l (HsType pass) -> HsType pass
forall l e. GenLocated l e -> e
unLoc GenLocated l (HsType pass)
t of
        HsForAllTy XForAllTy pass
_ HsForAllTelescope pass
_ XRec pass (HsType pass)
s -> GenLocated l (HsType pass) -> Bool
isFirstContextEmpty XRec pass (HsType pass)
GenLocated l (HsType pass)
s
        HsQualTy XQualTy pass
_ LHsContext pass
cxt XRec pass (HsType pass)
_ -> [GenLocated l (HsType pass)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null (GenLocated l [GenLocated l (HsType pass)]
-> [GenLocated l (HsType pass)]
forall l e. GenLocated l e -> e
unLoc LHsContext pass
GenLocated l [GenLocated l (HsType pass)]
cxt)
        HsFunTy XFunTy pass
_ HsArrow pass
_ XRec pass (HsType pass)
_ XRec pass (HsType pass)
s -> GenLocated l (HsType pass) -> Bool
isFirstContextEmpty XRec pass (HsType pass)
GenLocated l (HsType pass)
s
        HsType pass
_ -> Bool
False

-- | Pretty-print a pattern signature (all this does over 'ppLType' is slot in
-- the right 'HideEmptyContext' value)
ppPatSigType :: Unicode -> Qualification -> LHsSigType DocNameI -> Html
ppPatSigType :: Bool -> Qualification -> LHsSigType DocNameI -> Html
ppPatSigType Bool
unicode Qualification
qual LHsSigType DocNameI
typ =
  let emptyCtxts :: HideEmptyContexts
emptyCtxts = LHsSigType DocNameI -> HideEmptyContexts
patSigContext LHsSigType DocNameI
typ in Bool
-> Qualification
-> HideEmptyContexts
-> LHsSigType DocNameI
-> Html
ppLSigType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts LHsSigType DocNameI
typ

ppHsOuterTyVarBndrs
  :: RenderableBndrFlag flag
  => Unicode
  -> Qualification
  -> HsOuterTyVarBndrs flag DocNameI
  -> Html
ppHsOuterTyVarBndrs :: forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> HsOuterTyVarBndrs flag DocNameI -> Html
ppHsOuterTyVarBndrs Bool
unicode Qualification
qual HsOuterTyVarBndrs flag DocNameI
outer_bndrs = case HsOuterTyVarBndrs flag DocNameI
outer_bndrs of
  HsOuterImplicit{} -> Html
noHtml
  HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr flag (NoGhcTc DocNameI)]
bndrs} ->
    [Html] -> Html
hsep (Bool -> Html
forallSymbol Bool
unicode Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Bool -> Qualification -> [LHsTyVarBndr flag DocNameI] -> [Html]
forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> [LHsTyVarBndr flag DocNameI] -> [Html]
ppTyVars Bool
unicode Qualification
qual [LHsTyVarBndr flag (NoGhcTc DocNameI)]
[LHsTyVarBndr flag DocNameI]
bndrs) Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
dot

ppForAllPart :: Unicode -> Qualification -> HsForAllTelescope DocNameI -> Html
ppForAllPart :: Bool -> Qualification -> HsForAllTelescope DocNameI -> Html
ppForAllPart Bool
unicode Qualification
qual HsForAllTelescope DocNameI
tele = case HsForAllTelescope DocNameI
tele of
  HsForAllVis{hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () DocNameI]
bndrs} ->
    [Html] -> Html
hsep (Bool -> Html
forallSymbol Bool
unicode Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Bool -> Qualification -> [LHsTyVarBndr () DocNameI] -> [Html]
forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> [LHsTyVarBndr flag DocNameI] -> [Html]
ppTyVars Bool
unicode Qualification
qual [LHsTyVarBndr () DocNameI]
bndrs)
      Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
spaceHtml
      Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Bool -> Html
arrow Bool
unicode
  HsForAllInvis{hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity DocNameI]
bndrs} ->
    [Html] -> Html
hsep (Bool -> Html
forallSymbol Bool
unicode Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Bool
-> Qualification -> [LHsTyVarBndr Specificity DocNameI] -> [Html]
forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> [LHsTyVarBndr flag DocNameI] -> [Html]
ppTyVars Bool
unicode Qualification
qual [LHsTyVarBndr Specificity DocNameI]
bndrs) Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
dot

ppr_sig_ty :: HsSigType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppr_sig_ty :: HsSigType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_sig_ty (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs DocNameI
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = XRec DocNameI (HsType DocNameI)
ltype}) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts =
  Bool -> Qualification -> HsOuterSigTyVarBndrs DocNameI -> Html
forall flag.
RenderableBndrFlag flag =>
Bool -> Qualification -> HsOuterTyVarBndrs flag DocNameI -> Html
ppHsOuterTyVarBndrs Bool
unicode Qualification
qual HsOuterSigTyVarBndrs DocNameI
outer_bndrs Html -> Html -> Html
<+> XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ltype Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts

ppr_mono_lty :: LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty :: XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty = HsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc XRec DocNameI (HsType DocNameI)
GenLocated SrcSpanAnnA (HsType DocNameI)
ty)

ppr_mono_ty :: HsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty :: HsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty (HsForAllTy XForAllTy DocNameI
_ HsForAllTelescope DocNameI
tele XRec DocNameI (HsType DocNameI)
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts =
  Bool -> Qualification -> HsForAllTelescope DocNameI -> Html
ppForAllPart Bool
unicode Qualification
qual HsForAllTelescope DocNameI
tele Html -> Html -> Html
<+> XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts
ppr_mono_ty (HsQualTy XQualTy DocNameI
_ LHsContext DocNameI
ctxt XRec DocNameI (HsType DocNameI)
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts =
  Maybe (LHsContext DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContext (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)])
forall a. a -> Maybe a
Just LHsContext DocNameI
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
ctxt) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts Html -> Html -> Html
<+> XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts
-- UnicodeSyntax alternatives
ppr_mono_ty (HsTyVar XTyVar DocNameI
_ PromotionFlag
_ (L SrcSpanAnnN
_ DocName
name)) Bool
True Qualification
_ HideEmptyContexts
_
  | Name -> String
forall a. NamedThing a => a -> String
getOccString (DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
name) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"(->)" = String -> Html
forall a. HTML a => a -> Html
toHtml String
"(→)"
ppr_mono_ty (HsBangTy XBangTy DocNameI
_ HsBang
b XRec DocNameI (HsType DocNameI)
ty) Bool
u Qualification
q HideEmptyContexts
_ =
  HsBang -> Html
ppBang HsBang
b Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLParendType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts XRec DocNameI (HsType DocNameI)
ty
ppr_mono_ty (HsTyVar XTyVar DocNameI
_ PromotionFlag
prom (L SrcSpanAnnN
_ DocName
name)) Bool
_ Qualification
q HideEmptyContexts
_
  | PromotionFlag -> Bool
isPromoted PromotionFlag
prom = Html -> Html
promoQuote (Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
q Notation
Prefix Bool
True DocName
name)
  | Bool
otherwise = Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
q Notation
Prefix Bool
True DocName
name
ppr_mono_ty (HsStarTy XStarTy DocNameI
_ Bool
isUni) Bool
u Qualification
_ HideEmptyContexts
_ =
  String -> Html
forall a. HTML a => a -> Html
toHtml (if Bool
u Bool -> Bool -> Bool
|| Bool
isUni then String
"★" else String
"*")
ppr_mono_ty (HsFunTy XFunTy DocNameI
_ HsArrow DocNameI
mult XRec DocNameI (HsType DocNameI)
ty1 XRec DocNameI (HsType DocNameI)
ty2) Bool
u Qualification
q HideEmptyContexts
e =
  [Html] -> Html
hsep
    [ XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty1 Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts
    , Html
arr Html -> Html -> Html
<+> XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty2 Bool
u Qualification
q HideEmptyContexts
e
    ]
  where
    arr :: Html
arr = case HsArrow DocNameI
mult of
      HsLinearArrow XLinearArrow (XRec DocNameI (HsType DocNameI)) DocNameI
_ -> Bool -> Html
lollipop Bool
u
      HsUnrestrictedArrow XUnrestrictedArrow (XRec DocNameI (HsType DocNameI)) DocNameI
_ -> Bool -> Html
arrow Bool
u
      HsExplicitMult XExplicitMult (XRec DocNameI (HsType DocNameI)) DocNameI
_ XRec DocNameI (HsType DocNameI)
m -> Html
multAnnotation Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
m Bool
u Qualification
q HideEmptyContexts
e Html -> Html -> Html
<+> Bool -> Html
arrow Bool
u
ppr_mono_ty (HsTupleTy XTupleTy DocNameI
_ HsTupleSort
con HsContext DocNameI
tys) Bool
u Qualification
q HideEmptyContexts
_ =
  HsTupleSort -> [Html] -> Html
tupleParens HsTupleSort
con ((GenLocated SrcSpanAnnA (HsType DocNameI) -> Html)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) HsContext DocNameI
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys)
ppr_mono_ty (HsSumTy XSumTy DocNameI
_ HsContext DocNameI
tys) Bool
u Qualification
q HideEmptyContexts
_ =
  [Html] -> Html
sumParens ((GenLocated SrcSpanAnnA (HsType DocNameI) -> Html)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) HsContext DocNameI
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys)
ppr_mono_ty (HsKindSig XKindSig DocNameI
_ XRec DocNameI (HsType DocNameI)
ty XRec DocNameI (HsType DocNameI)
kind) Bool
u Qualification
q HideEmptyContexts
e =
  XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty Bool
u Qualification
q HideEmptyContexts
e Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
u Html -> Html -> Html
<+> Bool -> Qualification -> XRec DocNameI (HsType DocNameI) -> Html
ppLKind Bool
u Qualification
q XRec DocNameI (HsType DocNameI)
kind
ppr_mono_ty (HsListTy XListTy DocNameI
_ XRec DocNameI (HsType DocNameI)
ty) Bool
u Qualification
q HideEmptyContexts
_ = Html -> Html
brackets (XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts)
ppr_mono_ty (HsIParamTy XIParamTy DocNameI
_ (L EpAnn NoEpAnns
_ HsIPName
n) XRec DocNameI (HsType DocNameI)
ty) Bool
u Qualification
q HideEmptyContexts
_ =
  HsIPName -> Html
ppIPName HsIPName
n Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
u Html -> Html -> Html
<+> XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts
ppr_mono_ty (HsSpliceTy XSpliceTy DocNameI
v HsUntypedSplice DocNameI
_) Bool
_ Qualification
_ HideEmptyContexts
_ = DataConCantHappen -> Html
forall a. DataConCantHappen -> a
dataConCantHappen XSpliceTy DocNameI
DataConCantHappen
v
ppr_mono_ty (HsRecTy{}) Bool
_ Qualification
_ HideEmptyContexts
_ = String -> Html
forall a. HTML a => a -> Html
toHtml String
"{..}"
-- Can now legally occur in ConDeclGADT, the output here is to provide a
-- placeholder in the signature, which is followed by the field
-- declarations.
ppr_mono_ty (XHsType{}) Bool
_ Qualification
_ HideEmptyContexts
_ = String -> Html
forall a. HasCallStack => String -> a
error String
"ppr_mono_ty HsCoreTy"
ppr_mono_ty (HsExplicitListTy XExplicitListTy DocNameI
_ PromotionFlag
IsPromoted HsContext DocNameI
tys) Bool
u Qualification
q HideEmptyContexts
_ = Html -> Html
promoQuote (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
brackets (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
hsep ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ Html -> [Html] -> [Html]
punctuate Html
comma ([Html] -> [Html]) -> [Html] -> [Html]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType DocNameI) -> Html)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) HsContext DocNameI
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys
ppr_mono_ty (HsExplicitListTy XExplicitListTy DocNameI
_ PromotionFlag
NotPromoted HsContext DocNameI
tys) Bool
u Qualification
q HideEmptyContexts
_ = Html -> Html
brackets (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
hsep ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ Html -> [Html] -> [Html]
punctuate Html
comma ([Html] -> [Html]) -> [Html] -> [Html]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType DocNameI) -> Html)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) HsContext DocNameI
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys
ppr_mono_ty (HsExplicitTupleTy XExplicitTupleTy DocNameI
_ PromotionFlag
IsPromoted HsContext DocNameI
tys) Bool
u Qualification
q HideEmptyContexts
_ = Html -> Html
promoQuote (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
parenList ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType DocNameI) -> Html)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) HsContext DocNameI
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys
ppr_mono_ty (HsExplicitTupleTy XExplicitTupleTy DocNameI
_ PromotionFlag
NotPromoted HsContext DocNameI
tys) Bool
u Qualification
q HideEmptyContexts
_ = [Html] -> Html
parenList ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType DocNameI) -> Html)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> XRec DocNameI (HsType DocNameI)
-> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) HsContext DocNameI
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys
ppr_mono_ty (HsAppTy XAppTy DocNameI
_ XRec DocNameI (HsType DocNameI)
fun_ty XRec DocNameI (HsType DocNameI)
arg_ty) Bool
unicode Qualification
qual HideEmptyContexts
_ =
  [Html] -> Html
hsep
    [ XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
fun_ty Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
    , XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
arg_ty Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
    ]
ppr_mono_ty (HsAppKindTy XAppKindTy DocNameI
_ XRec DocNameI (HsType DocNameI)
fun_ty XRec DocNameI (HsType DocNameI)
arg_ki) Bool
unicode Qualification
qual HideEmptyContexts
_ =
  [Html] -> Html
hsep
    [ XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
fun_ty Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
    , Html
atSign Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
arg_ki Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
    ]
ppr_mono_ty (HsOpTy XOpTy DocNameI
_ PromotionFlag
prom XRec DocNameI (HsType DocNameI)
ty1 LIdP DocNameI
op XRec DocNameI (HsType DocNameI)
ty2) Bool
unicode Qualification
qual HideEmptyContexts
_ =
  XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty1 Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts Html -> Html -> Html
<+> Html
ppr_op_prom Html -> Html -> Html
<+> XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty2 Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
  where
    ppr_op_prom :: Html
ppr_op_prom
      | PromotionFlag -> Bool
isPromoted PromotionFlag
prom =
          Html -> Html
promoQuote Html
ppr_op
      | Bool
otherwise =
          Html
ppr_op
    ppr_op :: Html
ppr_op = Qualification -> Notation -> GenLocated SrcSpanAnnN DocName -> Html
forall l. Qualification -> Notation -> GenLocated l DocName -> Html
ppLDocName Qualification
qual Notation
Infix LIdP DocNameI
GenLocated SrcSpanAnnN DocName
op
ppr_mono_ty (HsParTy XParTy DocNameI
_ XRec DocNameI (HsType DocNameI)
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts =
  Html -> Html
parens (XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts)
--  = parens (ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts)

ppr_mono_ty (HsDocTy XDocTy DocNameI
_ XRec DocNameI (HsType DocNameI)
ty LHsDoc DocNameI
_) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts =
  XRec DocNameI (HsType DocNameI)
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty XRec DocNameI (HsType DocNameI)
ty Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts
ppr_mono_ty (HsWildCardTy XWildCardTy DocNameI
_) Bool
_ Qualification
_ HideEmptyContexts
_ = Char -> Html
char Char
'_'
ppr_mono_ty (HsTyLit XTyLit DocNameI
_ HsTyLit DocNameI
n) Bool
_ Qualification
_ HideEmptyContexts
_ = HsTyLit DocNameI -> Html
ppr_tylit HsTyLit DocNameI
n

ppr_tylit :: HsTyLit DocNameI -> Html
ppr_tylit :: HsTyLit DocNameI -> Html
ppr_tylit (HsNumTy XNumTy DocNameI
_ Integer
n) = String -> Html
forall a. HTML a => a -> Html
toHtml (Integer -> String
forall a. Show a => a -> String
show Integer
n)
ppr_tylit (HsStrTy XStrTy DocNameI
_ FastString
s) = String -> Html
forall a. HTML a => a -> Html
toHtml (FastString -> String
forall a. Show a => a -> String
show FastString
s)
ppr_tylit (HsCharTy XCharTy DocNameI
_ Char
c) = String -> Html
forall a. HTML a => a -> Html
toHtml (Char -> String
forall a. Show a => a -> String
show Char
c)