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

-----------------------------------------------------------------------------
-- |
-- 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.Types
import Haddock.Utils
import Haddock.GhcUtils
import Pretty hiding (Doc, quote)
import qualified Pretty

import BasicTypes           ( PromotionFlag(..) )
import GHC
import OccName
import Name                 ( nameOccName )
import RdrName              ( rdrNameOcc )
import FastString           ( unpackFS )
import Outputable           ( panic)

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.Void            ( absurd )
import Prelude hiding ((<>))

import Haddock.Doc (combineDocumentation)

-- import Debug.Trace

{- 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 :: String
-> Maybe String
-> [Interface]
-> String
-> Maybe (Doc RdrName)
-> Maybe String
-> String
-> IO ()
ppLaTeX String
title Maybe String
packageStr [Interface]
visible_ifaces String
odir Maybe (Doc RdrName)
prologue Maybe String
maybe_style String
libdir
 = do
   Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
odir
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
maybe_style) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
     String -> String -> IO ()
copyFile (String
libdir String -> String -> String
</> String
"latex" String -> String -> String
</> String
haddockSty) (String
odir String -> String -> String
</> String
haddockSty)
   String
-> Maybe String
-> String
-> Maybe (Doc RdrName)
-> Maybe String
-> [Interface]
-> IO ()
ppLaTeXTop String
title Maybe String
packageStr String
odir Maybe (Doc RdrName)
prologue Maybe String
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_ (String -> String -> Interface -> IO ()
ppLaTeXModule String
title String
odir) [Interface]
visible_ifaces


haddockSty :: FilePath
haddockSty :: String
haddockSty = String
"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 :: LaTeX -> String
latex2String = Mode
-> Int
-> Float
-> (TextDetails -> String -> String)
-> String
-> LaTeX
-> String
forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> LaTeX -> a
fullRender Mode
PageMode Int
90 Float
1 TextDetails -> String -> String
txtPrinter String
""

ppLaTeXTop
   :: String
   -> Maybe String
   -> FilePath
   -> Maybe (Doc GHC.RdrName)
   -> Maybe String
   -> [Interface]
   -> IO ()

ppLaTeXTop :: String
-> Maybe String
-> String
-> Maybe (Doc RdrName)
-> Maybe String
-> [Interface]
-> IO ()
ppLaTeXTop String
doctitle Maybe String
packageStr String
odir Maybe (Doc RdrName)
prologue Maybe String
maybe_style [Interface]
ifaces = do

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

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

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

  String -> String -> IO ()
writeUtf8File String
filename (LaTeX -> String
forall a. Show a => a -> String
show LaTeX
tex)


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

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

      tex :: LaTeX
tex = [LaTeX] -> LaTeX
vcat [
        String -> LaTeX
text String
"\\haddockmoduleheading" LaTeX -> LaTeX -> LaTeX
<> LaTeX -> LaTeX
braces (String -> LaTeX
text String
mdl_str),
        String -> LaTeX
text String
"\\label{module:" LaTeX -> LaTeX -> LaTeX
<> String -> LaTeX
text String
mdl_str LaTeX -> LaTeX -> LaTeX
<> Char -> LaTeX
char Char
'}',
        String -> LaTeX
text String
"\\haddockbeginheader",
        LaTeX -> LaTeX
verb (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ [LaTeX] -> LaTeX
vcat [
           String -> LaTeX
text String
"module" LaTeX -> LaTeX -> LaTeX
<+> String -> LaTeX
text String
mdl_str LaTeX -> LaTeX -> LaTeX
<+> LaTeX
lparen,
           String -> LaTeX
text String
"    " LaTeX -> LaTeX -> LaTeX
<> [LaTeX] -> LaTeX
fsep (LaTeX -> [LaTeX] -> [LaTeX]
punctuate (Char -> LaTeX
char Char
',') ([LaTeX] -> [LaTeX]) -> [LaTeX] -> [LaTeX]
forall a b. (a -> b) -> a -> b
$
                               (ExportItem DocNameI -> LaTeX) -> [ExportItem DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map ExportItem DocNameI -> LaTeX
exportListItem ([ExportItem DocNameI] -> [LaTeX])
-> [ExportItem DocNameI] -> [LaTeX]
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),
           String -> LaTeX
text String
"  ) where"
         ],
        String -> LaTeX
text String
"\\haddockendheader" LaTeX -> LaTeX -> LaTeX
$$ String -> LaTeX
text String
"",
        LaTeX
description,
        LaTeX
body
       ]

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

      body :: LaTeX
body = [ExportItem DocNameI] -> LaTeX
processExports [ExportItem DocNameI]
exports
  --
  String -> String -> IO ()
writeUtf8File (String
odir String -> String -> String
</> Module -> String
moduleLaTeXFile Module
mdl) (LaTeX -> String
forall a. Show a => a -> String
show LaTeX
tex)

-- | Prints out an entry in a module export list.
exportListItem :: ExportItem DocNameI -> LaTeX
exportListItem :: ExportItem DocNameI -> LaTeX
exportListItem ExportDecl { expItemDecl :: forall name. ExportItem name -> LHsDecl name
expItemDecl = LHsDecl DocNameI
decl, expItemSubDocs :: forall name. ExportItem name -> [(IdP name, DocForDecl (IdP name))]
expItemSubDocs = [(IdP DocNameI, DocForDecl (IdP DocNameI))]
subdocs }
  = let (LaTeX
leader, [DocName]
names) = LHsDecl DocNameI -> (LaTeX, [DocName])
declNames LHsDecl DocNameI
decl
    in [LaTeX] -> LaTeX
sep (LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma [ LaTeX
leader LaTeX -> LaTeX -> LaTeX
<+> DocName -> LaTeX
ppDocBinder DocName
name | DocName
name <- [DocName]
names ]) LaTeX -> LaTeX -> LaTeX
<>
         case [(IdP DocNameI, DocForDecl (IdP DocNameI))]
subdocs of
           [] -> LaTeX
empty
           [(IdP DocNameI, DocForDecl (IdP DocNameI))]
_  -> LaTeX -> LaTeX
parens ([LaTeX] -> LaTeX
sep (LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma (((DocName, DocForDecl DocName) -> LaTeX)
-> [(DocName, DocForDecl DocName)] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> LaTeX
ppDocBinder (DocName -> LaTeX)
-> ((DocName, DocForDecl DocName) -> DocName)
-> (DocName, DocForDecl DocName)
-> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocName, DocForDecl DocName) -> DocName
forall a b. (a, b) -> a
fst) [(IdP DocNameI, DocForDecl (IdP DocNameI))]
[(DocName, DocForDecl DocName)]
subdocs)))
exportListItem (ExportNoDecl IdP DocNameI
y [])
  = DocName -> LaTeX
ppDocBinder IdP DocNameI
DocName
y
exportListItem (ExportNoDecl IdP DocNameI
y [IdP DocNameI]
subs)
  = DocName -> LaTeX
ppDocBinder IdP DocNameI
DocName
y LaTeX -> LaTeX -> LaTeX
<> LaTeX -> LaTeX
parens ([LaTeX] -> LaTeX
sep (LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ((DocName -> LaTeX) -> [DocName] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> LaTeX
ppDocBinder [IdP DocNameI]
[DocName]
subs)))
exportListItem (ExportModule Module
mdl)
  = String -> LaTeX
text String
"module" LaTeX -> LaTeX -> LaTeX
<+> String -> LaTeX
text (Module -> String
moduleString Module
mdl)
exportListItem ExportItem DocNameI
_
  = String -> LaTeX
forall a. HasCallStack => String -> a
error String
"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] -> LaTeX
processExports [] = LaTeX
empty
processExports (ExportItem DocNameI
decl : [ExportItem DocNameI]
es)
  | Just ([DocName], HsType DocNameI)
sig <- ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI)
isSimpleSig ExportItem DocNameI
decl
  = [LaTeX] -> LaTeX
multiDecl [ [Name] -> HsType DocNameI -> Bool -> LaTeX
ppTypeSig ((DocName -> Name) -> [DocName] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> Name
forall a. NamedThing a => a -> Name
getName [DocName]
names) HsType DocNameI
typ Bool
False
              | ([DocName]
names,HsType DocNameI
typ) <- ([DocName], HsType DocNameI)
sig([DocName], HsType DocNameI)
-> [([DocName], HsType DocNameI)] -> [([DocName], HsType DocNameI)]
forall a. a -> [a] -> [a]
:[([DocName], HsType DocNameI)]
sigs ] LaTeX -> LaTeX -> LaTeX
$$
    [ExportItem DocNameI] -> LaTeX
processExports [ExportItem DocNameI]
es'
  where ([([DocName], HsType DocNameI)]
sigs, [ExportItem DocNameI]
es') = (ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI))
-> [ExportItem DocNameI]
-> ([([DocName], HsType DocNameI)], [ExportItem DocNameI])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
spanWith ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI)
isSimpleSig [ExportItem DocNameI]
es
processExports (ExportModule Module
mdl : [ExportItem DocNameI]
es)
  = LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc ([LaTeX] -> LaTeX
vcat [ String -> LaTeX
text String
"module" LaTeX -> LaTeX -> LaTeX
<+> String -> LaTeX
text (Module -> String
moduleString Module
m) | Module
m <- Module
mdlModule -> [Module] -> [Module]
forall a. a -> [a] -> [a]
:[Module]
mdls ]) Maybe LaTeX
forall a. Maybe a
Nothing LaTeX -> LaTeX -> LaTeX
$$
    [ExportItem DocNameI] -> LaTeX
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 -> LaTeX
processExport ExportItem DocNameI
e LaTeX -> LaTeX -> LaTeX
$$ [ExportItem DocNameI] -> LaTeX
processExports [ExportItem DocNameI]
es


