{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

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

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

-- |
-- Module      :  Haddock.Backends.LaTeX
-- Copyright   :  (c) Simon Marlow      2010,
--                    Mateusz Kowalczyk 2013
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
module Haddock.Backends.LaTeX
  ( ppLaTeX
  ) where

import Control.Monad
import Data.Char
import Data.Foldable (toList)
import Data.List (sort)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import GHC hiding (fromMaybeContext)
import GHC.Core.Type (Specificity (..))
import GHC.Data.FastString (unpackFS)
import GHC.Types.Name (getOccString, nameOccName, tidyNameOcc)
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Reader (rdrNameOcc)
import GHC.Utils.Ppr hiding (Doc, quote)
import qualified GHC.Utils.Ppr as Pretty
import System.Directory
import System.FilePath
import Prelude hiding ((<>))

import Documentation.Haddock.Markup
import Haddock.Doc (combineDocumentation)
import Haddock.GhcUtils
import Haddock.Types
import Haddock.Utils

{- SAMPLE OUTPUT

\haddockmoduleheading{\texttt{Data.List}}
\hrulefill
{\haddockverb\begin{verbatim}
module Data.List (
    (++),  head,  last,  tail,  init,  null,  length,  map,  reverse,
  ) where\end{verbatim}}
\hrulefill

\section{Basic functions}
\begin{haddockdesc}
\item[\begin{tabular}{@{}l}
head\ ::\ {\char 91}a{\char 93}\ ->\ a
\end{tabular}]\haddockbegindoc
Extract the first element of a list, which must be non-empty.
\par

\end{haddockdesc}
\begin{haddockdesc}
\item[\begin{tabular}{@{}l}
last\ ::\ {\char 91}a{\char 93}\ ->\ a
\end{tabular}]\haddockbegindoc
Extract the last element of a list, which must be finite and non-empty.
\par

\end{haddockdesc}
-}

{- TODO
 * don't forget fixity!!
-}

ppLaTeX
  :: String -- Title
  -> Maybe String -- Package name
  -> [Interface]
  -> FilePath -- destination directory
  -> Maybe (Doc GHC.RdrName) -- prologue text, maybe
  -> Maybe String -- style file
  -> FilePath
  -> IO ()
ppLaTeX :: FilePath
-> Maybe FilePath
-> [Interface]
-> FilePath
-> Maybe (Doc RdrName)
-> Maybe FilePath
-> FilePath
-> IO ()
ppLaTeX FilePath
title Maybe FilePath
packageStr [Interface]
visible_ifaces FilePath
odir Maybe (Doc RdrName)
prologue Maybe FilePath
maybe_style FilePath
libdir =
  do
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
odir
    Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe FilePath
maybe_style) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> FilePath -> IO ()
copyFile (FilePath
libdir FilePath -> FilePath -> FilePath
</> FilePath
"latex" FilePath -> FilePath -> FilePath
</> FilePath
haddockSty) (FilePath
odir FilePath -> FilePath -> FilePath
</> FilePath
haddockSty)
    FilePath
-> Maybe FilePath
-> FilePath
-> Maybe (Doc RdrName)
-> Maybe FilePath
-> [Interface]
-> IO ()
ppLaTeXTop FilePath
title Maybe FilePath
packageStr FilePath
odir Maybe (Doc RdrName)
prologue Maybe FilePath
maybe_style [Interface]
visible_ifaces
    (Interface -> IO ()) -> [Interface] -> IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FilePath -> Interface -> IO ()
ppLaTeXModule FilePath
title FilePath
odir) [Interface]
visible_ifaces

haddockSty :: FilePath
haddockSty :: FilePath
haddockSty = FilePath
"haddock.sty"

type LaTeX = Pretty.Doc

-- | Default way of rendering a 'LaTeX'. The width is 90 by default (since 100
-- often overflows the line).
latex2String :: LaTeX -> String
latex2String :: Doc -> FilePath
latex2String = Mode
-> Int
-> Float
-> (TextDetails -> FilePath -> FilePath)
-> FilePath
-> Doc
-> FilePath
forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
fullRender (Bool -> Mode
PageMode Bool
True) Int
90 Float
1 TextDetails -> FilePath -> FilePath
txtPrinter FilePath
""

ppLaTeXTop
  :: String
  -> Maybe String
  -> FilePath
  -> Maybe (Doc GHC.RdrName)
  -> Maybe String
  -> [Interface]
  -> IO ()
ppLaTeXTop :: FilePath
-> Maybe FilePath
-> FilePath
-> Maybe (Doc RdrName)
-> Maybe FilePath
-> [Interface]
-> IO ()
ppLaTeXTop FilePath
doctitle Maybe FilePath
packageStr FilePath
odir Maybe (Doc RdrName)
prologue Maybe FilePath
maybe_style [Interface]
ifaces = do
  let tex :: Doc
tex =
        [Doc] -> Doc
vcat
          [ FilePath -> Doc
text FilePath
"\\documentclass{book}"
          , FilePath -> Doc
text FilePath
"\\usepackage" Doc -> Doc -> Doc
<> Doc -> Doc
braces (Doc -> (FilePath -> Doc) -> Maybe FilePath -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Doc
text FilePath
"haddock") FilePath -> Doc
text Maybe FilePath
maybe_style)
          , FilePath -> Doc
text FilePath
"\\begin{document}"
          , FilePath -> Doc
text FilePath
"\\begin{titlepage}"
          , FilePath -> Doc
text FilePath
"\\begin{haddocktitle}"
          , FilePath -> Doc
text FilePath
doctitle
          , FilePath -> Doc
text FilePath
"\\end{haddocktitle}"
          , case Maybe (Doc RdrName)
prologue of
              Maybe (Doc RdrName)
Nothing -> Doc
empty
              Just Doc RdrName
d ->
                [Doc] -> Doc
vcat
                  [ FilePath -> Doc
text FilePath
"\\begin{haddockprologue}"
                  , Doc RdrName -> Doc
rdrDocToLaTeX Doc RdrName
d
                  , FilePath -> Doc
text FilePath
"\\end{haddockprologue}"
                  ]
          , FilePath -> Doc
text FilePath
"\\end{titlepage}"
          , FilePath -> Doc
text FilePath
"\\tableofcontents"
          , [Doc] -> Doc
vcat [FilePath -> Doc
text FilePath
"\\input" Doc -> Doc -> Doc
<> Doc -> Doc
braces (FilePath -> Doc
text FilePath
mdl) | FilePath
mdl <- [FilePath]
mods]
          , FilePath -> Doc
text FilePath
"\\end{document}"
          ]

      mods :: [FilePath]
mods = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ((Interface -> FilePath) -> [Interface] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> FilePath
moduleBasename (Module -> FilePath)
-> (Interface -> Module) -> Interface -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Module
ifaceMod) [Interface]
ifaces)

      filename :: FilePath
filename = FilePath
odir FilePath -> FilePath -> FilePath
</> (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
Maybe.fromMaybe FilePath
"haddock" Maybe FilePath
packageStr FilePath -> FilePath -> FilePath
<.> FilePath
"tex")

  FilePath -> FilePath -> IO ()
writeUtf8File FilePath
filename (Doc -> FilePath
forall a. Show a => a -> FilePath
show Doc
tex)

ppLaTeXModule :: String -> FilePath -> Interface -> IO ()
ppLaTeXModule :: FilePath -> FilePath -> Interface -> IO ()
ppLaTeXModule FilePath
_title FilePath
odir Interface
iface = do
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
odir
  let
    mdl :: Module
mdl = Interface -> Module
ifaceMod Interface
iface
    mdl_str :: FilePath
mdl_str = Module -> FilePath
moduleString Module
mdl

    exports :: [ExportItem DocNameI]
exports = Interface -> [ExportItem DocNameI]
ifaceRnExportItems Interface
iface

    tex :: Doc
tex =
      [Doc] -> Doc
vcat
        [ FilePath -> Doc
text FilePath
"\\haddockmoduleheading" Doc -> Doc -> Doc
<> Doc -> Doc
braces (FilePath -> Doc
text FilePath
mdl_str)
        , FilePath -> Doc
text FilePath
"\\label{module:" Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
mdl_str Doc -> Doc -> Doc
<> Char -> Doc
char Char
'}'
        , FilePath -> Doc
text FilePath
"\\haddockbeginheader"
        , Doc -> Doc
verb (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
            [Doc] -> Doc
vcat
              [ FilePath -> Doc
text FilePath
"module" Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
mdl_str Doc -> Doc -> Doc
<+> Doc
lparen
              , FilePath -> Doc
text FilePath
"    "
                  Doc -> Doc -> Doc
<> [Doc] -> Doc
fsep
                    ( Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
',') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                        (ExportItem DocNameI -> Doc) -> [ExportItem DocNameI] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ExportItem DocNameI -> Doc
exportListItem ([ExportItem DocNameI] -> [Doc]) -> [ExportItem DocNameI] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                          (ExportItem DocNameI -> Bool)
-> [ExportItem DocNameI] -> [ExportItem DocNameI]
forall a. (a -> Bool) -> [a] -> [a]
filter ExportItem DocNameI -> Bool
forSummary [ExportItem DocNameI]
exports
                    )
              , FilePath -> Doc
text FilePath
"  ) where"
              ]
        , FilePath -> Doc
text FilePath
"\\haddockendheader" Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
""
        , Doc
description
        , Doc
body
        ]

    description :: Doc
description =
      (Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
Maybe.fromMaybe Doc
empty (Maybe Doc -> Doc) -> (Interface -> Maybe Doc) -> Interface -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Documentation DocName -> Maybe Doc
documentationToLaTeX (Documentation DocName -> Maybe Doc)
-> (Interface -> Documentation DocName) -> Interface -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Documentation DocName
ifaceRnDoc) Interface
iface

    body :: Doc
body = [ExportItem DocNameI] -> Doc
processExports [ExportItem DocNameI]
exports
  --
  FilePath -> FilePath -> IO ()
writeUtf8File (FilePath
odir FilePath -> FilePath -> FilePath
</> Module -> FilePath
moduleLaTeXFile Module
mdl) (Mode
-> Int
-> Float
-> (TextDetails -> FilePath -> FilePath)
-> FilePath
-> Doc
-> FilePath
forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
fullRender (Bool -> Mode
PageMode Bool
True) Int
80 Float
1 TextDetails -> FilePath -> FilePath
txtPrinter FilePath
"" Doc
tex)

-- | Prints out an entry in a module export list.
exportListItem :: ExportItem DocNameI -> LaTeX
exportListItem :: ExportItem DocNameI -> Doc
exportListItem
  ( ExportDecl
      ( RnExportD
          { rnExpDExpD :: RnExportD -> ExportD DocNameI
rnExpDExpD =
            ( ExportD
                { expDDecl :: forall name. ExportD name -> LHsDecl name
expDDecl = LHsDecl DocNameI
decl
                , expDSubDocs :: forall name. ExportD name -> [(IdP name, DocForDecl (IdP name))]
expDSubDocs = [(IdP DocNameI, DocForDecl (IdP DocNameI))]
subdocs
                }
              )
          }
        )
    ) =
    let (Doc
leader, [DocName]
names) = LHsDecl DocNameI -> (Doc, [DocName])
declNames LHsDecl DocNameI
decl
        go :: (DocName, b) -> Maybe Doc
go (DocName
n, b
_)
          | OccName -> Bool
isDefaultMethodOcc (DocName -> OccName
forall name. HasOccName name => name -> OccName
occName DocName
n) = Maybe Doc
forall a. Maybe a
Nothing
          | Bool
otherwise = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ DocName -> Doc
ppDocBinder DocName
n
     in [Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma [Doc
leader Doc -> Doc -> Doc
<+> DocName -> Doc
ppDocBinder DocName
name | DocName
name <- [DocName]
names])
          Doc -> Doc -> Doc
<> case [(IdP DocNameI, DocForDecl (IdP DocNameI))]
subdocs of
            [] -> Doc
empty
            [(IdP DocNameI, DocForDecl (IdP DocNameI))]
_ -> Doc -> Doc
parens ([Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (((DocName, DocForDecl DocName) -> Maybe Doc)
-> [(DocName, DocForDecl DocName)] -> [Doc]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe (DocName, DocForDecl DocName) -> Maybe Doc
forall {b}. (DocName, b) -> Maybe Doc
go [(IdP DocNameI, DocForDecl (IdP DocNameI))]
[(DocName, DocForDecl DocName)]
subdocs)))
exportListItem (ExportNoDecl IdP DocNameI
y []) =
  DocName -> Doc
ppDocBinder IdP DocNameI
DocName
y
exportListItem (ExportNoDecl IdP DocNameI
y [IdP DocNameI]
subs) =
  DocName -> Doc
ppDocBinder IdP DocNameI
DocName
y Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((DocName -> Doc) -> [DocName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> Doc
ppDocBinder [IdP DocNameI]
[DocName]
subs)))
exportListItem (ExportModule Module
mdl) =
  FilePath -> Doc
text FilePath
"module" Doc -> Doc -> Doc
<+> FilePath -> Doc
text (Module -> FilePath
moduleString Module
mdl)
exportListItem ExportItem DocNameI
_ =
  FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"exportListItem"

-- Deal with a group of undocumented exports together, to avoid lots
-- of blank vertical space between them.
processExports :: [ExportItem DocNameI] -> LaTeX
processExports :: [ExportItem DocNameI] -> Doc
processExports [] = Doc
empty
processExports (ExportItem DocNameI
decl : [ExportItem DocNameI]
es)
  | Just ([DocName], HsSigType DocNameI)
sig <- ExportItem DocNameI -> Maybe ([DocName], HsSigType DocNameI)
isSimpleSig ExportItem DocNameI
decl =
      [Doc] -> Doc
multiDecl
        [ [Name] -> HsSigType DocNameI -> Bool -> Doc
ppTypeSig ((DocName -> Name) -> [DocName] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> Name
forall a. NamedThing a => a -> Name
getName [DocName]
names) HsSigType DocNameI
typ Bool
False
        | ([DocName]
names, HsSigType DocNameI
typ) <- ([DocName], HsSigType DocNameI)
sig ([DocName], HsSigType DocNameI)
-> [([DocName], HsSigType DocNameI)]
-> [([DocName], HsSigType DocNameI)]
forall a. a -> [a] -> [a]
: [([DocName], HsSigType DocNameI)]
sigs
        ]
        Doc -> Doc -> Doc
