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

-----------------------------------------------------------------------------
-- |
-- 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 Documentation.Haddock.Markup
import Haddock.Doc (combineDocumentation)
import Haddock.Types
import Haddock.Utils
import Haddock.GhcUtils
import GHC.Utils.Ppr hiding (Doc, quote)
import qualified GHC.Utils.Ppr as Pretty

import GHC hiding (fromMaybeContext )
import GHC.Types.Name.Occurrence
import GHC.Types.Name        ( nameOccName, getOccString, tidyNameOcc )
import GHC.Types.Name.Reader ( rdrNameOcc )
import GHC.Core.Type         ( Specificity(..) )
import GHC.Data.FastString   ( unpackFS )

import qualified Data.Map as Map
import System.Directory
import System.FilePath
import Data.Char
import Control.Monad
import Data.Maybe
import Data.List            ( sort )
import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Foldable ( toList )
import Prelude hiding ((<>))

{- 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 :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
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 :: * -> *) (m :: * -> *) 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
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
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]
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
mdlModule -> [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 :: * -> *) 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]
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 :: * -> *) 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]
: (Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
ppSymName (LHsQTyVars DocNameI -> [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
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 :: * -> *) 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
nInt -> 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
nInt -> 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 -> [Name]
tyvarNames :: LHsQTyVars DocNameI -> [Name]
tyvarNames = (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)
 -> Name)
-> [GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)]
-> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name)
-> (GenLocated
      SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)
    -> DocName)
-> GenLocated
     SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr (HsBndrVis DocNameI) DocNameI -> DocName
GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)
-> DocName
forall flag. LHsTyVarBndr flag DocNameI -> DocName
hsLTyVarNameI) ([GenLocated
    SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)]
 -> [Name])
-> (LHsQTyVars DocNameI
    -> [GenLocated
          SrcSpanAnnA (HsTyVarBndr (HsBndrVis DocNameI) DocNameI)])