isSimpleSig :: ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI)
isSimpleSig :: ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI)
isSimpleSig ExportDecl { expItemDecl :: forall name. ExportItem name -> LHsDecl name
expItemDecl = L SrcSpan
_ (SigD XSigD DocNameI
_ (TypeSig XTypeSig DocNameI
_ [Located (IdP DocNameI)]
lnames LHsSigWcType DocNameI
t))
                       , expItemMbDoc :: forall name. ExportItem name -> DocForDecl (IdP name)
expItemMbDoc = (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], HsType DocNameI) -> Maybe ([DocName], HsType DocNameI)
forall a. a -> Maybe a
Just ((Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames, LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsSigWcType DocNameI -> LHsType DocNameI
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType DocNameI
t))
isSimpleSig ExportItem DocNameI
_ = Maybe ([DocName], HsType 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 -> LaTeX
processExport (ExportGroup Int
lev String
_id0 Doc (IdP DocNameI)
doc)
  = Int -> LaTeX -> LaTeX
ppDocGroup Int
lev (Doc DocName -> LaTeX
docToLaTeX Doc (IdP DocNameI)
Doc DocName
doc)
processExport (ExportDecl 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)
  = LHsDecl DocNameI
-> [(HsDecl DocNameI, DocForDecl DocName)]
-> DocForDecl DocName
-> [DocInstance DocNameI]
-> [(DocName, DocForDecl DocName)]
-> [(DocName, Fixity)]
-> LaTeX
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 -> LaTeX
ppDocName IdP DocNameI
DocName
y
processExport (ExportNoDecl IdP DocNameI
y [IdP DocNameI]
subs)
  = DocName -> LaTeX
ppDocName IdP DocNameI
DocName
y LaTeX -> LaTeX -> LaTeX
<> LaTeX -> LaTeX
parens ([LaTeX] -> LaTeX
sep (LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ((DocName -> LaTeX) -> [DocName] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map DocName -> LaTeX
ppDocName [IdP DocNameI]
[DocName]
subs)))
processExport (ExportModule Module
mdl)
  = LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc (String -> LaTeX
text String
"module" LaTeX -> LaTeX -> LaTeX
<+> String -> LaTeX
text (Module -> String
moduleString Module
mdl)) Maybe LaTeX
forall a. Maybe a
Nothing
processExport (ExportDoc MDoc (IdP DocNameI)
doc)
  = Doc DocName -> LaTeX
docToLaTeX (Doc DocName -> LaTeX) -> Doc DocName -> LaTeX
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 -> LaTeX -> LaTeX
ppDocGroup Int
lev LaTeX
doc = Int -> LaTeX
forall a. (Eq a, Num a) => a -> LaTeX
sec Int
lev LaTeX -> LaTeX -> LaTeX
<> LaTeX -> LaTeX
braces LaTeX
doc
  where sec :: a -> LaTeX
sec a
1 = String -> LaTeX
text String
"\\section"
        sec a
2 = String -> LaTeX
text String
"\\subsection"
        sec a
3 = String -> LaTeX
text String
"\\subsubsection"
        sec a
_ = String -> LaTeX
text String
"\\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 -> (LaTeX, [DocName])
declNames (L SrcSpan
_ HsDecl DocNameI
decl) = case HsDecl DocNameI
decl of
  TyClD XTyClD DocNameI
_ TyClDecl DocNameI
d  -> (LaTeX
empty, [TyClDecl DocNameI -> DocName
tcdNameI TyClDecl DocNameI
d])
  SigD XSigD DocNameI
_ (TypeSig XTypeSig DocNameI
_ [Located (IdP DocNameI)]
lnames LHsSigWcType DocNameI
_ ) -> (LaTeX
empty, (Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames)
  SigD XSigD DocNameI
_ (PatSynSig XPatSynSig DocNameI
_ [Located (IdP DocNameI)]
lnames LHsSigType DocNameI
_) -> (String -> LaTeX
text String
"pattern", (Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames)
  ForD XForD DocNameI
_ (ForeignImport XForeignImport DocNameI
_ (L SrcSpan
_ IdP DocNameI
n) LHsSigType DocNameI
_ ForeignImport
_) -> (LaTeX
empty, [IdP DocNameI
DocName
n])
  ForD XForD DocNameI
_ (ForeignExport XForeignExport DocNameI
_ (L SrcSpan
_ IdP DocNameI
n) LHsSigType DocNameI
_ ForeignExport
_) -> (LaTeX
empty, [IdP DocNameI
DocName
n])
  HsDecl DocNameI
_ -> String -> (LaTeX, [DocName])
forall a. HasCallStack => String -> a
error String
"declaration not supported by declNames"


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


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


moduleBasename :: Module -> FilePath
moduleBasename :: Module -> String
moduleBasename Module
mdl = (Char -> Char) -> String -> String
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 -> String
moduleNameString (Module -> 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)]
-> LaTeX
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 LHsDecl DocNameI -> SrcSpanLess (LHsDecl DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsDecl DocNameI
decl of
  TyClD _ d@FamDecl {}         -> Bool
-> Documentation DocName
-> [DocInstance DocNameI]
-> TyClDecl DocNameI
-> Bool
-> LaTeX
ppFamDecl Bool
False Documentation DocName
doc [DocInstance DocNameI]
instances TyClDecl DocNameI
d Bool
unicode
  TyClD _ d@DataDecl {}        -> [(HsDecl DocNameI, DocForDecl DocName)]
-> [DocInstance DocNameI]
-> [(DocName, DocForDecl DocName)]
-> Maybe (Documentation DocName)
-> TyClDecl DocNameI
-> Bool
-> LaTeX
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 _ d@SynDecl {}         -> DocForDecl DocName -> TyClDecl DocNameI -> Bool -> LaTeX
ppTySyn (Documentation DocName
doc, Map Int (MDoc DocName)
fnArgsDoc) TyClDecl DocNameI
d Bool
unicode
-- Family instances happen via FamInst now
--  TyClD _ d@TySynonym{}
--    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode
-- Family instances happen via FamInst now
  TyClD _ d@ClassDecl{}          -> [DocInstance DocNameI]
-> Documentation DocName
-> [(DocName, DocForDecl DocName)]
-> TyClDecl DocNameI
-> Bool
-> LaTeX
ppClassDecl [DocInstance DocNameI]
instances Documentation DocName
doc [(DocName, DocForDecl DocName)]
subdocs TyClDecl DocNameI
d Bool
unicode
  SigD _ (TypeSig _ lnames ty)   -> Maybe LaTeX
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> Bool
-> LaTeX
ppFunSig Maybe LaTeX
forall a. Maybe a
Nothing (Documentation DocName
doc, Map Int (MDoc DocName)
fnArgsDoc) ((Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames) (LHsSigWcType DocNameI -> LHsType DocNameI
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType DocNameI
ty) Bool
unicode
  SigD _ (PatSynSig _ lnames ty) -> DocForDecl DocName
-> [DocName] -> LHsSigType DocNameI -> Bool -> LaTeX
ppLPatSig (Documentation DocName
doc, Map Int (MDoc DocName)
fnArgsDoc) ((Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames) LHsSigType DocNameI
ty Bool
unicode
  ForD _ d                       -> DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
ppFor (Documentation DocName
doc, Map Int (MDoc DocName)
fnArgsDoc) ForeignDecl DocNameI
d Bool
unicode
  InstD _ _                      -> LaTeX
empty
  DerivD _ _                     -> LaTeX
empty
  SrcSpanLess (LHsDecl DocNameI)
_                              -> String -> LaTeX
forall a. HasCallStack => String -> a
error String
"declaration not supported by ppDecl"
  where
    unicode :: Bool
unicode = Bool
False


ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
ppFor DocForDecl DocName
doc (ForeignImport XForeignImport DocNameI
_ (L SrcSpan
_ IdP DocNameI
name) LHsSigType DocNameI
typ ForeignImport
_) Bool
unicode =
  Maybe LaTeX
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> Bool
-> LaTeX
ppFunSig Maybe LaTeX
forall a. Maybe a
Nothing DocForDecl DocName
doc [IdP DocNameI
DocName
name] (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
typ) Bool
unicode
ppFor DocForDecl DocName
_ ForeignDecl DocNameI
_ Bool
_ = String -> LaTeX
forall a. HasCallStack => String -> a
error String
"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
-> LaTeX
ppFamDecl Bool
associated Documentation DocName
doc [DocInstance DocNameI]
instances TyClDecl DocNameI
decl Bool
unicode =
  LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc (FamilyDecl DocNameI -> Bool -> Bool -> LaTeX
ppFamHeader (TyClDecl DocNameI -> FamilyDecl DocNameI
forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam TyClDecl DocNameI
decl) Bool
unicode Bool
associated LaTeX -> LaTeX -> LaTeX
<+> LaTeX
whereBit)
              (if [LaTeX] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LaTeX]
body then Maybe LaTeX
forall a. Maybe a
Nothing else LaTeX -> Maybe LaTeX
forall a. a -> Maybe a
Just ([LaTeX] -> LaTeX
vcat [LaTeX]
body))
  LaTeX -> LaTeX -> LaTeX
$$ LaTeX
instancesBit
  where
    body :: [LaTeX]
body = [Maybe LaTeX] -> [LaTeX]
forall a. [Maybe a] -> [a]
catMaybes [Maybe LaTeX
familyEqns, Documentation DocName -> Maybe LaTeX
documentationToLaTeX Documentation DocName
doc]

    whereBit :: LaTeX
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]
_ -> String -> LaTeX
keyword String
"where"
      FamilyInfo DocNameI
_                  -> LaTeX
empty

    familyEqns :: Maybe LaTeX
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 ([LTyFamInstEqn DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LTyFamInstEqn DocNameI]
eqns)
      = LaTeX -> Maybe LaTeX
forall a. a -> Maybe a
Just (String -> LaTeX
text String
"\\haddockbeginargs" LaTeX -> LaTeX -> LaTeX
$$
              [LaTeX] -> LaTeX
vcat [ LaTeX -> LaTeX
decltt (TyFamInstEqn DocNameI -> LaTeX
ppFamDeclEqn TyFamInstEqn DocNameI
eqn) LaTeX -> LaTeX -> LaTeX
<+> LaTeX
nl | L SrcSpan
_ TyFamInstEqn DocNameI
eqn <- [LTyFamInstEqn DocNameI]
eqns ] LaTeX -> LaTeX -> LaTeX
$$
              String -> LaTeX
text String
"\\end{tabulary}\\par")
      | Bool
otherwise = Maybe LaTeX
forall a. Maybe a
Nothing

    -- Individual equations of a closed type family
    ppFamDeclEqn :: TyFamInstEqn DocNameI -> LaTeX
    ppFamDeclEqn :: TyFamInstEqn DocNameI -> LaTeX
ppFamDeclEqn (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = FamEqn { feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
feqn_tycon = L SrcSpan
_ IdP DocNameI
n
                                            , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs = LHsType DocNameI
rhs
                                            , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_pats = HsTyPats DocNameI
ts } })
      = [LaTeX] -> LaTeX
hsep [ DocName -> HsTyPats DocNameI -> Bool -> LaTeX
ppAppNameTypeArgs IdP DocNameI
DocName
n HsTyPats DocNameI
ts Bool
unicode
             , LaTeX
equals
             , Bool -> HsType DocNameI -> LaTeX
ppType Bool
unicode (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
rhs)
             ]
    ppFamDeclEqn (XHsImplicitBndrs XXHsImplicitBndrs DocNameI (FamEqn DocNameI (LHsType DocNameI))
nec) = NoExtCon -> LaTeX
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsImplicitBndrs DocNameI (FamEqn DocNameI (LHsType DocNameI))
nec
    ppFamDeclEqn (HsIB { hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body = XFamEqn XXFamEqn DocNameI (LHsType DocNameI)
nec}) = NoExtCon -> LaTeX
forall a. NoExtCon -> a
noExtCon NoExtCon
XXFamEqn DocNameI (LHsType DocNameI)
nec

    instancesBit :: LaTeX
instancesBit = Bool -> [DocInstance DocNameI] -> LaTeX
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 -> LaTeX
ppFamHeader (XFamilyDecl XXFamilyDecl DocNameI
nec) Bool
_ Bool
_ = NoExtCon -> LaTeX
forall a. NoExtCon -> a
noExtCon NoExtCon
XXFamilyDecl DocNameI
nec
ppFamHeader (FamilyDecl { fdLName :: forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName = L SrcSpan
_ IdP DocNameI
name
                        , fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
fdTyVars = LHsQTyVars DocNameI
tvs
                        , fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = FamilyInfo DocNameI
info
                        , fdResultSig :: forall pass. FamilyDecl pass -> LFamilyResultSig pass
fdResultSig = L SrcSpan
_ FamilyResultSig DocNameI
result
                        , fdInjectivityAnn :: forall pass. FamilyDecl pass -> Maybe (LInjectivityAnn pass)
fdInjectivityAnn = Maybe (LInjectivityAnn DocNameI)
injectivity })
              Bool
unicode Bool
associated =
  LaTeX -> LaTeX
famly LaTeX
leader LaTeX -> LaTeX -> LaTeX
<+> LaTeX
famName LaTeX -> LaTeX -> LaTeX
<+> LaTeX
famSig LaTeX -> LaTeX -> LaTeX
<+> LaTeX
injAnn
  where
    leader :: LaTeX
leader = case FamilyInfo DocNameI
info of
      FamilyInfo DocNameI
OpenTypeFamily     -> String -> LaTeX
keyword String
"type"
      ClosedTypeFamily Maybe [LTyFamInstEqn DocNameI]
_ -> String -> LaTeX
keyword String
"type"
      FamilyInfo DocNameI
DataFamily         -> String -> LaTeX
keyword String
"data"

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

    famName :: LaTeX
famName = Bool -> DocName -> [LHsTyVarBndr DocNameI] -> LaTeX
ppAppDocNameTyVarBndrs Bool
unicode IdP DocNameI
DocName
name (LHsQTyVars DocNameI -> [LHsTyVarBndr DocNameI]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsq_explicit LHsQTyVars DocNameI
tvs)

    famSig :: LaTeX
famSig = case FamilyResultSig DocNameI
result of
      NoSig XNoSig DocNameI
_               -> LaTeX
empty
      KindSig XCKindSig DocNameI
_ LHsType DocNameI
kind        -> Bool -> LaTeX
dcolon Bool
unicode LaTeX -> LaTeX -> LaTeX
<+> Bool -> LHsType DocNameI -> LaTeX
ppLKind Bool
unicode LHsType DocNameI
kind
      TyVarSig XTyVarSig DocNameI
_ (L SrcSpan
_ HsTyVarBndr DocNameI
bndr) -> LaTeX
equals LaTeX -> LaTeX -> LaTeX
<+> Bool -> HsTyVarBndr DocNameI -> LaTeX
ppHsTyVarBndr Bool
unicode HsTyVarBndr DocNameI
bndr
      XFamilyResultSig XXFamilyResultSig DocNameI
nec  -> NoExtCon -> LaTeX
forall a. NoExtCon -> a
noExtCon NoExtCon
XXFamilyResultSig DocNameI
nec

    injAnn :: LaTeX
injAnn = case Maybe (LInjectivityAnn DocNameI)
injectivity of
      Maybe (LInjectivityAnn DocNameI)
Nothing -> LaTeX
empty
      Just (L SrcSpan
_ (InjectivityAnn Located (IdP DocNameI)
lhs [Located (IdP DocNameI)]
rhs)) -> [LaTeX] -> LaTeX
hsep ( LaTeX -> LaTeX
decltt (String -> LaTeX
text String
"|")
                                                  LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
: Located DocName -> LaTeX
ppLDocName Located (IdP DocNameI)
Located DocName
lhs
                                                  LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
: Bool -> LaTeX
arrow Bool
unicode
                                                  LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
: (Located DocName -> LaTeX) -> [Located DocName] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> LaTeX
ppLDocName [Located (IdP DocNameI)]
[Located DocName]
rhs)



-------------------------------------------------------------------------------
-- * Type Synonyms
-------------------------------------------------------------------------------


-- we skip type patterns for now
ppTySyn :: DocForDecl DocName -> TyClDecl DocNameI -> Bool -> LaTeX

ppTySyn :: DocForDecl DocName -> TyClDecl DocNameI -> Bool -> LaTeX
ppTySyn DocForDecl DocName
doc (SynDecl { tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = L SrcSpan
_ IdP DocNameI
name, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
ltyvars
                         , tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LHsType DocNameI
ltype }) Bool
unicode
  = HsType DocNameI
-> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX) -> Bool -> LaTeX
ppTypeOrFunSig (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
ltype) DocForDecl DocName
doc (LaTeX
full, LaTeX
hdr, Char -> LaTeX
char Char
'=') Bool
unicode
  where
    hdr :: LaTeX
hdr  = [LaTeX] -> LaTeX
hsep (String -> LaTeX
keyword String
"type"
                 LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
: DocName -> LaTeX
ppDocBinder IdP DocNameI
DocName
name
                 LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
: (Name -> LaTeX) -> [Name] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map Name -> LaTeX
ppSymName (LHsQTyVars DocNameI -> [Name]
tyvarNames LHsQTyVars DocNameI
ltyvars))
    full :: LaTeX
full = LaTeX
hdr LaTeX -> LaTeX -> LaTeX
<+> Char -> LaTeX
char Char
'=' LaTeX -> LaTeX -> LaTeX
<+> Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
unicode LHsType DocNameI
ltype

ppTySyn DocForDecl DocName
_ TyClDecl DocNameI
_ Bool
_ = String -> LaTeX
forall a. HasCallStack => String -> a
error String
"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
  -> LHsType DocNameI    -- ^ type of the pattern synonym
  -> Bool                -- ^ unicode
  -> LaTeX
ppFunSig :: Maybe LaTeX
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> Bool
-> LaTeX
ppFunSig Maybe LaTeX
leader DocForDecl DocName
doc [DocName]
docnames (L SrcSpan
_ HsType DocNameI
typ) Bool
unicode =
  HsType DocNameI
-> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX) -> Bool -> LaTeX
ppTypeOrFunSig HsType DocNameI
typ DocForDecl DocName
doc
    ( LaTeX -> LaTeX
lead (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ [Name] -> HsType DocNameI -> Bool -> LaTeX
ppTypeSig [Name]
names HsType DocNameI
typ Bool
False
    , LaTeX -> LaTeX
lead (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ [LaTeX] -> LaTeX
hsep ([LaTeX] -> LaTeX) -> ([LaTeX] -> [LaTeX]) -> [LaTeX] -> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ([LaTeX] -> LaTeX) -> [LaTeX] -> LaTeX
forall a b. (a -> b) -> a -> b
$ (Name -> LaTeX) -> [Name] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map Name -> LaTeX
ppSymName [Name]
names
    , Bool -> LaTeX
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 :: LaTeX -> LaTeX
lead = (LaTeX -> LaTeX)
-> (LaTeX -> LaTeX -> LaTeX) -> Maybe LaTeX -> LaTeX -> LaTeX
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LaTeX -> LaTeX
forall a. a -> a
id LaTeX -> LaTeX -> LaTeX
(<+>) Maybe LaTeX
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 -> LaTeX
ppLPatSig DocForDecl DocName
doc [DocName]
docnames LHsSigType DocNameI
ty Bool
unicode
  = Maybe LaTeX
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> Bool
-> LaTeX
ppFunSig (LaTeX -> Maybe LaTeX
forall a. a -> Maybe a
Just (String -> LaTeX
keyword String
"pattern")) DocForDecl DocName
doc [DocName]
docnames (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
ty) Bool
unicode

-- | Pretty-print a type, adding documentation to the whole type and its
-- arguments as needed.
ppTypeOrFunSig :: HsType 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 :: HsType DocNameI
-> DocForDecl DocName -> (LaTeX, LaTeX, LaTeX) -> Bool -> LaTeX
ppTypeOrFunSig HsType DocNameI
typ (Documentation DocName
doc, Map Int (MDoc DocName)
argDocs) (LaTeX
pref1, LaTeX
pref2, LaTeX
sep0) Bool
unicode
  | Map Int (MDoc DocName) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (MDoc DocName)
argDocs = LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc LaTeX
pref1 (Documentation DocName -> Maybe LaTeX
documentationToLaTeX Documentation DocName
doc)
  | Bool
otherwise        = LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc LaTeX
pref2 (Maybe LaTeX -> LaTeX) -> Maybe LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ LaTeX -> Maybe LaTeX
forall a. a -> Maybe a
Just (LaTeX -> Maybe LaTeX) -> LaTeX -> Maybe LaTeX
forall a b. (a -> b) -> a -> b
$
        String -> LaTeX
text String
"\\haddockbeginargs" LaTeX -> LaTeX -> LaTeX
$$
        [LaTeX] -> LaTeX
vcat (((LaTeX, LaTeX) -> LaTeX) -> [(LaTeX, LaTeX)] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map ((LaTeX -> LaTeX -> LaTeX) -> (LaTeX, LaTeX) -> LaTeX
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LaTeX -> LaTeX -> LaTeX
(<->)) (Bool
-> HsType DocNameI
-> Map Int (MDoc DocName)
-> [(DocName, DocForDecl DocName)]
-> LaTeX
-> [(LaTeX, LaTeX)]
ppSubSigLike Bool
unicode HsType DocNameI
typ Map Int (MDoc DocName)
argDocs [] LaTeX
sep0)) LaTeX -> LaTeX -> LaTeX
$$
        String -> LaTeX
text String
"\\end{tabulary}\\par" LaTeX -> LaTeX -> LaTeX
$$
        LaTeX -> Maybe LaTeX -> LaTeX
forall a. a -> Maybe a -> a
fromMaybe LaTeX
empty (Documentation DocName -> Maybe LaTeX
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
             -> HsType 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
-> HsType DocNameI
-> Map Int (MDoc DocName)
-> [(DocName, DocForDecl DocName)]
-> LaTeX
-> [(LaTeX, LaTeX)]
ppSubSigLike Bool
unicode HsType DocNameI
typ Map Int (MDoc DocName)
argDocs [(DocName, DocForDecl DocName)]
subdocs LaTeX
leader = Int -> LaTeX -> HsType DocNameI -> [(LaTeX, LaTeX)]
do_args Int
0 LaTeX
leader HsType DocNameI
typ
  where
    do_largs :: Int -> LaTeX -> LHsType DocNameI -> [(LaTeX, LaTeX)]
do_largs Int
n LaTeX
leader (L SrcSpan
_ HsType DocNameI
t) = Int -> LaTeX -> HsType DocNameI -> [(LaTeX, LaTeX)]
do_args Int
n LaTeX
leader HsType DocNameI
t

    arg_doc :: Int -> LaTeX
arg_doc Int
n = Maybe (Doc DocName) -> LaTeX
rDoc (Maybe (Doc DocName) -> LaTeX)
-> (Maybe (MDoc DocName) -> Maybe (Doc DocName))
-> Maybe (MDoc DocName)
-> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
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) -> LaTeX) -> Maybe (MDoc DocName) -> LaTeX
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 -> LaTeX -> HsType DocNameI -> [(LaTeX, LaTeX)]
do_args Int
_n LaTeX
leader (HsForAllTy XForAllTy DocNameI
_ ForallVisFlag
fvf [LHsTyVarBndr DocNameI]
tvs LHsType DocNameI
ltype)
      = [ ( LaTeX -> LaTeX
decltt LaTeX
leader
          , LaTeX -> LaTeX
decltt (Bool -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> LaTeX
ppForAllPart Bool
unicode [LHsTyVarBndr DocNameI]
tvs ForallVisFlag
fvf)
              LaTeX -> LaTeX -> LaTeX
<+> Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
unicode LHsType DocNameI
ltype
          ) ]
    do_args Int
n LaTeX
leader (HsQualTy XQualTy DocNameI
_ LHsContext DocNameI
lctxt LHsType DocNameI
ltype)
      = ( LaTeX -> LaTeX
decltt LaTeX
leader
        , LaTeX -> LaTeX
decltt (LHsContext DocNameI -> Bool -> LaTeX
ppLContextNoArrow LHsContext DocNameI
lctxt Bool
unicode) LaTeX -> LaTeX -> LaTeX
<+> LaTeX
nl
        ) (LaTeX, LaTeX) -> [(LaTeX, LaTeX)] -> [(LaTeX, LaTeX)]
forall a. a -> [a] -> [a]
: Int -> LaTeX -> LHsType DocNameI -> [(LaTeX, LaTeX)]
do_largs Int
n (Bool -> LaTeX
darrow Bool
unicode) LHsType DocNameI
ltype

    do_args Int
n LaTeX
leader (HsFunTy XFunTy DocNameI
_ (L SrcSpan
_ (HsRecTy XRecTy DocNameI
_ [LConDeclField DocNameI]
fields)) LHsType DocNameI
r)
      = [ (LaTeX -> LaTeX
decltt LaTeX
ldr, LaTeX
latex LaTeX -> LaTeX -> LaTeX
<+> LaTeX
nl)
        | (L SrcSpan
_ ConDeclField DocNameI
field, LaTeX
ldr) <- [LConDeclField DocNameI]
-> [LaTeX] -> [(LConDeclField DocNameI, LaTeX)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LConDeclField DocNameI]
fields (LaTeX
leader LaTeX -> LaTeX -> LaTeX
<+> LaTeX
gadtOpen LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
: LaTeX -> [LaTeX]
forall a. a -> [a]
repeat LaTeX
gadtComma)
        , let latex :: LaTeX
latex = [(DocName, DocForDecl DocName)]
-> Bool -> ConDeclField DocNameI -> LaTeX
ppSideBySideField [(DocName, DocForDecl DocName)]
subdocs Bool
unicode ConDeclField DocNameI
field
        ]
        [(LaTeX, LaTeX)] -> [(LaTeX, LaTeX)] -> [(LaTeX, LaTeX)]
forall a. [a] -> [a] -> [a]
++ Int -> LaTeX -> LHsType DocNameI -> [(LaTeX, LaTeX)]
do_largs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (LaTeX
gadtEnd LaTeX -> LaTeX -> LaTeX
<+> Bool -> LaTeX
arrow Bool
unicode) LHsType DocNameI
r
    do_args Int
n LaTeX
leader (HsFunTy XFunTy DocNameI
_ LHsType DocNameI
lt LHsType DocNameI
r)
      = (LaTeX -> LaTeX
decltt LaTeX
leader, LaTeX -> LaTeX
decltt (Bool -> LHsType DocNameI -> LaTeX
ppLFunLhType Bool
unicode LHsType DocNameI
lt) LaTeX -> LaTeX -> LaTeX
<-> Int -> LaTeX
arg_doc Int
n LaTeX -> LaTeX -> LaTeX
<+> LaTeX
nl)
        (LaTeX, LaTeX) -> [(LaTeX, LaTeX)] -> [(LaTeX, LaTeX)]
forall a. a -> [a] -> [a]
: Int -> LaTeX -> LHsType DocNameI -> [(LaTeX, LaTeX)]
do_largs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Bool -> LaTeX
arrow Bool
unicode) LHsType DocNameI
r
    do_args Int
n LaTeX
leader HsType DocNameI
t
      = [ (LaTeX -> LaTeX
decltt LaTeX
leader, LaTeX -> LaTeX
decltt (Bool -> HsType DocNameI -> LaTeX
ppType Bool
unicode HsType DocNameI
t) LaTeX -> LaTeX -> LaTeX
<-> Int -> LaTeX
arg_doc Int
n LaTeX -> LaTeX -> LaTeX
<+> LaTeX
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 :: LaTeX
gadtComma = [LaTeX] -> LaTeX
hcat (Int -> LaTeX -> [LaTeX]
forall a. Int -> a -> [a]
replicate (if Bool
unicode then Int
3 else Int
4) (Char -> LaTeX
char Char
' ')) LaTeX -> LaTeX -> LaTeX
<> Char -> LaTeX
char Char
','
    gadtEnd :: LaTeX
gadtEnd = [LaTeX] -> LaTeX
hcat (Int -> LaTeX -> [LaTeX]
forall a. Int -> a -> [a]
replicate (if Bool
unicode then Int
3 else Int
4) (Char -> LaTeX
char Char
' ')) LaTeX -> LaTeX -> LaTeX
<> Char -> LaTeX
char Char
'}'
    gadtOpen :: LaTeX
gadtOpen = Char -> LaTeX
char Char
'{'


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


-- | Pretty-print type variables.
ppTyVars :: Bool -> [LHsTyVarBndr DocNameI] -> [LaTeX]
ppTyVars :: Bool -> [LHsTyVarBndr DocNameI] -> [LaTeX]
ppTyVars Bool
unicode = (LHsTyVarBndr DocNameI -> LaTeX)
-> [LHsTyVarBndr DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> HsTyVarBndr DocNameI -> LaTeX
ppHsTyVarBndr Bool
unicode (HsTyVarBndr DocNameI -> LaTeX)
-> (LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI)
-> LHsTyVarBndr DocNameI
-> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)


tyvarNames :: LHsQTyVars DocNameI -> [Name]
tyvarNames :: LHsQTyVars DocNameI -> [Name]
tyvarNames = (LHsTyVarBndr DocNameI -> Name)
-> [LHsTyVarBndr DocNameI] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name)
-> (LHsTyVarBndr DocNameI -> DocName)
-> LHsTyVarBndr DocNameI
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsTyVarBndr DocNameI -> DocName
forall n. (XXTyVarBndr n ~ NoExtCon) => HsTyVarBndr n -> IdP n
hsTyVarBndrName (HsTyVarBndr DocNameI -> DocName)
-> (LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI)
-> LHsTyVarBndr DocNameI
-> DocName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([LHsTyVarBndr DocNameI] -> [Name])
-> (LHsQTyVars DocNameI -> [LHsTyVarBndr DocNameI])
-> LHsQTyVars DocNameI
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsQTyVars DocNameI -> [LHsTyVarBndr DocNameI]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit


declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc LaTeX
decl Maybe LaTeX
doc =
   String -> LaTeX
text String
"\\begin{haddockdesc}" LaTeX -> LaTeX -> LaTeX
$$
   String -> LaTeX
text String
"\\item[\\begin{tabular}{@{}l}" LaTeX -> LaTeX -> LaTeX
$$
   String -> LaTeX
text (String -> String
latexMonoFilter (LaTeX -> String
latex2String LaTeX
decl)) LaTeX -> LaTeX -> LaTeX
$$
   String -> LaTeX
text String
"\\end{tabular}]" LaTeX -> LaTeX -> LaTeX
$$
   LaTeX -> (LaTeX -> LaTeX) -> Maybe LaTeX -> LaTeX
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LaTeX
empty (\LaTeX
x -> String -> LaTeX
text String
"{\\haddockbegindoc" LaTeX -> LaTeX -> LaTeX
$$ LaTeX
x LaTeX -> LaTeX -> LaTeX
<> String -> LaTeX
text String
"}") Maybe LaTeX
doc LaTeX -> LaTeX -> LaTeX
$$
   String -> LaTeX
text String
"\\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 :: [LaTeX] -> LaTeX
multiDecl [LaTeX]
decls =
   String -> LaTeX
text String
"\\begin{haddockdesc}" LaTeX -> LaTeX -> LaTeX
$$
   [LaTeX] -> LaTeX
vcat [
      String -> LaTeX
text String
"\\item[\\begin{tabular}{@{}l}" LaTeX -> LaTeX -> LaTeX
$$
      String -> LaTeX
text (String -> String
latexMonoFilter (LaTeX -> String
latex2String LaTeX
decl)) LaTeX -> LaTeX -> LaTeX
$$
      String -> LaTeX
text String
"\\end{tabular}]"
      | LaTeX
decl <- [LaTeX]
decls ] LaTeX -> LaTeX -> LaTeX
$$
   String -> LaTeX
text String
"\\end{haddockdesc}"


-------------------------------------------------------------------------------
-- * Rendering Doc
-------------------------------------------------------------------------------


maybeDoc :: Maybe (Doc DocName) -> LaTeX
maybeDoc :: Maybe (Doc DocName) -> LaTeX
maybeDoc = LaTeX -> (Doc DocName -> LaTeX) -> Maybe (Doc DocName) -> LaTeX
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LaTeX
empty Doc DocName -> LaTeX
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) -> LaTeX
rDoc = Maybe (Doc DocName) -> LaTeX
maybeDoc (Maybe (Doc DocName) -> LaTeX)
-> (Maybe (Doc DocName) -> Maybe (Doc DocName))
-> Maybe (Doc DocName)
-> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc DocName -> Doc DocName)
-> Maybe (Doc DocName) -> Maybe (Doc DocName)
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 -> Located [LHsType DocNameI] -> DocName
           -> LHsQTyVars DocNameI -> [Located ([Located DocName], [Located DocName])]
           -> Bool -> LaTeX