$$ [ExportItem DocNameI] -> Doc
processExports [ExportItem DocNameI]
es'
  where
    ([([DocName], HsSigType DocNameI)]
sigs, [ExportItem DocNameI]
es') = (ExportItem DocNameI -> Maybe ([DocName], HsSigType DocNameI))
-> [ExportItem DocNameI]
-> ([([DocName], HsSigType DocNameI)], [ExportItem DocNameI])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
spanWith ExportItem DocNameI -> Maybe ([DocName], HsSigType DocNameI)
isSimpleSig [ExportItem DocNameI]
es
processExports (ExportModule Module
mdl : [ExportItem DocNameI]
es) =
  Doc -> Maybe Doc -> Doc
declWithDoc ([Doc] -> Doc
vcat [FilePath -> Doc
text FilePath
"module" Doc -> Doc -> Doc
<+> FilePath -> Doc
text (Module -> FilePath
moduleString Module
m) | Module
m <- Module
mdl Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: [Module]
mdls]) Maybe Doc
forall a. Maybe a
Nothing
    Doc -> Doc -> Doc
$$ [ExportItem DocNameI] -> Doc
processExports [ExportItem DocNameI]
es'
  where
    ([Module]
mdls, [ExportItem DocNameI]
es') = (ExportItem DocNameI -> Maybe Module)
-> [ExportItem DocNameI] -> ([Module], [ExportItem DocNameI])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
spanWith ExportItem DocNameI -> Maybe Module
isExportModule [ExportItem DocNameI]
es
processExports (ExportItem DocNameI
e : [ExportItem DocNameI]
es) =
  ExportItem DocNameI -> Doc
processExport ExportItem DocNameI
e Doc -> Doc -> Doc
$$ [ExportItem DocNameI] -> Doc
processExports [ExportItem DocNameI]
es

isSimpleSig :: ExportItem DocNameI -> Maybe ([DocName], HsSigType DocNameI)
isSimpleSig :: ExportItem DocNameI -> Maybe ([DocName], HsSigType DocNameI)
isSimpleSig
  ( ExportDecl
      ( RnExportD
          { rnExpDExpD :: RnExportD -> ExportD DocNameI
rnExpDExpD =
            ExportD
              { expDDecl :: forall name. ExportD name -> LHsDecl name
expDDecl = L SrcSpanAnnA
_ (SigD XSigD DocNameI
_ (TypeSig XTypeSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigWcType DocNameI
t))
              , expDMbDoc :: forall name. ExportD name -> DocForDecl (IdP name)
expDMbDoc = (Documentation Maybe (MDoc (IdP DocNameI))
Nothing Maybe (Doc (IdP DocNameI))
Nothing, FnArgsDoc (IdP DocNameI)
argDocs)
              }
          }
        )
    )
    | Map Int (MDoc DocName) -> Bool
forall k a. Map k a -> Bool
Map.null FnArgsDoc (IdP DocNameI)
Map Int (MDoc DocName)
argDocs = ([DocName], HsSigType DocNameI)
-> Maybe ([DocName], HsSigType DocNameI)
forall a. a -> Maybe a
Just ((GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames, GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc (LHsSigWcType DocNameI -> LHsSigType DocNameI
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType DocNameI
t))
isSimpleSig ExportItem DocNameI
_ = Maybe ([DocName], HsSigType DocNameI)
forall a. Maybe a
Nothing

isExportModule :: ExportItem DocNameI -> Maybe Module
isExportModule :: ExportItem DocNameI -> Maybe Module
isExportModule (ExportModule Module
m) = Module -> Maybe Module
forall a. a -> Maybe a
Just Module
m
isExportModule ExportItem DocNameI
_ = Maybe Module
forall a. Maybe a
Nothing

processExport :: ExportItem DocNameI -> LaTeX
processExport :: ExportItem DocNameI -> Doc
processExport (ExportGroup Int
lev FilePath
_id0 Doc (IdP DocNameI)
doc) =
  Int -> Doc -> Doc
ppDocGroup Int
lev (Doc DocName -> Doc
docToLaTeX Doc (IdP DocNameI)
Doc DocName
doc)
processExport (ExportDecl (RnExportD (ExportD LHsDecl DocNameI
decl [(HsDecl DocNameI, DocForDecl (IdP DocNameI))]
pats DocForDecl (IdP DocNameI)
doc [(IdP DocNameI, DocForDecl (IdP DocNameI))]
subdocs [DocInstance DocNameI]
insts [(IdP DocNameI, Fixity)]
fixities Bool
_splice) [FilePath]
_)) =
  LHsDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> DocForDecl DocName
-> [DocInstance DocNameI]
-> [(DocName, DocForDecl DocName)]
-> [(DocName, Fixity)]
-> Doc
ppDecl LHsDecl DocNameI
decl [(HsDecl DocNameI, DocForDecl (IdP DocNameI))]
[(HsDecl DocNameI, DocForDecl DocName)]
pats DocForDecl (IdP DocNameI)
DocForDecl DocName
doc [DocInstance DocNameI]
insts [(IdP DocNameI, DocForDecl (IdP DocNameI))]
[(DocName, DocForDecl DocName)]
subdocs [(IdP DocNameI, Fixity)]
[(DocName, Fixity)]
fixities
processExport (ExportNoDecl IdP DocNameI
y []) =
  DocName -> Doc
ppDocName IdP DocNameI
DocName
y
processExport (ExportNoDecl IdP DocNameI
y [IdP DocNameI]
subs) =
  DocName -> Doc
ppDocName IdP DocNameI
DocName
y Doc -> Doc -> Doc
<> Doc -> Doc
parens ([Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((DocName -> Doc) -> [DocName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> Doc
ppDocName [IdP DocNameI]
[DocName]
subs)))
processExport (ExportModule Module
mdl) =
  Doc -> Maybe Doc -> Doc
declWithDoc (FilePath -> Doc
text FilePath
"module" Doc -> Doc -> Doc
<+> FilePath -> Doc
text (Module -> FilePath
moduleString Module
mdl)) Maybe Doc
forall a. Maybe a
Nothing
processExport (ExportDoc MDoc (IdP DocNameI)
doc) =
  Doc DocName -> Doc
docToLaTeX (Doc DocName -> Doc) -> Doc DocName -> Doc
forall a b. (a -> b) -> a -> b
$ MDoc DocName -> Doc DocName
forall mod id. MetaDoc mod id -> DocH mod id
_doc MDoc (IdP DocNameI)
MDoc DocName
doc

ppDocGroup :: Int -> LaTeX -> LaTeX
ppDocGroup :: Int -> Doc -> Doc
ppDocGroup Int
lev Doc
doc = Int -> Doc
forall {a}. (Eq a, Num a) => a -> Doc
sec Int
lev Doc -> Doc -> Doc
<> Doc -> Doc
braces Doc
doc
  where
    sec :: a -> Doc
sec a
1 = FilePath -> Doc
text FilePath
"\\section"
    sec a
2 = FilePath -> Doc
text FilePath
"\\subsection"
    sec a
3 = FilePath -> Doc
text FilePath
"\\subsubsection"
    sec a
_ = FilePath -> Doc
text FilePath
"\\paragraph"

-- | Given a declaration, extract out the names being declared
declNames
  :: LHsDecl DocNameI
  -> ( LaTeX --   to print before each name in an export list
     , [DocName] --   names being declared
     )
declNames :: LHsDecl DocNameI -> (Doc, [DocName])
declNames (L SrcSpanAnnA
_ HsDecl DocNameI
decl) = case HsDecl DocNameI
decl of
  TyClD XTyClD DocNameI
_ TyClDecl DocNameI
d -> (Doc
empty, [TyClDecl DocNameI -> DocName
tcdNameI TyClDecl DocNameI
d])
  SigD XSigD DocNameI
_ (TypeSig XTypeSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigWcType DocNameI
_) -> (Doc
empty, (GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames)
  SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigType DocNameI
_) -> (FilePath -> Doc
text FilePath
"pattern", (GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames)
  ForD XForD DocNameI
_ (ForeignImport XForeignImport DocNameI
_ (L SrcSpanAnnN
_ DocName
n) LHsSigType DocNameI
_ ForeignImport DocNameI
_) -> (Doc
empty, [DocName
n])
  ForD XForD DocNameI
_ (ForeignExport XForeignExport DocNameI
_ (L SrcSpanAnnN
_ DocName
n) LHsSigType DocNameI
_ ForeignExport DocNameI
_) -> (Doc
empty, [DocName
n])
  HsDecl DocNameI
_ -> FilePath -> (Doc, [DocName])
forall a. HasCallStack => FilePath -> a
error FilePath
"declaration not supported by declNames"

forSummary :: (ExportItem DocNameI) -> Bool
forSummary :: ExportItem DocNameI -> Bool
forSummary (ExportGroup Int
_ FilePath
_ Doc (IdP DocNameI)
_) = Bool
False
forSummary (ExportDoc MDoc (IdP DocNameI)
_) = Bool
False
forSummary ExportItem DocNameI
_ = Bool
True

moduleLaTeXFile :: Module -> FilePath
moduleLaTeXFile :: Module -> FilePath
moduleLaTeXFile Module
mdl = Module -> FilePath
moduleBasename Module
mdl FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".tex"

moduleBasename :: Module -> FilePath
moduleBasename :: Module -> FilePath
moduleBasename Module
mdl =
  (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map
    (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
'-' else Char
c)
    (ModuleName -> FilePath
moduleNameString (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mdl))

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

-- * Decls

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

-- | Pretty print a declaration
ppDecl
  :: LHsDecl DocNameI
  -- ^ decl to print
  -> [(HsDecl DocNameI, DocForDecl DocName)]
  -- ^ all pattern decls
  -> DocForDecl DocName
  -- ^ documentation for decl
  -> [DocInstance DocNameI]
  -- ^ all instances
  -> [(DocName, DocForDecl DocName)]
  -- ^ all subdocs
  -> [(DocName, Fixity)]
  -- ^ all fixities
  -> LaTeX
ppDecl :: LHsDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> DocForDecl DocName
-> [DocInstance DocNameI]
-> [(DocName, DocForDecl DocName)]
-> [(DocName, Fixity)]
-> Doc
ppDecl LHsDecl DocNameI
decl [(HsDecl DocNameI, DocForDecl DocName)]
pats (Documentation DocName
doc, Map Int (MDoc DocName)
fnArgsDoc) [DocInstance DocNameI]
instances [(DocName, DocForDecl DocName)]
subdocs [(DocName, Fixity)]
_fxts = case GenLocated SrcSpanAnnA (HsDecl DocNameI) -> HsDecl DocNameI
forall l e. GenLocated l e -> e
unLoc LHsDecl DocNameI
GenLocated SrcSpanAnnA (HsDecl DocNameI)
decl of
  TyClD XTyClD DocNameI
_ d :: TyClDecl DocNameI
d@FamDecl{} -> Bool
-> Documentation DocName
-> [DocInstance DocNameI]
-> TyClDecl DocNameI
-> Bool
-> Doc
ppFamDecl Bool
False Documentation DocName
doc [DocInstance DocNameI]
instances TyClDecl DocNameI
d Bool
unicode
  TyClD XTyClD DocNameI
_ d :: TyClDecl DocNameI
d@DataDecl{} -> [(HsDecl DocNameI, DocForDecl DocName)]
-> [DocInstance DocNameI]
-> [(DocName, DocForDecl DocName)]
-> Maybe (Documentation DocName)
-> TyClDecl DocNameI
-> Bool
-> Doc
ppDataDecl [(HsDecl DocNameI, DocForDecl DocName)]
pats [DocInstance DocNameI]
instances [(DocName, DocForDecl DocName)]
subdocs (Documentation DocName -> Maybe (Documentation DocName)
forall a. a -> Maybe a
Just Documentation DocName
doc) TyClDecl DocNameI
d Bool
unicode
  TyClD XTyClD DocNameI
_ d :: TyClDecl DocNameI
d@SynDecl{} -> DocForDecl DocName -> TyClDecl DocNameI -> Bool -> Doc
ppTySyn (Documentation DocName
doc, Map Int (MDoc DocName)
fnArgsDoc) TyClDecl DocNameI
d Bool
unicode
  TyClD XTyClD DocNameI
_ d :: TyClDecl DocNameI
d@ClassDecl{} -> [DocInstance DocNameI]
-> Documentation DocName
-> [(DocName, DocForDecl DocName)]
-> TyClDecl DocNameI
-> Bool
-> Doc
ppClassDecl [DocInstance DocNameI]
instances Documentation DocName
doc [(DocName, DocForDecl DocName)]
subdocs TyClDecl DocNameI
d Bool
unicode
  SigD XSigD DocNameI
_ (TypeSig XTypeSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigWcType DocNameI
ty) -> Maybe Doc
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> Bool
-> Doc
ppFunSig Maybe Doc
forall a. Maybe a
Nothing (Documentation DocName
doc, Map Int (MDoc DocName)
fnArgsDoc) ((GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames) (LHsSigWcType DocNameI -> LHsSigType DocNameI
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType DocNameI
ty) Bool
unicode
  SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigType DocNameI
ty) -> DocForDecl DocName
-> [DocName] -> LHsSigType DocNameI -> Bool -> Doc
ppLPatSig (Documentation DocName
doc, Map Int (MDoc DocName)
fnArgsDoc) ((GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames) LHsSigType DocNameI
ty Bool
unicode
  ForD XForD DocNameI
_ ForeignDecl DocNameI
d -> DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> Doc
ppFor (Documentation DocName
doc, Map Int (MDoc DocName)
fnArgsDoc) ForeignDecl DocNameI
d Bool
unicode
  InstD XInstD DocNameI
_ InstDecl DocNameI
_ -> Doc
empty
  DerivD XDerivD DocNameI
_ DerivDecl DocNameI
_ -> Doc
empty
  HsDecl DocNameI
_ -> FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"declaration not supported by ppDecl"
  where
    unicode :: Bool
unicode = Bool
False

ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> Doc
ppFor DocForDecl DocName
doc (ForeignImport XForeignImport DocNameI
_ (L SrcSpanAnnN
_ DocName
name) LHsSigType DocNameI
typ ForeignImport DocNameI
_) Bool
unicode =
  Maybe Doc
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> Bool
-> Doc
ppFunSig Maybe Doc
forall a. Maybe a
Nothing DocForDecl DocName
doc [DocName
name] LHsSigType DocNameI
typ Bool
unicode
ppFor DocForDecl DocName
_ ForeignDecl DocNameI
_ Bool
_ = FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"ppFor error in Haddock.Backends.LaTeX"

--  error "foreign declarations are currently not supported by --latex"

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

-- * Type families

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

-- | Pretty-print a data\/type family declaration
ppFamDecl
  :: Bool
  -- ^ is the family associated?
  -> Documentation DocName
  -- ^ this decl's docs
  -> [DocInstance DocNameI]
  -- ^ relevant instances
  -> TyClDecl DocNameI
  -- ^ family to print
  -> Bool
  -- ^ unicode
  -> LaTeX
ppFamDecl :: Bool
-> Documentation DocName
-> [DocInstance DocNameI]
-> TyClDecl DocNameI
-> Bool
-> Doc
ppFamDecl Bool
associated Documentation DocName
doc [DocInstance DocNameI]
instances TyClDecl DocNameI
decl Bool
unicode =
  Doc -> Maybe Doc -> Doc
declWithDoc
    (FamilyDecl DocNameI -> Bool -> Bool -> Doc
ppFamHeader (TyClDecl DocNameI -> FamilyDecl DocNameI
forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam TyClDecl DocNameI
decl) Bool
unicode Bool
associated Doc -> Doc -> Doc
<+> Doc
whereBit)
    (if [Doc] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Doc]
body then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just ([Doc] -> Doc
vcat [Doc]
body))
    Doc -> Doc -> Doc
$$ Doc
instancesBit
  where
    body :: [Doc]
body = [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
Maybe.catMaybes [Maybe Doc
familyEqns, Documentation DocName -> Maybe Doc
documentationToLaTeX Documentation DocName
doc]

    whereBit :: Doc
whereBit = case FamilyDecl DocNameI -> FamilyInfo DocNameI
forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo (TyClDecl DocNameI -> FamilyDecl DocNameI
forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam TyClDecl DocNameI
decl) of
      ClosedTypeFamily Maybe [LTyFamInstEqn DocNameI]
_ -> FilePath -> Doc
keyword FilePath
"where"
      FamilyInfo DocNameI
_ -> Doc
empty

    familyEqns :: Maybe Doc
familyEqns
      | FamilyDecl{fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = ClosedTypeFamily (Just [LTyFamInstEqn DocNameI]
eqns)} <- TyClDecl DocNameI -> FamilyDecl DocNameI
forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam TyClDecl DocNameI
decl
      , Bool -> Bool
not ([GenLocated
   SrcSpanAnnA
   (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
-> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LTyFamInstEqn DocNameI]
[GenLocated
   SrcSpanAnnA
   (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
eqns) =
          Doc -> Maybe Doc
forall a. a -> Maybe a
Just
            ( FilePath -> Doc
text FilePath
"\\haddockbeginargs"
                Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat [Doc -> Doc
decltt (TyFamInstEqn DocNameI -> Doc
ppFamDeclEqn TyFamInstEqn DocNameI
FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
eqn) Doc -> Doc -> Doc
<+> Doc
nl | L SrcSpanAnnA
_ FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI))
eqn <- [LTyFamInstEqn DocNameI]
[GenLocated
   SrcSpanAnnA
   (FamEqn DocNameI (GenLocated SrcSpanAnnA (HsType DocNameI)))]
eqns]
                Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{tabulary}\\par"
            )
      | Bool
otherwise = Maybe Doc
forall a. Maybe a
Nothing

    -- Individual equations of a closed type family
    ppFamDeclEqn :: TyFamInstEqn DocNameI -> LaTeX
    ppFamDeclEqn :: TyFamInstEqn DocNameI -> Doc
ppFamDeclEqn
      ( FamEqn
          { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_tycon = L SrcSpanAnnN
_ DocName
n
          , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = LHsType DocNameI
rhs
          , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsFamEqnPats pass
feqn_pats = HsFamEqnPats DocNameI
ts
          }
        ) =
        [Doc] -> Doc
hsep
          [ DocName -> HsFamEqnPats DocNameI -> Bool -> Doc
ppAppNameTypeArgs DocName
n HsFamEqnPats DocNameI
ts Bool
unicode
          , Doc
equals
          , Bool -> HsType DocNameI -> Doc
ppType Bool
unicode (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsType DocNameI
GenLocated SrcSpanAnnA (HsType DocNameI)
rhs)
          ]

    instancesBit :: Doc
instancesBit = Bool -> [DocInstance DocNameI] -> Doc
ppDocInstances Bool
unicode [DocInstance DocNameI]
instances

-- | Print the LHS of a type\/data family declaration.
ppFamHeader
  :: FamilyDecl DocNameI
  -- ^ family header to print
  -> Bool
  -- ^ unicode
  -> Bool
  -- ^ is the family associated?
  -> LaTeX
ppFamHeader :: FamilyDecl DocNameI -> Bool -> Bool -> Doc
ppFamHeader
  ( FamilyDecl
      { fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName = L SrcSpanAnnN
_ DocName
name
      , fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars = LHsQTyVars DocNameI
tvs
      , fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = FamilyInfo DocNameI
info
      , fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdResultSig = L EpAnn NoEpAnns
_ FamilyResultSig DocNameI
result
      , fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn DocNameI)
injectivity
      }
    )
  Bool
unicode
  Bool
associated =
    Doc -> Doc
famly Doc
leader Doc -> Doc -> Doc
<+> Doc
famName Doc -> Doc -> Doc
<+> Doc
famSig Doc -> Doc -> Doc
<+> Doc
injAnn
    where
      leader :: Doc
leader = case FamilyInfo DocNameI
info of
        FamilyInfo DocNameI
OpenTypeFamily -> FilePath -> Doc
keyword FilePath
"type"
        ClosedTypeFamily Maybe [LTyFamInstEqn DocNameI]
_ -> FilePath -> Doc
keyword FilePath
"type"
        FamilyInfo DocNameI
DataFamily -> FilePath -> Doc
keyword FilePath
"data"

      famly :: Doc -> Doc
famly
        | Bool
associated = Doc -> Doc
forall a. a -> a
id
        | Bool
otherwise = (Doc -> Doc -> Doc
<+> FilePath -> Doc
keyword FilePath
"family")

      famName :: Doc
famName = Bool
-> DocName -> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI] -> Doc
forall flag.
RenderableBndrFlag flag =>
Bool -> DocName -> [LHsTyVarBndr flag DocNameI] -> Doc
ppAppDocNameTyVarBndrs Bool
unicode DocName
name (LHsQTyVars DocNameI -> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsq_explicit LHsQTyVars DocNameI
tvs)

      famSig :: Doc
famSig = case FamilyResultSig DocNameI
result of
        NoSig XNoSig DocNameI
_ -> Doc
empty
        KindSig XCKindSig DocNameI
_ LHsType DocNameI
kind -> Bool -> Doc
dcolon Bool
unicode Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLKind Bool
unicode LHsType DocNameI
kind
        TyVarSig XTyVarSig DocNameI
_ (L SrcSpanAnnA
_ HsTyVarBndr () DocNameI
bndr) -> Doc
equals Doc -> Doc -> Doc
<+> Bool -> HsTyVarBndr () DocNameI -> Doc
forall flag.
RenderableBndrFlag flag =>
Bool -> HsTyVarBndr flag DocNameI -> Doc
ppHsTyVarBndr Bool
unicode HsTyVarBndr () DocNameI
bndr

      injAnn :: Doc
injAnn = case Maybe (LInjectivityAnn DocNameI)
injectivity of
        Maybe (LInjectivityAnn DocNameI)
Nothing -> Doc
empty
        Just (L EpAnn NoEpAnns
_ (InjectivityAnn XCInjectivityAnn DocNameI
_ LIdP DocNameI
lhs [LIdP DocNameI]
rhs)) ->
          [Doc] -> Doc
hsep
            ( Doc -> Doc
decltt (FilePath -> Doc
text FilePath
"|")
                Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: GenLocated SrcSpanAnnN DocName -> Doc
forall l. GenLocated l DocName -> Doc
ppLDocName LIdP DocNameI
GenLocated SrcSpanAnnN DocName
lhs
                Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Bool -> Doc
arrow Bool
unicode
                Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnN DocName -> Doc)
-> [GenLocated SrcSpanAnnN DocName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnN DocName -> Doc
forall l. GenLocated l DocName -> Doc
ppLDocName [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
rhs
            )
        Just LInjectivityAnn DocNameI
_ -> Doc
empty

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

-- * Type Synonyms

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

-- we skip type patterns for now
ppTySyn :: DocForDecl DocName -> TyClDecl DocNameI -> Bool -> LaTeX
ppTySyn :: DocForDecl DocName -> TyClDecl DocNameI -> Bool -> Doc
ppTySyn
  DocForDecl DocName
doc
  ( SynDecl
      { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = L SrcSpanAnnN
_ DocName
name
      , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
ltyvars
      , tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LHsType DocNameI
ltype
      }
    )
  Bool
unicode =
    HsSigType DocNameI
-> DocForDecl DocName -> (Doc, Doc, Doc) -> Bool -> Doc
ppTypeOrFunSig (LHsType DocNameI -> HsSigType DocNameI
mkHsImplicitSigTypeI LHsType DocNameI
ltype) DocForDecl DocName
doc (Doc
full, Doc
hdr, Char -> Doc
char Char
'=') Bool
unicode
    where
      hdr :: Doc
hdr =
        [Doc] -> Doc
hsep
          ( FilePath -> Doc
keyword FilePath
"type"
              Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: DocName -> Doc
ppDocBinder DocName
name
              Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (Maybe Name -> Doc) -> [Maybe Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Name -> Doc
ppWcSymName (LHsQTyVars DocNameI -> [Maybe Name]
tyvarNames LHsQTyVars DocNameI
ltyvars)
          )
      full :: Doc
full = Doc
hdr Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLType Bool
unicode LHsType DocNameI
ltype
ppTySyn DocForDecl DocName
_ TyClDecl DocNameI
_ Bool
_ = FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"declaration not supported by ppTySyn"

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

-- * Function signatures

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

ppFunSig
  :: Maybe LaTeX
  -- ^ a prefix to put right before the signature
  -> DocForDecl DocName
  -- ^ documentation
  -> [DocName]
  -- ^ pattern names in the pattern signature
  -> LHsSigType DocNameI
  -- ^ type of the pattern synonym
  -> Bool
  -- ^ unicode
  -> LaTeX
ppFunSig :: Maybe Doc
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> Bool
-> Doc
ppFunSig Maybe Doc
leader DocForDecl DocName
doc [DocName]
docnames (L SrcSpanAnnA
_ HsSigType DocNameI
typ) Bool
unicode =
  HsSigType DocNameI
-> DocForDecl DocName -> (Doc, Doc, Doc) -> Bool -> Doc
ppTypeOrFunSig
    HsSigType DocNameI
typ
    DocForDecl DocName
doc
    ( Doc -> Doc
lead (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Name] -> HsSigType DocNameI -> Bool -> Doc
ppTypeSig [Name]
names HsSigType DocNameI
typ Bool
False
    , Doc -> Doc
lead (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
ppSymName [Name]
names
    , Bool -> Doc
dcolon Bool
unicode
    )
    Bool
unicode
  where
    names :: [Name]
names = (DocName -> Name) -> [DocName] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> Name
forall a. NamedThing a => a -> Name
getName [DocName]
docnames
    lead :: Doc -> Doc
lead = (Doc -> Doc) -> (Doc -> Doc -> Doc) -> Maybe Doc -> Doc -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc -> Doc
forall a. a -> a
id Doc -> Doc -> Doc
(<+>) Maybe Doc
leader

-- | Pretty-print a pattern synonym
ppLPatSig
  :: DocForDecl DocName
  -- ^ documentation
  -> [DocName]
  -- ^ pattern names in the pattern signature
  -> LHsSigType DocNameI
  -- ^ type of the pattern synonym
  -> Bool
  -- ^ unicode
  -> LaTeX
ppLPatSig :: DocForDecl DocName
-> [DocName] -> LHsSigType DocNameI -> Bool -> Doc
ppLPatSig DocForDecl DocName
doc [DocName]
docnames LHsSigType DocNameI
ty Bool
unicode =
  Maybe Doc
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> Bool
-> Doc
ppFunSig (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (FilePath -> Doc
keyword FilePath
"pattern")) DocForDecl DocName
doc [DocName]
docnames LHsSigType DocNameI
ty Bool
unicode

-- | Pretty-print a type, adding documentation to the whole type and its
-- arguments as needed.
ppTypeOrFunSig
  :: HsSigType DocNameI
  -> DocForDecl DocName
  -- ^ documentation
  -> ( LaTeX --   first-line (no-argument docs only)
     , LaTeX --   first-line (argument docs only)
     , LaTeX --   type prefix (argument docs only)
     )
  -> Bool
  -- ^ unicode
  -> LaTeX
ppTypeOrFunSig :: HsSigType DocNameI
-> DocForDecl DocName -> (Doc, Doc, Doc) -> Bool -> Doc
ppTypeOrFunSig HsSigType DocNameI
typ (Documentation DocName
doc, Map Int (MDoc DocName)
argDocs) (Doc
pref1, Doc
pref2, Doc
sep0) Bool
unicode
  | Map Int (MDoc DocName) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (MDoc DocName)
argDocs = Doc -> Maybe Doc -> Doc
declWithDoc Doc
pref1 (Documentation DocName -> Maybe Doc
documentationToLaTeX Documentation DocName
doc)
  | Bool
otherwise =
      Doc -> Maybe Doc -> Doc
declWithDoc Doc
pref2 (Maybe Doc -> Doc) -> Maybe Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
          FilePath -> Doc
text FilePath
"\\haddockbeginargs"
            Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (((Doc, Doc) -> Doc) -> [(Doc, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc) -> (Doc, Doc) -> Doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Doc -> Doc -> Doc
(<->)) (Bool
-> HsSigType DocNameI
-> Map Int (MDoc DocName)
-> [(DocName, DocForDecl DocName)]
-> Doc
-> [(Doc, Doc)]
ppSubSigLike Bool
unicode HsSigType DocNameI
typ Map Int (MDoc DocName)
argDocs [] Doc
sep0))
            Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{tabulary}\\par"
            Doc -> Doc -> Doc
$$ Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
Maybe.fromMaybe Doc
empty (Documentation DocName -> Maybe Doc
documentationToLaTeX Documentation DocName
doc)

-- | This splits up a type signature along @->@ and adds docs (when they exist)
-- to the arguments. The output is a list of (leader/seperator, argument and
-- its doc)
ppSubSigLike
  :: Bool
  -- ^ unicode
  -> HsSigType DocNameI
  -- ^ type signature
  -> FnArgsDoc DocName
  -- ^ docs to add
  -> [(DocName, DocForDecl DocName)]
  -- ^ all subdocs (useful when we have `HsRecTy`)
  -> LaTeX
  -- ^ seperator (beginning of first line)
  -> [(LaTeX, LaTeX)]
  -- ^ arguments (leader/sep, type)
ppSubSigLike :: Bool
-> HsSigType DocNameI
-> Map Int (MDoc DocName)
-> [(DocName, DocForDecl DocName)]
-> Doc
-> [(Doc, Doc)]
ppSubSigLike Bool
unicode HsSigType DocNameI
typ Map Int (MDoc DocName)
argDocs [(DocName, DocForDecl DocName)]
subdocs Doc
leader = Int -> Doc -> HsSigType DocNameI -> [(Doc, Doc)]
do_sig_args Int
0 Doc
leader HsSigType DocNameI
typ
  where
    do_sig_args :: Int -> LaTeX -> HsSigType DocNameI -> [(LaTeX, LaTeX)]
    do_sig_args :: Int -> Doc -> HsSigType DocNameI -> [(Doc, Doc)]
do_sig_args Int
n Doc
leader (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs DocNameI
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType DocNameI
ltype}) =
      case HsOuterSigTyVarBndrs DocNameI
outer_bndrs of
        HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc DocNameI)]
bndrs} ->
          [
            ( Doc -> Doc
decltt Doc
leader
            , Doc -> Doc
decltt (HsForAllTelescope DocNameI -> Bool -> Doc
ppHsForAllTelescope ([LHsTyVarBndr Specificity DocNameI] -> HsForAllTelescope DocNameI
mkHsForAllInvisTeleI [LHsTyVarBndr Specificity (NoGhcTc DocNameI)]
[LHsTyVarBndr Specificity DocNameI]
bndrs) Bool
unicode)
                Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLType Bool
unicode LHsType DocNameI
ltype
            )
          ]
        HsOuterImplicit{} -> Int -> Doc -> LHsType DocNameI -> [(Doc, Doc)]
do_largs Int
n Doc
leader LHsType DocNameI
ltype

    do_largs :: Int -> LaTeX -> LHsType DocNameI -> [(LaTeX, LaTeX)]
    do_largs :: Int -> Doc -> LHsType DocNameI -> [(Doc, Doc)]
do_largs Int
n Doc
leader (L SrcSpanAnnA
_ HsType DocNameI
t) = Int -> Doc -> HsType DocNameI -> [(Doc, Doc)]
do_args Int
n Doc
leader HsType DocNameI
t

    arg_doc :: Int -> Doc
arg_doc Int
n = Maybe (Doc DocName) -> Doc
rDoc (Maybe (Doc DocName) -> Doc)
-> (Maybe (MDoc DocName) -> Maybe (Doc DocName))
-> Maybe (MDoc DocName)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap MDoc DocName -> Doc DocName
forall mod id. MetaDoc mod id -> DocH mod id
_doc (Maybe (MDoc DocName) -> Doc) -> Maybe (MDoc DocName) -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (MDoc DocName) -> Maybe (MDoc DocName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
n Map Int (MDoc DocName)
argDocs

    do_args :: Int -> LaTeX -> HsType DocNameI -> [(LaTeX, LaTeX)]
    do_args :: Int -> Doc -> HsType DocNameI -> [(Doc, Doc)]
do_args Int
_n Doc
leader (HsForAllTy XForAllTy DocNameI
_ HsForAllTelescope DocNameI
tele LHsType DocNameI
ltype) =
      [
        ( Doc -> Doc
decltt Doc
leader
        , Doc -> Doc
decltt (HsForAllTelescope DocNameI -> Bool -> Doc
ppHsForAllTelescope HsForAllTelescope DocNameI
tele Bool
unicode)
            Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLType Bool
unicode LHsType DocNameI
ltype
        )
      ]
    do_args Int
n Doc
leader (HsQualTy XQualTy DocNameI
_ LHsContext DocNameI
lctxt LHsType DocNameI
ltype) =
      ( Doc -> Doc
decltt Doc
leader
      , Doc -> Doc
decltt (LHsContext DocNameI -> Bool -> Doc
ppLContextNoArrow LHsContext DocNameI
lctxt Bool
unicode) Doc -> Doc -> Doc
<+> Doc
nl
      )
        (Doc, Doc) -> [(Doc, Doc)] -> [(Doc, Doc)]
forall a. a -> [a] -> [a]
: Int -> Doc -> LHsType DocNameI -> [(Doc, Doc)]
do_largs Int
n (Bool -> Doc
darrow Bool
unicode) LHsType DocNameI
ltype
    do_args Int
n Doc
leader (HsFunTy XFunTy DocNameI
_ HsArrow DocNameI
_w (L SrcSpanAnnA
_ (HsRecTy XRecTy DocNameI
_ [LConDeclField DocNameI]
fields)) LHsType DocNameI
r) =
      [ (Doc -> Doc
decltt Doc
ldr, Doc
latex Doc -> Doc -> Doc
<+> Doc
nl)
      | (L SrcSpan
_ ConDeclField DocNameI
field, Doc
ldr) <- [GenLocated SrcSpan (ConDeclField DocNameI)]
-> [Doc] -> [(GenLocated SrcSpan (ConDeclField DocNameI), Doc)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LConDeclField DocNameI]
[GenLocated SrcSpan (ConDeclField DocNameI)]
fields (Doc
leader Doc -> Doc -> Doc
<+> Doc
gadtOpen Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat Doc
gadtComma)
      , let latex :: Doc
latex = [(DocName, DocForDecl DocName)]
-> Bool -> ConDeclField DocNameI -> Doc
ppSideBySideField [(DocName, DocForDecl DocName)]
subdocs Bool
unicode ConDeclField DocNameI
field
      ]
        [(Doc, Doc)] -> [(Doc, Doc)] -> [(Doc, Doc)]
forall a. [a] -> [a] -> [a]
++ Int -> Doc -> LHsType DocNameI -> [(Doc, Doc)]
do_largs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Doc
gadtEnd Doc -> Doc -> Doc
<+> Bool -> Doc
arrow Bool
unicode) LHsType DocNameI
r
    do_args Int
n Doc
leader (HsFunTy XFunTy DocNameI
_ HsArrow DocNameI
_w LHsType DocNameI
lt LHsType DocNameI
r) =
      (Doc -> Doc
decltt Doc
leader, Doc -> Doc
decltt (Bool -> LHsType DocNameI -> Doc
ppLFunLhType Bool
unicode LHsType DocNameI
lt) Doc -> Doc -> Doc
<-> Int -> Doc
arg_doc Int
n Doc -> Doc -> Doc
<+> Doc
nl)
        (Doc, Doc) -> [(Doc, Doc)] -> [(Doc, Doc)]
forall a. a -> [a] -> [a]
: Int -> Doc -> LHsType DocNameI -> [(Doc, Doc)]
do_largs (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Bool -> Doc
arrow Bool
unicode) LHsType DocNameI
r
    do_args Int
n Doc
leader HsType DocNameI
t =
      [(Doc -> Doc
decltt Doc
leader, Doc -> Doc
decltt (Bool -> HsType DocNameI -> Doc
ppType Bool
unicode HsType DocNameI
t) Doc -> Doc -> Doc
<-> Int -> Doc
arg_doc Int
n Doc -> Doc -> Doc
<+> Doc
nl)]

    -- 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 :: Doc
gadtComma = [Doc] -> Doc
hcat (Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (if Bool
unicode then Int
3 else Int
4) (Char -> Doc
char Char
' ')) Doc -> Doc -> Doc
<> Char -> Doc
char Char
','
    gadtEnd :: Doc
gadtEnd = [Doc] -> Doc
hcat (Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (if Bool
unicode then Int
3 else Int
4) (Char -> Doc
char Char
' ')) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'}'
    gadtOpen :: Doc
gadtOpen = Char -> Doc
char Char
'{'

ppTypeSig :: [Name] -> HsSigType DocNameI -> Bool -> LaTeX
ppTypeSig :: [Name] -> HsSigType DocNameI -> Bool -> Doc
ppTypeSig [Name]
nms HsSigType DocNameI
ty Bool
unicode =
  [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
ppSymName [Name]
nms)
    Doc -> Doc -> Doc
<+> Bool -> Doc
dcolon Bool
unicode
    Doc -> Doc -> Doc
<+> Bool -> HsSigType DocNameI -> Doc
ppSigType Bool
unicode HsSigType DocNameI
ty

ppHsOuterTyVarBndrs :: RenderableBndrFlag flag => HsOuterTyVarBndrs flag DocNameI -> Bool -> LaTeX
ppHsOuterTyVarBndrs :: forall flag.
RenderableBndrFlag flag =>
HsOuterTyVarBndrs flag DocNameI -> Bool -> Doc
ppHsOuterTyVarBndrs (HsOuterImplicit{}) Bool
_ = Doc
empty
ppHsOuterTyVarBndrs (HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr flag (NoGhcTc DocNameI)]
bndrs}) Bool
unicode =
  [Doc] -> Doc
hsep (Bool -> Doc
forallSymbol Bool
unicode Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Bool -> [LHsTyVarBndr flag DocNameI] -> [Doc]
forall flag.
RenderableBndrFlag flag =>
Bool -> [LHsTyVarBndr flag DocNameI] -> [Doc]
ppTyVars Bool
unicode [LHsTyVarBndr flag (NoGhcTc DocNameI)]
[LHsTyVarBndr flag DocNameI]
bndrs) Doc -> Doc -> Doc
<> Doc
dot

ppHsForAllTelescope :: HsForAllTelescope DocNameI -> Bool -> LaTeX
ppHsForAllTelescope :: HsForAllTelescope DocNameI -> Bool -> Doc
ppHsForAllTelescope HsForAllTelescope DocNameI
tele Bool
unicode = case HsForAllTelescope DocNameI
tele of
  HsForAllVis{hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () DocNameI]
bndrs} ->
    [Doc] -> Doc
hsep (Bool -> Doc
forallSymbol Bool
unicode Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Bool -> [LHsTyVarBndr () DocNameI] -> [Doc]
forall flag.
RenderableBndrFlag flag =>
Bool -> [LHsTyVarBndr flag DocNameI] -> [Doc]
ppTyVars Bool
unicode [LHsTyVarBndr () DocNameI]
bndrs) Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
"\\" Doc -> Doc -> Doc
<> Bool -> Doc
arrow Bool
unicode
  HsForAllInvis{hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity DocNameI]
bndrs} ->
    [Doc] -> Doc
hsep (Bool -> Doc
forallSymbol Bool
unicode Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Bool -> [LHsTyVarBndr Specificity DocNameI] -> [Doc]
forall flag.
RenderableBndrFlag flag =>
Bool -> [LHsTyVarBndr flag DocNameI] -> [Doc]
ppTyVars Bool
unicode [LHsTyVarBndr Specificity DocNameI]
bndrs) Doc -> Doc -> Doc
<> Doc
dot

ppTyVars :: RenderableBndrFlag flag => Bool -> [LHsTyVarBndr flag DocNameI] -> [LaTeX]
ppTyVars :: forall flag.
RenderableBndrFlag flag =>
Bool -> [LHsTyVarBndr flag DocNameI] -> [Doc]
ppTyVars Bool
unicode [LHsTyVarBndr flag DocNameI]
tvs = (GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI) -> Doc)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> HsTyVarBndr flag DocNameI -> Doc
forall flag.
RenderableBndrFlag flag =>
Bool -> HsTyVarBndr flag DocNameI -> Doc
ppHsTyVarBndr Bool
unicode (HsTyVarBndr flag DocNameI -> Doc)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
    -> HsTyVarBndr flag DocNameI)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