-> LHsQTyVars DocNameI
-> [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 :: * -> *) 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 :: * -> *) 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 -> [Name] -> Doc
ppAppDocNameNames Bool
summ DocName
n (LHsQTyVars DocNameI -> [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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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]
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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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] -> DocName
forall a. HasCallStack => [a] -> a
head [DocName]
names) [(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
            ]
            -- 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
iheadInstHead 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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]
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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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) -> FieldOcc DocNameI)
-> GenLocated SrcSpanAnnA (FieldOcc DocNameI) -> FieldOcc DocNameI
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (FieldOcc DocNameI)]
-> GenLocated SrcSpanAnnA (FieldOcc DocNameI)
forall a. HasCallStack => [a] -> a
head [LFieldOcc DocNameI]
[GenLocated SrcSpanAnnA (FieldOcc DocNameI)]
names) [(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 :: * -> *) 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 :: * -> *) 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 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 :: * -> *) 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 -> [Name] -> Doc
ppAppDocNameNames Bool
False DocName
name (LHsQTyVars DocNameI -> [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 -> [Name] -> LaTeX
ppAppDocNameNames :: Bool -> DocName -> [Name] -> Doc
ppAppDocNameNames Bool
_summ DocName
n [Name]
ns =
  DocName -> [Name] -> (DocName -> Doc) -> (Name -> Doc) -> Doc
forall a. DocName -> [a] -> (DocName -> Doc) -> (a -> Doc) -> Doc
ppTypeApp DocName
n [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) Name -> Doc
ppSymName


-- | 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 :: * -> *) 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
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 :: HsSrcBang -> LaTeX
ppBang :: HsSrcBang -> Doc
ppBang (HsSrcBang SourceText
_ SrcUnpackedness
_ SrcStrictness
SrcStrict) = Char -> Doc
char Char
'!'
ppBang (HsSrcBang SourceText
_ SrcUnpackedness
_ SrcStrictness
SrcLazy)   = Char -> Doc
char Char
'~'
ppBang HsSrcBang
_                         = 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
_ (UserTyVar XUserTyVar DocNameI
_ ()
_ (L SrcSpanAnnN
_ DocName
name)) = DocName -> Doc
ppDocName DocName
name
  ppHsTyVarBndr Bool
unicode (KindedTyVar XKindedTyVar DocNameI
_ ()
_ (L SrcSpanAnnN
_ DocName
name) LHsType DocNameI
kind) =
    Doc -> Doc
parens (DocName -> Doc
ppDocName DocName
name Doc -> Doc -> Doc
<+> Bool -> Doc
dcolon Bool
unicode Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLKind Bool
unicode LHsType DocNameI
kind)

instance RenderableBndrFlag Specificity where
  ppHsTyVarBndr :: Bool -> HsTyVarBndr Specificity DocNameI -> Doc
ppHsTyVarBndr Bool
_ (UserTyVar XUserTyVar DocNameI
_ Specificity
SpecifiedSpec (L SrcSpanAnnN
_ DocName
name)) = DocName -> Doc
ppDocName DocName
name
  ppHsTyVarBndr Bool
_ (UserTyVar XUserTyVar DocNameI
_ Specificity
InferredSpec (L SrcSpanAnnN
_ DocName
name)) = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ DocName -> Doc
ppDocName DocName
name
  ppHsTyVarBndr Bool
unicode (KindedTyVar XKindedTyVar DocNameI
_ Specificity
SpecifiedSpec (L SrcSpanAnnN
_ DocName
name) LHsType DocNameI
kind) =
    Doc -> Doc
parens (DocName -> Doc
ppDocName DocName
name Doc -> Doc -> Doc
<+> Bool -> Doc
dcolon Bool
unicode Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLKind Bool
unicode LHsType DocNameI
kind)
  ppHsTyVarBndr Bool
unicode (KindedTyVar XKindedTyVar DocNameI
_ Specificity
InferredSpec (L SrcSpanAnnN
_ DocName
name) LHsType DocNameI
kind) =
    Doc -> Doc
braces (DocName -> Doc
ppDocName DocName
name Doc -> Doc -> Doc
<+> Bool -> Doc
dcolon Bool
unicode Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLKind Bool
unicode LHsType DocNameI
kind)

instance RenderableBndrFlag (HsBndrVis DocNameI) where
  ppHsTyVarBndr :: Bool -> HsTyVarBndr (HsBndrVis DocNameI) DocNameI -> Doc
ppHsTyVarBndr Bool
_ (UserTyVar XUserTyVar DocNameI
_ HsBndrVis DocNameI
bvis (L SrcSpanAnnN
_ DocName
name)) =
    HsBndrVis DocNameI -> Doc -> Doc
ppHsBndrVis HsBndrVis DocNameI
bvis (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ DocName -> Doc
ppDocName DocName
name
  ppHsTyVarBndr Bool
unicode (KindedTyVar XKindedTyVar DocNameI
_ HsBndrVis DocNameI
bvis (L SrcSpanAnnN
_ DocName
name) LHsType DocNameI
kind) =
    HsBndrVis DocNameI -> Doc -> Doc
ppHsBndrVis HsBndrVis DocNameI
bvis (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Doc -> Doc
parens (DocName -> Doc
ppDocName DocName
name Doc -> Doc -> Doc
<+> Bool -> Doc
dcolon Bool
unicode Doc -> Doc -> Doc
<+> Bool -> LHsType DocNameI -> Doc
ppLKind Bool
unicode LHsType DocNameI
kind)

ppHsBndrVis :: HsBndrVis DocNameI -> LaTeX -> LaTeX
ppHsBndrVis :: HsBndrVis DocNameI -> Doc -> Doc
ppHsBndrVis (HsBndrRequired XBndrRequired DocNameI
_) Doc
d = Doc
d
ppHsBndrVis (HsBndrInvisible XBndrInvisible DocNameI
_) Doc
d = Doc
atSign Doc -> Doc -> Doc
<> 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 DocNameI
_ -> Bool -> Doc
lollipop Bool
u
                 HsUnrestrictedArrow XUnrestrictedArrow DocNameI
_ -> Bool -> Doc
arrow Bool
u
                 HsExplicitMult XExplicitMult 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
_ HsSrcBang
b LHsType DocNameI
ty)     Bool
u = HsSrcBang -> Doc
ppBang HsSrcBang
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


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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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 :: * -> *) 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
  = Plain  -- ^ all special characters have to be escape
  | Mono   -- ^ on top of special characters, escape space characters
  | Verb   -- ^ don't escape anything


latexStripTrailingWhitespace :: Doc a -> Doc a
latexStripTrailingWhitespace :: forall a. Doc a -> Doc a
latexStripTrailingWhitespace (DocString FilePath
s)
  | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) 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