ppClassHdr :: Bool
-> LHsContext DocNameI
-> DocName
-> LHsQTyVars DocNameI
-> [Located ([Located DocName], [Located DocName])]
-> Bool
-> LaTeX
ppClassHdr Bool
summ LHsContext DocNameI
lctxt DocName
n LHsQTyVars DocNameI
tvs [Located ([Located DocName], [Located DocName])]
fds Bool
unicode =
  String -> LaTeX
keyword String
"class"
  LaTeX -> LaTeX -> LaTeX
<+> (if Bool -> Bool
not (Bool -> Bool)
-> (LHsContext DocNameI -> Bool) -> LHsContext DocNameI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsType DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LHsType DocNameI] -> Bool)
-> (LHsContext DocNameI -> [LHsType DocNameI])
-> LHsContext DocNameI
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsContext DocNameI -> [LHsType DocNameI]
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsContext DocNameI -> Bool) -> LHsContext DocNameI -> Bool
forall a b. (a -> b) -> a -> b
$ LHsContext DocNameI
lctxt then LHsContext DocNameI -> Bool -> LaTeX
ppLContext LHsContext DocNameI
lctxt Bool
unicode else LaTeX
empty)
  LaTeX -> LaTeX -> LaTeX
<+> Bool -> DocName -> [Name] -> LaTeX
ppAppDocNameNames Bool
summ DocName
n (LHsQTyVars DocNameI -> [Name]
tyvarNames LHsQTyVars DocNameI
tvs)
  LaTeX -> LaTeX -> LaTeX