-> HsTyVarBndr flag DocNameI
forall l e. GenLocated l e -> e
unLoc) [LHsTyVarBndr flag DocNameI]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)]
tvs

tyvarNames :: LHsQTyVars DocNameI -> [Maybe Name]
tyvarNames :: LHsQTyVars DocNameI -> [Maybe Name]
tyvarNames = (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)
 -> Maybe Name)
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)]
-> [Maybe Name]
forall a b. (a -> b) -> [a] -> [b]
map ((DocName -> Name) -> Maybe DocName -> Maybe Name
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap DocName -> Name
forall a. NamedThing a => a -> Name
getName (Maybe DocName -> Maybe Name)
-> (GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)
    -> Maybe DocName)
-> GenLocated
     SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)
-> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr (HsBndrVis DocNameI) DocNameI -> Maybe DocName
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)
-> Maybe DocName
forall flag. LHsTyVarBndr flag DocNameI -> Maybe DocName
hsLTyVarNameI) ([GenLocated
    SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)]
 -> [Maybe Name])
-> (LHsQTyVars DocNameI
    -> [GenLocated
          SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)])
-> LHsQTyVars DocNameI
-> [Maybe Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsQTyVars DocNameI -> [LHsTyVarBndr (HsBndrVis DocNameI) DocNameI]
LHsQTyVars DocNameI
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsQTvExplicit

declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc :: Doc -> Maybe Doc -> Doc
declWithDoc Doc
decl Maybe Doc
doc =
  FilePath -> Doc
text FilePath
"\\begin{haddockdesc}"
    Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\item[\\begin{tabular}{@{}l}"
    Doc -> Doc -> Doc
$$ FilePath -> Doc
text (FilePath -> FilePath
latexMonoFilter (Doc -> FilePath
latex2String Doc
decl))
    Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{tabular}]"
    Doc -> Doc -> Doc
$$ Doc -> (Doc -> Doc) -> Maybe Doc -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\Doc
x -> FilePath -> Doc
text FilePath
"{\\haddockbegindoc" Doc -> Doc -> Doc
$$ Doc
x Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
"}") Maybe Doc
doc
    Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{haddockdesc}"

-- in a group of decls, we don't put them all in the same tabular,
-- because that would prevent the group being broken over a page
-- boundary (breaks Foreign.C.Error for example).
multiDecl :: [LaTeX] -> LaTeX
multiDecl :: [Doc] -> Doc
multiDecl [Doc]
decls =
  FilePath -> Doc
text FilePath
"\\begin{haddockdesc}"
    Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat
      [ FilePath -> Doc
text FilePath
"\\item[\\begin{tabular}{@{}l}"
        Doc -> Doc -> Doc
$$ FilePath -> Doc
text (FilePath -> FilePath
latexMonoFilter (Doc -> FilePath
latex2String Doc
decl))
        Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{tabular}]"
      | Doc
decl <- [Doc]
decls
      ]
    Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{haddockdesc}"

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

-- * Rendering Doc

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

maybeDoc :: Maybe (Doc DocName) -> LaTeX
maybeDoc :: Maybe (Doc DocName) -> Doc
maybeDoc = Doc -> (Doc DocName -> Doc) -> Maybe (Doc DocName) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Doc DocName -> Doc
docToLaTeX

