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

-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.Backends.Html.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 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.GhcUtils
import Haddock.Types
import Haddock.Doc (combineDocumentation)

import           Data.List             ( intersperse, sort )
import qualified Data.Map as Map
import           Data.Maybe
import           Data.Void             ( absurd )
import           Text.XHtml hiding     ( name, title, p, quote )

import BasicTypes (PromotionFlag(..), isPromoted)
import GHC hiding (LexicalFixity(..))
import GHC.Exts
import Name
import BooleanFormula
import RdrName ( rdrNameOcc )

-- | 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 Package
-> Qualification
-> Html
ppDecl Bool
summ LinksInfo
links (L SrcSpan
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 Package
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 Package
-> Qualification
-> Html
ppFamDecl Bool
summ Bool
False LinksInfo
links [DocInstance DocNameI]
instances [(DocName, Fixity)]
fixities SrcSpan
loc Documentation DocName
mbDoc FamilyDecl DocNameI
d Bool
splice Bool
unicode Maybe Package
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 Package
-> Qualification
-> Html
ppDataDecl Bool
summ LinksInfo
links [DocInstance DocNameI]
instances [(DocName, Fixity)]
fixities [(DocName, DocForDecl DocName)]
subdocs SrcSpan
loc Documentation DocName
mbDoc TyClDecl DocNameI
d [(HsDecl DocNameI, DocForDecl DocName)]
pats Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  TyClD XTyClD DocNameI
_ d :: TyClDecl DocNameI
d@(SynDecl {})         -> Bool
-> LinksInfo
-> [(DocName, Fixity)]
-> SrcSpan
-> DocForDecl DocName
-> TyClDecl DocNameI
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppTySyn Bool
summ LinksInfo
links [(DocName, Fixity)]
fixities SrcSpan
loc (Documentation DocName
mbDoc, FnArgsDoc DocName
fnArgsDoc) TyClDecl DocNameI
d Bool
splice Bool
unicode Maybe Package
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 Package
-> Qualification
-> Html
ppClassDecl Bool
summ LinksInfo
links [DocInstance DocNameI]
instances [(DocName, Fixity)]
fixities SrcSpan
loc Documentation DocName
mbDoc [(DocName, DocForDecl DocName)]
subdocs TyClDecl DocNameI
d Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  SigD XSigD DocNameI
_ (TypeSig XTypeSig DocNameI
_ [Located (IdP DocNameI)]
lnames LHsSigWcType DocNameI
lty)  -> Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> [Located DocName]
-> LHsType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppLFunSig Bool
summ LinksInfo
links SrcSpan
loc (Documentation DocName
mbDoc, FnArgsDoc DocName
fnArgsDoc) [Located (IdP DocNameI)]
[Located DocName]
lnames
                                         (LHsSigWcType DocNameI -> LHsType DocNameI
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType DocNameI
lty) [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [Located (IdP DocNameI)]
lnames LHsSigType DocNameI
lty) -> Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> [Located DocName]
-> LHsType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppLPatSig Bool
summ LinksInfo
links SrcSpan
loc (Documentation DocName
mbDoc, FnArgsDoc DocName
fnArgsDoc) [Located (IdP DocNameI)]
[Located DocName]
lnames
                                         (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
lty) [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  ForD XForD DocNameI
_ ForeignDecl DocNameI
d                       -> Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> ForeignDecl DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppFor Bool
summ LinksInfo
links SrcSpan
loc (Documentation DocName
mbDoc, FnArgsDoc DocName
fnArgsDoc) ForeignDecl DocNameI
d [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  InstD XInstD DocNameI
_ InstDecl DocNameI
_                      -> Html
noHtml
  DerivD XDerivD DocNameI
_ DerivDecl DocNameI
_                     -> Html
noHtml
  HsDecl DocNameI
_                              -> Package -> Html
forall a. HasCallStack => Package -> a
error Package
"declaration not supported by ppDecl"


ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
             [Located DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
             Splice -> Unicode -> Maybe Package -> Qualification -> Html
ppLFunSig :: Bool
-> LinksInfo
-> SrcSpan
-> DocForDecl DocName
-> [Located DocName]
-> LHsType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppLFunSig Bool
summary LinksInfo
links SrcSpan
loc DocForDecl DocName
doc [Located DocName]
lnames LHsType DocNameI
lty [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual =
  Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppFunSig Bool
summary LinksInfo
links SrcSpan
loc Html
noHtml DocForDecl DocName
doc ((Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located DocName]
lnames) LHsType DocNameI
lty [(DocName, Fixity)]
fixities
           Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual

ppFunSig :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
            [DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
            Splice -> Unicode -> Maybe Package -> Qualification -> Html
ppFunSig :: Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppFunSig Bool
summary LinksInfo
links SrcSpan
loc Html
leader DocForDecl DocName
doc [DocName]
docnames LHsType DocNameI
typ [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual =
  Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> [(DocName, Fixity)]
-> (HsType DocNameI, Html)
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> HideEmptyContexts
-> Html
ppSigLike Bool
summary LinksInfo
links SrcSpan
loc Html
leader DocForDecl DocName
doc [DocName]
docnames [(DocName, Fixity)]
fixities (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
typ, Html
pp_typ)
            Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual HideEmptyContexts
HideEmptyContexts
  where
    pp_typ :: Html
pp_typ = Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts LHsType DocNameI
typ

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


ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
             [DocName] -> [(DocName, Fixity)] -> (HsType DocNameI, Html) ->
             Splice -> Unicode -> Maybe Package -> Qualification -> HideEmptyContexts -> Html
ppSigLike :: Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> [(DocName, Fixity)]
-> (HsType DocNameI, Html)
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> HideEmptyContexts
-> Html
ppSigLike Bool
summary LinksInfo
links SrcSpan
loc Html
leader DocForDecl DocName
doc [DocName]
docnames [(DocName, Fixity)]
fixities (HsType DocNameI
typ, Html
pp_typ)
          Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual HideEmptyContexts
emptyCtxts =
  Bool
-> LinksInfo
-> SrcSpan
-> [DocName]
-> HsType DocNameI
-> DocForDecl DocName
-> (Html, Html, Html)
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> HideEmptyContexts
-> Html
ppTypeOrFunSig Bool
summary LinksInfo
links SrcSpan
loc [DocName]
docnames HsType 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 Package
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] -> HsType DocNameI
               -> DocForDecl DocName -> (Html, Html, Html)
               -> Splice -> Unicode -> Maybe Package -> Qualification
               -> HideEmptyContexts -> Html
ppTypeOrFunSig :: Bool
-> LinksInfo
-> SrcSpan
-> [DocName]
-> HsType DocNameI
-> DocForDecl DocName
-> (Html, Html, Html)
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> HideEmptyContexts
-> Html
ppTypeOrFunSig Bool
summary LinksInfo
links SrcSpan
loc [DocName]
docnames HsType DocNameI
typ (Documentation DocName
doc, FnArgsDoc DocName
argDocs) (Html
pref1, Html
pref2, Html
sep)
               Bool
splice Bool
unicode Maybe Package
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]
docnames Html
pref1 Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe Name
-> Maybe Package -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe Package
pkg Qualification
qual Documentation DocName
doc
  | Bool
otherwise = LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice [DocName]
docnames Html
pref2
                  Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe Package -> Qualification -> [SubDecl] -> Html
subArguments Maybe Package
pkg Qualification
qual (Bool
-> Qualification
-> HsType DocNameI
-> FnArgsDoc DocName
-> [(DocName, DocForDecl DocName)]
-> Html
-> HideEmptyContexts
-> [SubDecl]
ppSubSigLike Bool
unicode Qualification
qual HsType 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 Package -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe Package
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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DocName] -> Maybe DocName
forall a. [a] -> Maybe a
listToMaybe [DocName]
docnames


-- | 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
             -> HsType 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
-> HsType DocNameI
-> FnArgsDoc DocName
-> [(DocName, DocForDecl DocName)]
-> Html
-> HideEmptyContexts
-> [SubDecl]
ppSubSigLike Bool
unicode Qualification
qual HsType DocNameI
typ FnArgsDoc DocName
argDocs [(DocName, DocForDecl DocName)]
subdocs Html
sep HideEmptyContexts
emptyCtxts = Int -> Html -> HsType DocNameI -> [SubDecl]
do_args Int
0 Html
sep HsType DocNameI
typ
  where
    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
n Html
leader (L SrcSpan
_ 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
_ ForallVisFlag
fvf [LHsTyVarBndr DocNameI]
tvs LHsType DocNameI
ltype)
      = Int -> Html -> LHsType DocNameI -> [SubDecl]
do_largs Int
n (Html
leader Html -> Html -> Html
<+> Bool
-> Qualification
-> [LHsTyVarBndr DocNameI]
-> ForallVisFlag
-> Html
ppForAllPart Bool
unicode Qualification
qual [LHsTyVarBndr DocNameI]
tvs ForallVisFlag
fvf) LHsType DocNameI
ltype

    do_args Int
n Html
leader (HsQualTy XQualTy DocNameI
_ LHsContext DocNameI
lctxt LHsType DocNameI
ltype)
      | [LHsType DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LHsContext DocNameI -> SrcSpanLess (LHsContext DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsContext DocNameI
lctxt)
      = Int -> Html -> LHsType DocNameI -> [SubDecl]
do_largs Int
n Html
leader LHsType 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 -> LHsType DocNameI -> [SubDecl]
do_largs Int
n (Bool -> Html
darrow Bool
unicode) LHsType DocNameI
ltype

    do_args Int
n Html
leader (HsFunTy XFunTy DocNameI
_ (L SrcSpan
_ (HsRecTy XRecTy DocNameI
_ [LConDeclField DocNameI]
fields)) LHsType DocNameI
r)
      = [ (Html
ldr Html -> Html -> Html
<+> Html
html, Maybe (MDoc DocName)
mdoc, [Html]
subs)
        | (L SrcSpan
_ ConDeclField DocNameI
field, Html
ldr) <- [LConDeclField DocNameI]
-> [Html] -> [(LConDeclField DocNameI, Html)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LConDeclField 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 -> LHsType DocNameI -> [SubDecl]
do_largs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Html
gadtEnd Html -> Html -> Html
<+> Bool -> Html
arrow Bool
unicode) LHsType DocNameI
r

    do_args Int
n Html
leader (HsFunTy XFunTy DocNameI
_ LHsType DocNameI
lt LHsType DocNameI
r)
      = (Html
leader Html -> Html -> Html
<+> Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLFunLhType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts LHsType DocNameI
lt, Int -> Maybe (MDoc DocName)
argDoc Int
n, [])
        SubDecl -> [SubDecl] -> [SubDecl]
forall a. a -> [a] -> [a]
: Int -> Html -> LHsType DocNameI -> [SubDecl]
do_largs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Bool -> Html
arrow Bool
unicode) LHsType 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
<> Package -> Html
forall a. HTML a => a -> Html
toHtml Package
","
    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
<> Package -> Html
forall a. HTML a => a -> Html
toHtml Package
"}"
    gadtOpen :: Html
gadtOpen = Package -> Html
forall a. HTML a => a -> Html
toHtml Package
"{"


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 (t :: * -> *) 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, Package) -> Html)
-> [([DocName], Int, Package)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ([DocName], Int, Package) -> Html
ppFix [([DocName], Int, Package)]
uniq_fs) Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
rightEdge
  where
    ppFix :: ([DocName], Int, Package) -> Html
ppFix ([DocName]
ns, Int
p, Package
d) = Html -> Html
thespan (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [Package -> HtmlAttr
theclass Package
"fixity"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<<
                         (Package -> Html
forall a. HTML a => a -> Html
toHtml Package
d Html -> Html -> Html
<+> Package -> Html
forall a. HTML a => a -> Html
toHtml (Int -> Package
forall a. Show a => a -> Package
show Int
p) Html -> Html -> Html
<+> [DocName] -> Html
ppNames [DocName]
ns)

    ppDir :: FixityDirection -> Package
ppDir FixityDirection
InfixR = Package
"infixr"
    ppDir FixityDirection
InfixL = Package
"infixl"
    ppDir FixityDirection
InfixN = Package
"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 (Package -> Html
stringToHtml Package
", ") ([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, Package)]
uniq_fs = [ ([DocName]
n, [Int] -> Int
forall a. Eq a => [a] -> a
the [Int]
p, [Package] -> Package
forall a. Eq a => [a] -> a
the [Package]
d') | (DocName
n, Fixity SourceText
_ Int
p FixityDirection
d) <- [(DocName, Fixity)]
fs
                                   , let d' :: Package
d' = FixityDirection -> Package
ppDir FixityDirection
d
                                   , then group by (Int, Package) -> Down (Int, Package)
forall a. a -> Down a
Down (Int
p,Package
d') using ((DocName, Int, Package) -> Down (Int, Package))
-> [(DocName, Int, Package)] -> [[(DocName, Int, Package)]]
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
! [Package -> HtmlAttr
theclass Package
"rightedge"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html
noHtml


-- | Pretty-print type variables.
ppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html]
ppTyVars :: Bool -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html]
ppTyVars Bool
unicode Qualification
qual [LHsTyVarBndr DocNameI]
tvs = (LHsTyVarBndr DocNameI -> Html)
-> [LHsTyVarBndr DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Qualification -> HsTyVarBndr DocNameI -> Html
ppHsTyVarBndr Bool
unicode Qualification
qual (HsTyVarBndr DocNameI -> Html)
-> (LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI)
-> LHsTyVarBndr DocNameI
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LHsTyVarBndr 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 Package
-> Qualification
-> Html
ppFor Bool
summary LinksInfo
links SrcSpan
loc DocForDecl DocName
doc (ForeignImport XForeignImport DocNameI
_ (L SrcSpan
_ IdP DocNameI
name) LHsSigType DocNameI
typ ForeignImport
_) [(DocName, Fixity)]
fixities
      Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  = Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppFunSig Bool
summary LinksInfo
links SrcSpan
loc Html
noHtml DocForDecl DocName
doc [IdP DocNameI
DocName
name] (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
typ) [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
ppFor Bool
_ LinksInfo
_ SrcSpan
_ DocForDecl DocName
_ ForeignDecl DocNameI
_ [(DocName, Fixity)]
_ Bool
_ Bool
_ Maybe Package
_ Qualification
_ = Package -> Html
forall a. HasCallStack => Package -> a
error Package
"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 Package
-> Qualification
-> Html
ppTySyn Bool
summary LinksInfo
links [(DocName, Fixity)]
fixities SrcSpan
loc DocForDecl DocName
doc (SynDecl { tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = L SrcSpan
_ IdP DocNameI
name, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
ltyvars
                                                , tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LHsType DocNameI
ltype })
        Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  = Bool
-> LinksInfo
-> SrcSpan
-> [DocName]
-> HsType DocNameI
-> DocForDecl DocName
-> (Html, Html, Html)
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> HideEmptyContexts
-> Html
ppTypeOrFunSig Bool
summary LinksInfo
links SrcSpan
loc [IdP DocNameI
DocName
name] (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
ltype) 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 Package
pkg Qualification
qual HideEmptyContexts
ShowEmptyToplevelContexts
  where
    hdr :: Html
hdr  = [Html] -> Html
hsep ([Package -> Html
keyword Package
"type", Bool -> OccName -> Html
ppBinder Bool
summary OccName
occ]
                 [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ Bool -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html]
ppTyVars Bool
unicode Qualification
qual (LHsQTyVars DocNameI -> [LHsTyVarBndr DocNameI]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit LHsQTyVars DocNameI
ltyvars))
    full :: Html
full = Html
hdr Html -> Html -> Html
<+> Html
equals Html -> Html -> Html
<+> Bool -> Qualification -> LHsType DocNameI -> Html
ppPatSigType Bool
unicode Qualification
qual LHsType DocNameI
ltype
    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
$ IdP DocNameI
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 Package
_ Qualification
_ = Package -> Html
forall a. HasCallStack => Package -> a
error Package
"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 (Package -> Html
stringToHtml Package
", ") ([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] -> HsType DocNameI
            -> Html
ppSimpleSig :: LinksInfo
-> Bool
-> Bool
-> Qualification
-> HideEmptyContexts
-> SrcSpan
-> [DocName]
-> HsType DocNameI
-> Html
ppSimpleSig LinksInfo
links Bool
splice Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts SrcSpan
loc [DocName]
names HsType DocNameI
typ =
    [DocName] -> Html -> Html
topDeclElem' [DocName]
names (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 -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts HsType 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


--------------------------------------------------------------------------------
-- * 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 Package
-> 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 Package
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 Package -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe Package
pkg Qualification
qual Documentation DocName
doc Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
instancesBit

  where
    docname :: SrcSpanLess (Located DocName)
docname = Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located DocName -> SrcSpanLess (Located DocName))
-> Located DocName -> SrcSpanLess (Located DocName)
forall a b. (a -> b) -> a -> b
$ FamilyDecl DocNameI -> Located (IdP DocNameI)
forall pass. FamilyDecl pass -> Located (IdP 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 SrcSpanLess (Located DocName)
DocName
docname

    header_ :: Html
header_ = LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice [SrcSpanLess (Located DocName)
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 Package -> Qualification -> [SubDecl] -> Html
subEquations Maybe Package
pkg Qualification
qual ([SubDecl] -> Html) -> [SubDecl] -> Html
forall a b. (a -> b) -> a -> b
$ (LTyFamInstEqn DocNameI -> SubDecl)
-> [LTyFamInstEqn DocNameI] -> [SubDecl]
forall a b. (a -> b) -> [a] -> [b]
map (TyFamInstEqn DocNameI -> SubDecl
ppFamDeclEqn (TyFamInstEqn DocNameI -> SubDecl)
-> (LTyFamInstEqn DocNameI -> TyFamInstEqn DocNameI)
-> LTyFamInstEqn DocNameI
-> SubDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTyFamInstEqn DocNameI -> TyFamInstEqn DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([LTyFamInstEqn DocNameI] -> [SubDecl])
-> [LTyFamInstEqn DocNameI] -> [SubDecl]
forall a b. (a -> b) -> a -> b
$ [LTyFamInstEqn DocNameI]
-> Maybe [LTyFamInstEqn DocNameI] -> [LTyFamInstEqn DocNameI]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [LTyFamInstEqn DocNameI]
mb_eqns

      | Bool
otherwise
      = LinksInfo
-> InstOrigin DocName
-> [DocInstance DocNameI]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppInstances LinksInfo
links (DocName -> InstOrigin DocName
forall name. name -> InstOrigin name
OriginFamily SrcSpanLess (Located DocName)
DocName
docname) [DocInstance DocNameI]
instances Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual

    -- Individual equation of a closed type family
    ppFamDeclEqn :: TyFamInstEqn DocNameI -> SubDecl
    ppFamDeclEqn :: TyFamInstEqn DocNameI -> SubDecl
ppFamDeclEqn (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = L SrcSpan
_ IdP DocNameI
n
                                            , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = LHsType DocNameI
rhs
                                            , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats = HsTyPats DocNameI
ts } })
      = ( DocName -> HsTyPats DocNameI -> Bool -> Qualification -> Html
ppAppNameTypeArgs IdP DocNameI
DocName
n HsTyPats 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 (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
rhs)
        , Maybe (MDoc DocName)
forall a. Maybe a
Nothing
        , []
        )
    ppFamDeclEqn (XHsImplicitBndrs XXHsImplicitBndrs DocNameI (FamEqn DocNameI (LHsType DocNameI))
nec) = NoExtCon -> SubDecl
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsImplicitBndrs DocNameI (FamEqn DocNameI (LHsType DocNameI))
nec
    ppFamDeclEqn (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = XFamEqn XXFamEqn DocNameI (LHsType DocNameI)
nec}) = NoExtCon -> SubDecl
forall a. NoExtCon -> a
noExtCon NoExtCon
XXFamEqn DocNameI (LHsType DocNameI)
nec


-- | Print a pseudo family declaration
ppPseudoFamDecl :: LinksInfo -> Splice
                -> PseudoFamilyDecl DocNameI   -- ^ this decl
                -> Unicode -> Qualification -> Html
ppPseudoFamDecl :: LinksInfo
-> Bool
-> PseudoFamilyDecl DocNameI
-> Bool
-> Qualification
-> Html
ppPseudoFamDecl LinksInfo
links Bool
splice
                (PseudoFamilyDecl { pfdInfo :: forall name. PseudoFamilyDecl name -> FamilyInfo name
pfdInfo = FamilyInfo DocNameI
info
                                  , pfdKindSig :: forall name. PseudoFamilyDecl name -> LFamilyResultSig name
pfdKindSig = L SrcSpan
_ FamilyResultSig DocNameI
kindSig
                                  , pfdTyVars :: forall name. PseudoFamilyDecl name -> [LHsType name]
pfdTyVars = [LHsType DocNameI]
tvs
                                  , pfdLName :: forall name. PseudoFamilyDecl name -> Located (IdP name)
pfdLName = L SrcSpan
loc IdP DocNameI
name })
                Bool
unicode Qualification
qual =
    LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html
topDeclElem LinksInfo
links SrcSpan
loc Bool
splice [IdP DocNameI
DocName
name] Html
leader
  where
    leader :: Html
leader = [Html] -> Html
hsep [ Bool -> FamilyInfo DocNameI -> Html
ppFamilyLeader Bool
True FamilyInfo DocNameI
info
                  , DocName -> [HsType DocNameI] -> Bool -> Qualification -> Html
ppAppNameTypes IdP DocNameI
DocName
name ((LHsType DocNameI -> HsType DocNameI)
-> [LHsType DocNameI] -> [HsType DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map LHsType DocNameI -> HsType DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LHsType DocNameI]
tvs) Bool
unicode Qualification
qual
                  , FamilyResultSig DocNameI -> Bool -> Qualification -> Html
ppResultSig FamilyResultSig DocNameI
kindSig Bool
unicode Qualification
qual
                  ]

-- | 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
_ Bool
_ (XFamilyDecl XXFamilyDecl DocNameI
nec) Bool
_ Qualification
_ = NoExtCon -> Html
forall a. NoExtCon -> a
noExtCon NoExtCon
XXFamilyDecl DocNameI
nec
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 SrcSpan
_ FamilyResultSig DocNameI
result
                                           , fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn DocNameI)
injectivity
                                           , fdLName :: forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName = L SrcSpan
_ IdP DocNameI
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 DocNameI]
-> Html
ppAppDocNameTyVarBndrs Bool
summary Bool
unicode Qualification
qual IdP DocNameI
DocName
name (LHsQTyVars DocNameI -> [LHsTyVarBndr DocNameI]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr 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]
_ -> Package -> Html
keyword Package
"where ..."
      FamilyInfo DocNameI
_                  -> Html
noHtml

    injAnn :: Html
injAnn = case Maybe (LInjectivityAnn DocNameI)
injectivity of
      Maybe (LInjectivityAnn DocNameI)
Nothing -> Html
noHtml
      Just (L SrcSpan
_ (InjectivityAnn Located (IdP DocNameI)
lhs [Located (IdP DocNameI)]
rhs)) -> [Html] -> Html
hsep ( Package -> Html
keyword Package
"|"
                                                  Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Qualification -> Notation -> Located DocName -> Html
ppLDocName Qualification
qual Notation
Raw Located (IdP DocNameI)
Located DocName
lhs
                                                  Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: Bool -> Html
arrow Bool
unicode
                                                  Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: (Located DocName -> Html) -> [Located DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Qualification -> Notation -> Located DocName -> Html
ppLDocName Qualification
qual Notation
Raw) [Located (IdP DocNameI)]
[Located DocName]
rhs)

-- | Print the keywords that begin the family declaration
ppFamilyLeader :: Bool -> FamilyInfo DocNameI -> Html
ppFamilyLeader :: Bool -> FamilyInfo DocNameI -> Html
ppFamilyLeader Bool
assoc FamilyInfo DocNameI
info = Package -> Html
keyword (Package
typ Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ if Bool
assoc then Package
"" else Package
" family")
  where
    typ :: Package
typ = case FamilyInfo DocNameI
info of
       FamilyInfo DocNameI
OpenTypeFamily     -> Package
"type"
       ClosedTypeFamily Maybe [LTyFamInstEqn DocNameI]
_ -> Package
"type"
       FamilyInfo DocNameI
DataFamily         -> Package
"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
_ LHsType DocNameI
kind        -> Bool -> Html
dcolon Bool
unicode  Html -> Html -> Html
<+> Bool -> Qualification -> LHsType DocNameI -> Html
ppLKind Bool
unicode Qualification
qual LHsType DocNameI
kind
    TyVarSig XTyVarSig DocNameI
_ (L SrcSpan
_ HsTyVarBndr DocNameI
bndr) -> Html
equals Html -> Html -> Html
<+> Bool -> Qualification -> HsTyVarBndr DocNameI -> Html
ppHsTyVarBndr Bool
unicode Qualification
qual HsTyVarBndr DocNameI
bndr
    XFamilyResultSig XXFamilyResultSig DocNameI
nec  -> NoExtCon -> Html
forall a. NoExtCon -> a
noExtCon NoExtCon
XXFamilyResultSig DocNameI
nec


--------------------------------------------------------------------------------
-- * 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 Package
-> Qualification
-> Html
ppAssocType Bool
summ LinksInfo
links DocForDecl DocName
doc (L SrcSpan
loc FamilyDecl DocNameI
decl) [(DocName, Fixity)]
fixities Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual =
   Bool
-> Bool
-> LinksInfo
-> [DocInstance DocNameI]
-> [(DocName, Fixity)]
-> SrcSpan
-> Documentation DocName
-> FamilyDecl DocNameI
-> Bool
-> Bool
-> Maybe Package
-> 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 Package
pkg Qualification
qual


--------------------------------------------------------------------------------
-- * Type applications
--------------------------------------------------------------------------------

ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [LHsTyVarBndr DocNameI] -> Html
ppAppDocNameTyVarBndrs :: Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr DocNameI]
-> Html
ppAppDocNameTyVarBndrs Bool
summ Bool
unicode Qualification
qual DocName
n [LHsTyVarBndr DocNameI]
vs =
    DocName
-> [LHsTyVarBndr DocNameI]
-> (Notation -> DocName -> Html)
-> (LHsTyVarBndr DocNameI -> Html)
-> Html
forall a.
DocName
-> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
ppTypeApp DocName
n [LHsTyVarBndr DocNameI]
vs Notation -> DocName -> Html
ppDN (Bool -> Qualification -> HsTyVarBndr DocNameI -> Html
ppHsTyVarBndr Bool
unicode Qualification
qual (HsTyVarBndr DocNameI -> Html)
-> (LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI)
-> LHsTyVarBndr DocNameI
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
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 -> HsTyPats DocNameI -> Bool -> Qualification -> Html
ppAppNameTypeArgs DocName
n args :: HsTyPats DocNameI
args@(HsValArg LHsType DocNameI
_:HsValArg LHsType DocNameI
_:HsTyPats DocNameI
_) Bool
u Qualification
q
  = DocName
-> HsTyPats DocNameI
-> (Notation -> DocName -> Html)
-> (HsArg (LHsType DocNameI) (LHsType DocNameI) -> Html)
-> Html
forall a.
DocName
-> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
ppTypeApp DocName
n HsTyPats DocNameI
args (\Notation
p -> Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
q Notation
p Bool
True) (Bool
-> Qualification
-> HideEmptyContexts
-> HsArg (LHsType DocNameI) (LHsType DocNameI)
-> Html
ppLHsTypeArg Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts)
ppAppNameTypeArgs DocName
n HsTyPats 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 (LHsType DocNameI) (LHsType DocNameI) -> Html)
-> HsTyPats DocNameI -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification
-> HideEmptyContexts
-> HsArg (LHsType DocNameI) (LHsType DocNameI)
-> Html
ppLHsTypeArg Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) HsTyPats DocNameI
args)

-- | General printing of type applications
ppTypeApp :: DocName -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
ppTypeApp :: 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 (t :: * -> *) 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, ppLContextNoArrow :: Located (HsContext DocNameI) -> Unicode
                              -> Qualification -> HideEmptyContexts -> Html
ppLContext :: LHsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContext        = [LHsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContext        ([LHsType DocNameI]
 -> Bool -> Qualification -> HideEmptyContexts -> Html)
-> (LHsContext DocNameI -> [LHsType DocNameI])
-> LHsContext DocNameI
-> Bool
-> Qualification
-> HideEmptyContexts
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsContext DocNameI -> [LHsType DocNameI]
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
ppLContextNoArrow :: LHsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContextNoArrow = [LHsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoArrow ([LHsType DocNameI]
 -> Bool -> Qualification -> HideEmptyContexts -> Html)
-> (LHsContext DocNameI -> [LHsType DocNameI])
-> LHsContext DocNameI
-> Bool
-> Qualification
-> HideEmptyContexts
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsContext DocNameI -> [LHsType DocNameI]
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc

ppContextNoArrow :: HsContext DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppContextNoArrow :: [LHsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoArrow [LHsType DocNameI]
cxt Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts = Html -> Maybe Html -> Html
forall a. a -> Maybe a -> a
fromMaybe Html
noHtml (Maybe Html -> Html) -> Maybe Html -> Html
forall a b. (a -> b) -> a -> b
$
                                               [HsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Maybe Html
ppContextNoLocsMaybe ((LHsType DocNameI -> HsType DocNameI)
-> [LHsType DocNameI] -> [HsType DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map LHsType DocNameI -> HsType DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LHsType 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 (Package -> Html
forall a. HTML a => a -> Html
toHtml Package
"()")
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 :: [LHsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContext [LHsType DocNameI]
cxt Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts = [HsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoLocs ((LHsType DocNameI -> HsType DocNameI)
-> [LHsType DocNameI] -> [HsType DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map LHsType DocNameI -> HsType DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LHsType 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 -> Located [LHsType DocNameI] -> DocName
           -> LHsQTyVars DocNameI -> [Located ([Located DocName], [Located DocName])]
           -> Unicode -> Qualification -> Html
ppClassHdr :: Bool
-> LHsContext DocNameI
-> DocName
-> LHsQTyVars DocNameI
-> [Located ([Located DocName], [Located DocName])]
-> Bool
-> Qualification
-> Html
ppClassHdr Bool
summ LHsContext DocNameI
lctxt DocName
n LHsQTyVars DocNameI
tvs [Located ([Located DocName], [Located DocName])]
fds Bool
unicode Qualification
qual =
  Package -> Html
keyword Package
"class"
  Html -> Html -> Html
<+> (if Bool -> Bool
not (Bool -> Bool)
-> (LHsContext DocNameI -> Bool) -> LHsContext DocNameI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsType DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LHsType DocNameI] -> Bool)
-> (LHsContext DocNameI -> [LHsType DocNameI])
-> LHsContext DocNameI
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsContext DocNameI -> [LHsType DocNameI]
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsContext DocNameI -> Bool) -> LHsContext DocNameI -> Bool
forall a b. (a -> b) -> a -> b
$ LHsContext DocNameI
lctxt then LHsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContext LHsContext DocNameI
lctxt Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts else Html
noHtml)
  Html -> Html -> Html
<+> Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr DocNameI]
-> Html
ppAppDocNameTyVarBndrs Bool
summ Bool
unicode Qualification
qual DocName
n (LHsQTyVars DocNameI -> [LHsTyVarBndr DocNameI]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit LHsQTyVars DocNameI
tvs)
  Html -> Html -> Html
<+> [Located ([Located DocName], [Located DocName])]
-> Bool -> Qualification -> Html
ppFds [Located ([Located DocName], [Located DocName])]
fds Bool
unicode Qualification
qual


ppFds :: [Located ([Located DocName], [Located DocName])] -> Unicode -> Qualification -> Html
ppFds :: [Located ([Located DocName], [Located DocName])]
-> Bool -> Qualification -> Html
ppFds [Located ([Located DocName], [Located DocName])]
fds Bool
unicode Qualification
qual =
  if [Located ([Located DocName], [Located DocName])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located ([Located DocName], [Located DocName])]
fds then Html
noHtml else
        Char -> Html
char Char
'|' Html -> Html -> Html
<+> [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma ((Located ([Located DocName], [Located DocName]) -> Html)
-> [Located ([Located DocName], [Located DocName])] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (([Located DocName], [Located DocName]) -> Html
fundep (([Located DocName], [Located DocName]) -> Html)
-> (Located ([Located DocName], [Located DocName])
    -> ([Located DocName], [Located DocName]))
-> Located ([Located DocName], [Located DocName])
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ([Located DocName], [Located DocName])
-> ([Located DocName], [Located DocName])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located ([Located DocName], [Located DocName])]
fds))
  where
        fundep :: ([Located DocName], [Located DocName]) -> Html
fundep ([Located DocName]
vars1,[Located DocName]
vars2) = [Located DocName] -> Html
ppVars [Located DocName]
vars1 Html -> Html -> Html
<+> Bool -> Html
arrow Bool
unicode Html -> Html -> Html
<+> [Located DocName] -> Html
ppVars [Located DocName]
vars2
        ppVars :: [Located DocName] -> Html
ppVars = [Html] -> Html
hsep ([Html] -> Html)
-> ([Located DocName] -> [Html]) -> [Located DocName] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located DocName -> Html) -> [Located DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Prefix Bool
True) (DocName -> Html)
-> (Located DocName -> DocName) -> Located DocName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
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 Package
-> Qualification
-> Html
ppShortClassDecl Bool
summary LinksInfo
links (ClassDecl { tcdCtxt :: forall pass. TyClDecl pass -> LHsContext pass
tcdCtxt = LHsContext DocNameI
lctxt, tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = Located (IdP 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 Package
pkg Qualification
qual =
  if Bool -> Bool
not ((LSig DocNameI -> Bool) -> [LSig DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LSig DocNameI -> Bool
forall name. LSig name -> Bool
isUserLSig [LSig DocNameI]
sigs) Bool -> Bool -> Bool
&& [LFamilyDecl DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LFamilyDecl 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 [SrcSpanLess (Located DocName)
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 [SrcSpanLess (Located DocName)
DocName
nm]) (Html
hdr Html -> Html -> Html
<+> Package -> Html
keyword Package
"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 Package
-> Qualification
-> Html
ppAssocType Bool
summary LinksInfo
links DocForDecl DocName
doc LFamilyDecl DocNameI
at [] Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual | LFamilyDecl DocNameI
at <- [LFamilyDecl 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 (Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located DocName -> SrcSpanLess (Located DocName))
-> Located DocName -> SrcSpanLess (Located DocName)
forall a b. (a -> b) -> a -> b
$ FamilyDecl DocNameI -> Located (IdP DocNameI)
forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName (FamilyDecl DocNameI -> Located (IdP DocNameI))
-> FamilyDecl DocNameI -> Located (IdP DocNameI)
forall a b. (a -> b) -> a -> b
$ LFamilyDecl DocNameI -> SrcSpanLess (LFamilyDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LFamilyDecl 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]
-> LHsType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppFunSig Bool
summary LinksInfo
links SrcSpan
loc Html
noHtml DocForDecl DocName
doc [DocName]
names (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
typ)
                       [] Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
              | L SrcSpan
_ (ClassOpSig XClassOpSig DocNameI
_ Bool
False [Located (IdP DocNameI)]
lnames LHsSigType DocNameI
typ) <- [LSig DocNameI]
sigs
              , let doc :: DocForDecl DocName
doc = DocName -> [(DocName, DocForDecl DocName)] -> DocForDecl DocName
forall id1 id2.
Eq id1 =>
id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc ([DocName] -> DocName
forall a. [a] -> a
head [DocName]
names) [(DocName, DocForDecl DocName)]
subdocs
                    names :: [DocName]
names = (Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames ]
              -- 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
-> LHsContext DocNameI
-> DocName
-> LHsQTyVars DocNameI
-> [Located ([Located DocName], [Located DocName])]
-> Bool
-> Qualification
-> Html
ppClassHdr Bool
summary LHsContext DocNameI
lctxt (Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP DocNameI)
Located DocName
lname) LHsQTyVars DocNameI
tvs [LHsFunDep DocNameI]
[Located ([Located DocName], [Located DocName])]
fds Bool
unicode Qualification
qual
    nm :: SrcSpanLess (Located DocName)
nm  = Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP DocNameI)
Located DocName
lname
ppShortClassDecl Bool
_ LinksInfo
_ TyClDecl DocNameI
_ SrcSpan
_ [(DocName, DocForDecl DocName)]
_ Bool
_ Bool
_ Maybe Package
_ Qualification
_ = Package -> Html
forall a. HasCallStack => Package -> a
error Package
"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 Package
-> 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 -> LHsContext pass
tcdCtxt = LHsContext DocNameI
lctxt, tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = lname :: Located (IdP DocNameI)
lname@(L SrcSpan
_ IdP DocNameI
nm)
                        , 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 Package
pkg Qualification
qual
  | Bool
summary = Bool
-> LinksInfo
-> TyClDecl DocNameI
-> SrcSpan
-> [(DocName, DocForDecl DocName)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppShortClassDecl Bool
summary LinksInfo
links TyClDecl DocNameI
decl SrcSpan
loc [(DocName, DocForDecl DocName)]
subdocs Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  | Bool
otherwise = Html
classheader Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Maybe Name
-> Maybe Package -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe Package
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 = (LSig DocNameI -> Sig DocNameI)
-> [LSig DocNameI] -> [Sig DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map LSig DocNameI -> Sig DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LSig DocNameI]
lsigs

    classheader :: Html
classheader
      | (LSig DocNameI -> Bool) -> [LSig DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LSig DocNameI -> Bool
forall name. LSig name -> 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
<+> Package -> Html
keyword Package
"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
== Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP DocNameI)
Located DocName
lname ] Qualification
qual

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

    hdr :: Bool -> Qualification -> Html
hdr = Bool
-> LHsContext DocNameI
-> DocName
-> LHsQTyVars DocNameI
-> [Located ([Located DocName], [Located DocName])]
-> Bool
-> Qualification
-> Html
ppClassHdr Bool
summary LHsContext DocNameI
lctxt (Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP DocNameI)
Located DocName
lname) LHsQTyVars DocNameI
ltyvars [LHsFunDep DocNameI]
[Located ([Located DocName], [Located DocName])]
lfds

    -- Associated types
    atBit :: Html
atBit = [Html] -> Html
subAssociatedTypes
      [ Bool
-> LinksInfo
-> DocForDecl DocName
-> LFamilyDecl DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppAssocType Bool
summary LinksInfo
links DocForDecl DocName
doc LFamilyDecl DocNameI
at [(DocName, Fixity)]
subfixs Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
          Html -> Html -> Html
<+>
        [Html] -> Html
subDefaults (Maybe Html -> [Html]
forall a. Maybe a -> [a]
maybeToList Maybe Html
defTys)
      | LFamilyDecl DocNameI
at <- [LFamilyDecl DocNameI]
ats
      , let name :: DocName
name = Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located DocName -> DocName)
-> (FamilyDecl DocNameI -> Located DocName)
-> FamilyDecl DocNameI
-> DocName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamilyDecl DocNameI -> Located DocName
forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName (FamilyDecl DocNameI -> DocName) -> FamilyDecl DocNameI -> DocName
forall a b. (a -> b) -> a -> b
$ LFamilyDecl DocNameI -> SrcSpanLess (LFamilyDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LFamilyDecl 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)
-> ((HsTyPats DocNameI, LHsType DocNameI) -> Html)
-> (HsTyPats DocNameI, LHsType DocNameI)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> (HsTyPats DocNameI, LHsType DocNameI) -> Html
ppDefaultAssocTy DocName
name) ((HsTyPats DocNameI, LHsType DocNameI) -> Html)
-> Maybe (HsTyPats DocNameI, LHsType DocNameI) -> Maybe Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DocName -> Maybe (HsTyPats DocNameI, LHsType DocNameI)
lookupDAT DocName
name
      ]

    -- Default associated types
    ppDefaultAssocTy :: DocName -> (HsTyPats DocNameI, LHsType DocNameI) -> Html
ppDefaultAssocTy DocName
n (HsTyPats DocNameI
vs,LHsType DocNameI
rhs) = [Html] -> Html
hsep
      [ Package -> Html
keyword Package
"type", DocName -> HsTyPats DocNameI -> Bool -> Qualification -> Html
ppAppNameTypeArgs DocName
n HsTyPats DocNameI
vs Bool
unicode Qualification
qual, Html
equals
      , Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
rhs)
      ]

    lookupDAT :: DocName -> Maybe (HsTyPats DocNameI, LHsType DocNameI)
lookupDAT DocName
name = Name
-> Map Name (HsTyPats DocNameI, LHsType DocNameI)
-> Maybe (HsTyPats DocNameI, LHsType 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 (HsTyPats DocNameI, LHsType DocNameI)
defaultAssocTys
    defaultAssocTys :: Map Name (HsTyPats DocNameI, LHsType DocNameI)
defaultAssocTys = [(Name, (HsTyPats DocNameI, LHsType DocNameI))]
-> Map Name (HsTyPats DocNameI, LHsType DocNameI)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (DocName -> Name
forall a. NamedThing a => a -> Name
getName IdP DocNameI
DocName
name, (HsTyPats DocNameI
vs, LHsType DocNameI
typ))
      | L SrcSpan
_ (TyFamInstDecl (HsIB XHsIB DocNameI (FamEqn DocNameI (LHsType DocNameI))
_ (FamEqn { feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = LHsType DocNameI
typ
                                           , feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = L SrcSpan
_ IdP DocNameI
name
                                           , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats = HsTyPats DocNameI
vs }))) <- [LTyFamDefltDecl DocNameI]
atsDefs
      ]

    -- Methods
    methodBit :: Html
methodBit = [Html] -> Html
subMethods
      [ Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppFunSig Bool
summary LinksInfo
links SrcSpan
loc Html
noHtml DocForDecl DocName
doc [DocName
name] (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
typ)
                 [(DocName, Fixity)]
subfixs Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
          Html -> Html -> Html
<+>
        [Html] -> Html
subDefaults (Maybe Html -> [Html]
forall a. Maybe a -> [a]
maybeToList Maybe Html
defSigs)
      | ClassOpSig XClassOpSig DocNameI
_ Bool
False [Located (IdP DocNameI)]
lnames LHsSigType DocNameI
typ <- [Sig DocNameI]
sigs
      , DocName
name <- (Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located 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 -> (LHsSigType DocNameI, DocForDecl DocName) -> Html
ppDefaultFunSig DocName
name ((LHsSigType DocNameI, DocForDecl DocName) -> Html)
-> Maybe (LHsSigType DocNameI, DocForDecl DocName) -> Maybe Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DocName -> Maybe (LHsSigType 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 -> (LHsSigType DocNameI, DocForDecl DocName) -> Html
ppDefaultFunSig DocName
n (LHsSigType DocNameI
t, DocForDecl DocName
d') = Bool
-> LinksInfo
-> SrcSpan
-> Html
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> [(DocName, Fixity)]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppFunSig Bool
summary LinksInfo
links SrcSpan
loc (Package -> Html
keyword Package
"default")
      DocForDecl DocName
d' [DocName
n] (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
t) [] Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual

    lookupDM :: DocName -> Maybe (LHsSigType DocNameI, DocForDecl DocName)
lookupDM DocName
name = Package
-> Map Package (LHsSigType DocNameI, DocForDecl DocName)
-> Maybe (LHsSigType DocNameI, DocForDecl DocName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DocName -> Package
forall a. NamedThing a => a -> Package
getOccString DocName
name) Map Package (LHsSigType DocNameI, DocForDecl DocName)
defaultMethods
    defaultMethods :: Map Package (LHsSigType DocNameI, DocForDecl DocName)
defaultMethods = [(Package, (LHsSigType DocNameI, DocForDecl DocName))]
-> Map Package (LHsSigType DocNameI, DocForDecl DocName)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (Package
nameStr, (LHsSigType DocNameI
typ, DocForDecl DocName
forall name. DocForDecl name
doc))
      | ClassOpSig XClassOpSig DocNameI
_ Bool
True [Located (IdP DocNameI)]
lnames LHsSigType DocNameI
typ <- [Sig DocNameI]
sigs
      , DocName
name <- (Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames
      , let doc :: DocForDecl name
doc = DocForDecl name
forall name. DocForDecl name
noDocForDecl -- TODO: get docs for method defaults
            nameStr :: Package
nameStr = DocName -> Package
forall a. NamedThing a => a -> Package
getOccString DocName
name
      ]

    -- Minimal complete definition
    minimalBit :: Html
minimalBit = case [ BooleanFormula (Located (IdP DocNameI))
BooleanFormula (Located DocName)
s | MinimalSig XMinimalSig DocNameI
_ SourceText
_ (L SrcSpan
_ BooleanFormula (Located (IdP DocNameI))
s) <- [Sig DocNameI]
sigs ] of
      -- Miminal complete definition = every shown method
      And [LBooleanFormula (Located DocName)]
xs : [BooleanFormula (Located DocName)]
_ | [Name] -> [Name]
forall a. Ord a => [a] -> [a]
sort [DocName -> Name
forall a. NamedThing a => a -> Name
getName DocName
n | L SrcSpan
_ (Var (L SrcSpan
_ DocName
n)) <- [LBooleanFormula (Located 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
_ [Located (IdP DocNameI)]
ns LHsSigType DocNameI
_ <- [Sig DocNameI]
sigs, L SrcSpan
_ DocName
n <- [Located (IdP DocNameI)]
[Located DocName]
ns]
        -> Html
noHtml

      -- Minimal complete definition = the only shown method
      Var (L SrcSpan
_ DocName
n) : [BooleanFormula (Located 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
_ [Located (IdP DocNameI)]
ns LHsSigType DocNameI
_ <- [Sig DocNameI]
sigs, L SrcSpan
_ DocName
n' <- [Located (IdP DocNameI)]
[Located DocName]
ns]
        -> Html
noHtml

      -- Minimal complete definition = nothing
      And [] : [BooleanFormula (Located DocName)]
_ -> Html -> Html
subMinimal (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Package -> Html
forall a. HTML a => a -> Html
toHtml Package
"Nothing"

      BooleanFormula (Located DocName)
m : [BooleanFormula (Located DocName)]
_  -> Html -> Html
subMinimal (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Bool -> BooleanFormula (Located DocName) -> Html
ppMinimal Bool
False BooleanFormula (Located DocName)
m
      [BooleanFormula (Located DocName)]
_ -> Html
noHtml

    ppMinimal :: Bool -> BooleanFormula (Located DocName) -> Html
ppMinimal Bool
_ (Var (L SrcSpan
_ DocName
n)) = Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Prefix Bool
True DocName
n
    ppMinimal Bool
_ (And [LBooleanFormula (Located DocName)]
fs) = (Html -> Html -> Html) -> [Html] -> Html
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Html
a Html
b -> Html
aHtml -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++Package
", "Package -> 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 (Located DocName) -> Html)
-> [LBooleanFormula (Located DocName)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BooleanFormula (Located DocName) -> Html
ppMinimal Bool
True (BooleanFormula (Located DocName) -> Html)
-> (LBooleanFormula (Located DocName)
    -> BooleanFormula (Located DocName))
-> LBooleanFormula (Located DocName)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LBooleanFormula (Located DocName)
-> BooleanFormula (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LBooleanFormula (Located DocName)]
fs
    ppMinimal Bool
p (Or [LBooleanFormula (Located DocName)]
fs) = Html -> Html
wrap (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (Html -> Html -> Html) -> [Html] -> Html
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\Html
a Html
b -> Html
aHtml -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++Package
" | "Package -> 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 (Located DocName) -> Html)
-> [LBooleanFormula (Located DocName)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BooleanFormula (Located DocName) -> Html
ppMinimal Bool
False (BooleanFormula (Located DocName) -> Html)
-> (LBooleanFormula (Located DocName)
    -> BooleanFormula (Located DocName))
-> LBooleanFormula (Located DocName)
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LBooleanFormula (Located DocName)
-> BooleanFormula (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LBooleanFormula (Located 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 (Located DocName)
x) = Bool -> BooleanFormula (Located DocName) -> Html
ppMinimal Bool
p (LBooleanFormula (Located DocName)
-> SrcSpanLess (LBooleanFormula (Located DocName))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LBooleanFormula (Located DocName)
x)

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

ppClassDecl Bool
_ LinksInfo
_ [DocInstance DocNameI]
_ [(DocName, Fixity)]
_ SrcSpan
_ Documentation DocName
_ [(DocName, DocForDecl DocName)]
_ TyClDecl DocNameI
_ Bool
_ Bool
_ Maybe Package
_ Qualification
_ = Package -> Html
forall a. HasCallStack => Package -> a
error Package
"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 Package
-> Qualification
-> Html
ppInstances LinksInfo
links InstOrigin DocName
origin [DocInstance DocNameI]
instances Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  = Maybe Package
-> Qualification
-> Package
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
subInstances Maybe Package
pkg Qualification
qual Package
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)
  -- force Splice = True to use line URLs
  where
    instName :: Package
instName = InstOrigin DocName -> Package
forall a. NamedThing a => a -> Package
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 Package
-> Qualification
-> Html
ppOrphanInstances LinksInfo
links [DocInstance DocNameI]
instances Bool
splice Bool
unicode Maybe Package
pkg Qualification
qual
  = Maybe Package
-> Qualification
-> LinksInfo
-> Bool
-> [(SubDecl, Maybe Module, Located DocName)]
-> Html
subOrphanInstances Maybe Package
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 :: 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
ihdInstType :: forall name. InstHead name -> InstType name
ihdTypes :: forall name. InstHead name -> [HsType name]
ihdInstType :: InstType DocNameI
ihdTypes :: [HsType DocNameI]
ihdClsName :: IdP DocNameI
ihdClsName :: forall name. InstHead name -> IdP name
..}) Maybe Module
mdl =
    case InstType DocNameI
ihdInstType of
        ClassInst { [Sig DocNameI]
[HsType DocNameI]
[PseudoFamilyDecl DocNameI]
LHsQTyVars DocNameI
clsiAssocTys :: forall name. InstType name -> [PseudoFamilyDecl name]
clsiSigs :: forall name. InstType name -> [Sig name]
clsiTyVars :: forall name. InstType name -> LHsQTyVars name
clsiCtx :: forall name. InstType name -> [HsType name]
clsiAssocTys :: [PseudoFamilyDecl DocNameI]
clsiSigs :: [Sig DocNameI]
clsiTyVars :: LHsQTyVars DocNameI
clsiCtx :: [HsType DocNameI]
.. } ->
            ( Package -> Html -> Html
subInstHead Package
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
            , [Package -> [Html] -> [Html] -> Html -> Html
subInstDetails Package
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
-> [PseudoFamilyDecl DocNameI]
-> [Html]
ppInstanceAssocTys LinksInfo
links Bool
splice Bool
unicode Qualification
qual [PseudoFamilyDecl DocNameI]
clsiAssocTys
        TypeInst Maybe (HsType DocNameI)
rhs ->
            ( Package -> Html -> Html
subInstHead Package
iid Html
ptype
            , Maybe (MDoc DocName)
mdoc
            , [Package -> Html -> Html -> Html
subFamInstDetails Package
iid Html
prhs Html
mname]
            )
          where
            ptype :: Html
ptype = Package -> Html
keyword Package
"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 ->
            ( Package -> Html -> Html
subInstHead Package
iid Html
pdata
            , Maybe (MDoc DocName)
mdoc
            , [Package -> Html -> Html -> Html
subFamInstDetails Package
iid Html
pdecl Html
mname])
          where
            nd :: NewOrData
nd = HsDataDefn DocNameI -> NewOrData
forall pass. HsDataDefn pass -> NewOrData
dd_ND (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dd)
            pref :: Html
pref = case NewOrData
nd of { NewOrData
NewType -> Package -> Html
keyword Package
"newtype"; NewOrData
DataType -> Package -> Html
keyword Package
"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 -> Package -> Html
forall a. HTML a => a -> Html
toHtml Package
"Defined in" Html -> Html -> Html
<+> Module -> Html
ppModule Module
m) Maybe Module
mdl
    iid :: Package
iid = InstOrigin DocName -> Int -> Bool -> InstHead DocNameI -> Package
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
                   -> [PseudoFamilyDecl DocNameI]
                   -> [Html]
ppInstanceAssocTys :: LinksInfo
-> Bool
-> Bool
-> Qualification
-> [PseudoFamilyDecl DocNameI]
-> [Html]
ppInstanceAssocTys LinksInfo
links Bool
splice Bool
unicode Qualification
qual =
    (PseudoFamilyDecl DocNameI -> Html)
-> [PseudoFamilyDecl DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (\PseudoFamilyDecl DocNameI
pseudo -> LinksInfo
-> Bool
-> PseudoFamilyDecl DocNameI
-> Bool
-> Qualification
-> Html
ppPseudoFamDecl LinksInfo
links Bool
splice PseudoFamilyDecl DocNameI
pseudo Bool
unicode Qualification
qual)


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 XTypeSig DocNameI
_ [Located (IdP DocNameI)]
lnames LHsSigWcType DocNameI
typ <- [Sig DocNameI]
sigs
    let names :: [DocName]
names = (Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames
        L SrcSpan
_ HsType DocNameI
rtyp = LHsSigWcType DocNameI -> LHsType DocNameI
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType DocNameI
typ
    -- Instance methods signatures are synified and thus don't have a useful
    -- SrcSpan value. Use the methods name location instead.
    Html -> [Html]
forall (m :: * -> *) a. Monad m => a -> m a
return (Html -> [Html]) -> Html -> [Html]
forall a b. (a -> b) -> a -> b
$ LinksInfo
-> Bool
-> Bool
-> Qualification
-> HideEmptyContexts
-> SrcSpan
-> [DocName]
-> HsType DocNameI
-> Html
ppSimpleSig LinksInfo
links Bool
splice Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (Located DocName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc (Located DocName -> SrcSpan) -> Located DocName -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [Located DocName] -> Located DocName
forall a. [a] -> a
head ([Located DocName] -> Located DocName)
-> [Located DocName] -> Located DocName
forall a b. (a -> b) -> a -> b
$ [Located (IdP DocNameI)]
[Located DocName]
lnames) [DocName]
names HsType DocNameI
rtyp


lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc :: id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc id1
n = DocForDecl id2 -> Maybe (DocForDecl id2) -> DocForDecl id2
forall a. a -> Maybe a -> a
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 -> Package
instanceId InstOrigin DocName
origin Int
no Bool
orphan InstHead DocNameI
ihd = [Package] -> Package
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Package] -> Package) -> [Package] -> Package
forall a b. (a -> b) -> a -> b
$
    [ Package
"o:" | Bool
orphan ] [Package] -> [Package] -> [Package]
forall a. [a] -> [a] -> [a]
++
    [ InstOrigin DocName -> Package
forall name. InstOrigin name -> Package
qual InstOrigin DocName
origin
    , Package
":" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ InstOrigin DocName -> Package
forall a. NamedThing a => a -> Package
getOccString InstOrigin DocName
origin
    , Package
":" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ DocName -> Package
forall a. NamedThing a => a -> Package
getOccString (InstHead DocNameI -> IdP DocNameI
forall name. InstHead name -> IdP name
ihdClsName InstHead DocNameI
ihd)
    , Package
":" Package -> Package -> Package
forall a. [a] -> [a] -> [a]
++ Int -> Package
forall a. Show a => a -> Package
show Int
no
    ]
  where
    qual :: InstOrigin name -> Package
qual (OriginClass name
_) = Package
"ic"
    qual (OriginData name
_) = Package
"id"
    qual (OriginFamily name
_) = Package
"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

  | [] <- [LConDecl DocNameI]
cons
  , [] <- [(HsDecl DocNameI, DocForDecl DocName)]
pats = Html
dataHeader

  | [LConDecl DocNameI
lcon] <- [LConDecl 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 (LConDecl DocNameI -> SrcSpanLess (LConDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LConDecl 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 -> LConDecl DocNameI -> Html)
-> Package -> [LConDecl DocNameI] -> [Html]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> LConDecl DocNameI -> Html
doConstr (Char
'='Char -> Package -> Package
forall a. a -> [a] -> [a]
:Char -> Package
forall a. a -> [a]
repeat Char
'|') [LConDecl DocNameI]
cons [Html] -> [Html] -> [Html]
forall a. [a] -> [a] -> [a]
++ [Html]
pats1)

  | Bool
otherwise = (Html
dataHeader Html -> Html -> Html
<+> Package -> Html
keyword Package
"where")
      Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Bool -> [Html] -> Html
shortSubDecls Bool
dataInst ((LConDecl DocNameI -> Html) -> [LConDecl DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map LConDecl DocNameI -> Html
doGADTConstr [LConDecl 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 -> LConDecl DocNameI -> Html
doConstr Char
c LConDecl DocNameI
con = Package -> Html
forall a. HTML a => a -> Html
toHtml [Char
c] Html -> Html -> Html
<+> Bool -> ConDecl DocNameI -> Bool -> Qualification -> Html
ppShortConstr Bool
summary (LConDecl DocNameI -> SrcSpanLess (LConDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LConDecl DocNameI
con) Bool
unicode Qualification
qual
    doGADTConstr :: LConDecl DocNameI -> Html
doGADTConstr LConDecl DocNameI
con = Bool -> ConDecl DocNameI -> Bool -> Qualification -> Html
ppShortConstr Bool
summary (LConDecl DocNameI -> SrcSpanLess (LConDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LConDecl DocNameI
con) Bool
unicode Qualification
qual

    cons :: [LConDecl DocNameI]
cons      = HsDataDefn DocNameI -> [LConDecl DocNameI]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dataDecl)
    isH98 :: Bool
isH98     = case LConDecl DocNameI -> SrcSpanLess (LConDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([LConDecl DocNameI] -> LConDecl DocNameI
forall a. [a] -> a
head [LConDecl DocNameI]
cons) of
                  ConDeclH98 {} -> Bool
True
                  ConDeclGADT{} -> Bool
False
                  XConDecl{}    -> Bool
False

    pats1 :: [Html]
pats1 = [ [Html] -> Html
hsep [ Package -> Html
keyword Package
"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
$ (Located DocName -> Html) -> [Located DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinder Bool
summary (OccName -> Html)
-> (Located DocName -> OccName) -> Located DocName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> OccName
forall a. NamedThing a => a -> OccName
getOccName) [Located (IdP DocNameI)]
[Located DocName]
lnames
                   , Bool -> Html
dcolon Bool
unicode
                   , Bool -> Qualification -> LHsType DocNameI -> Html
ppPatSigType Bool
unicode Qualification
qual (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
typ)
                   ]
            | (SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [Located (IdP 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 Package
-> 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 Package
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 Package -> Qualification -> Documentation DocName -> Html
docSection Maybe Name
curname Maybe Package
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 :: [LConDecl DocNameI]
cons      = HsDataDefn DocNameI -> [LConDecl DocNameI]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dataDecl)
    isH98 :: Bool
isH98     = case LConDecl DocNameI -> SrcSpanLess (LConDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([LConDecl DocNameI] -> LConDecl DocNameI
forall a. [a] -> a
head [LConDecl DocNameI]
cons) of
                  ConDeclH98 {} -> Bool
True
                  ConDeclGADT{} -> Bool
False
                  XConDecl{}    -> 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
      | [LConDecl DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LConDecl DocNameI]
cons
      , [(HsDecl DocNameI, DocForDecl DocName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HsDecl DocNameI, DocForDecl DocName)]
pats = Html
noHtml
      | [LConDecl DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LConDecl DocNameI]
cons = Package -> Html
keyword Package
"where"
      | Bool
otherwise = if Bool
isH98 then Html
noHtml else Package -> Html
keyword Package
"where"

    constrBit :: Html
constrBit = Maybe Package -> Qualification -> [SubDecl] -> Html
subConstructors Maybe Package
pkg Qualification
qual
      [ [(DocName, DocForDecl DocName)]
-> [(DocName, Fixity)]
-> Bool
-> Maybe Package
-> Qualification
-> LConDecl DocNameI
-> SubDecl
ppSideBySideConstr [(DocName, DocForDecl DocName)]
subdocs [(DocName, Fixity)]
subfixs Bool
unicode Maybe Package
pkg Qualification
qual LConDecl DocNameI
c
      | LConDecl DocNameI
c <- [LConDecl 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) -> [DocName] -> Bool
forall (t :: * -> *) 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)
                                            ((Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ConDecl DocNameI -> [Located DocName]
getConNamesI (LConDecl DocNameI -> SrcSpanLess (LConDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LConDecl DocNameI
c)))) [(DocName, Fixity)]
fixities
      ]

    patternBit :: Html
patternBit = Maybe Package -> Qualification -> [SubDecl] -> Html
subPatterns Maybe Package
pkg Qualification
qual
      [ [(DocName, Fixity)]
-> Bool
-> Qualification
-> [Located DocName]
-> LHsSigType DocNameI
-> DocForDecl DocName
-> SubDecl
ppSideBySidePat [(DocName, Fixity)]
subfixs Bool
unicode Qualification
qual [Located (IdP DocNameI)]
[Located DocName]
lnames LHsSigType DocNameI
typ DocForDecl DocName
d
      | (SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [Located (IdP 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 :: * -> *) 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)
                                            ((Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames)) [(DocName, Fixity)]
fixities
      ]

    instancesBit :: Html
instancesBit = LinksInfo
-> InstOrigin DocName
-> [DocInstance DocNameI]
-> Bool
-> Bool
-> Maybe Package
-> Qualification
-> Html
ppInstances LinksInfo
links (DocName -> InstOrigin DocName
forall name. name -> InstOrigin name
OriginData DocName
docname) [DocInstance DocNameI]
instances
        Bool
splice Bool
unicode Maybe Package
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 -> HsConDeclDetails pass
con_args = HsConDeclDetails DocNameI
det
                , con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_ex_tvs = [LHsTyVarBndr DocNameI]
tyVars
                , con_forall :: forall pass. ConDecl pass -> Located Bool
con_forall = L SrcSpan
_ Bool
forall_
                , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext DocNameI)
cxt
                } -> let context :: SrcSpanLess (LHsContext DocNameI)
context = LHsContext DocNameI -> SrcSpanLess (LHsContext DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsContext DocNameI
-> Maybe (LHsContext DocNameI) -> LHsContext DocNameI
forall a. a -> Maybe a -> a
fromMaybe (SrcSpanLess (LHsContext DocNameI) -> LHsContext DocNameI
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc []) Maybe (LHsContext DocNameI)
cxt)
                         header_ :: Html
header_ = Bool
-> [LHsTyVarBndr DocNameI]
-> [LHsType DocNameI]
-> Bool
-> Qualification
-> Html
ppConstrHdr Bool
forall_ [LHsTyVarBndr DocNameI]
tyVars [LHsType DocNameI]
SrcSpanLess (LHsContext DocNameI)
context Bool
unicode Qualification
qual
                     in case HsConDeclDetails DocNameI
det of

        -- Prefix constructor, e.g. 'Just a'
        PrefixCon [LHsType DocNameI]
args ->
          ( Html
header_ Html -> Html -> Html
<+> [Html] -> Html
hsep (Html
ppOcc Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: (LHsType DocNameI -> Html) -> [LHsType DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts) [LHsType DocNameI]
args)
          , Html
noHtml
          , Html
noHtml
          )

        -- Record constructor, e.g. 'Identity { runIdentity :: a }'
        RecCon (L SrcSpan
_ [LConDeclField DocNameI]
fields) ->
          ( Html
header_ Html -> Html -> 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 <- [LConDeclField DocNameI]
fields
                                   ]
          , Char -> Html
char Char
'}'
          )

        -- Infix constructor, e.g. 'a :| [a]'
        InfixCon LHsType DocNameI
arg1 LHsType DocNameI
arg2 ->
          ( Html
header_ Html -> Html -> Html
<+> [Html] -> Html
hsep [ Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts LHsType DocNameI
arg1
                             , Html
ppOccInfix
                             , Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts LHsType 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 -> LHsType DocNameI -> Html
ppLType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (ConDecl DocNameI -> LHsType DocNameI
getGADTConType ConDecl DocNameI
con) ]
          , Html
noHtml
          , Html
noHtml
          )
      XConDecl XXConDecl DocNameI
nec -> NoExtCon -> (Html, Html, Html)
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl DocNameI
nec

  where
    occ :: [OccName]
occ        = (Located DocName -> OccName) -> [Located DocName] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> OccName
nameOccName (Name -> OccName)
-> (Located DocName -> Name) -> Located DocName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name)
-> (Located DocName -> DocName) -> Located DocName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([Located DocName] -> [OccName]) -> [Located DocName] -> [OccName]
forall a b. (a -> b) -> a -> b
$ ConDecl DocNameI -> [Located 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 Package
-> Qualification
-> LConDecl DocNameI
-> SubDecl
ppSideBySideConstr [(DocName, DocForDecl DocName)]
subdocs [(DocName, Fixity)]
fixities Bool
unicode Maybe Package
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)
    aConName :: SrcSpanLess (Located DocName)
aConName = Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([Located DocName] -> Located DocName
forall a. [a] -> a
head (ConDecl DocNameI -> [Located DocName]
getConNamesI ConDecl DocNameI
con))

    fixity :: Html
fixity   = [(DocName, Fixity)] -> Qualification -> Html
ppFixities [(DocName, Fixity)]
fixities Qualification
qual
    occ :: [OccName]
occ      = (Located DocName -> OccName) -> [Located DocName] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> OccName
nameOccName (Name -> OccName)
-> (Located DocName -> Name) -> Located DocName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name)
-> (Located DocName -> DocName) -> Located DocName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([Located DocName] -> [OccName]) -> [Located DocName] -> [OccName]
forall a b. (a -> b) -> a -> b
$ ConDecl DocNameI -> [Located 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 SrcSpanLess (Located DocName)
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 -> HsConDeclDetails pass
con_args = HsConDeclDetails DocNameI
det
                , con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_ex_tvs = [LHsTyVarBndr DocNameI]
tyVars
                , con_forall :: forall pass. ConDecl pass -> Located Bool
con_forall = L SrcSpan
_ Bool
forall_
                , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext DocNameI)
cxt
                } -> let context :: SrcSpanLess (LHsContext DocNameI)
context = LHsContext DocNameI -> SrcSpanLess (LHsContext DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsContext DocNameI
-> Maybe (LHsContext DocNameI) -> LHsContext DocNameI
forall a. a -> Maybe a -> a
fromMaybe (SrcSpanLess (LHsContext DocNameI) -> LHsContext DocNameI
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc []) Maybe (LHsContext DocNameI)
cxt)
                         header_ :: Html
header_ = Bool
-> [LHsTyVarBndr DocNameI]
-> [LHsType DocNameI]
-> Bool
-> Qualification
-> Html
ppConstrHdr Bool
forall_ [LHsTyVarBndr DocNameI]
tyVars [LHsType DocNameI]
SrcSpanLess (LHsContext DocNameI)
context Bool
unicode Qualification
qual
                     in case HsConDeclDetails DocNameI
det of
        -- Prefix constructor, e.g. 'Just a'
        PrefixCon [LHsType 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 ((LHsType DocNameI -> Html) -> [LHsType DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts) [LHsType DocNameI]
args)
                              , Html
fixity
                              ]

        -- Record constructor, e.g. 'Identity { runIdentity :: a }'
        RecCon GenLocated SrcSpan [LConDeclField DocNameI]
_ -> Html
header_ Html -> Html -> Html
<+> Html
ppOcc Html -> Html -> Html
<+> Html
fixity

        -- Infix constructor, e.g. 'a :| [a]'
        InfixCon LHsType DocNameI
arg1 LHsType 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 -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts LHsType DocNameI
arg1
                              , Html
ppOccInfix
                              , Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts LHsType DocNameI
arg2
                              , Html
fixity
                              ]

      -- GADT constructor, e.g. 'Foo :: Int -> Foo'
      ConDeclGADT{}
          | Bool
hasArgDocs Bool -> Bool -> Bool
|| Bool -> Bool
not ([Html] -> Bool
forall (t :: * -> *) 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 -> LHsType DocNameI -> Html
ppLType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts (ConDecl DocNameI -> LHsType DocNameI
getGADTConType ConDecl DocNameI
con)
                              , Html
fixity
                              ]
      XConDecl XXConDecl DocNameI
nec -> NoExtCon -> Html
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl DocNameI
nec

    fieldPart :: [Html]
fieldPart = case (ConDecl DocNameI
con, ConDecl DocNameI -> HsConDeclDetails DocNameI
forall pass. ConDecl pass -> HsConDeclDetails pass
getConArgs ConDecl DocNameI
con) of
        -- Record style GADTs
        (ConDeclGADT{}, RecCon GenLocated SrcSpan [LConDeclField DocNameI]
_)            -> [ [LHsType DocNameI] -> Html
doConstrArgsWithDocs [] ]

        -- Regular record declarations
        (ConDecl DocNameI
_, RecCon (L SrcSpan
_ [LConDeclField DocNameI]
fields))             -> [ [LConDeclField DocNameI] -> Html
doRecordFields [LConDeclField DocNameI]
fields ]

        -- Any GADT or a regular H98 prefix data constructor
        (ConDecl DocNameI
_, PrefixCon [LHsType DocNameI]
args)     | Bool
hasArgDocs -> [ [LHsType DocNameI] -> Html
doConstrArgsWithDocs [LHsType DocNameI]
args ]

        -- An infix H98 data constructor
        (ConDecl DocNameI
_, InfixCon LHsType DocNameI
arg1 LHsType DocNameI
arg2) | Bool
hasArgDocs -> [ [LHsType DocNameI] -> Html
doConstrArgsWithDocs [LHsType DocNameI
arg1,LHsType DocNameI
arg2] ]

        (ConDecl DocNameI, HsConDeclDetails DocNameI)
_ -> []

    doRecordFields :: [LConDeclField DocNameI] -> Html
doRecordFields [LConDeclField DocNameI]
fields = Maybe Package -> Qualification -> [SubDecl] -> Html
subFields Maybe Package
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) ((LConDeclField DocNameI -> ConDeclField DocNameI)
-> [LConDeclField DocNameI] -> [ConDeclField DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map LConDeclField DocNameI -> ConDeclField DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LConDeclField DocNameI]
fields))

    doConstrArgsWithDocs :: [LHsType DocNameI] -> Html
doConstrArgsWithDocs [LHsType DocNameI]
args = Maybe Package -> Qualification -> [SubDecl] -> Html
subFields Maybe Package
pkg Qualification
qual ([SubDecl] -> Html) -> [SubDecl] -> Html
forall a b. (a -> b) -> a -> b
$ case ConDecl DocNameI
con of
      ConDeclH98{} ->
        [ (Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts LHsType DocNameI
arg, Maybe (MDoc DocName)
mdoc, [])
        | (Int
i, LHsType DocNameI
arg) <- [Int] -> [LHsType DocNameI] -> [(Int, LHsType DocNameI)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [LHsType 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
-> HsType DocNameI
-> FnArgsDoc DocName
-> [(DocName, DocForDecl DocName)]
-> Html
-> HideEmptyContexts
-> [SubDecl]
ppSubSigLike Bool
unicode Qualification
qual (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ConDecl DocNameI -> LHsType DocNameI
getGADTConType ConDecl DocNameI
con))
                     FnArgsDoc DocName
argDocs [(DocName, DocForDecl DocName)]
subdocs (Bool -> Html
dcolon Bool
unicode) HideEmptyContexts
HideEmptyContexts
      XConDecl XXConDecl DocNameI
nec -> NoExtCon -> [SubDecl]
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl DocNameI
nec

    -- 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 (Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located DocName -> SrcSpanLess (Located DocName))
-> Located DocName -> SrcSpanLess (Located DocName)
forall a b. (a -> b) -> a -> b
$ [Located DocName] -> Located DocName
forall a. [a] -> a
head ([Located DocName] -> Located DocName)
-> [Located DocName] -> Located DocName
forall a b. (a -> b) -> a -> b
$ ConDecl DocNameI -> [Located DocName]
getConNamesI ConDecl DocNameI
con) [(DocName, DocForDecl DocName)]
subdocs Maybe (DocForDecl DocName)
-> (DocForDecl DocName -> Maybe (MDoc DocName))
-> Maybe (MDoc DocName)
forall (m :: * -> *) 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 DocNameI] -- ^ type variables
  -> HsContext DocNameI      -- ^ context
  -> Unicode -> Qualification
  -> Html
ppConstrHdr :: Bool
-> [LHsTyVarBndr DocNameI]
-> [LHsType DocNameI]
-> Bool
-> Qualification
-> Html
ppConstrHdr Bool
forall_ [LHsTyVarBndr DocNameI]
tvs [LHsType 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
      | [LHsTyVarBndr DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr DocNameI]
tvs Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
forall_ = Html
noHtml
      | Bool
otherwise = Bool
-> Qualification
-> [LHsTyVarBndr DocNameI]
-> ForallVisFlag
-> Html
ppForAllPart Bool
unicode Qualification
qual [LHsTyVarBndr DocNameI]
tvs ForallVisFlag
ForallInvis

    ppCtxt :: Html
ppCtxt
      | [LHsType DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsType DocNameI]
ctxt = Html
noHtml
      | Bool
otherwise = [LHsType DocNameI]
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppContextNoArrow [LHsType 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
+++ Package -> Html
forall a. HTML a => a -> Html
toHtml Package
" "


-- | 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 LHsType DocNameI
ltype Maybe LHsDocString
_) =
  ( [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma [ Bool -> OccName -> Html
ppBinder Bool
False (RdrName -> OccName
rdrNameOcc RdrName
field)
                          | L SrcSpan
_ FieldOcc DocNameI
name <- [LFieldOcc DocNameI]
names
                          , let field :: RdrName
field = (Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located RdrName -> RdrName)
-> (FieldOcc DocNameI -> Located RdrName)
-> FieldOcc DocNameI
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc DocNameI -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc) FieldOcc DocNameI
name
                          ])
      Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
unicode
      Html -> Html -> Html
<+> Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts LHsType 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 (FieldOcc DocNameI -> XCFieldOcc DocNameI
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc (FieldOcc DocNameI -> XCFieldOcc DocNameI)
-> FieldOcc DocNameI -> XCFieldOcc DocNameI
forall a b. (a -> b) -> a -> b
$ LFieldOcc DocNameI -> SrcSpanLess (LFieldOcc DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LFieldOcc DocNameI -> SrcSpanLess (LFieldOcc DocNameI))
-> LFieldOcc DocNameI -> SrcSpanLess (LFieldOcc DocNameI)
forall a b. (a -> b) -> a -> b
$ [LFieldOcc DocNameI] -> LFieldOcc DocNameI
forall a. [a] -> a
head [LFieldOcc DocNameI]
names) [(DocName, DocForDecl DocName)]
subdocs Maybe (DocForDecl DocName)
-> (DocForDecl DocName -> Maybe (MDoc DocName))
-> Maybe (MDoc DocName)
forall (m :: * -> *) 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
ppSideBySideField [(DocName, DocForDecl DocName)]
_ Bool
_ Qualification
_ (XConDeclField XXConDeclField DocNameI
nec) = NoExtCon -> SubDecl
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDeclField DocNameI
nec


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 LHsType DocNameI
ltype Maybe LHsDocString
_)
  = [Html] -> Html
hsep (Html -> [Html] -> [Html]
punctuate Html
comma ((LFieldOcc DocNameI -> Html) -> [LFieldOcc DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Bool -> OccName -> Html
ppBinder Bool
summary) (OccName -> Html)
-> (LFieldOcc DocNameI -> OccName) -> LFieldOcc DocNameI -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (LFieldOcc DocNameI -> RdrName) -> LFieldOcc DocNameI -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located RdrName -> RdrName)
-> (LFieldOcc DocNameI -> Located RdrName)
-> LFieldOcc DocNameI
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc DocNameI -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc (FieldOcc DocNameI -> Located RdrName)
-> (LFieldOcc DocNameI -> FieldOcc DocNameI)
-> LFieldOcc DocNameI
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFieldOcc DocNameI -> FieldOcc DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LFieldOcc DocNameI]
names))
    Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
unicode Html -> Html -> Html
<+> Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts LHsType DocNameI
ltype
ppShortField Bool
_ Bool
_ Qualification
_ (XConDeclField XXConDeclField DocNameI
nec) = NoExtCon -> Html
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDeclField DocNameI
nec


-- | Pretty print an expanded pattern (for bundled patterns)
ppSideBySidePat :: [(DocName, Fixity)] -> Unicode -> Qualification
                   -> [Located DocName]    -- ^ pattern name(s)
                   -> LHsSigType DocNameI  -- ^ type of pattern(s)
                   -> DocForDecl DocName   -- ^ doc map
                   -> SubDecl
ppSideBySidePat :: [(DocName, Fixity)]
-> Bool
-> Qualification
-> [Located DocName]
-> LHsSigType DocNameI
-> DocForDecl DocName
-> SubDecl
ppSideBySidePat [(DocName, Fixity)]
fixities Bool
unicode Qualification
qual [Located 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 ((Located DocName -> Html) -> [Located DocName] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> OccName -> Html
ppBinder Bool
False (OccName -> Html)
-> (Located DocName -> OccName) -> Located DocName -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> OccName
forall a. NamedThing a => a -> OccName
getOccName) [Located DocName]
lnames))

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

    fieldPart :: [Html]
fieldPart
      | Bool -> Bool
not Bool
hasArgDocs = []
      | Bool
otherwise = [ Maybe Package -> Qualification -> [SubDecl] -> Html
subFields Maybe Package
forall a. Maybe a
Nothing Qualification
qual (Bool
-> Qualification
-> HsType DocNameI
-> FnArgsDoc DocName
-> [(DocName, DocForDecl DocName)]
-> Html
-> HideEmptyContexts
-> [SubDecl]
ppSubSigLike Bool
unicode Qualification
qual (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
patTy)
                                                        FnArgsDoc DocName
argDocs [] (Bool -> Html
dcolon Bool
unicode)
                                                        HideEmptyContexts
emptyCtxt) ]

    patTy :: LHsType DocNameI
patTy = LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
typ
    emptyCtxt :: HideEmptyContexts
emptyCtxt = LHsType DocNameI -> HideEmptyContexts
forall name. LHsType name -> HideEmptyContexts
patSigContext LHsType DocNameI
patTy


-- | 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_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_ND = NewOrData
nd
                                               , dd_ctxt :: forall pass. HsDataDefn pass -> LHsContext pass
dd_ctxt = LHsContext DocNameI
ctxt
                                               , dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig = Maybe (LHsType DocNameI)
ks }
                               , tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = L SrcSpan
_ IdP DocNameI
name
                               , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
tvs })
             Bool
unicode Qualification
qual
  = -- newtype or data
    (case NewOrData
nd of { NewOrData
NewType -> Package -> Html
keyword Package
"newtype"; NewOrData
DataType -> Package -> Html
keyword Package
"data" })
    Html -> Html -> Html
<+>
    -- context
    LHsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContext LHsContext DocNameI
ctxt Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts Html -> Html -> Html
<+>
    -- T a b c ..., or a :+: b
    Bool
-> Bool
-> Qualification
-> DocName
-> [LHsTyVarBndr DocNameI]
-> Html
ppAppDocNameTyVarBndrs Bool
summary Bool
unicode Qualification
qual IdP DocNameI
DocName
name (LHsQTyVars DocNameI -> [LHsTyVarBndr DocNameI]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit LHsQTyVars DocNameI
tvs)
    Html -> Html -> Html
<+> case Maybe (LHsType DocNameI)
ks of
      Maybe (LHsType DocNameI)
Nothing -> Html
forall a. Monoid a => a
mempty
      Just (L SrcSpan
_ 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
_ = Package -> Html
forall a. HasCallStack => Package -> a
error Package
"ppDataHeader: illegal argument"

--------------------------------------------------------------------------------
-- * Types and contexts
--------------------------------------------------------------------------------


ppBang :: HsSrcBang -> Html
ppBang :: HsSrcBang -> Html
ppBang (HsSrcBang SourceText
_ SrcUnpackedness
_ SrcStrictness
SrcStrict) = Package -> Html
forall a. HTML a => a -> Html
toHtml Package
"!"
ppBang (HsSrcBang SourceText
_ SrcUnpackedness
_ SrcStrictness
SrcLazy)   = Package -> Html
forall a. HTML a => a -> Html
toHtml Package
"~"
ppBang HsSrcBang
_                         = 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 -> Located (HsType DocNameI) -> Html
ppLType :: Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType       Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts LHsType DocNameI
y = Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
y)
ppLParendType :: Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts LHsType DocNameI
y = Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppParendType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
y)
ppLFunLhType :: Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLFunLhType  Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts LHsType DocNameI
y = Bool
-> Qualification -> HideEmptyContexts -> HsType DocNameI -> Html
ppFunLhType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType 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.
(XParTy a ~ NoExtField) =>
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.
(XParTy a ~ NoExtField) =>
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.
(XParTy a ~ NoExtField) =>
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.
(XParTy a ~ NoExtField) =>
Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_FUN HsType DocNameI
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts

ppLHsTypeArg :: Unicode -> Qualification -> HideEmptyContexts -> LHsTypeArg DocNameI -> Html
ppLHsTypeArg :: Bool
-> Qualification
-> HideEmptyContexts
-> HsArg (LHsType DocNameI) (LHsType DocNameI)
-> Html
ppLHsTypeArg Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (HsValArg LHsType DocNameI
ty) = Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts LHsType DocNameI
ty
ppLHsTypeArg Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts (HsTypeArg SrcSpan
_ LHsType DocNameI
ki) = Bool -> Html
atSign Bool
unicode Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<>
                                                       Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts LHsType DocNameI
ki
ppLHsTypeArg Bool
_ Qualification
_ HideEmptyContexts
_ (HsArgPar SrcSpan
_) = Package -> Html
forall a. HTML a => a -> Html
toHtml Package
""
ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocNameI -> Html
ppHsTyVarBndr :: Bool -> Qualification -> HsTyVarBndr DocNameI -> Html
ppHsTyVarBndr Bool
_       Qualification
qual (UserTyVar XUserTyVar DocNameI
_ (L SrcSpan
_ IdP DocNameI
name)) =
    Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Raw Bool
False IdP DocNameI
DocName
name
ppHsTyVarBndr Bool
unicode Qualification
qual (KindedTyVar XKindedTyVar DocNameI
_ Located (IdP DocNameI)
name LHsType DocNameI
kind) =
    Html -> Html
parens (Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
qual Notation
Raw Bool
False (Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP DocNameI)
Located DocName
name) Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
unicode Html -> Html -> Html
<+>
            Bool -> Qualification -> LHsType DocNameI -> Html
ppLKind Bool
unicode Qualification
qual LHsType DocNameI
kind)
ppHsTyVarBndr Bool
_ Qualification
_ (XTyVarBndr XXTyVarBndr DocNameI
nec) = NoExtCon -> Html
forall a. NoExtCon -> a
noExtCon NoExtCon
XXTyVarBndr DocNameI
nec

ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html
ppLKind :: Bool -> Qualification -> LHsType DocNameI -> Html
ppLKind Bool
unicode Qualification
qual LHsType DocNameI
y = Bool -> Qualification -> HsType DocNameI -> Html
ppKind Bool
unicode Qualification
qual (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType 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.
(XParTy a ~ NoExtField) =>
Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_TOP HsType DocNameI
ki) Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts

patSigContext :: LHsType name -> HideEmptyContexts
patSigContext :: LHsType name -> HideEmptyContexts
patSigContext LHsType name
typ | LHsType name -> Bool
forall name. LHsType name -> Bool
hasNonEmptyContext LHsType name
typ Bool -> Bool -> Bool
&& LHsType name -> Bool
forall name. LHsType name -> Bool
isFirstContextEmpty LHsType name
typ =  HideEmptyContexts
ShowEmptyToplevelContexts
                  | Bool
otherwise = HideEmptyContexts
HideEmptyContexts
  where
    hasNonEmptyContext :: LHsType name -> Bool
    hasNonEmptyContext :: LHsType name -> Bool
hasNonEmptyContext LHsType name
t =
      case LHsType name -> SrcSpanLess (LHsType name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType name
t of
        HsForAllTy _ _ _ s -> LHsType name -> Bool
forall name. LHsType name -> Bool
hasNonEmptyContext LHsType name
s
        HsQualTy _ cxt s   -> if [LHsType name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LHsContext name -> SrcSpanLess (LHsContext name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsContext name
cxt) then LHsType name -> Bool
forall name. LHsType name -> Bool
hasNonEmptyContext LHsType name
s else Bool
True
        HsFunTy _ _ s      -> LHsType name -> Bool
forall name. LHsType name -> Bool
hasNonEmptyContext LHsType name
s
        SrcSpanLess (LHsType name)
_ -> Bool
False
    isFirstContextEmpty :: LHsType name -> Bool
    isFirstContextEmpty :: LHsType name -> Bool
isFirstContextEmpty LHsType name
t =
      case LHsType name -> SrcSpanLess (LHsType name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType name
t of
        HsForAllTy _ _ _ s -> LHsType name -> Bool
forall name. LHsType name -> Bool
isFirstContextEmpty LHsType name
s
        HsQualTy _ cxt _   -> [LHsType name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (LHsContext name -> SrcSpanLess (LHsContext name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsContext name
cxt)
        HsFunTy _ _ s      -> LHsType name -> Bool
forall name. LHsType name -> Bool
isFirstContextEmpty LHsType name
s
        SrcSpanLess (LHsType name)
_ -> Bool
False


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


ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> Html
ppForAllPart :: Bool
-> Qualification
-> [LHsTyVarBndr DocNameI]
-> ForallVisFlag
-> Html
ppForAllPart Bool
unicode Qualification
qual [LHsTyVarBndr DocNameI]
tvs ForallVisFlag
fvf = [Html] -> Html
hsep (Bool -> Html
forallSymbol Bool
unicode Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
: [Html]
tvs') Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Html
fv
  where
    tvs' :: [Html]
tvs' = Bool -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html]
ppTyVars Bool
unicode Qualification
qual [LHsTyVarBndr DocNameI]
tvs
    fv :: Html
fv = case ForallVisFlag
fvf of
           ForallVisFlag
ForallVis   -> Html
spaceHtml Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Bool -> Html
arrow Bool
unicode
           ForallVisFlag
ForallInvis -> Html
dot

ppr_mono_lty :: LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty :: LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty = HsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_ty (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType 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
_ ForallVisFlag
fvf [LHsTyVarBndr DocNameI]
tvs LHsType DocNameI
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts
  = Bool
-> Qualification
-> [LHsTyVarBndr DocNameI]
-> ForallVisFlag
-> Html
ppForAllPart Bool
unicode Qualification
qual [LHsTyVarBndr DocNameI]
tvs ForallVisFlag
fvf Html -> Html -> Html
<+> LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts

ppr_mono_ty (HsQualTy XQualTy DocNameI
_ LHsContext DocNameI
ctxt LHsType DocNameI
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts
  = LHsContext DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppLContext LHsContext DocNameI
ctxt Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts Html -> Html -> Html
<+> LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts

-- UnicodeSyntax alternatives
ppr_mono_ty (HsTyVar XTyVar DocNameI
_ PromotionFlag
_ (L SrcSpan
_ IdP DocNameI
name)) Bool
True Qualification
_ HideEmptyContexts
_
  | Name -> Package
forall a. NamedThing a => a -> Package
getOccString (DocName -> Name
forall a. NamedThing a => a -> Name
getName IdP DocNameI
DocName
name) Package -> Package -> Bool
forall a. Eq a => a -> a -> Bool
== Package
"(->)" = Package -> Html
forall a. HTML a => a -> Html
toHtml Package
"(→)"

ppr_mono_ty (HsBangTy XBangTy DocNameI
_ HsSrcBang
b LHsType DocNameI
ty) Bool
u Qualification
q HideEmptyContexts
_ =
  HsSrcBang -> Html
ppBang HsSrcBang
b Html -> Html -> Html
forall a b. (HTML a, HTML b) => a -> b -> Html
+++ Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLParendType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts LHsType DocNameI
ty
ppr_mono_ty (HsTyVar XTyVar DocNameI
_ PromotionFlag
prom (L SrcSpan
_ IdP DocNameI
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 IdP DocNameI
DocName
name)
  | Bool
otherwise = Qualification -> Notation -> Bool -> DocName -> Html
ppDocName Qualification
q Notation
Prefix Bool
True IdP DocNameI
DocName
name
ppr_mono_ty (HsStarTy XStarTy DocNameI
_ Bool
isUni) Bool
u Qualification
_ HideEmptyContexts
_ =
  Package -> Html
forall a. HTML a => a -> Html
toHtml (if Bool
u Bool -> Bool -> Bool
|| Bool
isUni then Package
"★" else Package
"*")
ppr_mono_ty (HsFunTy XFunTy DocNameI
_ LHsType DocNameI
ty1 LHsType DocNameI
ty2) Bool
u Qualification
q HideEmptyContexts
e =
  [Html] -> Html
hsep [ LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty1 Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts
       , Bool -> Html
arrow Bool
u Html -> Html -> Html
<+> LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty2 Bool
u Qualification
q HideEmptyContexts
e
       ]
ppr_mono_ty (HsTupleTy XTupleTy DocNameI
_ HsTupleSort
con [LHsType DocNameI]
tys) Bool
u Qualification
q HideEmptyContexts
_ =
  HsTupleSort -> [Html] -> Html
tupleParens HsTupleSort
con ((LHsType DocNameI -> Html) -> [LHsType DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) [LHsType DocNameI]
tys)
ppr_mono_ty (HsSumTy XSumTy DocNameI
_ [LHsType DocNameI]
tys) Bool
u Qualification
q HideEmptyContexts
_ =
  [Html] -> Html
sumParens ((LHsType DocNameI -> Html) -> [LHsType DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) [LHsType DocNameI]
tys)
ppr_mono_ty (HsKindSig XKindSig DocNameI
_ LHsType DocNameI
ty LHsType DocNameI
kind) Bool
u Qualification
q HideEmptyContexts
e =
  LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty Bool
u Qualification
q HideEmptyContexts
e Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
u Html -> Html -> Html
<+> Bool -> Qualification -> LHsType DocNameI -> Html
ppLKind Bool
u Qualification
q LHsType DocNameI
kind
ppr_mono_ty (HsListTy XListTy DocNameI
_ LHsType DocNameI
ty)       Bool
u Qualification
q HideEmptyContexts
_ = Html -> Html
brackets (LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts)
ppr_mono_ty (HsIParamTy XIParamTy DocNameI
_ (L SrcSpan
_ HsIPName
n) LHsType DocNameI
ty) Bool
u Qualification
q HideEmptyContexts
_ =
  HsIPName -> Html
ppIPName HsIPName
n Html -> Html -> Html
<+> Bool -> Html
dcolon Bool
u Html -> Html -> Html
<+> LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts
ppr_mono_ty (HsSpliceTy XSpliceTy DocNameI
v HsSplice DocNameI
_) Bool
_ Qualification
_ HideEmptyContexts
_ = Void -> Html
forall a. Void -> a
absurd Void
XSpliceTy DocNameI
v
ppr_mono_ty (HsRecTy {})        Bool
_ Qualification
_ HideEmptyContexts
_ = Package -> Html
forall a. HTML a => a -> Html
toHtml Package
"{..}"
       -- 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 (NHsCoreTy {})) Bool
_ Qualification
_ HideEmptyContexts
_ = Package -> Html
forall a. HasCallStack => Package -> a
error Package
"ppr_mono_ty HsCoreTy"
ppr_mono_ty (HsExplicitListTy XExplicitListTy DocNameI
_ PromotionFlag
IsPromoted [LHsType 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
$ (LHsType DocNameI -> Html) -> [LHsType DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) [LHsType DocNameI]
tys
ppr_mono_ty (HsExplicitListTy XExplicitListTy DocNameI
_ PromotionFlag
NotPromoted [LHsType 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
$ (LHsType DocNameI -> Html) -> [LHsType DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) [LHsType DocNameI]
tys
ppr_mono_ty (HsExplicitTupleTy XExplicitTupleTy DocNameI
_ [LHsType 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
$ (LHsType DocNameI -> Html) -> [LHsType DocNameI] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Qualification -> HideEmptyContexts -> LHsType DocNameI -> Html
ppLType Bool
u Qualification
q HideEmptyContexts
HideEmptyContexts) [LHsType DocNameI]
tys

ppr_mono_ty (HsAppTy XAppTy DocNameI
_ LHsType DocNameI
fun_ty LHsType DocNameI
arg_ty) Bool
unicode Qualification
qual HideEmptyContexts
_
  = [Html] -> Html
hsep [ LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
fun_ty Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
         , LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
arg_ty Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts ]

ppr_mono_ty (HsAppKindTy XAppKindTy DocNameI
_ LHsType DocNameI
fun_ty LHsType DocNameI
arg_ki) Bool
unicode Qualification
qual HideEmptyContexts
_
  = [Html] -> Html
hsep [LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
fun_ty Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
         , Bool -> Html
atSign Bool
unicode Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
arg_ki Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts]

ppr_mono_ty (HsOpTy XOpTy DocNameI
_ LHsType DocNameI
ty1 Located (IdP DocNameI)
op LHsType DocNameI
ty2) Bool
unicode Qualification
qual HideEmptyContexts
_
  = LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty1 Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts Html -> Html -> Html
<+> Html
ppr_op Html -> Html -> Html
<+> LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty2 Bool
unicode Qualification
qual HideEmptyContexts
HideEmptyContexts
  where
    -- `(:)` is valid in type signature only as constructor to promoted list
    -- and needs to be quoted in code so we explicitly quote it here too.
    ppr_op :: Html
ppr_op
        | (Name -> Package
forall a. NamedThing a => a -> Package
getOccString (Name -> Package)
-> (Located DocName -> Name) -> Located DocName -> Package
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name)
-> (Located DocName -> DocName) -> Located DocName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) Located (IdP DocNameI)
Located DocName
op Package -> Package -> Bool
forall a. Eq a => a -> a -> Bool
== Package
":" = Html -> Html
promoQuote Html
ppr_op'
        | Bool
otherwise = Html
ppr_op'
    ppr_op' :: Html
ppr_op' = Qualification -> Notation -> Located DocName -> Html
ppLDocName Qualification
qual Notation
Infix Located (IdP DocNameI)
Located DocName
op

ppr_mono_ty (HsParTy XParTy DocNameI
_ LHsType DocNameI
ty) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts
  = Html -> Html
parens (LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType DocNameI
ty Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts)
--  = parens (ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts)

ppr_mono_ty (HsDocTy XDocTy DocNameI
_ LHsType DocNameI
ty LHsDocString
_) Bool
unicode Qualification
qual HideEmptyContexts
emptyCtxts
  = LHsType DocNameI
-> Bool -> Qualification -> HideEmptyContexts -> Html
ppr_mono_lty LHsType 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
n) Bool
_ Qualification
_ HideEmptyContexts
_ = HsTyLit -> Html
ppr_tylit HsTyLit
n

ppr_tylit :: HsTyLit -> Html
ppr_tylit :: HsTyLit -> Html
ppr_tylit (HsNumTy SourceText
_ Integer
n) = Package -> Html
forall a. HTML a => a -> Html
toHtml (Integer -> Package
forall a. Show a => a -> Package
show Integer
n)
ppr_tylit (HsStrTy SourceText
_ FastString
s) = Package -> Html
forall a. HTML a => a -> Html
toHtml (FastString -> Package
forall a. Show a => a -> Package
show FastString
s)