<+> [Located ([Located DocName], [Located DocName])] -> Bool -> LaTeX
ppFds [Located ([Located DocName], [Located DocName])]
fds Bool
unicode


ppFds :: [Located ([Located DocName], [Located DocName])] -> Bool -> LaTeX
ppFds :: [Located ([Located DocName], [Located DocName])] -> Bool -> LaTeX
ppFds [Located ([Located DocName], [Located DocName])]
fds Bool
unicode =
  if [Located ([Located DocName], [Located DocName])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located ([Located DocName], [Located DocName])]
fds then LaTeX
empty else
    Char -> LaTeX
char Char
'|' LaTeX -> LaTeX -> LaTeX
<+> [LaTeX] -> LaTeX
hsep (LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ((Located ([Located DocName], [Located DocName]) -> LaTeX)
-> [Located ([Located DocName], [Located DocName])] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (([Located DocName], [Located DocName]) -> LaTeX
fundep (([Located DocName], [Located DocName]) -> LaTeX)
-> (Located ([Located DocName], [Located DocName])
    -> ([Located DocName], [Located DocName]))
-> Located ([Located DocName], [Located DocName])
-> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ([Located DocName], [Located DocName])
-> ([Located DocName], [Located DocName])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located ([Located DocName], [Located DocName])]
fds))
  where
    fundep :: ([Located DocName], [Located DocName]) -> LaTeX
fundep ([Located DocName]
vars1,[Located DocName]
vars2) = [LaTeX] -> LaTeX
hsep ((Located DocName -> LaTeX) -> [Located DocName] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> LaTeX
ppDocName (DocName -> LaTeX)
-> (Located DocName -> DocName) -> Located DocName -> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located DocName]
vars1) LaTeX -> LaTeX -> LaTeX
<+> Bool -> LaTeX
arrow Bool
unicode LaTeX -> LaTeX -> LaTeX
<+>
                           [LaTeX] -> LaTeX
hsep ((Located DocName -> LaTeX) -> [Located DocName] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> LaTeX
ppDocName (DocName -> LaTeX)
-> (Located DocName -> DocName) -> Located DocName -> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located DocName]
vars2)


-- 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
-> LaTeX
ppClassDecl [DocInstance DocNameI]
instances Documentation DocName
doc [(DocName, DocForDecl DocName)]
subdocs
  (ClassDecl { tcdCtxt :: forall pass. TyClDecl pass -> LHsContext pass
tcdCtxt = LHsContext DocNameI
lctxt, tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = Located (IdP DocNameI)
lname, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
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
  = LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc LaTeX
classheader (if [LaTeX] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LaTeX]
body then Maybe LaTeX
forall a. Maybe a
Nothing else LaTeX -> Maybe LaTeX
forall a. a -> Maybe a
Just ([LaTeX] -> LaTeX
vcat [LaTeX]
body)) LaTeX -> LaTeX -> LaTeX
$$
    LaTeX
instancesBit
  where
    classheader :: LaTeX
classheader
      | [LSig DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSig DocNameI]
lsigs = Bool -> LaTeX
hdr Bool
unicode
      | Bool
otherwise  = Bool -> LaTeX
hdr Bool
unicode LaTeX -> LaTeX -> LaTeX
<+> String -> LaTeX
keyword String
"where"

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

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

    body_ :: Maybe LaTeX
body_
      | [LSig DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSig DocNameI]
lsigs, [LFamilyDecl DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LFamilyDecl DocNameI]
ats, [LTyFamDefltDecl DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LTyFamDefltDecl DocNameI]
at_defs = Maybe LaTeX
forall a. Maybe a
Nothing
      | [LFamilyDecl DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LFamilyDecl DocNameI]
ats, [LTyFamDefltDecl DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LTyFamDefltDecl DocNameI]
at_defs = LaTeX -> Maybe LaTeX
forall a. a -> Maybe a
Just LaTeX
methodTable
      | Bool
otherwise = LaTeX -> Maybe LaTeX
forall a. a -> Maybe a
Just (LaTeX
atTable LaTeX -> LaTeX -> LaTeX
$$ LaTeX
methodTable)

    atTable :: LaTeX
atTable =
      String -> LaTeX
text String
"\\haddockpremethods{}" LaTeX -> LaTeX -> LaTeX
<> LaTeX -> LaTeX
emph (String -> LaTeX
text String
"Associated Types") LaTeX -> LaTeX -> LaTeX
$$
      [LaTeX] -> LaTeX
vcat  [ Bool
-> Documentation DocName
-> [DocInstance DocNameI]
-> TyClDecl DocNameI
-> Bool
-> LaTeX
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 NoExtField
XFamDecl DocNameI
noExtField FamilyDecl DocNameI
decl) Bool
True
            | L SrcSpan
_ FamilyDecl DocNameI
decl <- [LFamilyDecl DocNameI]
ats
            , let name :: DocName
name = Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located DocName -> DocName)
-> (FamilyDecl DocNameI -> Located DocName)
-> FamilyDecl DocNameI
-> DocName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamilyDecl DocNameI -> Located DocName
forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName (FamilyDecl DocNameI -> DocName) -> FamilyDecl DocNameI -> DocName
forall a b. (a -> b) -> a -> b
$ 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 :: LaTeX
methodTable =
      String -> LaTeX
text String
"\\haddockpremethods{}" LaTeX -> LaTeX -> LaTeX
<> LaTeX -> LaTeX
emph (String -> LaTeX
text String
"Methods") LaTeX -> LaTeX -> LaTeX
$$
      [LaTeX] -> LaTeX
vcat  [ Maybe LaTeX
-> DocForDecl DocName
-> [DocName]
-> LHsType DocNameI
-> Bool
-> LaTeX
ppFunSig Maybe LaTeX
leader DocForDecl DocName
doc [DocName]
names (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
typ) Bool
unicode
            | L SrcSpan
_ (ClassOpSig XClassOpSig DocNameI
_ Bool
is_def [Located (IdP DocNameI)]
lnames LHsSigType DocNameI
typ) <- [LSig 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. [a] -> a
head [DocName]
names) [(DocName, DocForDecl DocName)]
subdocs
                  names :: [DocName]
names = (Located DocName -> DocName) -> [Located DocName] -> [DocName]
forall a b. (a -> b) -> [a] -> [b]
map Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP DocNameI)]
[Located DocName]
lnames
                  leader :: Maybe LaTeX