-- for table cells, we strip paragraphs out to avoid extra vertical space
-- and don't add a quote environment.
rDoc :: Maybe (Doc DocName) -> LaTeX
rDoc :: Maybe (Doc DocName) -> Doc
rDoc = Maybe (Doc DocName) -> Doc
maybeDoc (Maybe (Doc DocName) -> Doc)
-> (Maybe (Doc DocName) -> Maybe (Doc DocName))
-> Maybe (Doc DocName)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc DocName -> Doc DocName)
-> Maybe (Doc DocName) -> Maybe (Doc DocName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc DocName -> Doc DocName
forall a. Doc a -> Doc a
latexStripTrailingWhitespace

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

-- * Class declarations

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

ppClassHdr
  :: Bool
  -> Maybe (LocatedC [LHsType DocNameI])
  -> DocName
  -> LHsQTyVars DocNameI
  -> [LHsFunDep DocNameI]
  -> Bool
  -> LaTeX
ppClassHdr :: Bool
-> Maybe (LocatedC [LHsType DocNameI])
-> DocName
-> LHsQTyVars DocNameI
-> [LHsFunDep DocNameI]
-> Bool
-> Doc
ppClassHdr Bool
summ Maybe (LocatedC [LHsType DocNameI])
lctxt DocName
n LHsQTyVars DocNameI
tvs [LHsFunDep DocNameI]
fds Bool
unicode =
  FilePath -> Doc
keyword FilePath
"class"
    Doc -> Doc -> Doc
<+> (if Bool -> Bool
not ([LHsType DocNameI] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([LHsType DocNameI] -> Bool) -> [LHsType DocNameI] -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (LHsContext DocNameI) -> [LHsType DocNameI]
fromMaybeContext Maybe (LHsContext DocNameI)
Maybe (LocatedC [LHsType DocNameI])
lctxt) then Maybe (LHsContext DocNameI) -> Bool -> Doc
ppLContext Maybe (LHsContext DocNameI)
Maybe (LocatedC [LHsType DocNameI])
lctxt Bool
unicode else Doc
empty)
    Doc -> Doc -> Doc
<+> Bool -> DocName -> [Maybe Name] -> Doc
ppAppDocNameNames Bool
summ DocName
n (LHsQTyVars DocNameI -> [Maybe Name]
tyvarNames LHsQTyVars DocNameI
tvs)
    Doc -> Doc -> Doc
<+> [LHsFunDep DocNameI] -> Bool -> Doc
ppFds [LHsFunDep DocNameI]
fds Bool
unicode

-- ppFds :: [Located ([LocatedA DocName], [LocatedA DocName])] -> Bool -> LaTeX
ppFds :: [LHsFunDep DocNameI] -> Bool -> LaTeX
ppFds :: [LHsFunDep DocNameI] -> Bool -> Doc
ppFds [LHsFunDep DocNameI]
fds Bool
unicode =
  if [GenLocated SrcSpan (FunDep DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LHsFunDep DocNameI]
[GenLocated SrcSpan (FunDep DocNameI)]
fds
    then Doc
empty
    else Char -> Doc
char Char
'|' Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((GenLocated SrcSpan (FunDep DocNameI) -> Doc)
-> [GenLocated SrcSpan (FunDep DocNameI)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (FunDep DocNameI -> Doc
fundep (FunDep DocNameI -> Doc)
-> (GenLocated SrcSpan (FunDep DocNameI) -> FunDep DocNameI)
-> GenLocated SrcSpan (FunDep DocNameI)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (FunDep DocNameI) -> FunDep DocNameI
forall l e. GenLocated l e -> e
unLoc) [LHsFunDep DocNameI]
[GenLocated SrcSpan (FunDep DocNameI)]
fds))
  where
    fundep :: FunDep DocNameI -> Doc
fundep (FunDep XCFunDep DocNameI
_ [LIdP DocNameI]
vars1 [LIdP DocNameI]
vars2) =
      [Doc] -> Doc
hsep ((GenLocated SrcSpanAnnN DocName -> Doc)
-> [GenLocated SrcSpanAnnN DocName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> Doc
ppDocName (DocName -> Doc)
-> (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc) [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
vars1)
        Doc -> Doc -> Doc
<+> Bool -> Doc
arrow Bool
unicode
        Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((GenLocated SrcSpanAnnN DocName -> Doc)
-> [GenLocated SrcSpanAnnN DocName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> Doc
ppDocName (DocName -> Doc)
-> (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc) [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
vars2)
    fundep (XFunDep XXFunDep DocNameI
_) = FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"ppFds"

-- TODO: associated type defaults, docs on default methods
ppClassDecl
  :: [DocInstance DocNameI]
  -> Documentation DocName
  -> [(DocName, DocForDecl DocName)]
  -> TyClDecl DocNameI
  -> Bool
  -> LaTeX
ppClassDecl :: [DocInstance DocNameI]
-> Documentation DocName
-> [(DocName, DocForDecl DocName)]
-> TyClDecl DocNameI
-> Bool
-> Doc
ppClassDecl
  [DocInstance DocNameI]
instances
  Documentation DocName
doc
  [(DocName, DocForDecl DocName)]
subdocs
  ( ClassDecl
      { tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCtxt = Maybe (LHsContext DocNameI)
lctxt
      , tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP DocNameI
lname
      , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
ltyvars
      , tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdFDs = [LHsFunDep DocNameI]
lfds
      , tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig DocNameI]
lsigs
      , tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs = [LFamilyDecl DocNameI]
ats
      , tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs = [LTyFamDefltDecl DocNameI]
at_defs
      }
    )
  Bool
unicode =
    Doc -> Maybe Doc -> Doc
declWithDoc Doc
classheader (if [Doc] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Doc]
body then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just ([Doc] -> Doc
vcat [Doc]
body))
      Doc -> Doc -> Doc
$$ Doc
instancesBit
    where
      classheader :: Doc
classheader
        | [GenLocated SrcSpan (Sig DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LSig DocNameI]
[GenLocated SrcSpan (Sig DocNameI)]
lsigs = Bool -> Doc
hdr Bool
unicode
        | Bool
otherwise = Bool -> Doc
hdr Bool
unicode Doc -> Doc -> Doc
<+> FilePath -> Doc
keyword FilePath
"where"

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

      body :: [Doc]
body = [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
Maybe.catMaybes [Documentation DocName -> Maybe Doc
documentationToLaTeX Documentation DocName
doc, Maybe Doc
body_]

      body_ :: Maybe Doc
body_
        | [GenLocated SrcSpan (Sig DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LSig DocNameI]
[GenLocated SrcSpan (Sig DocNameI)]
lsigs, [GenLocated SrcSpan (FamilyDecl DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LFamilyDecl DocNameI]
[GenLocated SrcSpan (FamilyDecl DocNameI)]
ats, [GenLocated SrcSpanAnnA (TyFamInstDecl DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LTyFamDefltDecl DocNameI]
[GenLocated SrcSpanAnnA (TyFamInstDecl DocNameI)]
at_defs = Maybe Doc
forall a. Maybe a
Nothing
        | [GenLocated SrcSpan (FamilyDecl DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LFamilyDecl DocNameI]
[GenLocated SrcSpan (FamilyDecl DocNameI)]
ats, [GenLocated SrcSpanAnnA (TyFamInstDecl DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LTyFamDefltDecl DocNameI]
[GenLocated SrcSpanAnnA (TyFamInstDecl DocNameI)]
at_defs = Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
methodTable
        | Bool
otherwise = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc
atTable Doc -> Doc -> Doc
$$ Doc
methodTable)

      atTable :: Doc
atTable =
        FilePath -> Doc
text FilePath
"\\haddockpremethods{}" Doc -> Doc -> Doc
<> Doc -> Doc
emph (FilePath -> Doc
text FilePath
"Associated Types")
          Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat
            [ Bool
-> Documentation DocName
-> [DocInstance DocNameI]
-> TyClDecl DocNameI
-> Bool
-> Doc
ppFamDecl Bool
True (DocForDecl DocName -> Documentation DocName
forall a b. (a, b) -> a
fst DocForDecl DocName
doc) [] (XFamDecl DocNameI -> FamilyDecl DocNameI -> TyClDecl DocNameI
forall pass. XFamDecl pass -> FamilyDecl pass -> TyClDecl pass
FamDecl XFamDecl DocNameI
NoExtField
noExtField FamilyDecl DocNameI
decl) Bool
True
            | L SrcSpan
_ FamilyDecl DocNameI
decl <- [LFamilyDecl DocNameI]
[GenLocated SrcSpan (FamilyDecl DocNameI)]
ats
            , let name :: DocName
name = GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN DocName -> DocName)
-> (FamilyDecl DocNameI -> GenLocated SrcSpanAnnN DocName)
-> FamilyDecl DocNameI
-> DocName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamilyDecl DocNameI -> LIdP DocNameI
FamilyDecl DocNameI -> GenLocated SrcSpanAnnN DocName
forall pass. FamilyDecl pass -> LIdP pass
fdLName (FamilyDecl DocNameI -> DocName) -> FamilyDecl DocNameI -> DocName
forall a b. (a -> b) -> a -> b
$ FamilyDecl DocNameI
decl
                  doc :: DocForDecl DocName
doc = DocName -> [(DocName, DocForDecl DocName)] -> DocForDecl DocName
forall name1 name2.
Eq name1 =>
name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
lookupAnySubdoc DocName
name [(DocName, DocForDecl DocName)]
subdocs
            ]

      methodTable :: Doc
methodTable =
        FilePath -> Doc
text FilePath
"\\haddockpremethods{}" Doc -> Doc -> Doc
<> Doc -> Doc
emph (FilePath -> Doc
text FilePath
"Methods")
          Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat
            [ Maybe Doc
-> DocForDecl DocName
-> [DocName]
-> LHsSigType DocNameI
-> Bool
-> Doc
ppFunSig Maybe Doc
leader DocForDecl DocName
doc [DocName]
names LHsSigType DocNameI
typ Bool
unicode
            | L SrcSpan
_ (ClassOpSig XClassOpSig DocNameI
_ Bool
is_def [LIdP DocNameI]
lnames LHsSigType DocNameI
typ) <- [LSig DocNameI]
[GenLocated SrcSpan (Sig DocNameI)]
lsigs
            , let doc :: DocForDecl DocName
doc
                    | Bool
is_def = DocForDecl DocName
forall name. DocForDecl name
noDocForDecl
                    | Bool
otherwise = DocName -> [(DocName, DocForDecl DocName)] -> DocForDecl DocName
forall name1 name2.
Eq name1 =>
name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
lookupAnySubdoc DocName
firstName [(DocName, DocForDecl DocName)]
subdocs
                  names :: [DocName]
names = (GenLocated SrcSpanAnnN DocName -> DocName)
-> [GenLocated SrcSpanAnnN DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> DocName
forall {name}. (HasOccName name, SetName name) => name -> name
cleanName (DocName -> DocName)
-> (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName
-> DocName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc) [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames
                  leader :: Maybe Doc
leader = if Bool
is_def then Doc -> Maybe Doc
forall a. a -> Maybe a
Just (FilePath -> Doc
keyword FilePath
"default") else Maybe Doc
forall a. Maybe a
Nothing
                  firstName :: DocName
firstName =
                    case [DocName] -> Maybe DocName
forall a. [a] -> Maybe a
Maybe.listToMaybe [DocName]
names of
                      Maybe DocName
Nothing -> FilePath -> DocName
forall a. HasCallStack => FilePath -> a
error FilePath
"No names. An invariant was broken. Please report this to the Haddock project"
                      Just DocName
hd -> DocName
hd
            ]
      -- N.B. taking just the first name is ok. Signatures with multiple
      -- names are expanded so that each name gets its own signature.
      -- Get rid of the ugly '$dm' prefix on default method names
      cleanName :: name -> name
cleanName name
n
        | OccName -> Bool
isDefaultMethodOcc (name -> OccName
forall name. HasOccName name => name -> OccName
occName name
n)
        , Char
'$' : Char
'd' : Char
'm' : FilePath
occStr <- name -> FilePath
forall a. NamedThing a => a -> FilePath
getOccString name
n =
            Name -> name -> name
forall name. SetName name => Name -> name -> name
setName (Name -> OccName -> Name
tidyNameOcc (name -> Name
forall a. NamedThing a => a -> Name
getName name
n) (NameSpace -> FilePath -> OccName
mkOccName NameSpace
varName FilePath
occStr)) name
n
        | Bool
otherwise = name
n

      instancesBit :: Doc
instancesBit = Bool -> [DocInstance DocNameI] -> Doc
ppDocInstances Bool
unicode [DocInstance DocNameI]
instances
ppClassDecl [DocInstance DocNameI]
_ Documentation DocName
_ [(DocName, DocForDecl DocName)]
_ TyClDecl DocNameI
_ Bool
_ = FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"declaration type not supported by ppShortClassDecl"

ppDocInstances :: Bool -> [DocInstance DocNameI] -> LaTeX
ppDocInstances :: Bool -> [DocInstance DocNameI] -> Doc
ppDocInstances Bool
_unicode [] = Doc
empty
ppDocInstances Bool
unicode (DocInstance DocNameI
i : [DocInstance DocNameI]
rest)
  | Just InstHead DocNameI
ihead <- DocInstance DocNameI -> Maybe (InstHead DocNameI)
forall a. DocInstance a -> Maybe (InstHead a)
isUndocdInstance DocInstance DocNameI
i =
      Doc -> Maybe Doc -> Doc
declWithDoc ([Doc] -> Doc
vcat ((InstHead DocNameI -> Doc) -> [InstHead DocNameI] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> InstHead DocNameI -> Doc
ppInstDecl Bool
unicode) (InstHead DocNameI
ihead InstHead DocNameI -> [InstHead DocNameI] -> [InstHead DocNameI]
forall a. a -> [a] -> [a]
: [InstHead DocNameI]
is))) Maybe Doc
forall a. Maybe a
Nothing
        Doc -> Doc -> Doc
$$ Bool -> [DocInstance DocNameI] -> Doc
ppDocInstances Bool
unicode [DocInstance DocNameI]
[(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)]
rest'
  | Bool
otherwise =
      Bool -> DocInstance DocNameI -> Doc
ppDocInstance Bool
unicode DocInstance DocNameI
i Doc -> Doc -> Doc
$$ Bool -> [DocInstance DocNameI] -> Doc
ppDocInstances Bool
unicode [DocInstance DocNameI]
rest
  where
    ([InstHead DocNameI]
is, [(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)]
rest') = ((InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)
 -> Maybe (InstHead DocNameI))
-> [(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
     Maybe Module)]
-> ([InstHead DocNameI],
    [(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
      Maybe Module)])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
spanWith DocInstance DocNameI -> Maybe (InstHead DocNameI)
(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
 Maybe Module)
-> Maybe (InstHead DocNameI)
forall a. DocInstance a -> Maybe (InstHead a)
isUndocdInstance [DocInstance DocNameI]
[(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)]
rest

isUndocdInstance :: DocInstance a -> Maybe (InstHead a)
isUndocdInstance :: forall a. DocInstance a -> Maybe (InstHead a)
isUndocdInstance (InstHead a
i, Maybe (MDoc (IdP a))
Nothing, Located (IdP a)
_, Maybe Module
_) = InstHead a -> Maybe (InstHead a)
forall a. a -> Maybe a
Just InstHead a
i
isUndocdInstance (InstHead a
i, Just (MetaDoc Meta
_ DocH (Wrap (ModuleName, OccName)) (Wrap (IdP a))
DocEmpty), Located (IdP a)
_, Maybe Module
_) = InstHead a -> Maybe (InstHead a)
forall a. a -> Maybe a
Just InstHead a
i
isUndocdInstance (InstHead a, Maybe (MDoc (IdP a)), Located (IdP a), Maybe Module)
_ = Maybe (InstHead a)
forall a. Maybe a
Nothing

-- | Print a possibly commented instance. The instance header is printed inside
-- an 'argBox'. The comment is printed to the right of the box in normal comment
-- style.
ppDocInstance :: Bool -> DocInstance DocNameI -> LaTeX
ppDocInstance :: Bool -> DocInstance DocNameI -> Doc
ppDocInstance Bool
unicode (InstHead DocNameI
instHead, Maybe (MDoc (IdP DocNameI))
doc, Located (IdP DocNameI)
_, Maybe Module
_) =
  Doc -> Maybe Doc -> Doc
declWithDoc (Bool -> InstHead DocNameI -> Doc
ppInstDecl Bool
unicode InstHead DocNameI
instHead) ((Doc DocName -> Doc) -> Maybe (Doc DocName) -> Maybe Doc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc DocName -> Doc
docToLaTeX (Maybe (Doc DocName) -> Maybe Doc)
-> Maybe (Doc DocName) -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap MDoc DocName -> Doc DocName
forall mod id. MetaDoc mod id -> DocH mod id
_doc Maybe (MDoc (IdP DocNameI))
Maybe (MDoc DocName)
doc)

ppInstDecl :: Bool -> InstHead DocNameI -> LaTeX
ppInstDecl :: Bool -> InstHead DocNameI -> Doc
ppInstDecl Bool
unicode (InstHead{[HsType DocNameI]
IdP DocNameI
InstType DocNameI
ihdClsName :: IdP DocNameI
ihdTypes :: [HsType DocNameI]
ihdInstType :: InstType DocNameI
ihdInstType :: forall name. InstHead name -> InstType name
ihdTypes :: forall name. InstHead name -> [HsType name]
ihdClsName :: forall name. InstHead name -> IdP name
..}) = case InstType DocNameI
ihdInstType of
  ClassInst [HsType DocNameI]
ctx LHsQTyVars DocNameI
_ [Sig DocNameI]
_ [DocInstance DocNameI]
_ -> FilePath -> Doc
keyword FilePath
"instance" Doc -> Doc -> Doc
<+> [HsType DocNameI] -> Bool -> Doc
ppContextNoLocs [HsType DocNameI]
ctx Bool
unicode Doc -> Doc -> Doc
<+> Doc
typ
  TypeInst Maybe (HsType DocNameI)
rhs -> FilePath -> Doc
keyword FilePath
"type" Doc -> Doc -> Doc
<+> FilePath -> Doc
keyword FilePath
"instance" Doc -> Doc -> Doc
<+> Doc
typ Doc -> Doc -> Doc
<+> Maybe (HsType DocNameI) -> Doc
tibody Maybe (HsType DocNameI)
rhs
  DataInst TyClDecl DocNameI
dd ->
    let cons :: DataDefnCons (LConDecl DocNameI)
cons = HsDataDefn DocNameI -> DataDefnCons (LConDecl DocNameI)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dd)
        pref :: Doc
pref = case DataDefnCons (LConDecl DocNameI)
cons of NewTypeCon LConDecl DocNameI
_ -> FilePath -> Doc
keyword FilePath
"newtype"; DataTypeCons Bool
_ [LConDecl DocNameI]
_ -> FilePath -> Doc
keyword FilePath
"data"
     in Doc
pref Doc -> Doc -> Doc
<+> FilePath -> Doc
keyword FilePath
"instance" Doc -> Doc -> Doc
<+> Doc
typ
  where
    typ :: Doc
typ = DocName -> [HsType DocNameI] -> Bool -> Doc
ppAppNameTypes IdP DocNameI
DocName
ihdClsName [HsType DocNameI]
ihdTypes Bool
unicode
    tibody :: Maybe (HsType DocNameI) -> Doc
tibody = Doc -> (HsType DocNameI -> Doc) -> Maybe (HsType DocNameI) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\HsType DocNameI
t -> Doc
equals Doc -> Doc -> Doc
<+> Bool -> HsType DocNameI -> Doc
ppType Bool
unicode HsType DocNameI
t)

lookupAnySubdoc
  :: Eq name1
  => name1
  -> [(name1, DocForDecl name2)]
  -> DocForDecl name2
lookupAnySubdoc :: forall name1 name2.
Eq name1 =>
name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
lookupAnySubdoc name1
n [(name1, DocForDecl name2)]
subdocs = case name1 -> [(name1, DocForDecl name2)] -> Maybe (DocForDecl name2)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup name1
n [(name1, DocForDecl name2)]
subdocs of
  Maybe (DocForDecl name2)
Nothing -> DocForDecl name2
forall name. DocForDecl name
noDocForDecl
  Just DocForDecl name2
docs -> DocForDecl name2
docs

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

-- * Data & newtype declarations

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

-- | Pretty-print a data declaration
ppDataDecl
  :: [(HsDecl DocNameI, DocForDecl DocName)]
  -- ^ relevant patterns
  -> [DocInstance DocNameI]
  -- ^ relevant instances
  -> [(DocName, DocForDecl DocName)]
  -- ^ relevant decl docs
  -> Maybe (Documentation DocName)
  -- ^ this decl's docs
  -> TyClDecl DocNameI
  -- ^ data decl to print
  -> Bool
  -- ^ unicode
  -> LaTeX
ppDataDecl :: [(HsDecl DocNameI, DocForDecl DocName)]
-> [DocInstance DocNameI]
-> [(DocName, DocForDecl DocName)]
-> Maybe (Documentation DocName)
-> TyClDecl DocNameI
-> Bool
-> Doc
ppDataDecl [(HsDecl DocNameI, DocForDecl DocName)]
pats [DocInstance DocNameI]
instances [(DocName, DocForDecl DocName)]
subdocs Maybe (Documentation DocName)
doc TyClDecl DocNameI
dataDecl Bool
unicode =
  Doc -> Maybe Doc -> Doc
declWithDoc
    (TyClDecl DocNameI -> Bool -> Doc
ppDataHeader TyClDecl DocNameI
dataDecl Bool
unicode Doc -> Doc -> Doc
<+> Doc
whereBit)
    (if [Doc] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Doc]
body then Maybe Doc
forall a. Maybe a
Nothing else Doc -> Maybe Doc
forall a. a -> Maybe a
Just ([Doc] -> Doc
vcat [Doc]
body))
    Doc -> Doc -> Doc
$$ Doc
instancesBit
  where
    cons :: DataDefnCons (LConDecl DocNameI)
cons = HsDataDefn DocNameI -> DataDefnCons (LConDecl DocNameI)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dataDecl)

    body :: [Doc]
body = [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
Maybe.catMaybes [Maybe (Documentation DocName)
doc Maybe (Documentation DocName)
-> (Documentation DocName -> Maybe Doc) -> Maybe Doc
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Documentation DocName -> Maybe Doc
documentationToLaTeX, Maybe Doc
constrBit, Maybe Doc
patternBit]

    (Doc
whereBit, [Doc]
leaders)
      | DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI)) -> Bool
forall a. DataDefnCons a -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons
      , [(HsDecl DocNameI, DocForDecl DocName)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(HsDecl DocNameI, DocForDecl DocName)]
pats =
          (Doc
empty, [])
      | DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI)) -> Bool
forall a. DataDefnCons a -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons = (FilePath -> Doc
text FilePath
"where", Doc -> [Doc]
forall a. a -> [a]
repeat Doc
empty)
      | Bool
otherwise = case DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
-> [GenLocated SrcSpan (ConDecl DocNameI)]
forall a. DataDefnCons a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons of
          L SrcSpan
_ ConDeclGADT{} : [GenLocated SrcSpan (ConDecl DocNameI)]
_ -> (FilePath -> Doc
text FilePath
"where", Doc -> [Doc]
forall a. a -> [a]
repeat Doc
empty)
          [GenLocated SrcSpan (ConDecl DocNameI)]
_ -> (Doc
empty, (Doc -> Doc
decltt (FilePath -> Doc
text FilePath
"=") Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat (Doc -> Doc
decltt (FilePath -> Doc
text FilePath
"|"))))

    constrBit :: Maybe Doc
constrBit
      | DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI)) -> Bool
forall a. DataDefnCons a -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons = Maybe Doc
forall a. Maybe a
Nothing
      | Bool
otherwise =
          Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
            FilePath -> Doc
text FilePath
"\\enspace" Doc -> Doc -> Doc
<+> Doc -> Doc
emph (FilePath -> Doc
text FilePath
"Constructors") Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
"\\par"
              Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\haddockbeginconstrs"
              Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Doc -> GenLocated SrcSpan (ConDecl DocNameI) -> Doc)
-> [Doc] -> [GenLocated SrcSpan (ConDecl DocNameI)] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([(DocName, DocForDecl DocName)]
-> Bool -> Doc -> LConDecl DocNameI -> Doc
ppSideBySideConstr [(DocName, DocForDecl DocName)]
subdocs Bool
unicode) [Doc]
leaders (DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
-> [GenLocated SrcSpan (ConDecl DocNameI)]
forall a. DataDefnCons a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList DataDefnCons (LConDecl DocNameI)
DataDefnCons (GenLocated SrcSpan (ConDecl DocNameI))
cons))
              Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{tabulary}\\par"

    patternBit :: Maybe Doc
patternBit
      | [(HsDecl DocNameI, DocForDecl DocName)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [(HsDecl DocNameI, DocForDecl DocName)]
pats = Maybe Doc
forall a. Maybe a
Nothing
      | Bool
otherwise =
          Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$
            FilePath -> Doc
text FilePath
"\\enspace" Doc -> Doc -> Doc
<+> Doc -> Doc
emph (FilePath -> Doc
text FilePath
"Bundled Patterns") Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
"\\par"
              Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\haddockbeginconstrs"
              Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat
                [ Doc
empty Doc -> Doc -> Doc
<-> [GenLocated SrcSpanAnnN DocName]
-> LHsSigType DocNameI -> DocForDecl DocName -> Bool -> Doc
ppSideBySidePat [LIdP DocNameI]
[GenLocated SrcSpanAnnN DocName]
lnames LHsSigType DocNameI
typ DocForDecl DocName
d Bool
unicode
                | (SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [LIdP DocNameI]
lnames LHsSigType DocNameI
typ), DocForDecl DocName
d) <- [(HsDecl DocNameI, DocForDecl DocName)]
pats
                ]
              Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{tabulary}\\par"

    instancesBit :: Doc
instancesBit = Bool -> [DocInstance DocNameI] -> Doc
ppDocInstances Bool
unicode [DocInstance DocNameI]
instances

-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
ppConstrHdr
  :: Bool
  -- ^ print explicit foralls
  -> [LHsTyVarBndr Specificity DocNameI]
  -- ^ type variables
  -> HsContext DocNameI
  -- ^ context
  -> Bool
  -- ^ unicode
  -> LaTeX
ppConstrHdr :: Bool
-> [LHsTyVarBndr Specificity DocNameI]
-> [LHsType DocNameI]
-> Bool
-> Doc
ppConstrHdr Bool
forall_ [LHsTyVarBndr Specificity DocNameI]
tvs [LHsType DocNameI]
ctxt Bool
unicode = Doc
ppForall Doc -> Doc -> Doc
<> Doc
ppCtxt
  where
    ppForall :: Doc
ppForall
      | [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LHsTyVarBndr Specificity DocNameI]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity DocNameI)]
tvs Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
forall_ = Doc
empty
      | Bool
otherwise = HsForAllTelescope DocNameI -> Bool -> Doc
ppHsForAllTelescope ([LHsTyVarBndr Specificity DocNameI] -> HsForAllTelescope DocNameI
mkHsForAllInvisTeleI [LHsTyVarBndr Specificity DocNameI]
tvs) Bool
unicode

    ppCtxt :: Doc
ppCtxt
      | [GenLocated SrcSpanAnnA (HsType DocNameI)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [LHsType DocNameI]
[GenLocated SrcSpanAnnA (HsType DocNameI)]
ctxt = Doc
empty
      | Bool
otherwise = [LHsType DocNameI] -> Bool -> Doc
ppContextNoArrow [LHsType DocNameI]
ctxt Bool
unicode Doc -> Doc -> Doc
<+> Bool -> Doc
darrow Bool
unicode Doc -> Doc -> Doc
<> Doc
space

-- | Pretty-print a constructor
ppSideBySideConstr
  :: [(DocName, DocForDecl DocName)]
  -- ^ all decl docs
  -> Bool
  -- ^ unicode
  -> LaTeX
  -- ^ prefix to decl
  -> LConDecl DocNameI
  -- ^ constructor decl
  -> LaTeX
ppSideBySideConstr :: [(DocName, DocForDecl DocName)]
-> Bool -> Doc -> LConDecl DocNameI -> Doc
ppSideBySideConstr [(DocName, DocForDecl DocName)]
subdocs Bool
unicode Doc
leader (L SrcSpan
_ ConDecl DocNameI
con) =
  Doc
leader Doc -> Doc -> Doc
<-> Doc -> Doc
decltt Doc
decl Doc -> Doc -> Doc
<-> Maybe (Doc DocName) -> Doc
rDoc Maybe (Doc DocName)
mbDoc Doc -> Doc -> Doc
<+> Doc
nl
    Doc -> Doc -> Doc
$$ Doc
fieldPart
  where
    -- Find the name of a constructors in the decl (`getConName` always returns
    -- a non-empty list)
    L SrcSpanAnnN
_ DocName
aConName :| [GenLocated SrcSpanAnnN DocName]
_ = ConDecl DocNameI -> NonEmpty (GenLocated SrcSpanAnnN DocName)
getConNamesI ConDecl DocNameI
con

    occ :: [OccName]
occ = NonEmpty OccName -> [OccName]
forall a. NonEmpty a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (NonEmpty OccName -> [OccName]) -> NonEmpty OccName -> [OccName]
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName (Name -> OccName)
-> (GenLocated SrcSpanAnnN DocName -> Name)
-> GenLocated SrcSpanAnnN DocName
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name)
-> (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN DocName -> OccName)
-> NonEmpty (GenLocated SrcSpanAnnN DocName) -> NonEmpty OccName
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ConDecl DocNameI -> NonEmpty (GenLocated SrcSpanAnnN DocName)
getConNamesI ConDecl DocNameI
con

    ppOcc :: Doc
ppOcc = [Doc] -> Doc
cat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((OccName -> Doc) -> [OccName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map OccName -> Doc
ppBinder [OccName]
occ))
    ppOccInfix :: Doc
ppOccInfix = [Doc] -> Doc
cat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((OccName -> Doc) -> [OccName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map OccName -> Doc
ppBinderInfix [OccName]
occ))

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

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

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

    doRecordFields :: [GenLocated SrcSpan (ConDeclField DocNameI)] -> Doc
doRecordFields [GenLocated SrcSpan (ConDeclField DocNameI)]
fields =
      [Doc] -> Doc
vcat
        [ Doc
empty Doc -> Doc -> Doc
<-> Doc -> Doc
tt (FilePath -> Doc
text FilePath
begin) Doc -> Doc -> Doc
<+> [(DocName, DocForDecl DocName)]
-> Bool -> ConDeclField DocNameI -> Doc
ppSideBySideField [(DocName, DocForDecl DocName)]
subdocs Bool
unicode ConDeclField DocNameI
field Doc -> Doc -> Doc
<+> Doc
nl
        | (FilePath
begin, L SrcSpan
_ ConDeclField DocNameI
field) <- [FilePath]
-> [GenLocated SrcSpan (ConDeclField DocNameI)]
-> [(FilePath, GenLocated SrcSpan (ConDeclField DocNameI))]
forall a b. [a] -> [b] -> [(a, b)]
zip (FilePath
"\\qquad \\{" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
forall a. a -> [a]
repeat FilePath
"\\qquad ,") [GenLocated SrcSpan (ConDeclField DocNameI)]
fields
        ]
        Doc -> Doc -> Doc
$$ Doc
empty Doc -> Doc -> Doc
<-> Doc -> Doc
tt (FilePath -> Doc
text FilePath
"\\qquad \\}") Doc -> Doc -> Doc
<+> Doc
nl

    doConstrArgsWithDocs :: [GenLocated SrcSpanAnnA (HsType DocNameI)] -> Doc
doConstrArgsWithDocs [GenLocated SrcSpanAnnA (HsType DocNameI)]
args = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\Doc
l -> Doc
empty Doc -> Doc -> Doc
<-> FilePath -> Doc
text FilePath
"\\qquad" Doc -> Doc -> Doc
<+> Doc
l) ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ case ConDecl DocNameI
con of
      ConDeclH98{} ->
        [ Doc -> Doc
decltt (Bool -> LHsType DocNameI -> Doc
ppLParendType Bool
unicode LHsType DocNameI
GenLocated SrcSpanAnnA (HsType DocNameI)
arg) Doc -> Doc -> Doc
<-> Maybe (Doc DocName) -> Doc
rDoc ((MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap MDoc DocName -> Doc DocName
forall mod id. MetaDoc mod id -> DocH mod id
_doc Maybe (MDoc DocName)
mdoc) Doc -> Doc -> Doc
<+> Doc
nl
        | (Int
i, GenLocated SrcSpanAnnA (HsType DocNameI)
arg) <- [Int]
-> [GenLocated SrcSpanAnnA (HsType DocNameI)]
-> [(Int, GenLocated SrcSpanAnnA (HsType DocNameI))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [GenLocated SrcSpanAnnA (HsType DocNameI)]
args
        , let mdoc :: Maybe (MDoc DocName)
mdoc = Int -> Map Int (MDoc DocName) -> Maybe (MDoc DocName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
i Map Int (MDoc DocName)
argDocs
        ]
      ConDeclGADT{} ->
        [ Doc
l Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
"\\enspace" Doc -> Doc -> Doc
<+> Doc
r
        | (Doc
l, Doc
r) <- Bool
-> HsSigType DocNameI
-> Map Int (MDoc DocName)
-> [(DocName, DocForDecl DocName)]
-> Doc
-> [(Doc, Doc)]
ppSubSigLike Bool
unicode (GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc (ConDecl DocNameI -> LHsSigType DocNameI
getGADTConType ConDecl DocNameI
con)) Map Int (MDoc DocName)
argDocs [(DocName, DocForDecl DocName)]
subdocs (Bool -> Doc
dcolon Bool
unicode)
        ]

    -- 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 (Doc DocName)
mbDoc = case ConDecl DocNameI -> NonEmpty (GenLocated SrcSpanAnnN DocName)
getConNamesI ConDecl DocNameI
con of
      GenLocated SrcSpanAnnN DocName
cn :| [GenLocated SrcSpanAnnN DocName]
_ ->
        DocName
-> [(DocName, DocForDecl DocName)] -> Maybe (DocForDecl DocName)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN DocName
cn) [(DocName, DocForDecl DocName)]
subdocs
          Maybe (DocForDecl DocName)
-> (DocForDecl DocName -> Maybe (Doc DocName))
-> Maybe (Doc DocName)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap MDoc DocName -> Doc DocName
forall mod id. MetaDoc mod id -> DocH mod id
_doc (Maybe (MDoc DocName) -> Maybe (Doc DocName))
-> (DocForDecl DocName -> Maybe (MDoc DocName))
-> DocForDecl DocName
-> Maybe (Doc DocName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

-- | Pretty-print a record field
ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocNameI -> LaTeX
ppSideBySideField :: [(DocName, DocForDecl DocName)]
-> Bool -> ConDeclField DocNameI -> Doc
ppSideBySideField [(DocName, DocForDecl DocName)]
subdocs Bool
unicode (ConDeclField XConDeclField DocNameI
_ [LFieldOcc DocNameI]
names LHsType DocNameI
ltype Maybe (LHsDoc DocNameI)
_) =
  Doc -> Doc
decltt
    ( [Doc] -> Doc
cat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> Doc)
-> [GenLocated SrcSpanAnnA (FieldOcc DocNameI)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> Doc
ppBinder (OccName -> Doc)
-> (GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> OccName)
-> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> RdrName)
-> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> (GenLocated SrcSpanAnnA (FieldOcc DocNameI)
    -> GenLocated SrcSpanAnnN RdrName)
-> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc DocNameI -> XRec DocNameI RdrName
FieldOcc DocNameI -> GenLocated SrcSpanAnnN RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel (FieldOcc DocNameI -> GenLocated SrcSpanAnnN RdrName)
-> (GenLocated SrcSpanAnnA (FieldOcc DocNameI)
    -> FieldOcc DocNameI)
-> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
-> GenLocated SrcSpanAnnN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> FieldOcc DocNameI
forall l e. GenLocated l e -> e
unLoc) [LFieldOcc DocNameI]
[GenLocated SrcSpanAnnA (FieldOcc DocNameI)]
names))
        Doc -> Doc -> Doc
<+> Bool -> Doc
dcolon Bool
unicode
        Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLType Bool
unicode LHsType DocNameI
ltype
    )
    Doc -> Doc -> Doc
<-> Maybe (Doc DocName) -> Doc
rDoc Maybe (Doc 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 (Doc 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
foExt (FieldOcc DocNameI -> XCFieldOcc DocNameI)
-> FieldOcc DocNameI -> XCFieldOcc DocNameI
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> FieldOcc DocNameI
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (FieldOcc DocNameI)
name) [(DocName, DocForDecl DocName)]
subdocs Maybe (DocForDecl DocName)
-> (DocForDecl DocName -> Maybe (Doc DocName))
-> Maybe (Doc DocName)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap MDoc DocName -> Doc DocName
forall mod id. MetaDoc mod id -> DocH mod id
_doc (Maybe (MDoc DocName) -> Maybe (Doc DocName))
-> (DocForDecl DocName -> Maybe (MDoc DocName))
-> DocForDecl DocName
-> Maybe (Doc DocName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    name :: GenLocated SrcSpanAnnA (FieldOcc DocNameI)
name =
      case [GenLocated SrcSpanAnnA (FieldOcc DocNameI)]
-> Maybe (GenLocated SrcSpanAnnA (FieldOcc DocNameI))
forall a. [a] -> Maybe a
Maybe.listToMaybe [LFieldOcc DocNameI]
[GenLocated SrcSpanAnnA (FieldOcc DocNameI)]
names of
        Maybe (GenLocated SrcSpanAnnA (FieldOcc DocNameI))
Nothing -> FilePath -> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
forall a. HasCallStack => FilePath -> a
error FilePath
"No names. An invariant was broken. Please report this to the Haddock project"
        Just GenLocated SrcSpanAnnA (FieldOcc DocNameI)
hd -> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
hd

-- | Pretty-print a bundled pattern synonym
ppSideBySidePat
  :: [LocatedN DocName]
  -- ^ pattern name(s)
  -> LHsSigType DocNameI
  -- ^ type of pattern(s)
  -> DocForDecl DocName
  -- ^ doc map
  -> Bool
  -- ^ unicode
  -> LaTeX
ppSideBySidePat :: [GenLocated SrcSpanAnnN DocName]
-> LHsSigType DocNameI -> DocForDecl DocName -> Bool -> Doc
ppSideBySidePat [GenLocated SrcSpanAnnN DocName]
lnames LHsSigType DocNameI
typ (Documentation DocName
doc, Map Int (MDoc DocName)
argDocs) Bool
unicode =
  Doc -> Doc
decltt Doc
decl Doc -> Doc -> Doc
<-> Maybe (Doc DocName) -> Doc
rDoc Maybe (Doc DocName)
mDoc Doc -> Doc -> Doc
<+> Doc
nl
    Doc -> Doc -> Doc
$$ Doc
fieldPart
  where
    hasArgDocs :: Bool
hasArgDocs = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Map Int (MDoc DocName) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (MDoc DocName)
argDocs
    ppOcc :: Doc
ppOcc = [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((GenLocated SrcSpanAnnN DocName -> Doc)
-> [GenLocated SrcSpanAnnN DocName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> Doc
ppDocBinder (DocName -> Doc)
-> (GenLocated SrcSpanAnnN DocName -> DocName)
-> GenLocated SrcSpanAnnN DocName
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc) [GenLocated SrcSpanAnnN DocName]
lnames))

    decl :: Doc
decl
      | Bool
hasArgDocs = FilePath -> Doc
keyword FilePath
"pattern" Doc -> Doc -> Doc
<+> Doc
ppOcc
      | Bool
otherwise =
          [Doc] -> Doc
hsep
            [ FilePath -> Doc
keyword FilePath
"pattern"
            , Doc
ppOcc
            , Bool -> Doc
dcolon Bool
unicode
            , Bool -> LHsSigType DocNameI -> Doc
ppLSigType Bool
unicode LHsSigType DocNameI
typ
            ]

    fieldPart :: Doc
fieldPart
      | Bool -> Bool
not Bool
hasArgDocs = Doc
empty
      | Bool
otherwise =
          [Doc] -> Doc
vcat
            [ Doc
empty Doc -> Doc -> Doc
<-> FilePath -> Doc
text FilePath
"\\qquad" Doc -> Doc -> Doc
<+> Doc
l Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
"\\enspace" Doc -> Doc -> Doc
<+> Doc
r
            | (Doc
l, Doc
r) <- Bool
-> HsSigType DocNameI
-> Map Int (MDoc DocName)
-> [(DocName, DocForDecl DocName)]
-> Doc
-> [(Doc, Doc)]
ppSubSigLike Bool
unicode (GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsSigType DocNameI
GenLocated SrcSpanAnnA (HsSigType DocNameI)
typ) Map Int (MDoc DocName)
argDocs [] (Bool -> Doc
dcolon Bool
unicode)
            ]

    mDoc :: Maybe (Doc DocName)
mDoc = (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap MDoc DocName -> Doc DocName
forall mod id. MetaDoc mod id -> DocH mod id
_doc (Maybe (MDoc DocName) -> Maybe (Doc DocName))
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
forall a b. (a -> b) -> a -> b
$ Documentation DocName -> Maybe (MDoc DocName)
forall name. Documentation name -> Maybe (MDoc name)
combineDocumentation Documentation DocName
doc

-- | Print the LHS of a data\/newtype declaration.
-- Currently doesn't handle 'data instance' decls or kind signatures
ppDataHeader :: TyClDecl DocNameI -> Bool -> LaTeX
ppDataHeader :: TyClDecl DocNameI -> Bool -> Doc
ppDataHeader
  ( DataDecl
      { tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = L SrcSpanAnnN
_ DocName
name
      , tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
tyvars
      , tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn{dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons = DataDefnCons (LConDecl DocNameI)
cons, dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ctxt = Maybe (LHsContext DocNameI)
ctxt}
      }
    )
  Bool
unicode =
    -- newtype or data
    ( case DataDefnCons (LConDecl DocNameI)
cons of
        NewTypeCon LConDecl DocNameI
_ -> FilePath -> Doc
keyword FilePath
"newtype"
        DataTypeCons Bool
False [LConDecl DocNameI]
_ -> FilePath -> Doc
keyword FilePath
"data"
        DataTypeCons Bool
True [LConDecl DocNameI]
_ -> FilePath -> Doc
keyword FilePath
"type" Doc -> Doc -> Doc
<+> FilePath -> Doc
keyword FilePath
"data"
    )
      Doc -> Doc -> Doc
<+>
      -- context
      Maybe (LHsContext DocNameI) -> Bool -> Doc
ppLContext Maybe (LHsContext DocNameI)
ctxt Bool
unicode
      Doc -> Doc -> Doc
<+>
      -- T a b c ..., or a :+: b
      Bool -> DocName -> [Maybe Name] -> Doc
ppAppDocNameNames Bool
False DocName
name (LHsQTyVars DocNameI -> [Maybe Name]
tyvarNames LHsQTyVars DocNameI
tyvars)
ppDataHeader TyClDecl DocNameI
_ Bool
_ = FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"ppDataHeader: illegal argument"

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

-- * Type applications

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

ppAppDocNameTyVarBndrs
  :: RenderableBndrFlag flag
  => Bool
  -> DocName
  -> [LHsTyVarBndr flag DocNameI]
  -> LaTeX
ppAppDocNameTyVarBndrs :: forall flag.
RenderableBndrFlag flag =>
Bool -> DocName -> [LHsTyVarBndr flag DocNameI] -> Doc
ppAppDocNameTyVarBndrs Bool
unicode DocName
n [LHsTyVarBndr flag DocNameI]
vs =
  DocName
-> [GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)]
-> (DocName -> Doc)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI) -> Doc)
-> Doc
forall a. DocName -> [a] -> (DocName -> Doc) -> (a -> Doc) -> Doc
ppTypeApp DocName
n [LHsTyVarBndr flag DocNameI]
[GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)]
vs DocName -> Doc
ppDN (Bool -> HsTyVarBndr flag DocNameI -> Doc
forall flag.
RenderableBndrFlag flag =>
Bool -> HsTyVarBndr flag DocNameI -> Doc
ppHsTyVarBndr Bool
unicode (HsTyVarBndr flag DocNameI -> Doc)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
    -> HsTyVarBndr flag DocNameI)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr flag DocNameI)