leader = if Bool
is_def then LaTeX -> Maybe LaTeX
forall a. a -> Maybe a
Just (String -> LaTeX
keyword String
"default") else Maybe LaTeX
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.

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

ppClassDecl [DocInstance DocNameI]
_ Documentation DocName
_ [(DocName, DocForDecl DocName)]
_ TyClDecl DocNameI
_ Bool
_ = String -> LaTeX
forall a. HasCallStack => String -> a
error String
"declaration type not supported by ppShortClassDecl"

ppDocInstances :: Bool -> [DocInstance DocNameI] -> LaTeX
ppDocInstances :: Bool -> [DocInstance DocNameI] -> LaTeX
ppDocInstances Bool
_unicode [] = LaTeX
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
  = LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc ([LaTeX] -> LaTeX
vcat ((InstHead DocNameI -> LaTeX) -> [InstHead DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> InstHead DocNameI -> LaTeX
ppInstDecl Bool
unicode) (InstHead DocNameI
iheadInstHead DocNameI -> [InstHead DocNameI] -> [InstHead DocNameI]
forall a. a -> [a] -> [a]
:[InstHead DocNameI]
is))) Maybe LaTeX
forall a. Maybe a
Nothing LaTeX -> LaTeX -> LaTeX
$$
    Bool -> [DocInstance DocNameI] -> LaTeX
ppDocInstances Bool
unicode [DocInstance DocNameI]
[(InstHead DocNameI, Maybe (MDoc DocName), Located DocName,
  Maybe Module)]
rest'
  | Bool
otherwise
  = Bool -> DocInstance DocNameI -> LaTeX
ppDocInstance Bool
unicode DocInstance DocNameI
i LaTeX -> LaTeX -> LaTeX
$$ Bool -> [DocInstance DocNameI] -> LaTeX
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 (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 :: 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 DocInstance a
_ = 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 -> LaTeX
ppDocInstance Bool
unicode (InstHead DocNameI
instHead, Maybe (MDoc (IdP DocNameI))
doc, Located (IdP DocNameI)
_, Maybe Module
_) =
  LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc (Bool -> InstHead DocNameI -> LaTeX
ppInstDecl Bool
unicode InstHead DocNameI
instHead) ((Doc DocName -> LaTeX) -> Maybe (Doc DocName) -> Maybe LaTeX
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc DocName -> LaTeX
docToLaTeX (Maybe (Doc DocName) -> Maybe LaTeX)
-> Maybe (Doc DocName) -> Maybe LaTeX
forall a b. (a -> b) -> a -> b
$ (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
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 -> LaTeX
ppInstDecl Bool
unicode (InstHead {[HsType DocNameI]
IdP DocNameI
InstType DocNameI
ihdInstType :: forall name. InstHead name -> InstType name
ihdTypes :: forall name. InstHead name -> [HsType name]
ihdClsName :: forall name. InstHead name -> IdP name
ihdInstType :: InstType DocNameI
ihdTypes :: [HsType DocNameI]
ihdClsName :: IdP DocNameI
..}) = case InstType DocNameI
ihdInstType of
  ClassInst [HsType DocNameI]
ctx LHsQTyVars DocNameI
_ [Sig DocNameI]
_ [PseudoFamilyDecl DocNameI]
_ -> String -> LaTeX
keyword String
"instance" LaTeX -> LaTeX -> LaTeX
<+> [HsType DocNameI] -> Bool -> LaTeX
ppContextNoLocs [HsType DocNameI]
ctx Bool
unicode LaTeX -> LaTeX -> LaTeX
<+> LaTeX
typ
  TypeInst Maybe (HsType DocNameI)
rhs -> String -> LaTeX
keyword String
"type" LaTeX -> LaTeX -> LaTeX
<+> String -> LaTeX
keyword String
"instance" LaTeX -> LaTeX -> LaTeX
<+> LaTeX
typ LaTeX -> LaTeX -> LaTeX
<+> Maybe (HsType DocNameI) -> LaTeX
tibody Maybe (HsType DocNameI)
rhs
  DataInst TyClDecl DocNameI
dd ->
    let nd :: NewOrData
nd = HsDataDefn DocNameI -> NewOrData
forall pass. HsDataDefn pass -> NewOrData
dd_ND (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dd)
        pref :: LaTeX
pref = case NewOrData
nd of { NewOrData
NewType -> String -> LaTeX
keyword String
"newtype"; NewOrData
DataType -> String -> LaTeX
keyword String
"data" }
    in LaTeX
pref LaTeX -> LaTeX -> LaTeX
<+> String -> LaTeX
keyword String
"instance" LaTeX -> LaTeX -> LaTeX
<+> LaTeX
typ
  where
    typ :: LaTeX
typ = DocName -> [HsType DocNameI] -> Bool -> LaTeX
ppAppNameTypes IdP DocNameI
DocName
ihdClsName [HsType DocNameI]
ihdTypes Bool
unicode
    tibody :: Maybe (HsType DocNameI) -> LaTeX
tibody = LaTeX
-> (HsType DocNameI -> LaTeX) -> Maybe (HsType DocNameI) -> LaTeX
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LaTeX
empty (\HsType DocNameI
t -> LaTeX
equals LaTeX -> LaTeX -> LaTeX
<+> Bool -> HsType DocNameI -> LaTeX
ppType Bool
unicode HsType DocNameI
t)

lookupAnySubdoc :: (Eq name1) =>
                   name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
lookupAnySubdoc :: 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
-> LaTeX
ppDataDecl [(HsDecl DocNameI, DocForDecl DocName)]
pats [DocInstance DocNameI]
instances [(DocName, DocForDecl DocName)]
subdocs Maybe (Documentation DocName)
doc TyClDecl DocNameI
dataDecl Bool
unicode =
   LaTeX -> Maybe LaTeX -> LaTeX
declWithDoc (TyClDecl DocNameI -> Bool -> LaTeX
ppDataHeader TyClDecl DocNameI
dataDecl Bool
unicode LaTeX -> LaTeX -> LaTeX
<+> LaTeX
whereBit)
               (if [LaTeX] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LaTeX]
body then Maybe LaTeX
forall a. Maybe a
Nothing else LaTeX -> Maybe LaTeX
forall a. a -> Maybe a
Just ([LaTeX] -> LaTeX
vcat [LaTeX]
body))
   LaTeX -> LaTeX -> LaTeX
$$ LaTeX
instancesBit

  where
    cons :: [LConDecl DocNameI]
cons      = HsDataDefn DocNameI -> [LConDecl DocNameI]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons (TyClDecl DocNameI -> HsDataDefn DocNameI
forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn TyClDecl DocNameI
dataDecl)
    resTy :: ConDecl DocNameI
resTy     = (LConDecl DocNameI -> ConDecl DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LConDecl DocNameI -> ConDecl DocNameI)
-> ([LConDecl DocNameI] -> LConDecl DocNameI)
-> [LConDecl DocNameI]
-> ConDecl DocNameI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LConDecl DocNameI] -> LConDecl DocNameI
forall a. [a] -> a
head) [LConDecl DocNameI]
cons

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

    (LaTeX
whereBit, [LaTeX]
leaders)
      | [LConDecl DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LConDecl DocNameI]
cons
      , [(HsDecl DocNameI, DocForDecl DocName)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(HsDecl DocNameI, DocForDecl DocName)]
pats = (LaTeX
empty,[])
      | [LConDecl DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LConDecl DocNameI]
cons = (String -> LaTeX
text String
"where", LaTeX -> [LaTeX]
forall a. a -> [a]
repeat LaTeX
empty)
      | Bool
otherwise = case ConDecl DocNameI
resTy of
        ConDeclGADT{} -> (String -> LaTeX
text String
"where", LaTeX -> [LaTeX]
forall a. a -> [a]
repeat LaTeX
empty)
        ConDecl DocNameI
_             -> (LaTeX
empty, (LaTeX -> LaTeX
decltt (String -> LaTeX
text String
"=") LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
: LaTeX -> [LaTeX]
forall a. a -> [a]
repeat (LaTeX -> LaTeX
decltt (String -> LaTeX
text String
"|"))))

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

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

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


-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
ppConstrHdr
  :: Bool                    -- ^ print explicit foralls
  -> [LHsTyVarBndr DocNameI] -- ^ type variables
  -> HsContext DocNameI      -- ^ context
  -> Bool                    -- ^ unicode
  -> LaTeX
ppConstrHdr :: Bool
-> [LHsTyVarBndr DocNameI] -> [LHsType DocNameI] -> Bool -> LaTeX
ppConstrHdr Bool
forall_ [LHsTyVarBndr DocNameI]
tvs [LHsType DocNameI]
ctxt Bool
unicode = LaTeX
ppForall LaTeX -> LaTeX -> LaTeX
<> LaTeX
ppCtxt
  where
    ppForall :: LaTeX
ppForall
      | [LHsTyVarBndr DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr DocNameI]
tvs Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
forall_ = LaTeX
empty
      | Bool
otherwise = Bool -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> LaTeX
ppForAllPart Bool
unicode [LHsTyVarBndr DocNameI]
tvs ForallVisFlag
ForallInvis

    ppCtxt :: LaTeX
ppCtxt
      | [LHsType DocNameI] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsType DocNameI]
ctxt = LaTeX
empty
      | Bool
otherwise = [LHsType DocNameI] -> Bool -> LaTeX
ppContextNoArrow [LHsType DocNameI]
ctxt Bool
unicode LaTeX -> LaTeX -> LaTeX
<+> Bool -> LaTeX
darrow Bool
unicode LaTeX -> LaTeX -> LaTeX
<> LaTeX
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 -> LaTeX -> LConDecl DocNameI -> LaTeX
ppSideBySideConstr [(DocName, DocForDecl DocName)]
subdocs Bool
unicode LaTeX
leader (L SrcSpan
_ ConDecl DocNameI
con) =
  LaTeX
leader LaTeX -> LaTeX -> LaTeX
<-> LaTeX -> LaTeX
decltt LaTeX
decl LaTeX -> LaTeX -> LaTeX
<-> Maybe (Doc DocName) -> LaTeX
rDoc Maybe (Doc DocName)
mbDoc LaTeX -> LaTeX -> LaTeX
<+> LaTeX
nl
  LaTeX -> LaTeX -> LaTeX
$$ LaTeX
fieldPart
  where
    -- Find the name of a constructors in the decl (`getConName` always returns
    -- a non-empty list)
    aConName :: SrcSpanLess (Located DocName)
aConName = Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([Located DocName] -> Located DocName
forall a. [a] -> a
head (ConDecl DocNameI -> [Located DocName]
getConNamesI ConDecl DocNameI
con))

    occ :: [OccName]
occ      = (Located DocName -> OccName) -> [Located DocName] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> OccName
nameOccName (Name -> OccName)
-> (Located DocName -> Name) -> Located DocName -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocName -> Name
forall a. NamedThing a => a -> Name
getName (DocName -> Name)
-> (Located DocName -> DocName) -> Located DocName -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([Located DocName] -> [OccName]) -> [Located DocName] -> [OccName]
forall a b. (a -> b) -> a -> b
$ ConDecl DocNameI -> [Located DocName]
getConNamesI ConDecl DocNameI
con

    ppOcc :: LaTeX
ppOcc      = [LaTeX] -> LaTeX
cat (LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ((OccName -> LaTeX) -> [OccName] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map OccName -> LaTeX
ppBinder [OccName]
occ))
    ppOccInfix :: LaTeX
ppOccInfix = [LaTeX] -> LaTeX
cat (LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ((OccName -> LaTeX) -> [OccName] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map OccName -> LaTeX
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 SrcSpanLess (Located DocName)
DocName
aConName [(DocName, DocForDecl DocName)]
subdocs)
    hasArgDocs :: Bool
hasArgDocs = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ 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 :: LaTeX
decl = case ConDecl DocNameI
con of
      ConDeclH98{ con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_args = HsConDeclDetails DocNameI
det
                , con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_ex_tvs = [LHsTyVarBndr DocNameI]
tyVars
                , con_forall :: forall pass. ConDecl pass -> Located Bool
con_forall = L SrcSpan
_ Bool
forall_
                , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext DocNameI)
cxt
                } -> let context :: SrcSpanLess (LHsContext DocNameI)