-> HsTyVarBndr flag DocNameI
forall l e. GenLocated l e -> e
unLoc)
  where
    ppDN :: DocName -> Doc
ppDN = OccName -> Doc
ppBinder (OccName -> Doc) -> (DocName -> OccName) -> DocName -> Doc
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

-- | Print an application of a DocName to its list of HsTypes
ppAppNameTypes :: DocName -> [HsType DocNameI] -> Bool -> LaTeX
ppAppNameTypes :: DocName -> [HsType DocNameI] -> Bool -> Doc
ppAppNameTypes DocName
n [HsType DocNameI]
ts Bool
unicode = DocName
-> [HsType DocNameI]
-> (DocName -> Doc)
-> (HsType DocNameI -> Doc)
-> Doc
forall a. DocName -> [a] -> (DocName -> Doc) -> (a -> Doc) -> Doc
ppTypeApp DocName
n [HsType DocNameI]
ts DocName -> Doc
ppDocName (Bool -> HsType DocNameI -> Doc
ppParendType Bool
unicode)

ppAppNameTypeArgs :: DocName -> [LHsTypeArg DocNameI] -> Bool -> LaTeX
ppAppNameTypeArgs :: DocName -> HsFamEqnPats DocNameI -> Bool -> Doc
ppAppNameTypeArgs DocName
n args :: HsFamEqnPats DocNameI
args@(HsValArg XValArg DocNameI
_ LHsType DocNameI
_ : HsValArg XValArg DocNameI
_ LHsType DocNameI
_ : HsFamEqnPats DocNameI
_) Bool
unicode =
  DocName
-> [HsArg
      DocNameI
      (GenLocated SrcSpanAnnA (HsType DocNameI))
      (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> (DocName -> Doc)
-> (HsArg
      DocNameI
      (GenLocated SrcSpanAnnA (HsType DocNameI))
      (GenLocated SrcSpanAnnA (HsType DocNameI))
    -> Doc)
-> Doc
forall a. DocName -> [a] -> (DocName -> Doc) -> (a -> Doc) -> Doc
ppTypeApp DocName
n HsFamEqnPats DocNameI
[HsArg
   DocNameI
   (GenLocated SrcSpanAnnA (HsType DocNameI))
   (GenLocated SrcSpanAnnA (HsType DocNameI))]
args DocName -> Doc
ppDocName (Bool -> HsArg DocNameI (LHsType DocNameI) (LHsType DocNameI) -> Doc
ppLHsTypeArg Bool
unicode)
ppAppNameTypeArgs DocName
n HsFamEqnPats DocNameI
args Bool
unicode =
  DocName -> Doc
ppDocName DocName
n Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((HsArg
   DocNameI
   (GenLocated SrcSpanAnnA (HsType DocNameI))
   (GenLocated SrcSpanAnnA (HsType DocNameI))
 -> Doc)
-> [HsArg
      DocNameI
      (GenLocated SrcSpanAnnA (HsType DocNameI))
      (GenLocated SrcSpanAnnA (HsType DocNameI))]
-> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> HsArg DocNameI (LHsType DocNameI) (LHsType DocNameI) -> Doc
ppLHsTypeArg Bool
unicode) HsFamEqnPats DocNameI
[HsArg
   DocNameI
   (GenLocated SrcSpanAnnA (HsType DocNameI))
   (GenLocated SrcSpanAnnA (HsType DocNameI))]
args)

-- | Print an application of a DocName and a list of Names
ppAppDocNameNames :: Bool -> DocName -> [Maybe Name] -> LaTeX
ppAppDocNameNames :: Bool -> DocName -> [Maybe Name] -> Doc
ppAppDocNameNames Bool
_summ DocName
n [Maybe Name]
ns =
  DocName
-> [Maybe Name] -> (DocName -> Doc) -> (Maybe Name -> Doc) -> Doc
forall a. DocName -> [a] -> (DocName -> Doc) -> (a -> Doc) -> Doc
ppTypeApp DocName
n [Maybe Name]
ns (OccName -> Doc
ppBinder (OccName -> Doc) -> (DocName -> OccName) -> DocName -> Doc
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) Maybe Name -> Doc
ppWcSymName

-- | General printing of type applications
ppTypeApp :: DocName -> [a] -> (DocName -> LaTeX) -> (a -> LaTeX) -> LaTeX
ppTypeApp :: forall a. DocName -> [a] -> (DocName -> Doc) -> (a -> Doc) -> Doc
ppTypeApp DocName
n (a
t1 : a
t2 : [a]
rest) DocName -> Doc
ppDN a -> Doc
ppT
  | Bool
operator, Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ [a]
rest = Doc -> Doc
parens Doc
opApp Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
ppT [a]
rest)
  | Bool
operator = Doc
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 :: Doc
opApp = a -> Doc
ppT a
t1 Doc -> Doc -> Doc
<+> DocName -> Doc
ppDN DocName
n Doc -> Doc -> Doc
<+> a -> Doc
ppT a
t2
ppTypeApp DocName
n [a]
ts DocName -> Doc
ppDN a -> Doc
ppT = DocName -> Doc
ppDN DocName
n Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
ppT [a]
ts)

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

-- * Contexts

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

ppLContext :: Maybe (LHsContext DocNameI) -> Bool -> LaTeX
ppLContext :: Maybe (LHsContext DocNameI) -> Bool -> Doc
ppLContext Maybe (LHsContext DocNameI)
Nothing Bool
_ = Doc
empty
ppLContext (Just LHsContext DocNameI
ctxt) Bool
unicode = [LHsType DocNameI] -> Bool -> Doc
ppContext (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
-> [GenLocated SrcSpanAnnA (HsType DocNameI)]
forall l e. GenLocated l e -> e
unLoc LHsContext DocNameI
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
ctxt) Bool
unicode

ppLContextNoArrow :: LHsContext DocNameI -> Bool -> LaTeX
ppLContextNoArrow :: LHsContext DocNameI -> Bool -> Doc
ppLContextNoArrow LHsContext DocNameI
ctxt Bool
unicode = [LHsType DocNameI] -> Bool -> Doc
ppContextNoArrow (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
-> [GenLocated SrcSpanAnnA (HsType DocNameI)]
forall l e. GenLocated l e -> e
unLoc LHsContext DocNameI
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
ctxt) Bool
unicode

ppContextNoLocsMaybe :: [HsType DocNameI] -> Bool -> Maybe LaTeX
ppContextNoLocsMaybe :: [HsType DocNameI] -> Bool -> Maybe Doc
ppContextNoLocsMaybe [] Bool
_ = Maybe Doc
forall a. Maybe a
Nothing
ppContextNoLocsMaybe [HsType DocNameI]
cxt Bool
unicode = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [HsType DocNameI] -> Bool -> Doc
pp_hs_context [HsType DocNameI]
cxt Bool
unicode

ppContextNoArrow :: HsContext DocNameI -> Bool -> LaTeX
ppContextNoArrow :: [LHsType DocNameI] -> Bool -> Doc
ppContextNoArrow [LHsType DocNameI]
cxt Bool
unicode =
  Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
Maybe.fromMaybe Doc
empty (Maybe Doc -> Doc) -> Maybe Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    [HsType DocNameI] -> Bool -> Maybe Doc
ppContextNoLocsMaybe ((GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [HsType DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc [LHsType DocNameI]
[GenLocated SrcSpanAnnA (HsType DocNameI)]
cxt) Bool
unicode

ppContextNoLocs :: [HsType DocNameI] -> Bool -> LaTeX
ppContextNoLocs :: [HsType DocNameI] -> Bool -> Doc
ppContextNoLocs [HsType DocNameI]
cxt Bool
unicode =
  Doc -> (Doc -> Doc) -> Maybe Doc -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc -> Doc
<+> Bool -> Doc
darrow Bool
unicode) (Maybe Doc -> Doc) -> Maybe Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    [HsType DocNameI] -> Bool -> Maybe Doc
ppContextNoLocsMaybe [HsType DocNameI]
cxt Bool
unicode

ppContext :: HsContext DocNameI -> Bool -> LaTeX
ppContext :: [LHsType DocNameI] -> Bool -> Doc
ppContext [LHsType DocNameI]
cxt Bool
unicode = [HsType DocNameI] -> Bool -> Doc
ppContextNoLocs ((GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [HsType DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc [LHsType DocNameI]
[GenLocated SrcSpanAnnA (HsType DocNameI)]
cxt) Bool
unicode

pp_hs_context :: [HsType DocNameI] -> Bool -> LaTeX
pp_hs_context :: [HsType DocNameI] -> Bool -> Doc
pp_hs_context [] Bool
_ = Doc
empty
pp_hs_context [HsType DocNameI
p] Bool
unicode = Bool -> HsType DocNameI -> Doc
ppCtxType Bool
unicode HsType DocNameI
p
pp_hs_context [HsType DocNameI]
cxt Bool
unicode = [Doc] -> Doc
parenList ((HsType DocNameI -> Doc) -> [HsType DocNameI] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> HsType DocNameI -> Doc
ppType Bool
unicode) [HsType DocNameI]
cxt)

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

-- * Types and contexts

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

ppBang :: HsBang -> LaTeX
ppBang :: HsBang -> Doc
ppBang (HsBang SrcUnpackedness
_ SrcStrictness
SrcStrict) = Char -> Doc
char Char
'!'
ppBang (HsBang SrcUnpackedness
_ SrcStrictness
SrcLazy) = Char -> Doc
char Char
'~'
ppBang HsBang
_ = Doc
empty

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

sumParens :: [LaTeX] -> LaTeX
sumParens :: [Doc] -> Doc
sumParens = Doc -> Doc
ubxparens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (FilePath -> Doc
text FilePath
" |")

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

-- * Rendering of HsType

--
-- Stolen from Html and tweaked for LaTeX generation
-------------------------------------------------------------------------------

ppLType, ppLParendType, ppLFunLhType :: Bool -> LHsType DocNameI -> LaTeX
ppLType :: Bool -> LHsType DocNameI -> Doc
ppLType Bool
unicode LHsType DocNameI
y = Bool -> HsType DocNameI -> Doc
ppType Bool
unicode (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsType DocNameI
GenLocated SrcSpanAnnA (HsType DocNameI)
y)
ppLParendType :: Bool -> LHsType DocNameI -> Doc
ppLParendType Bool
unicode LHsType DocNameI
y = Bool -> HsType DocNameI -> Doc
ppParendType Bool
unicode (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsType DocNameI
GenLocated SrcSpanAnnA (HsType DocNameI)
y)
ppLFunLhType :: Bool -> LHsType DocNameI -> Doc
ppLFunLhType Bool
unicode LHsType DocNameI
y = Bool -> HsType DocNameI -> Doc
ppFunLhType Bool
unicode (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsType DocNameI
GenLocated SrcSpanAnnA (HsType DocNameI)
y)

ppLSigType :: Bool -> LHsSigType DocNameI -> LaTeX
ppLSigType :: Bool -> LHsSigType DocNameI -> Doc
ppLSigType Bool
unicode LHsSigType DocNameI
y = Bool -> HsSigType DocNameI -> Doc
ppSigType Bool
unicode (GenLocated SrcSpanAnnA (HsSigType DocNameI) -> HsSigType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsSigType DocNameI
GenLocated SrcSpanAnnA (HsSigType DocNameI)
y)

ppType, ppParendType, ppFunLhType, ppCtxType :: Bool -> HsType DocNameI -> LaTeX
ppType :: Bool -> HsType DocNameI -> Doc
ppType Bool
unicode HsType DocNameI
ty = HsType DocNameI -> Bool -> Doc
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_TOP HsType DocNameI
ty) Bool
unicode
ppParendType :: Bool -> HsType DocNameI -> Doc
ppParendType Bool
unicode HsType DocNameI
ty = HsType DocNameI -> Bool -> Doc
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_TOP HsType DocNameI
ty) Bool
unicode
ppFunLhType :: Bool -> HsType DocNameI -> Doc
ppFunLhType Bool
unicode HsType DocNameI
ty = HsType DocNameI -> Bool -> Doc
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_FUN HsType DocNameI
ty) Bool
unicode
ppCtxType :: Bool -> HsType DocNameI -> Doc
ppCtxType Bool
unicode HsType DocNameI
ty = HsType DocNameI -> Bool -> Doc
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_CTX HsType DocNameI
ty) Bool
unicode

ppSigType :: Bool -> HsSigType DocNameI -> LaTeX
ppSigType :: Bool -> HsSigType DocNameI -> Doc
ppSigType Bool
unicode HsSigType DocNameI
sig_ty = HsSigType DocNameI -> Bool -> Doc
ppr_sig_ty (HsSigType DocNameI -> HsSigType DocNameI
forall a. XRecCond a => HsSigType a -> HsSigType a
reparenSigType HsSigType DocNameI
sig_ty) Bool
unicode

ppLHsTypeArg :: Bool -> LHsTypeArg DocNameI -> LaTeX
ppLHsTypeArg :: Bool -> HsArg DocNameI (LHsType DocNameI) (LHsType DocNameI) -> Doc
ppLHsTypeArg Bool
unicode (HsValArg XValArg DocNameI
_ LHsType DocNameI
ty) = Bool -> LHsType DocNameI -> Doc
ppLParendType Bool
unicode LHsType DocNameI
ty
ppLHsTypeArg Bool
unicode (HsTypeArg XTypeArg DocNameI
_ LHsType DocNameI
ki) = Doc
atSign Doc -> Doc -> Doc
<> Bool -> LHsType DocNameI -> Doc
ppLParendType Bool
unicode LHsType DocNameI
ki
ppLHsTypeArg Bool
_ (HsArgPar XArgPar DocNameI
_) = FilePath -> Doc
text FilePath
""

class RenderableBndrFlag flag where
  ppHsTyVarBndr :: Bool -> HsTyVarBndr flag DocNameI -> LaTeX

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

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

instance RenderableBndrFlag (HsBndrVis DocNameI) where
  ppHsTyVarBndr :: Bool -> HsTyVarBndr (HsBndrVis DocNameI) DocNameI -> Doc
ppHsTyVarBndr Bool
unicode (HsTvb XTyVarBndr DocNameI
_ HsBndrVis DocNameI
bvis HsBndrVar DocNameI
bvar HsBndrKind DocNameI
bkind) =
    Doc -> Doc
decorate (Bool -> HsBndrVar DocNameI -> HsBndrKind DocNameI -> Doc
pp_hs_tvb Bool
unicode HsBndrVar DocNameI
bvar HsBndrKind DocNameI
bkind)
    where decorate :: LaTeX -> LaTeX
          decorate :: Doc -> Doc
decorate Doc
d = case HsBndrVis DocNameI
bvis of
            HsBndrRequired  XBndrRequired DocNameI
_ -> HsBndrKind DocNameI -> Doc -> Doc
parens_if_kind HsBndrKind DocNameI
bkind Doc
d
            HsBndrInvisible XBndrInvisible DocNameI
_ -> Doc
atSign Doc -> Doc -> Doc
<> HsBndrKind DocNameI -> Doc -> Doc
parens_if_kind HsBndrKind DocNameI
bkind Doc
d

ppHsBndrVar :: HsBndrVar DocNameI -> LaTeX
ppHsBndrVar :: HsBndrVar DocNameI -> Doc
ppHsBndrVar (HsBndrVar XBndrVar DocNameI
_ LIdP DocNameI
name) = DocName -> Doc
ppDocName (GenLocated SrcSpanAnnN DocName -> DocName
forall l e. GenLocated l e -> e
unLoc LIdP DocNameI
GenLocated SrcSpanAnnN DocName
name)
ppHsBndrVar (HsBndrWildCard XBndrWildCard DocNameI
_) = Char -> Doc
char Char
'_'

pp_hs_tvb :: Bool -> HsBndrVar DocNameI -> HsBndrKind DocNameI -> LaTeX
pp_hs_tvb :: Bool -> HsBndrVar DocNameI -> HsBndrKind DocNameI -> Doc
pp_hs_tvb Bool
_       HsBndrVar DocNameI
bvar (HsBndrNoKind XBndrNoKind DocNameI
_) = HsBndrVar DocNameI -> Doc
ppHsBndrVar HsBndrVar DocNameI
bvar
pp_hs_tvb Bool
unicode HsBndrVar DocNameI
bvar (HsBndrKind XBndrKind DocNameI
_ LHsType DocNameI
k) =
  HsBndrVar DocNameI -> Doc
ppHsBndrVar HsBndrVar DocNameI
bvar Doc -> Doc -> Doc
<+> Bool -> Doc
dcolon Bool
unicode
                   Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLKind Bool
unicode LHsType DocNameI
k

parens_if_kind :: HsBndrKind DocNameI -> LaTeX -> LaTeX
parens_if_kind :: HsBndrKind DocNameI -> Doc -> Doc
parens_if_kind (HsBndrNoKind XBndrNoKind DocNameI
_) Doc
d = Doc
d
parens_if_kind (HsBndrKind XBndrKind DocNameI
_ LHsType DocNameI
_) Doc
d = Doc -> Doc
parens Doc
d

ppLKind :: Bool -> LHsKind DocNameI -> LaTeX
ppLKind :: Bool -> LHsType DocNameI -> Doc
ppLKind Bool
unicode LHsType DocNameI
y = Bool -> HsType DocNameI -> Doc
ppKind Bool
unicode (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsType DocNameI
GenLocated SrcSpanAnnA (HsType DocNameI)
y)

ppKind :: Bool -> HsKind DocNameI -> LaTeX
ppKind :: Bool -> HsType DocNameI -> Doc
ppKind Bool
unicode HsType DocNameI
ki = HsType DocNameI -> Bool -> Doc
ppr_mono_ty (Precedence -> HsType DocNameI -> HsType DocNameI
forall a. XRecCond a => Precedence -> HsType a -> HsType a
reparenTypePrec Precedence
PREC_TOP HsType DocNameI
ki) Bool
unicode

-- Drop top-level for-all type variables in user style
-- since they are implicit in Haskell

ppr_sig_ty :: HsSigType DocNameI -> Bool -> LaTeX
ppr_sig_ty :: HsSigType DocNameI -> Bool -> Doc
ppr_sig_ty (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs = HsOuterSigTyVarBndrs DocNameI
outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body = LHsType DocNameI
ltype}) Bool
unicode =
  [Doc] -> Doc
sep
    [ HsOuterSigTyVarBndrs DocNameI -> Bool -> Doc
forall flag.
RenderableBndrFlag flag =>
HsOuterTyVarBndrs flag DocNameI -> Bool -> Doc
ppHsOuterTyVarBndrs HsOuterSigTyVarBndrs DocNameI
outer_bndrs Bool
unicode
    , LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ltype Bool
unicode
    ]

ppr_mono_lty :: LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty :: LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty Bool
unicode = HsType DocNameI -> Bool -> Doc
ppr_mono_ty (GenLocated SrcSpanAnnA (HsType DocNameI) -> HsType DocNameI
forall l e. GenLocated l e -> e
unLoc LHsType DocNameI
GenLocated SrcSpanAnnA (HsType DocNameI)
ty) Bool
unicode

ppr_mono_ty :: HsType DocNameI -> Bool -> LaTeX
ppr_mono_ty :: HsType DocNameI -> Bool -> Doc
ppr_mono_ty (HsForAllTy XForAllTy DocNameI
_ HsForAllTelescope DocNameI
tele LHsType DocNameI
ty) Bool
unicode =
  [Doc] -> Doc
sep
    [ HsForAllTelescope DocNameI -> Bool -> Doc
ppHsForAllTelescope HsForAllTelescope DocNameI
tele Bool
unicode
    , LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty Bool
unicode
    ]
ppr_mono_ty (HsQualTy XQualTy DocNameI
_ LHsContext DocNameI
ctxt LHsType DocNameI
ty) Bool
unicode =
  [Doc] -> Doc
sep
    [ Maybe (LHsContext DocNameI) -> Bool -> Doc
ppLContext (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
-> Maybe
     (GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)])
forall a. a -> Maybe a
Just LHsContext DocNameI
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType DocNameI)]
ctxt) Bool
unicode
    , LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty Bool
unicode
    ]
ppr_mono_ty (HsFunTy XFunTy DocNameI
_ HsArrow DocNameI
mult LHsType DocNameI
ty1 LHsType DocNameI
ty2) Bool
u =
  [Doc] -> Doc
sep
    [ LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty1 Bool
u
    , Doc
arr Doc -> Doc -> Doc
<+> LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty2 Bool
u
    ]
  where
    arr :: Doc
arr = case HsArrow DocNameI
mult of
      HsLinearArrow XLinearArrow (LHsType DocNameI) DocNameI
_ -> Bool -> Doc
lollipop Bool
u
      HsUnrestrictedArrow XUnrestrictedArrow (LHsType DocNameI) DocNameI
_ -> Bool -> Doc
arrow Bool
u
      HsExplicitMult XExplicitMult (LHsType DocNameI) DocNameI
_ LHsType DocNameI
m -> Doc
multAnnotation Doc -> Doc -> Doc
<> LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
m Bool
u Doc -> Doc -> Doc
<+> Bool -> Doc
arrow Bool
u
ppr_mono_ty (HsBangTy XBangTy DocNameI
_ HsBang
b LHsType DocNameI
ty) Bool
u = HsBang -> Doc
ppBang HsBang
b Doc -> Doc -> Doc
<> Bool -> LHsType DocNameI -> Doc
ppLParendType Bool
u LHsType DocNameI
ty
ppr_mono_ty (HsTyVar XTyVar DocNameI
_ PromotionFlag
NotPromoted (L SrcSpanAnnN
_ DocName
name)) Bool
_ = DocName -> Doc
ppDocName DocName
name
ppr_mono_ty (HsTyVar XTyVar DocNameI
_ PromotionFlag
IsPromoted (L SrcSpanAnnN
_ DocName
name)) Bool
_ = Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<> DocName -> Doc
ppDocName DocName
name
ppr_mono_ty (HsTupleTy XTupleTy DocNameI
_ HsTupleSort
con [LHsType DocNameI]
tys) Bool
u = HsTupleSort -> [Doc] -> Doc
tupleParens HsTupleSort
con ((GenLocated SrcSpanAnnA (HsType DocNameI) -> Doc)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> Doc
ppLType Bool
u) [LHsType DocNameI]
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys)
ppr_mono_ty (HsSumTy XSumTy DocNameI
_ [LHsType DocNameI]
tys) Bool
u = [Doc] -> Doc
sumParens ((GenLocated SrcSpanAnnA (HsType DocNameI) -> Doc)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> Doc
ppLType Bool
u) [LHsType DocNameI]
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys)
ppr_mono_ty (HsKindSig XKindSig DocNameI
_ LHsType DocNameI
ty LHsType DocNameI
kind) Bool
u = Doc -> Doc
parens (LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty Bool
u Doc -> Doc -> Doc
<+> Bool -> Doc
dcolon Bool
u Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLKind Bool
u LHsType DocNameI
kind)
ppr_mono_ty (HsListTy XListTy DocNameI
_ LHsType DocNameI
ty) Bool
u = Doc -> Doc
brackets (LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty Bool
u)
ppr_mono_ty (HsIParamTy XIParamTy DocNameI
_ (L EpAnn NoEpAnns
_ HsIPName
n) LHsType DocNameI
ty) Bool
u = HsIPName -> Doc
ppIPName HsIPName
n Doc -> Doc -> Doc
<+> Bool -> Doc
dcolon Bool
u Doc -> Doc -> Doc
<+> LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty Bool
u
ppr_mono_ty (HsSpliceTy XSpliceTy DocNameI
v HsUntypedSplice DocNameI
_) Bool
_ = DataConCantHappen -> Doc
forall a. DataConCantHappen -> a
dataConCantHappen XSpliceTy DocNameI
DataConCantHappen
v
ppr_mono_ty (HsRecTy{}) Bool
_ = FilePath -> Doc
text FilePath
"{..}"
ppr_mono_ty (XHsType{}) Bool
_ = FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error FilePath
"ppr_mono_ty HsCoreTy"
ppr_mono_ty (HsExplicitListTy XExplicitListTy DocNameI
_ PromotionFlag
IsPromoted [LHsType DocNameI]
tys) Bool
u = Doc -> Doc
Pretty.quote (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType DocNameI) -> Doc)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> Doc
ppLType Bool
u) [LHsType DocNameI]
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys
ppr_mono_ty (HsExplicitListTy XExplicitListTy DocNameI
_ PromotionFlag
NotPromoted [LHsType DocNameI]
tys) Bool
u = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType DocNameI) -> Doc)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> Doc
ppLType Bool
u) [LHsType DocNameI]
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys
ppr_mono_ty (HsExplicitTupleTy XExplicitTupleTy DocNameI
_ [LHsType DocNameI]
tys) Bool
u = Doc -> Doc
Pretty.quote (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
parenList ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType DocNameI) -> Doc)
-> [GenLocated SrcSpanAnnA (HsType DocNameI)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> Doc
ppLType Bool
u) [LHsType DocNameI]
[GenLocated SrcSpanAnnA (HsType DocNameI)]
tys
ppr_mono_ty (HsAppTy XAppTy DocNameI
_ LHsType DocNameI
fun_ty LHsType DocNameI
arg_ty) Bool
unicode =
  [Doc] -> Doc
hsep [LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
fun_ty Bool
unicode, LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
arg_ty Bool
unicode]
ppr_mono_ty (HsAppKindTy XAppKindTy DocNameI
_ LHsType DocNameI
fun_ty LHsType DocNameI
arg_ki) Bool
unicode =
  [Doc] -> Doc
hsep [LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
fun_ty Bool
unicode, Doc
atSign Doc -> Doc -> Doc
<> LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
arg_ki Bool
unicode]
ppr_mono_ty (HsOpTy XOpTy DocNameI
_ PromotionFlag
prom LHsType DocNameI
ty1 LIdP DocNameI
op LHsType DocNameI
ty2) Bool
unicode =
  LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty1 Bool
unicode Doc -> Doc -> Doc
<+> Doc
ppr_op_prom Doc -> Doc -> Doc
<+> LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty2 Bool
unicode
  where
    ppr_op_prom :: Doc
ppr_op_prom
      | PromotionFlag -> Bool
isPromoted PromotionFlag
prom =
          Char -> Doc
char Char
'\'' Doc -> Doc -> Doc
<> Doc
ppr_op
      | Bool
otherwise =
          Doc
ppr_op
    ppr_op :: Doc
ppr_op
      | OccName -> Bool
isSymOcc (GenLocated SrcSpanAnnN DocName -> OccName
forall a. NamedThing a => a -> OccName
getOccName LIdP DocNameI
GenLocated SrcSpanAnnN DocName
op) = GenLocated SrcSpanAnnN DocName -> Doc
forall l. GenLocated l DocName -> Doc
ppLDocName LIdP DocNameI
GenLocated SrcSpanAnnN DocName
op
      | Bool
otherwise = Char -> Doc
char Char
'`' Doc -> Doc -> Doc
<> GenLocated SrcSpanAnnN DocName -> Doc
forall l. GenLocated l DocName -> Doc
ppLDocName LIdP DocNameI
GenLocated SrcSpanAnnN DocName
op Doc -> Doc -> Doc
<> Char -> Doc
char Char
'`'
ppr_mono_ty (HsParTy XParTy DocNameI
_ LHsType DocNameI
ty) Bool
unicode =
  Doc -> Doc
parens (LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty Bool
unicode)
--  = ppr_mono_lty ty unicode

ppr_mono_ty (HsDocTy XDocTy DocNameI
_ LHsType DocNameI
ty LHsDoc DocNameI
_) Bool
unicode =
  LHsType DocNameI -> Bool -> Doc
ppr_mono_lty LHsType DocNameI
ty Bool
unicode
ppr_mono_ty (HsWildCardTy XWildCardTy DocNameI
_) Bool
_ = Char -> Doc
char Char
'_'
ppr_mono_ty (HsTyLit XTyLit DocNameI
_ HsTyLit DocNameI
t) Bool
u = HsTyLit DocNameI -> Bool -> Doc
ppr_tylit HsTyLit DocNameI
t Bool
u
ppr_mono_ty (HsStarTy XStarTy DocNameI
_ Bool
isUni) Bool
unicode = Bool -> Doc
starSymbol (Bool
isUni Bool -> Bool -> Bool
|| Bool
unicode)

ppr_tylit :: HsTyLit DocNameI -> Bool -> LaTeX
ppr_tylit :: HsTyLit DocNameI -> Bool -> Doc
ppr_tylit (HsNumTy XNumTy DocNameI
_ Integer
n) Bool
_ = Integer -> Doc
integer Integer
n
ppr_tylit (HsStrTy XStrTy DocNameI
_ FastString
s) Bool
_ = FilePath -> Doc
text (FastString -> FilePath
forall a. Show a => a -> FilePath
show FastString
s)
ppr_tylit (HsCharTy XCharTy DocNameI
_ Char
c) Bool
_ = FilePath -> Doc
text (Char -> FilePath
forall a. Show a => a -> FilePath
show Char
c)

-- XXX: Ok in verbatim, but not otherwise
-- XXX: Do something with Unicode parameter?

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

-- * Names

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

ppBinder :: OccName -> LaTeX
ppBinder :: OccName -> Doc
ppBinder OccName
n
  | OccName -> Bool
isSymOcc OccName
n = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ OccName -> Doc
ppOccName OccName
n
  | Bool
otherwise = OccName -> Doc
ppOccName OccName
n

ppBinderInfix :: OccName -> LaTeX
ppBinderInfix :: OccName -> Doc
ppBinderInfix OccName
n
  | OccName -> Bool
isSymOcc OccName
n = OccName -> Doc
ppOccName OccName
n
  | Bool
otherwise = [Doc] -> Doc
cat [Char -> Doc
char Char
'`', OccName -> Doc
ppOccName OccName
n, Char -> Doc
char Char
'`']

ppSymName :: Name -> LaTeX
ppSymName :: Name -> Doc
ppSymName Name
name
  | Name -> Bool
isNameSym Name
name = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Name -> Doc
ppName Name
name
  | Bool
otherwise = Name -> Doc
ppName Name
name

ppWcSymName :: Maybe Name -> LaTeX
ppWcSymName :: Maybe Name -> Doc
ppWcSymName = Doc -> (Name -> Doc) -> Maybe Name -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> Doc
char Char
'_') Name -> Doc
ppSymName

ppIPName :: HsIPName -> LaTeX
ppIPName :: HsIPName -> Doc
ppIPName = FilePath -> Doc
text (FilePath -> Doc) -> (HsIPName -> FilePath) -> HsIPName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'?' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:) (FilePath -> FilePath)
-> (HsIPName -> FilePath) -> HsIPName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> FilePath
unpackFS (FastString -> FilePath)
-> (HsIPName -> FastString) -> HsIPName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsIPName -> FastString
hsIPNameFS

ppOccName :: OccName -> LaTeX
ppOccName :: OccName -> Doc
ppOccName = FilePath -> Doc
text (FilePath -> Doc) -> (OccName -> FilePath) -> OccName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FilePath
occNameString

ppDocName :: DocName -> LaTeX
ppDocName :: DocName -> Doc
ppDocName = OccName -> Doc
ppOccName (OccName -> Doc) -> (DocName -> OccName) -> DocName -> Doc
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

ppLDocName :: GenLocated l DocName -> LaTeX
ppLDocName :: forall l. GenLocated l DocName -> Doc
ppLDocName (L l
_ DocName
d) = DocName -> Doc
ppDocName DocName
d

ppDocBinder :: DocName -> LaTeX
ppDocBinder :: DocName -> Doc
ppDocBinder = OccName -> Doc
ppBinder (OccName -> Doc) -> (DocName -> OccName) -> DocName -> Doc
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

ppName :: Name -> LaTeX
ppName :: Name -> Doc
ppName = OccName -> Doc
ppOccName (OccName -> Doc) -> (Name -> OccName) -> Name -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName

latexFilter :: String -> String
latexFilter :: FilePath -> FilePath
latexFilter = (Char -> FilePath -> FilePath) -> FilePath -> FilePath -> FilePath
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> FilePath -> FilePath
latexMunge FilePath
""

latexMonoFilter :: String -> String
latexMonoFilter :: FilePath -> FilePath
latexMonoFilter = (Char -> FilePath -> FilePath) -> FilePath -> FilePath -> FilePath
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> FilePath -> FilePath
latexMonoMunge FilePath
""

latexMunge :: Char -> String -> String
latexMunge :: Char -> FilePath -> FilePath
latexMunge Char
'#' FilePath
s = FilePath
"{\\char '43}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'$' FilePath
s = FilePath
"{\\char '44}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'%' FilePath
s = FilePath
"{\\char '45}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'&' FilePath
s = FilePath
"{\\char '46}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'~' FilePath
s = FilePath
"{\\char '176}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'_' FilePath
s = FilePath
"{\\char '137}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'^' FilePath
s = FilePath
"{\\char '136}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'\\' FilePath
s = FilePath
"{\\char '134}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'{' FilePath
s = FilePath
"{\\char '173}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'}' FilePath
s = FilePath
"{\\char '175}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
'[' FilePath
s = FilePath
"{\\char 91}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
']' FilePath
s = FilePath
"{\\char 93}" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMunge Char
c FilePath
s = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
s

latexMonoMunge :: Char -> String -> String
latexMonoMunge :: Char -> FilePath -> FilePath
latexMonoMunge Char
' ' (Char
' ' : FilePath
s) = FilePath
"\\ \\ " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMonoMunge Char
' ' (Char
'\\' : Char
' ' : FilePath
s) = FilePath
"\\ \\ " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
latexMonoMunge Char
'\n' FilePath
s = Char
'\\' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Char
'\\' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
s
latexMonoMunge Char
c FilePath
s = Char -> FilePath -> FilePath
latexMunge Char
c FilePath
s

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

-- * Doc Markup

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