context = LHsContext DocNameI -> SrcSpanLess (LHsContext DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsContext DocNameI
-> Maybe (LHsContext DocNameI) -> LHsContext DocNameI
forall a. a -> Maybe a -> a
fromMaybe (SrcSpanLess (LHsContext DocNameI) -> LHsContext DocNameI
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc []) Maybe (LHsContext DocNameI)
cxt)
                         header_ :: LaTeX
header_ = Bool
-> [LHsTyVarBndr DocNameI] -> [LHsType DocNameI] -> Bool -> LaTeX
ppConstrHdr Bool
forall_ [LHsTyVarBndr DocNameI]
tyVars [LHsType DocNameI]
SrcSpanLess (LHsContext DocNameI)
context Bool
unicode
                     in case HsConDeclDetails DocNameI
det of
        -- Prefix constructor, e.g. 'Just a'
        PrefixCon [LHsType DocNameI]
args
          | Bool
hasArgDocs -> LaTeX
header_ LaTeX -> LaTeX -> LaTeX
<+> LaTeX
ppOcc
          | Bool
otherwise -> [LaTeX] -> LaTeX
hsep [ LaTeX
header_
                              , LaTeX
ppOcc
                              , [LaTeX] -> LaTeX
hsep ((LHsType DocNameI -> LaTeX) -> [LHsType DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> LaTeX
ppLParendType Bool
unicode) [LHsType DocNameI]
args)
                              ]

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

        -- Infix constructor, e.g. 'a :| [a]'
        InfixCon LHsType DocNameI
arg1 LHsType DocNameI
arg2
          | Bool
hasArgDocs -> LaTeX
header_ LaTeX -> LaTeX -> LaTeX
<+> LaTeX
ppOcc
          | Bool
otherwise -> [LaTeX] -> LaTeX
hsep [ LaTeX
header_
                              , Bool -> LHsType DocNameI -> LaTeX
ppLParendType Bool
unicode LHsType DocNameI
arg1
                              , LaTeX
ppOccInfix
                              , Bool -> LHsType DocNameI -> LaTeX
ppLParendType Bool
unicode LHsType DocNameI
arg2
                              ]

      ConDeclGADT{}
        | Bool
hasArgDocs Bool -> Bool -> Bool
|| Bool -> Bool
not (LaTeX -> Bool
isEmpty LaTeX
fieldPart) -> LaTeX
ppOcc
        | Bool
otherwise -> [LaTeX] -> LaTeX
hsep [ LaTeX
ppOcc
                            , Bool -> LaTeX
dcolon Bool
unicode
                            -- ++AZ++ make this prepend "{..}" when it is a record style GADT
                            , Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
unicode (ConDecl DocNameI -> LHsType DocNameI
getGADTConType ConDecl DocNameI
con)
                            ]
      XConDecl XXConDecl DocNameI
nec -> NoExtCon -> LaTeX
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl DocNameI
nec

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

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

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

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

        (ConDecl DocNameI, HsConDeclDetails DocNameI)
_ -> LaTeX
empty

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

    doConstrArgsWithDocs :: [LHsType DocNameI] -> LaTeX