latexMarkup :: HasOccName a => DocMarkup (Wrap a) (StringContext -> LaTeX -> LaTeX)
latexMarkup :: forall a.
HasOccName a =>
DocMarkup (Wrap a) (StringContext -> Doc -> Doc)
latexMarkup =
  Markup
    { markupParagraph :: (StringContext -> Doc -> Doc) -> StringContext -> Doc -> Doc
markupParagraph = \StringContext -> Doc -> Doc
p StringContext
v -> Doc -> Doc -> Doc
blockElem (StringContext -> Doc -> Doc
p StringContext
v (FilePath -> Doc
text FilePath
"\\par"))
    , markupEmpty :: StringContext -> Doc -> Doc
markupEmpty = \StringContext
_ -> Doc -> Doc
forall a. a -> a
id
    , markupString :: FilePath -> StringContext -> Doc -> Doc
markupString = \FilePath
s StringContext
v -> Doc -> Doc -> Doc
inlineElem (FilePath -> Doc
text (StringContext -> FilePath -> FilePath
fixString StringContext
v FilePath
s))
    , markupAppend :: (StringContext -> Doc -> Doc)
-> (StringContext -> Doc -> Doc) -> StringContext -> Doc -> Doc
markupAppend = \StringContext -> Doc -> Doc
l StringContext -> Doc -> Doc
r StringContext
v -> StringContext -> Doc -> Doc
l StringContext
v (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringContext -> Doc -> Doc
r StringContext
v
    , markupIdentifier :: Wrap a -> StringContext -> Doc -> Doc
markupIdentifier = \Wrap a
i StringContext
v -> Doc -> Doc -> Doc
inlineElem (StringContext -> Wrap OccName -> Doc
markupId StringContext
v ((a -> OccName) -> Wrap a -> Wrap OccName
forall a b. (a -> b) -> Wrap a -> Wrap b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> OccName
forall name. HasOccName name => name -> OccName
occName Wrap a
i))
    , markupIdentifierUnchecked :: Wrap (ModuleName, OccName) -> StringContext -> Doc -> Doc
markupIdentifierUnchecked = \Wrap (ModuleName, OccName)
i StringContext
v -> Doc -> Doc -> Doc
inlineElem (StringContext -> Wrap OccName -> Doc
markupId StringContext
v (((ModuleName, OccName) -> OccName)
-> Wrap (ModuleName, OccName) -> Wrap OccName
forall a b. (a -> b) -> Wrap a -> Wrap b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModuleName, OccName) -> OccName
forall a b. (a, b) -> b
snd Wrap (ModuleName, OccName)
i))
    , markupModule :: ModLink (StringContext -> Doc -> Doc)
-> StringContext -> Doc -> Doc
markupModule =
        \(ModLink FilePath
m Maybe (StringContext -> Doc -> Doc)
mLabel) StringContext
v ->
          case Maybe (StringContext -> Doc -> Doc)
mLabel of
            Just StringContext -> Doc -> Doc
lbl -> Doc -> Doc -> Doc
inlineElem (Doc -> Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
tt (Doc -> Doc -> Doc) -> Doc -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ StringContext -> Doc -> Doc
lbl StringContext
v Doc
empty
            Maybe (StringContext -> Doc -> Doc)
Nothing ->
              Doc -> Doc -> Doc
inlineElem
                ( let (FilePath
mdl, FilePath
_ref) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') FilePath
m
                   in (Doc -> Doc
tt (FilePath -> Doc
text FilePath
mdl))
                )
    , markupWarning :: (StringContext -> Doc -> Doc) -> StringContext -> Doc -> Doc
markupWarning = \StringContext -> Doc -> Doc
p StringContext
v -> StringContext -> Doc -> Doc
p StringContext
v
    , markupEmphasis :: (StringContext -> Doc -> Doc) -> StringContext -> Doc -> Doc
markupEmphasis = \StringContext -> Doc -> Doc
p StringContext
v -> Doc -> Doc -> Doc
inlineElem (Doc -> Doc
emph (StringContext -> Doc -> Doc
p StringContext
v Doc
empty))
    , markupBold :: (StringContext -> Doc -> Doc) -> StringContext -> Doc -> Doc
markupBold = \StringContext -> Doc -> Doc
p StringContext
v -> Doc -> Doc -> Doc
inlineElem (Doc -> Doc
bold (StringContext -> Doc -> Doc
p StringContext
v Doc
empty))
    , markupMonospaced :: (StringContext -> Doc -> Doc) -> StringContext -> Doc -> Doc
markupMonospaced = \StringContext -> Doc -> Doc
p StringContext
v -> Doc -> Doc -> Doc
inlineElem ((StringContext -> Doc -> Doc) -> StringContext -> Doc
markupMonospace StringContext -> Doc -> Doc
p StringContext
v)
    , markupUnorderedList :: [StringContext -> Doc -> Doc] -> StringContext -> Doc -> Doc
markupUnorderedList = \[StringContext -> Doc -> Doc]
p StringContext
v -> Doc -> Doc -> Doc
blockElem ([Doc] -> Doc
itemizedList (((StringContext -> Doc -> Doc) -> Doc)
-> [StringContext -> Doc -> Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\StringContext -> Doc -> Doc
p' -> StringContext -> Doc -> Doc
p' StringContext
v Doc
empty) [StringContext -> Doc -> Doc]
p))
    , markupPic :: Picture -> StringContext -> Doc -> Doc
markupPic = \Picture
p StringContext
_ -> Doc -> Doc -> Doc
inlineElem (Picture -> Doc
markupPic Picture
p)
    , markupMathInline :: FilePath -> StringContext -> Doc -> Doc
markupMathInline = \FilePath
p StringContext
_ -> Doc -> Doc -> Doc
inlineElem (FilePath -> Doc
markupMathInline FilePath
p)
    , markupMathDisplay :: FilePath -> StringContext -> Doc -> Doc
markupMathDisplay = \FilePath
p StringContext
_ -> Doc -> Doc -> Doc
blockElem (FilePath -> Doc
markupMathDisplay FilePath
p)
    , markupOrderedList :: [(Int, StringContext -> Doc -> Doc)] -> StringContext -> Doc -> Doc
markupOrderedList = \[(Int, StringContext -> Doc -> Doc)]
p StringContext
v -> Doc -> Doc -> Doc
blockElem ([Doc] -> Doc
enumeratedList (((Int, StringContext -> Doc -> Doc) -> Doc)
-> [(Int, StringContext -> Doc -> Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, StringContext -> Doc -> Doc
p') -> StringContext -> Doc -> Doc
p' StringContext
v Doc
empty) [(Int, StringContext -> Doc -> Doc)]
p))
    , markupDefList :: [(StringContext -> Doc -> Doc, StringContext -> Doc -> Doc)]
-> StringContext -> Doc -> Doc
markupDefList = \[(StringContext -> Doc -> Doc, StringContext -> Doc -> Doc)]
l StringContext
v -> Doc -> Doc -> Doc
blockElem ([(Doc, Doc)] -> Doc
descriptionList (((StringContext -> Doc -> Doc, StringContext -> Doc -> Doc)
 -> (Doc, Doc))
-> [(StringContext -> Doc -> Doc, StringContext -> Doc -> Doc)]
-> [(Doc, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map (\(StringContext -> Doc -> Doc
a, StringContext -> Doc -> Doc
b) -> (StringContext -> Doc -> Doc
a StringContext
v Doc
empty, StringContext -> Doc -> Doc
b StringContext
v Doc
empty)) [(StringContext -> Doc -> Doc, StringContext -> Doc -> Doc)]
l))
    , markupCodeBlock :: (StringContext -> Doc -> Doc) -> StringContext -> Doc -> Doc
markupCodeBlock = \StringContext -> Doc -> Doc
p StringContext
_ -> Doc -> Doc -> Doc
blockElem (Doc -> Doc
quote (Doc -> Doc
verb (StringContext -> Doc -> Doc
p StringContext
Verb Doc
empty)))
    , markupHyperlink :: Hyperlink (StringContext -> Doc -> Doc)
-> StringContext -> Doc -> Doc
markupHyperlink = \(Hyperlink FilePath
u Maybe (StringContext -> Doc -> Doc)
l) StringContext
v -> Doc -> Doc -> Doc
inlineElem (FilePath -> Maybe Doc -> Doc
markupLink FilePath
u (((StringContext -> Doc -> Doc) -> Doc)
-> Maybe (StringContext -> Doc -> Doc) -> Maybe Doc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\StringContext -> Doc -> Doc
x -> StringContext -> Doc -> Doc
x StringContext
v Doc
empty) Maybe (StringContext -> Doc -> Doc)
l))
    , markupAName :: FilePath -> StringContext -> Doc -> Doc
markupAName = \FilePath
_ StringContext
_ -> Doc -> Doc
forall a. a -> a
id -- TODO
    , markupProperty :: FilePath -> StringContext -> Doc -> Doc
markupProperty = \FilePath
p StringContext
_ -> Doc -> Doc -> Doc
blockElem (Doc -> Doc
quote (Doc -> Doc
verb (FilePath -> Doc
text FilePath
p)))
    , markupExample :: [Example] -> StringContext -> Doc -> Doc
markupExample = \[Example]
e StringContext
_ -> Doc -> Doc -> Doc
blockElem (Doc -> Doc
quote (Doc -> Doc
verb (FilePath -> Doc
text (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (Example -> FilePath) -> [Example] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Example -> FilePath
exampleToString [Example]
e)))
    , markupHeader :: Header (StringContext -> Doc -> Doc) -> StringContext -> Doc -> Doc
markupHeader = \(Header Int
l StringContext -> Doc -> Doc
h) StringContext
p -> Doc -> Doc -> Doc
blockElem (Int -> Doc -> Doc
forall {a}. (Num a, Ord a, Show a) => a -> Doc -> Doc
header Int
l (StringContext -> Doc -> Doc
h StringContext
p Doc
empty))
    , markupTable :: Table (StringContext -> Doc -> Doc) -> StringContext -> Doc -> Doc
markupTable = \(Table [TableRow (StringContext -> Doc -> Doc)]
h [TableRow (StringContext -> Doc -> Doc)]
b) StringContext
p -> Doc -> Doc -> Doc
blockElem ([TableRow (StringContext -> Doc -> Doc)]
-> [TableRow (StringContext -> Doc -> Doc)] -> StringContext -> Doc
forall {p} {p} {p}. p -> p -> p -> Doc
table [TableRow (StringContext -> Doc -> Doc)]
h [TableRow (StringContext -> Doc -> Doc)]
b StringContext
p)
    }
  where
    blockElem :: LaTeX -> LaTeX -> LaTeX
    blockElem :: Doc -> Doc -> Doc
blockElem = Doc -> Doc -> Doc
($$)

    inlineElem :: LaTeX -> LaTeX -> LaTeX
    inlineElem :: Doc -> Doc -> Doc
inlineElem = Doc -> Doc -> Doc
(<>)

    header :: a -> Doc -> Doc
header a
1 Doc
d = FilePath -> Doc
text FilePath
"\\section*" Doc -> Doc -> Doc
<> Doc -> Doc
braces Doc
d
    header a
2 Doc
d = FilePath -> Doc
text FilePath
"\\subsection*" Doc -> Doc -> Doc
<> Doc -> Doc
braces Doc
d
    header a
l Doc
d
      | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
&& a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
6 = FilePath -> Doc
text FilePath
"\\subsubsection*" Doc -> Doc -> Doc
<> Doc -> Doc
braces Doc
d
    header a
l Doc
_ = FilePath -> Doc
forall a. HasCallStack => FilePath -> a
error (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath
"impossible header level in LaTeX generation: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
l

    table :: p -> p -> p -> Doc
table p
_ p
_ p
_ = FilePath -> Doc
text FilePath
"{TODO: Table}"

    fixString :: StringContext -> FilePath -> FilePath
fixString StringContext
Plain FilePath
s = FilePath -> FilePath
latexFilter FilePath
s
    fixString StringContext
Verb FilePath
s = FilePath
s
    fixString StringContext
Mono FilePath
s = FilePath -> FilePath
latexMonoFilter FilePath
s

    markupMonospace :: (StringContext -> Doc -> Doc) -> StringContext -> Doc
markupMonospace StringContext -> Doc -> Doc
p StringContext
Verb = StringContext -> Doc -> Doc
p StringContext
Verb Doc
empty
    markupMonospace StringContext -> Doc -> Doc
p StringContext
_ = Doc -> Doc
tt (StringContext -> Doc -> Doc
p StringContext
Mono Doc
empty)

    markupLink :: FilePath -> Maybe Doc -> Doc
markupLink FilePath
url Maybe Doc
mLabel = case Maybe Doc
mLabel of
      Just Doc
label -> FilePath -> Doc
text FilePath
"\\href" Doc -> Doc -> Doc
<> Doc -> Doc
braces (FilePath -> Doc
text FilePath
url) Doc -> Doc -> Doc
<> Doc -> Doc
braces Doc
label
      Maybe Doc
Nothing -> FilePath -> Doc
text FilePath
"\\url" Doc -> Doc -> Doc
<> Doc -> Doc
braces (FilePath -> Doc
text FilePath
url)

    -- Is there a better way of doing this? Just a space is an arbitrary choice.
    markupPic :: Picture -> Doc
markupPic (Picture FilePath
uri Maybe FilePath
title) = Doc -> Doc
parens (Maybe FilePath -> Doc
imageText Maybe FilePath
title)
      where
        imageText :: Maybe FilePath -> Doc
imageText Maybe FilePath
Nothing = Doc
beg
        imageText (Just FilePath
t) = Doc
beg Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
" " Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
t

        beg :: Doc
beg = FilePath -> Doc
text FilePath
"image: " Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
uri

    markupMathInline :: FilePath -> Doc
markupMathInline FilePath
mathjax = FilePath -> Doc
text FilePath
"\\(" Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
mathjax Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
"\\)"

    markupMathDisplay :: FilePath -> Doc
markupMathDisplay FilePath
mathjax = FilePath -> Doc
text FilePath
"\\[" Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
mathjax Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
"\\]"

    markupId :: StringContext -> Wrap OccName -> Doc
markupId StringContext
v Wrap OccName
wrappedOcc =
      case StringContext
v of
        StringContext
Verb -> FilePath -> Doc
text FilePath
i
        StringContext
Mono -> FilePath -> Doc
text FilePath
"\\haddockid" Doc -> Doc -> Doc
<> Doc -> Doc
braces (FilePath -> Doc
text (FilePath -> Doc) -> (FilePath -> FilePath) -> FilePath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
latexMonoFilter (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath
i)
        StringContext
Plain -> FilePath -> Doc
text FilePath
"\\haddockid" Doc -> Doc -> Doc
<> Doc -> Doc
braces (FilePath -> Doc
text (FilePath -> Doc) -> (FilePath -> FilePath) -> FilePath -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
latexFilter (FilePath -> Doc) -> FilePath -> Doc
forall a b. (a -> b) -> a -> b
$ FilePath
i)
      where
        i :: FilePath
i = (OccName -> FilePath) -> Wrap OccName -> FilePath
forall a. (a -> FilePath) -> Wrap a -> FilePath
showWrapped OccName -> FilePath
occNameString Wrap OccName
wrappedOcc

docToLaTeX :: Doc DocName -> LaTeX
docToLaTeX :: Doc DocName -> Doc
docToLaTeX Doc DocName
doc = DocMarkupH
  (Wrap (ModuleName, OccName))
  (Wrap DocName)
  (StringContext -> Doc -> Doc)
-> Doc DocName -> StringContext -> Doc -> Doc
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup DocMarkupH
  (Wrap (ModuleName, OccName))
  (Wrap DocName)
  (StringContext -> Doc -> Doc)
forall a.
HasOccName a =>
DocMarkup (Wrap a) (StringContext -> Doc -> Doc)
latexMarkup Doc DocName
doc StringContext
Plain Doc
empty

documentationToLaTeX :: Documentation DocName -> Maybe LaTeX
documentationToLaTeX :: Documentation DocName -> Maybe Doc
documentationToLaTeX = (Doc DocName -> Doc) -> Maybe (Doc DocName) -> Maybe Doc
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc DocName -> Doc
docToLaTeX (Maybe (Doc DocName) -> Maybe Doc)
-> (Documentation DocName -> Maybe (Doc DocName))
-> Documentation DocName
-> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap MDoc DocName -> Doc DocName
forall mod id. MetaDoc mod id -> DocH mod id
_doc (Maybe (MDoc DocName) -> Maybe (Doc DocName))
-> (Documentation DocName -> Maybe (MDoc DocName))
-> Documentation DocName
-> Maybe (Doc DocName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Documentation DocName -> Maybe (MDoc DocName)
forall name. Documentation name -> Maybe (MDoc name)
combineDocumentation

rdrDocToLaTeX :: Doc RdrName -> LaTeX
rdrDocToLaTeX :: Doc RdrName -> Doc
rdrDocToLaTeX Doc RdrName
doc = DocMarkupH
  (Wrap (ModuleName, OccName))
  (Wrap RdrName)
  (StringContext -> Doc -> Doc)
-> Doc RdrName -> StringContext -> Doc -> Doc
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup DocMarkupH
  (Wrap (ModuleName, OccName))
  (Wrap RdrName)
  (StringContext -> Doc -> Doc)
forall a.
HasOccName a =>
DocMarkup (Wrap a) (StringContext -> Doc -> Doc)
latexMarkup Doc RdrName
doc StringContext
Plain Doc
empty

data StringContext
  = -- | all special characters have to be escape
    Plain
  | -- | on top of special characters, escape space characters
    Mono
  | -- | don't escape anything
    Verb

latexStripTrailingWhitespace :: Doc a -> Doc a
latexStripTrailingWhitespace :: forall a. Doc a -> Doc a
latexStripTrailingWhitespace (DocString FilePath
s)
  | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null FilePath
s' = DocH (Wrap (ModuleName, OccName)) (Wrap a)
forall mod id. DocH mod id
DocEmpty
  | Bool
otherwise = FilePath -> DocH (Wrap (ModuleName, OccName)) (Wrap a)
forall mod id. FilePath -> DocH mod id
DocString FilePath
s
  where
    s' :: FilePath
s' = FilePath -> FilePath
forall a. [a] -> [a]
reverse ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
s))
latexStripTrailingWhitespace (DocAppend DocH (Wrap (ModuleName, OccName)) (Wrap a)
l DocH (Wrap (ModuleName, OccName)) (Wrap a)
r)
  | DocH (Wrap (ModuleName, OccName)) (Wrap a)
DocEmpty <- DocH (Wrap (ModuleName, OccName)) (Wrap a)
r' = DocH (Wrap (ModuleName, OccName)) (Wrap a)
-> DocH (Wrap (ModuleName, OccName)) (Wrap a)
forall a. Doc a -> Doc a
latexStripTrailingWhitespace DocH (Wrap (ModuleName, OccName)) (Wrap a)
l
  | Bool
otherwise = DocH (Wrap (ModuleName, OccName)) (Wrap a)
-> DocH (Wrap (ModuleName, OccName)) (Wrap a)
-> DocH (Wrap (ModuleName, OccName)) (Wrap a)
forall mod id. DocH mod id -> DocH mod id -> DocH mod id
DocAppend DocH (Wrap (ModuleName, OccName)) (Wrap a)
l DocH (Wrap (ModuleName, OccName)) (Wrap a)
r'
  where
    r' :: DocH (Wrap (ModuleName, OccName)) (Wrap a)
r' = DocH (Wrap (ModuleName, OccName)) (Wrap a)
-> DocH (Wrap (ModuleName, OccName)) (Wrap a)
forall a. Doc a -> Doc a
latexStripTrailingWhitespace DocH (Wrap (ModuleName, OccName)) (Wrap a)
r
latexStripTrailingWhitespace (DocParagraph DocH (Wrap (ModuleName, OccName)) (Wrap a)
p) =
  DocH (Wrap (ModuleName, OccName)) (Wrap a)
-> DocH (Wrap (ModuleName, OccName)) (Wrap a)
forall a. Doc a -> Doc a
latexStripTrailingWhitespace DocH (Wrap (ModuleName, OccName)) (Wrap a)
p
latexStripTrailingWhitespace DocH (Wrap (ModuleName, OccName)) (Wrap a)
other = DocH (Wrap (ModuleName, OccName)) (Wrap a)
other

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

-- * LaTeX utils

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

itemizedList :: [LaTeX] -> LaTeX
itemizedList :: [Doc] -> Doc
itemizedList [Doc]
items =
  FilePath -> Doc
text FilePath
"\\vbox{\\begin{itemize}"
    Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Doc
text FilePath
"\\item" Doc -> Doc -> Doc
$$) [Doc]
items)
    Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{itemize}}"

enumeratedList :: [LaTeX] -> LaTeX
enumeratedList :: [Doc] -> Doc
enumeratedList [Doc]
items =
  FilePath -> Doc
text FilePath
"\\vbox{\\begin{enumerate}"
    Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Doc
text FilePath
"\\item " Doc -> Doc -> Doc
$$) [Doc]
items)
    Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{enumerate}}"

descriptionList :: [(LaTeX, LaTeX)] -> LaTeX
descriptionList :: [(Doc, Doc)] -> Doc
descriptionList [(Doc, Doc)]
items =
  FilePath -> Doc
text FilePath
"\\vbox{\\begin{description}"
    Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (((Doc, Doc) -> Doc) -> [(Doc, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(Doc
a, Doc
b) -> FilePath -> Doc
text FilePath
"\\item" Doc -> Doc -> Doc
<> Doc -> Doc
brackets Doc
a Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
"\\hfill \\par" Doc -> Doc -> Doc
$$ Doc
b) [(Doc, Doc)]
items)
    Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{description}}"

tt :: LaTeX -> LaTeX
tt :: Doc -> Doc
tt Doc
ltx = FilePath -> Doc
text FilePath
"\\haddocktt" Doc -> Doc -> Doc
<> Doc -> Doc
braces Doc
ltx

decltt :: LaTeX -> LaTeX
decltt :: Doc -> Doc
decltt Doc
ltx = FilePath -> Doc
text FilePath
"\\haddockdecltt" Doc -> Doc -> Doc
<> Doc -> Doc
braces (FilePath -> Doc
text FilePath
filtered)
  where
    filtered :: FilePath
filtered = FilePath -> FilePath
latexMonoFilter (Doc -> FilePath
latex2String Doc
ltx)

emph :: LaTeX -> LaTeX
emph :: Doc -> Doc
emph Doc
ltx = FilePath -> Doc
text FilePath
"\\emph" Doc -> Doc -> Doc
<> Doc -> Doc
braces Doc
ltx

bold :: LaTeX -> LaTeX
bold :: Doc -> Doc
bold Doc
ltx = FilePath -> Doc
text FilePath
"\\textbf" Doc -> Doc -> Doc
<> Doc -> Doc
braces Doc
ltx

-- TODO: @verbatim@ is too much since
--
--   * Haddock supports markup _inside_ of code blocks. Right now, the LaTeX
--     representing that markup gets printed verbatim
--   * Verbatim environments are not supported everywhere (example: not nested
--     inside a @tabulary@ environment)
verb :: LaTeX -> LaTeX
verb :: Doc -> Doc
verb Doc
doc = FilePath -> Doc
text FilePath
"{\\haddockverb\\begin{verbatim}" Doc -> Doc -> Doc
$$ Doc
doc Doc -> Doc -> Doc
<> FilePath -> Doc
text FilePath
"\\end{verbatim}}"

-- NB. swallow a trailing \n in the verbatim text by appending the
-- \end{verbatim} directly, otherwise we get spurious blank lines at the
-- end of code blocks.

quote :: LaTeX -> LaTeX
quote :: Doc -> Doc
quote Doc
doc = FilePath -> Doc
text FilePath
"\\begin{quote}" Doc -> Doc -> Doc
$$ Doc
doc Doc -> Doc -> Doc
$$ FilePath -> Doc
text FilePath
"\\end{quote}"

dcolon, arrow, lollipop, darrow, forallSymbol, starSymbol :: Bool -> LaTeX
dcolon :: Bool -> Doc
dcolon Bool
unicode = FilePath -> Doc
text (if Bool
unicode then FilePath
"∷" else FilePath
"::")
arrow :: Bool -> Doc
arrow Bool
unicode = FilePath -> Doc
text (if Bool
unicode then FilePath
"→" else FilePath
"->")
lollipop :: Bool -> Doc
lollipop Bool
unicode = FilePath -> Doc
text (if Bool
unicode then FilePath
"⊸" else FilePath
"%1 ->")
darrow :: Bool -> Doc
darrow Bool
unicode = FilePath -> Doc
text (if Bool
unicode then FilePath
"⇒" else FilePath
"=>")
forallSymbol :: Bool -> Doc
forallSymbol Bool
unicode = FilePath -> Doc
text (if Bool
unicode then FilePath
"∀" else FilePath
"forall")
starSymbol :: Bool -> Doc
starSymbol Bool
unicode = FilePath -> Doc
text (if Bool
unicode then FilePath
"★" else FilePath
"*")

atSign :: LaTeX
atSign :: Doc
atSign = Char -> Doc
char Char
'@'

multAnnotation :: LaTeX
multAnnotation :: Doc
multAnnotation = Char -> Doc
char Char
'%'

dot :: LaTeX
dot :: Doc
dot = Char -> Doc
char Char
'.'

parenList :: [LaTeX] -> LaTeX
parenList :: [Doc] -> Doc
parenList = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

ubxParenList :: [LaTeX] -> LaTeX
ubxParenList :: [Doc] -> Doc
ubxParenList = Doc -> Doc
ubxparens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma

ubxparens :: LaTeX -> LaTeX
ubxparens :: Doc -> Doc
ubxparens Doc
h = FilePath -> Doc
text FilePath
"(#" Doc -> Doc -> Doc
<+> Doc
h Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
"#)"

nl :: LaTeX
nl :: Doc
nl = FilePath -> Doc
text FilePath
"\\\\"

keyword :: String -> LaTeX
keyword :: FilePath -> Doc
keyword = FilePath -> Doc
text

infixr 4 <-> -- combining table cells
(<->) :: LaTeX -> LaTeX -> LaTeX
Doc
a <-> :: Doc -> Doc -> Doc
<-> Doc
b = Doc
a Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'&' Doc -> Doc -> Doc
<+> Doc
b