doConstrArgsWithDocs [LHsType DocNameI]
args = [LaTeX] -> LaTeX
vcat ([LaTeX] -> LaTeX) -> [LaTeX] -> LaTeX
forall a b. (a -> b) -> a -> b
$ (LaTeX -> LaTeX) -> [LaTeX] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (\LaTeX
l -> LaTeX
empty LaTeX -> LaTeX -> LaTeX
<-> String -> LaTeX
text String
"\\qquad" LaTeX -> LaTeX -> LaTeX
<+> LaTeX
l) ([LaTeX] -> [LaTeX]) -> [LaTeX] -> [LaTeX]
forall a b. (a -> b) -> a -> b
$ case ConDecl DocNameI
con of
      ConDeclH98{} ->
        [ LaTeX -> LaTeX
decltt (Bool -> LHsType DocNameI -> LaTeX
ppLParendType Bool
unicode LHsType DocNameI
arg) LaTeX -> LaTeX -> LaTeX
<-> Maybe (Doc DocName) -> LaTeX
rDoc ((MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
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) LaTeX -> LaTeX -> LaTeX
<+> LaTeX
nl
        | (Int
i, LHsType DocNameI
arg) <- [Int] -> [LHsType DocNameI] -> [(Int, LHsType DocNameI)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [LHsType DocNameI]
args
        , let mdoc :: Maybe (MDoc DocName)
mdoc = Int -> 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{} ->
        [ LaTeX
l LaTeX -> LaTeX -> LaTeX
<+> String -> LaTeX
text String
"\\enspace" LaTeX -> LaTeX -> LaTeX
<+> LaTeX
r
        | (LaTeX
l,LaTeX
r) <- Bool
-> HsType DocNameI
-> Map Int (MDoc DocName)
-> [(DocName, DocForDecl DocName)]
-> LaTeX
-> [(LaTeX, LaTeX)]
ppSubSigLike Bool
unicode (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ConDecl DocNameI -> LHsType DocNameI
getGADTConType ConDecl DocNameI
con)) Map Int (MDoc DocName)
argDocs [(DocName, DocForDecl DocName)]
subdocs (Bool -> LaTeX
dcolon Bool
unicode)
        ]
      XConDecl XXConDecl DocNameI
nec -> NoExtCon -> [LaTeX]
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl DocNameI
nec


    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
    -- or also because we want Haddock to do the doc-parsing, not GHC.
    mbDoc :: Maybe (Doc DocName)
mbDoc = case ConDecl DocNameI -> [Located DocName]
getConNamesI ConDecl DocNameI
con of
              [] -> String -> Maybe (Doc DocName)
forall a. String -> a
panic String
"empty con_names"
              (Located DocName
cn:[Located DocName]
_) -> DocName
-> [(DocName, DocForDecl DocName)] -> Maybe (DocForDecl DocName)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Located DocName -> SrcSpanLess (Located DocName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located DocName
cn) [(DocName, DocForDecl DocName)]
subdocs Maybe (DocForDecl DocName)
-> (DocForDecl DocName -> Maybe (Doc DocName))
-> Maybe (Doc DocName)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                        (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
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 -> LaTeX
ppSideBySideField [(DocName, DocForDecl DocName)]
subdocs Bool
unicode (ConDeclField XConDeclField DocNameI
_ [LFieldOcc DocNameI]
names LHsType DocNameI
ltype Maybe LHsDocString
_) =
  LaTeX -> LaTeX
decltt ([LaTeX] -> LaTeX
cat (LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ((LFieldOcc DocNameI -> LaTeX) -> [LFieldOcc DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> LaTeX
ppBinder (OccName -> LaTeX)
-> (LFieldOcc DocNameI -> OccName) -> LFieldOcc DocNameI -> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (LFieldOcc DocNameI -> RdrName) -> LFieldOcc DocNameI -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located RdrName -> RdrName)
-> (LFieldOcc DocNameI -> Located RdrName)
-> LFieldOcc DocNameI
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc DocNameI -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc (FieldOcc DocNameI -> Located RdrName)
-> (LFieldOcc DocNameI -> FieldOcc DocNameI)
-> LFieldOcc DocNameI
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFieldOcc DocNameI -> FieldOcc DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LFieldOcc DocNameI]
names))
    LaTeX -> LaTeX -> LaTeX
<+> Bool -> LaTeX
dcolon Bool
unicode LaTeX -> LaTeX -> LaTeX
<+> Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
unicode LHsType DocNameI
ltype) LaTeX -> LaTeX -> LaTeX
<-> Maybe (Doc DocName) -> LaTeX
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
extFieldOcc (FieldOcc DocNameI -> XCFieldOcc DocNameI)
-> FieldOcc DocNameI -> XCFieldOcc DocNameI
forall a b. (a -> b) -> a -> b
$ LFieldOcc DocNameI -> SrcSpanLess (LFieldOcc DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LFieldOcc DocNameI -> SrcSpanLess (LFieldOcc DocNameI))
-> LFieldOcc DocNameI -> SrcSpanLess (LFieldOcc DocNameI)
forall a b. (a -> b) -> a -> b
$ [LFieldOcc DocNameI] -> LFieldOcc DocNameI
forall a. [a] -> a
head [LFieldOcc DocNameI]
names) [(DocName, DocForDecl DocName)]
subdocs Maybe (DocForDecl DocName)
-> (DocForDecl DocName -> Maybe (Doc DocName))
-> Maybe (Doc DocName)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
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
ppSideBySideField [(DocName, DocForDecl DocName)]
_ Bool
_ (XConDeclField XXConDeclField DocNameI
nec) = NoExtCon -> LaTeX
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDeclField DocNameI
nec


-- | Pretty-print a bundled pattern synonym
ppSideBySidePat :: [Located DocName]    -- ^ pattern name(s)
                -> LHsSigType DocNameI  -- ^ type of pattern(s)
                -> DocForDecl DocName   -- ^ doc map
                -> Bool                 -- ^ unicode
                -> LaTeX
ppSideBySidePat :: [Located DocName]
-> LHsSigType DocNameI -> DocForDecl DocName -> Bool -> LaTeX
ppSideBySidePat [Located DocName]
lnames LHsSigType DocNameI
typ (Documentation DocName
doc, Map Int (MDoc DocName)
argDocs) Bool
unicode =
  LaTeX -> LaTeX
decltt LaTeX
decl LaTeX -> LaTeX -> LaTeX
<-> Maybe (Doc DocName) -> LaTeX
rDoc Maybe (Doc DocName)
mDoc LaTeX -> LaTeX -> LaTeX
<+> LaTeX
nl
  LaTeX -> LaTeX -> LaTeX
$$ LaTeX
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 :: LaTeX
ppOcc = [LaTeX] -> LaTeX
hsep (LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ((Located DocName -> LaTeX) -> [Located DocName] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (DocName -> LaTeX
ppDocBinder (DocName -> LaTeX)
-> (Located DocName -> DocName) -> Located DocName -> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located DocName -> DocName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located DocName]
lnames))

    decl :: LaTeX
decl | Bool
hasArgDocs = String -> LaTeX
keyword String
"pattern" LaTeX -> LaTeX -> LaTeX
<+> LaTeX
ppOcc
         | Bool
otherwise = [LaTeX] -> LaTeX
hsep [ String -> LaTeX
keyword String
"pattern"
                            , LaTeX
ppOcc
                            , Bool -> LaTeX
dcolon Bool
unicode
                            , Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
unicode (LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
typ)
                            ]

    fieldPart :: LaTeX
fieldPart
      | Bool -> Bool
not Bool
hasArgDocs = LaTeX
empty
      | Bool
otherwise = [LaTeX] -> LaTeX
vcat
          [ LaTeX
empty LaTeX -> LaTeX -> LaTeX
<-> String -> LaTeX
text String
"\\qquad" LaTeX -> LaTeX -> LaTeX
<+> LaTeX
l LaTeX -> LaTeX -> LaTeX
<+> String -> LaTeX
text String
"\\enspace" LaTeX -> LaTeX -> LaTeX
<+> LaTeX
r
          | (LaTeX
l,LaTeX
r) <- Bool
-> HsType DocNameI
-> Map Int (MDoc DocName)
-> [(DocName, DocForDecl DocName)]
-> LaTeX
-> [(LaTeX, LaTeX)]
ppSubSigLike Bool
unicode (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
patTy) Map Int (MDoc DocName)
argDocs [] (Bool -> LaTeX
dcolon Bool
unicode)
          ]

    patTy :: LHsType DocNameI
patTy = LHsSigType DocNameI -> LHsType DocNameI
hsSigTypeI LHsSigType DocNameI
typ

    mDoc :: Maybe (Doc DocName)
mDoc = (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
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 -> LaTeX
ppDataHeader (DataDecl { tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName = L SrcSpan
_ IdP DocNameI
name, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars DocNameI
tyvars
                       , tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn { dd_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_ND = NewOrData
nd, dd_ctxt :: forall pass. HsDataDefn pass -> LHsContext pass
dd_ctxt = LHsContext DocNameI
ctxt } }) Bool
unicode
  = -- newtype or data
    (case NewOrData
nd of { NewOrData
NewType -> String -> LaTeX
keyword String
"newtype"; NewOrData
DataType -> String -> LaTeX
keyword String
"data" }) LaTeX -> LaTeX -> LaTeX
<+>
    -- context
    LHsContext DocNameI -> Bool -> LaTeX
ppLContext LHsContext DocNameI
ctxt Bool
unicode LaTeX -> LaTeX -> LaTeX
<+>
    -- T a b c ..., or a :+: b
    Bool -> DocName -> [Name] -> LaTeX
ppAppDocNameNames Bool
False IdP DocNameI
DocName
name (LHsQTyVars DocNameI -> [Name]
tyvarNames LHsQTyVars DocNameI
tyvars)
ppDataHeader TyClDecl DocNameI
_ Bool
_ = String -> LaTeX
forall a. HasCallStack => String -> a
error String
"ppDataHeader: illegal argument"


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

ppAppDocNameTyVarBndrs :: Bool -> DocName -> [LHsTyVarBndr DocNameI] -> LaTeX
ppAppDocNameTyVarBndrs :: Bool -> DocName -> [LHsTyVarBndr DocNameI] -> LaTeX
ppAppDocNameTyVarBndrs Bool
unicode DocName
n [LHsTyVarBndr DocNameI]
vs =
    DocName
-> [LHsTyVarBndr DocNameI]
-> (DocName -> LaTeX)
-> (LHsTyVarBndr DocNameI -> LaTeX)
-> LaTeX
forall a.
DocName -> [a] -> (DocName -> LaTeX) -> (a -> LaTeX) -> LaTeX
ppTypeApp DocName
n [LHsTyVarBndr DocNameI]
vs DocName -> LaTeX
ppDN (Bool -> HsTyVarBndr DocNameI -> LaTeX
ppHsTyVarBndr Bool
unicode (HsTyVarBndr DocNameI -> LaTeX)
-> (LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI)
-> LHsTyVarBndr DocNameI
-> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr DocNameI -> HsTyVarBndr DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
  where
    ppDN :: DocName -> LaTeX
ppDN = OccName -> LaTeX
ppBinder (OccName -> LaTeX) -> (DocName -> OccName) -> DocName -> LaTeX
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 -> LaTeX
ppAppNameTypes DocName
n [HsType DocNameI]
ts Bool
unicode = DocName
-> [HsType DocNameI]
-> (DocName -> LaTeX)
-> (HsType DocNameI -> LaTeX)
-> LaTeX
forall a.
DocName -> [a] -> (DocName -> LaTeX) -> (a -> LaTeX) -> LaTeX
ppTypeApp DocName
n [HsType DocNameI]
ts DocName -> LaTeX
ppDocName (Bool -> HsType DocNameI -> LaTeX
ppParendType Bool
unicode)

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

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


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

ppTypeApp DocName
n [a]
ts DocName -> LaTeX
ppDN a -> LaTeX
ppT = DocName -> LaTeX
ppDN DocName
n LaTeX -> LaTeX -> LaTeX
<+> [LaTeX] -> LaTeX
hsep ((a -> LaTeX) -> [a] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map a -> LaTeX
ppT [a]
ts)

-------------------------------------------------------------------------------
-- * Contexts
-------------------------------------------------------------------------------


ppLContext, ppLContextNoArrow :: Located (HsContext DocNameI) -> Bool -> LaTeX
ppLContext :: LHsContext DocNameI -> Bool -> LaTeX
ppLContext        = [LHsType DocNameI] -> Bool -> LaTeX
ppContext        ([LHsType DocNameI] -> Bool -> LaTeX)
-> (LHsContext DocNameI -> [LHsType DocNameI])
-> LHsContext DocNameI
-> Bool
-> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsContext DocNameI -> [LHsType DocNameI]
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
ppLContextNoArrow :: LHsContext DocNameI -> Bool -> LaTeX
ppLContextNoArrow = [LHsType DocNameI] -> Bool -> LaTeX
ppContextNoArrow ([LHsType DocNameI] -> Bool -> LaTeX)
-> (LHsContext DocNameI -> [LHsType DocNameI])
-> LHsContext DocNameI
-> Bool
-> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsContext DocNameI -> [LHsType DocNameI]
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc

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

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


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


ppContext :: HsContext DocNameI -> Bool -> LaTeX
ppContext :: [LHsType DocNameI] -> Bool -> LaTeX
ppContext [LHsType DocNameI]
cxt Bool
unicode = [HsType DocNameI] -> Bool -> LaTeX
ppContextNoLocs ((LHsType DocNameI -> HsType DocNameI)
-> [LHsType DocNameI] -> [HsType DocNameI]
forall a b. (a -> b) -> [a] -> [b]
map LHsType DocNameI -> HsType DocNameI
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LHsType DocNameI]
cxt) Bool
unicode


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


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


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


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


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


-------------------------------------------------------------------------------
-- * Rendering of HsType
--
-- Stolen from Html and tweaked for LaTeX generation
-------------------------------------------------------------------------------

ppLType, ppLParendType, ppLFunLhType :: Bool -> Located (HsType DocNameI) -> LaTeX
ppLType :: Bool -> LHsType DocNameI -> LaTeX
ppLType       Bool
unicode LHsType DocNameI
y = Bool -> HsType DocNameI -> LaTeX
ppType Bool
unicode (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
y)
ppLParendType :: Bool -> LHsType DocNameI -> LaTeX
ppLParendType Bool
unicode LHsType DocNameI
y = Bool -> HsType DocNameI -> LaTeX
ppParendType Bool
unicode (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
y)
ppLFunLhType :: Bool -> LHsType DocNameI -> LaTeX
ppLFunLhType  Bool
unicode LHsType DocNameI
y = Bool -> HsType DocNameI -> LaTeX
ppFunLhType Bool
unicode (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
y)

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

ppLHsTypeArg :: Bool -> LHsTypeArg DocNameI -> LaTeX
ppLHsTypeArg :: Bool -> HsArg (LHsType DocNameI) (LHsType DocNameI) -> LaTeX
ppLHsTypeArg Bool
unicode (HsValArg LHsType DocNameI
ty) = Bool -> LHsType DocNameI -> LaTeX
ppLParendType Bool
unicode LHsType DocNameI
ty
ppLHsTypeArg Bool
unicode (HsTypeArg SrcSpan
_ LHsType DocNameI
ki) = Bool -> LaTeX
atSign Bool
unicode LaTeX -> LaTeX -> LaTeX
<>
                                       Bool -> LHsType DocNameI -> LaTeX
ppLParendType Bool
unicode LHsType DocNameI
ki
ppLHsTypeArg Bool
_ (HsArgPar SrcSpan
_) = String -> LaTeX
text String
""

ppHsTyVarBndr :: Bool -> HsTyVarBndr DocNameI -> LaTeX
ppHsTyVarBndr :: Bool -> HsTyVarBndr DocNameI -> LaTeX
ppHsTyVarBndr Bool
_ (UserTyVar XUserTyVar DocNameI
_ (L SrcSpan
_ IdP DocNameI
name)) = DocName -> LaTeX
ppDocName IdP DocNameI
DocName
name
ppHsTyVarBndr Bool
unicode (KindedTyVar XKindedTyVar DocNameI
_ (L SrcSpan
_ IdP DocNameI
name) LHsType DocNameI
kind) =
  LaTeX -> LaTeX
parens (DocName -> LaTeX
ppDocName IdP DocNameI
DocName
name LaTeX -> LaTeX -> LaTeX
<+> Bool -> LaTeX
dcolon Bool
unicode LaTeX -> LaTeX -> LaTeX
<+> Bool -> LHsType DocNameI -> LaTeX
ppLKind Bool
unicode LHsType DocNameI
kind)
ppHsTyVarBndr Bool
_ (XTyVarBndr XXTyVarBndr DocNameI
nec) = NoExtCon -> LaTeX
forall a. NoExtCon -> a
noExtCon NoExtCon
XXTyVarBndr DocNameI
nec

ppLKind :: Bool -> LHsKind DocNameI -> LaTeX
ppLKind :: Bool -> LHsType DocNameI -> LaTeX
ppLKind Bool
unicode LHsType DocNameI
y = Bool -> HsType DocNameI -> LaTeX
ppKind Bool
unicode (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
y)

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


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

ppForAllPart :: Bool -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> LaTeX
ppForAllPart :: Bool -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> LaTeX
ppForAllPart Bool
unicode [LHsTyVarBndr DocNameI]
tvs ForallVisFlag
fvf = [LaTeX] -> LaTeX
hsep (Bool -> LaTeX
forallSymbol Bool
unicode LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
: [LaTeX]
tvs') LaTeX -> LaTeX -> LaTeX
<> LaTeX
fv
  where
    tvs' :: [LaTeX]
tvs' = Bool -> [LHsTyVarBndr DocNameI] -> [LaTeX]
ppTyVars Bool
unicode [LHsTyVarBndr DocNameI]
tvs
    fv :: LaTeX
fv = case ForallVisFlag
fvf of
           ForallVisFlag
ForallVis   -> String -> LaTeX
text String
"\\ " LaTeX -> LaTeX -> LaTeX
<> Bool -> LaTeX
arrow Bool
unicode
           ForallVisFlag
ForallInvis -> LaTeX
dot

ppr_mono_lty :: LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty :: LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty Bool
unicode = HsType DocNameI -> Bool -> LaTeX
ppr_mono_ty (LHsType DocNameI -> SrcSpanLess (LHsType DocNameI)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType DocNameI
ty) Bool
unicode


ppr_mono_ty :: HsType DocNameI -> Bool -> LaTeX
ppr_mono_ty :: HsType DocNameI -> Bool -> LaTeX
ppr_mono_ty (HsForAllTy XForAllTy DocNameI
_ ForallVisFlag
fvf [LHsTyVarBndr DocNameI]
tvs LHsType DocNameI
ty) Bool
unicode
  = [LaTeX] -> LaTeX
sep [ Bool -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> LaTeX
ppForAllPart Bool
unicode [LHsTyVarBndr DocNameI]
tvs ForallVisFlag
fvf
        , LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty Bool
unicode ]
ppr_mono_ty (HsQualTy XQualTy DocNameI
_ LHsContext DocNameI
ctxt LHsType DocNameI
ty) Bool
unicode
  = [LaTeX] -> LaTeX
sep [ LHsContext DocNameI -> Bool -> LaTeX
ppLContext LHsContext DocNameI
ctxt Bool
unicode
        , LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty Bool
unicode ]
ppr_mono_ty (HsFunTy XFunTy DocNameI
_ LHsType DocNameI
ty1 LHsType DocNameI
ty2)   Bool
u
  = [LaTeX] -> LaTeX
sep [ LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty1 Bool
u
        , Bool -> LaTeX
arrow Bool
u LaTeX -> LaTeX -> LaTeX
<+> LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty2 Bool
u ]

ppr_mono_ty (HsBangTy XBangTy DocNameI
_ HsSrcBang
b LHsType DocNameI
ty)     Bool
u = HsSrcBang -> LaTeX
ppBang HsSrcBang
b LaTeX -> LaTeX -> LaTeX
<> Bool -> LHsType DocNameI -> LaTeX
ppLParendType Bool
u LHsType DocNameI
ty
ppr_mono_ty (HsTyVar XTyVar DocNameI
_ PromotionFlag
NotPromoted (L SrcSpan
_ IdP DocNameI
name)) Bool
_ = DocName -> LaTeX
ppDocName IdP DocNameI
DocName
name
ppr_mono_ty (HsTyVar XTyVar DocNameI
_ PromotionFlag
IsPromoted  (L SrcSpan
_ IdP DocNameI
name)) Bool
_ = Char -> LaTeX
char Char
'\'' LaTeX -> LaTeX -> LaTeX
<> DocName -> LaTeX
ppDocName IdP DocNameI
DocName
name
ppr_mono_ty (HsTupleTy XTupleTy DocNameI
_ HsTupleSort
con [LHsType DocNameI]
tys) Bool
u = HsTupleSort -> [LaTeX] -> LaTeX
tupleParens HsTupleSort
con ((LHsType DocNameI -> LaTeX) -> [LHsType DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
u) [LHsType DocNameI]
tys)
ppr_mono_ty (HsSumTy XSumTy DocNameI
_ [LHsType DocNameI]
tys) Bool
u       = [LaTeX] -> LaTeX
sumParens ((LHsType DocNameI -> LaTeX) -> [LHsType DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
u) [LHsType DocNameI]
tys)
ppr_mono_ty (HsKindSig XKindSig DocNameI
_ LHsType DocNameI
ty LHsType DocNameI
kind) Bool
u = LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty Bool
u LaTeX -> LaTeX -> LaTeX
<+> Bool -> LaTeX
dcolon Bool
u LaTeX -> LaTeX -> LaTeX
<+> Bool -> LHsType DocNameI -> LaTeX
ppLKind Bool
u LHsType DocNameI
kind
ppr_mono_ty (HsListTy XListTy DocNameI
_ LHsType DocNameI
ty)       Bool
u = LaTeX -> LaTeX
brackets (LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty Bool
u)
ppr_mono_ty (HsIParamTy XIParamTy DocNameI
_ (L SrcSpan
_ HsIPName
n) LHsType DocNameI
ty) Bool
u = HsIPName -> LaTeX
ppIPName HsIPName
n LaTeX -> LaTeX -> LaTeX
<+> Bool -> LaTeX
dcolon Bool
u LaTeX -> LaTeX -> LaTeX
<+> LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty Bool
u
ppr_mono_ty (HsSpliceTy XSpliceTy DocNameI
v HsSplice DocNameI
_)    Bool
_ = Void -> LaTeX
forall a. Void -> a
absurd Void
XSpliceTy DocNameI
v
ppr_mono_ty (HsRecTy {})        Bool
_ = String -> LaTeX
text String
"{..}"
ppr_mono_ty (XHsType (NHsCoreTy {}))  Bool
_ = String -> LaTeX
forall a. HasCallStack => String -> a
error String
"ppr_mono_ty HsCoreTy"
ppr_mono_ty (HsExplicitListTy XExplicitListTy DocNameI
_ PromotionFlag
IsPromoted [LHsType DocNameI]
tys) Bool
u = LaTeX -> LaTeX
Pretty.quote (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ LaTeX -> LaTeX
brackets (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ [LaTeX] -> LaTeX
hsep ([LaTeX] -> LaTeX) -> [LaTeX] -> LaTeX
forall a b. (a -> b) -> a -> b
$ LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ([LaTeX] -> [LaTeX]) -> [LaTeX] -> [LaTeX]
forall a b. (a -> b) -> a -> b
$ (LHsType DocNameI -> LaTeX) -> [LHsType DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
u) [LHsType DocNameI]
tys
ppr_mono_ty (HsExplicitListTy XExplicitListTy DocNameI
_ PromotionFlag
NotPromoted [LHsType DocNameI]
tys) Bool
u = LaTeX -> LaTeX
brackets (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ [LaTeX] -> LaTeX
hsep ([LaTeX] -> LaTeX) -> [LaTeX] -> LaTeX
forall a b. (a -> b) -> a -> b
$ LaTeX -> [LaTeX] -> [LaTeX]
punctuate LaTeX
comma ([LaTeX] -> [LaTeX]) -> [LaTeX] -> [LaTeX]
forall a b. (a -> b) -> a -> b
$ (LHsType DocNameI -> LaTeX) -> [LHsType DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
u) [LHsType DocNameI]
tys
ppr_mono_ty (HsExplicitTupleTy XExplicitTupleTy DocNameI
_ [LHsType DocNameI]
tys) Bool
u = LaTeX -> LaTeX
Pretty.quote (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ [LaTeX] -> LaTeX
parenList ([LaTeX] -> LaTeX) -> [LaTeX] -> LaTeX
forall a b. (a -> b) -> a -> b
$ (LHsType DocNameI -> LaTeX) -> [LHsType DocNameI] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> LHsType DocNameI -> LaTeX
ppLType Bool
u) [LHsType DocNameI]
tys

ppr_mono_ty (HsAppTy XAppTy DocNameI
_ LHsType DocNameI
fun_ty LHsType DocNameI
arg_ty) Bool
unicode
  = [LaTeX] -> LaTeX
hsep [LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
fun_ty Bool
unicode, LHsType DocNameI -> Bool -> LaTeX
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
  = [LaTeX] -> LaTeX
hsep [LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
fun_ty Bool
unicode, Bool -> LaTeX
atSign Bool
unicode LaTeX -> LaTeX -> LaTeX
<> LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
arg_ki Bool
unicode]

ppr_mono_ty (HsOpTy XOpTy DocNameI
_ LHsType DocNameI
ty1 Located (IdP DocNameI)
op LHsType DocNameI
ty2) Bool
unicode
  = LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty1 Bool
unicode LaTeX -> LaTeX -> LaTeX
<+> LaTeX
ppr_op LaTeX -> LaTeX -> LaTeX
<+> LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty2 Bool
unicode
  where
    ppr_op :: LaTeX
ppr_op | OccName -> Bool
isSymOcc (Located DocName -> OccName
forall a. NamedThing a => a -> OccName
getOccName Located (IdP DocNameI)
Located DocName
op) = Located DocName -> LaTeX
ppLDocName Located (IdP DocNameI)
Located DocName
op
           | Bool
otherwise = Char -> LaTeX
char Char
'`' LaTeX -> LaTeX -> LaTeX
<> Located DocName -> LaTeX
ppLDocName Located (IdP DocNameI)
Located DocName
op LaTeX -> LaTeX -> LaTeX
<> Char -> LaTeX
char Char
'`'

ppr_mono_ty (HsParTy XParTy DocNameI
_ LHsType DocNameI
ty) Bool
unicode
  = LaTeX -> LaTeX
parens (LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty Bool
unicode)
--  = ppr_mono_lty ty unicode

ppr_mono_ty (HsDocTy XDocTy DocNameI
_ LHsType DocNameI
ty LHsDocString
_) Bool
unicode
  = LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty LHsType DocNameI
ty Bool
unicode

ppr_mono_ty (HsWildCardTy XWildCardTy DocNameI
_) Bool
_ = Char -> LaTeX
char Char
'_'

ppr_mono_ty (HsTyLit XTyLit DocNameI
_ HsTyLit
t) Bool
u = HsTyLit -> Bool -> LaTeX
ppr_tylit HsTyLit
t Bool
u
ppr_mono_ty (HsStarTy XStarTy DocNameI
_ Bool
isUni) Bool
unicode = Bool -> LaTeX
starSymbol (Bool
isUni Bool -> Bool -> Bool
|| Bool
unicode)


ppr_tylit :: HsTyLit -> Bool -> LaTeX
ppr_tylit :: HsTyLit -> Bool -> LaTeX
ppr_tylit (HsNumTy SourceText
_ Integer
n) Bool
_ = Integer -> LaTeX
integer Integer
n
ppr_tylit (HsStrTy SourceText
_ FastString
s) Bool
_ = String -> LaTeX
text (FastString -> String
forall a. Show a => a -> String
show FastString
s)
  -- XXX: Ok in verbatim, but not otherwise
  -- XXX: Do something with Unicode parameter?


-------------------------------------------------------------------------------
-- * Names
-------------------------------------------------------------------------------


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

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

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


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

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


ppDocName :: DocName -> LaTeX
ppDocName :: DocName -> LaTeX
ppDocName = OccName -> LaTeX
ppOccName (OccName -> LaTeX) -> (DocName -> OccName) -> DocName -> LaTeX
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 :: Located DocName -> LaTeX
ppLDocName :: Located DocName -> LaTeX
ppLDocName (L SrcSpan
_ DocName
d) = DocName -> LaTeX
ppDocName DocName
d


ppDocBinder :: DocName -> LaTeX
ppDocBinder :: DocName -> LaTeX
ppDocBinder = OccName -> LaTeX
ppBinder (OccName -> LaTeX) -> (DocName -> OccName) -> DocName -> LaTeX
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 -> LaTeX
ppName = OccName -> LaTeX
ppOccName (OccName -> LaTeX) -> (Name -> OccName) -> Name -> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName


latexFilter :: String -> String
latexFilter :: String -> String
latexFilter = (Char -> String -> String) -> String -> String -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> String -> String
latexMunge String
""


latexMonoFilter :: String -> String
latexMonoFilter :: String -> String
latexMonoFilter = (Char -> String -> String) -> String -> String -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> String -> String
latexMonoMunge String
""


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


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


-------------------------------------------------------------------------------
-- * Doc Markup
-------------------------------------------------------------------------------


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

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

    header :: a -> LaTeX -> LaTeX
header a
1 LaTeX
d = String -> LaTeX
text String
"\\section*" LaTeX -> LaTeX -> LaTeX
<> LaTeX -> LaTeX
braces LaTeX
d
    header a
2 LaTeX
d = String -> LaTeX
text String
"\\subsection*" LaTeX -> LaTeX -> LaTeX
<> LaTeX -> LaTeX
braces LaTeX
d
    header a
l LaTeX
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 = String -> LaTeX
text String
"\\subsubsection*" LaTeX -> LaTeX -> LaTeX
<> LaTeX -> LaTeX
braces LaTeX
d
    header a
l LaTeX
_ = String -> LaTeX
forall a. HasCallStack => String -> a
error (String -> LaTeX) -> String -> LaTeX
forall a b. (a -> b) -> a -> b
$ String
"impossible header level in LaTeX generation: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l

    table :: p -> p -> p -> LaTeX
table p
_ p
_ p
_ = String -> LaTeX
text String
"{TODO: Table}"

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

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

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

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

        beg :: LaTeX
beg = String -> LaTeX
text String
"image: " LaTeX -> LaTeX -> LaTeX
<> String -> LaTeX
text String
uri

    markupMathInline :: String -> LaTeX
markupMathInline String
mathjax = String -> LaTeX
text String
"\\(" LaTeX -> LaTeX -> LaTeX
<> String -> LaTeX
text String
mathjax LaTeX -> LaTeX -> LaTeX
<> String -> LaTeX
text String
"\\)"

    markupMathDisplay :: String -> LaTeX
markupMathDisplay String
mathjax = String -> LaTeX
text String
"\\[" LaTeX -> LaTeX -> LaTeX
<> String -> LaTeX
text String
mathjax LaTeX -> LaTeX -> LaTeX
<> String -> LaTeX
text String
"\\]"

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

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

documentationToLaTeX :: Documentation DocName -> Maybe LaTeX
documentationToLaTeX :: Documentation DocName -> Maybe LaTeX
documentationToLaTeX = (Doc DocName -> LaTeX) -> Maybe (Doc DocName) -> Maybe LaTeX
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc DocName -> LaTeX
docToLaTeX (Maybe (Doc DocName) -> Maybe LaTeX)
-> (Documentation DocName -> Maybe (Doc DocName))
-> Documentation DocName
-> Maybe LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MDoc DocName -> Doc DocName)
-> Maybe (MDoc DocName) -> Maybe (Doc DocName)
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 -> LaTeX
rdrDocToLaTeX Doc RdrName
doc = DocMarkupH
  (Wrap (ModuleName, OccName))
  (Wrap RdrName)
  (StringContext -> LaTeX -> LaTeX)
-> Doc RdrName -> StringContext -> LaTeX -> LaTeX
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup DocMarkupH
  (Wrap (ModuleName, OccName))
  (Wrap RdrName)
  (StringContext -> LaTeX -> LaTeX)
forall a.
HasOccName a =>
DocMarkup (Wrap a) (StringContext -> LaTeX -> LaTeX)
latexMarkup Doc RdrName
doc StringContext
Plain LaTeX
empty


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


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


-------------------------------------------------------------------------------
-- * LaTeX utils
-------------------------------------------------------------------------------


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


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


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


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


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

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

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

-- TODO: @verbatim@ is too much since
--
--   * Haddock supports markup _inside_ of codeblocks. 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 :: LaTeX -> LaTeX
verb LaTeX
doc = String -> LaTeX
text String
"{\\haddockverb\\begin{verbatim}" LaTeX -> LaTeX -> LaTeX
$$ LaTeX
doc LaTeX -> LaTeX -> LaTeX
<> String -> LaTeX
text String
"\\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 :: LaTeX -> LaTeX
quote LaTeX
doc = String -> LaTeX
text String
"\\begin{quote}" LaTeX -> LaTeX -> LaTeX
$$ LaTeX
doc LaTeX -> LaTeX -> LaTeX
$$ String -> LaTeX
text String
"\\end{quote}"


dcolon, arrow, darrow, forallSymbol, starSymbol, atSign :: Bool -> LaTeX
dcolon :: Bool -> LaTeX
dcolon Bool
unicode = String -> LaTeX
text (if Bool
unicode then String
"∷" else String
"::")
arrow :: Bool -> LaTeX
arrow  Bool
unicode = String -> LaTeX
text (if Bool
unicode then String
"→" else String
"->")
darrow :: Bool -> LaTeX
darrow Bool
unicode = String -> LaTeX
text (if Bool
unicode then String
"⇒" else String
"=>")
forallSymbol :: Bool -> LaTeX
forallSymbol Bool
unicode = String -> LaTeX
text (if Bool
unicode then String
"∀" else String
"forall")
starSymbol :: Bool -> LaTeX
starSymbol Bool
unicode = String -> LaTeX
text (if Bool
unicode then String
"★" else String
"*")
atSign :: Bool -> LaTeX
atSign Bool
unicode = String -> LaTeX
text (if Bool
unicode then String
"@" else String
"@")

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


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


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


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


nl :: LaTeX
nl :: LaTeX
nl = String -> LaTeX
text String
"\\\\"


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


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