{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {- | Module : Text.Pandoc.Writers.LaTeX Copyright : Copyright (C) 2006-2021 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha Portability : portable Conversion of 'Pandoc' format into LaTeX. -} module Text.Pandoc.Writers.LaTeX ( writeLaTeX , writeBeamer ) where import Control.Applicative ((<|>)) import Control.Monad.State.Strict import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isSpace, isPunctuation, ord) import Data.List (foldl', intersperse, nubBy, (\\), uncons) import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, isNothing) import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) import Text.DocTemplates (FromContext(lookupContext), renderTemplate, Val(..), Context(..)) import Text.Pandoc.BCP47 (Lang (..), getLang, renderLang) import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang) import Text.Pandoc.Definition import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight, styleToLaTeX, toListingsLanguage) import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.Options import Text.DocLayout import Text.Pandoc.Shared import Text.Pandoc.Slides import Text.Pandoc.Walk (query, walk, walkM) import Text.Pandoc.Writers.LaTeX.Caption (getCaption) import Text.Pandoc.Writers.LaTeX.Table (tableToLaTeX) import Text.Pandoc.Writers.LaTeX.Types (LW, WriterState (..), startingState) import Text.Pandoc.Writers.LaTeX.Lang (toPolyglossiaEnv, toPolyglossia, toBabel) import Text.Pandoc.Writers.Shared import Text.Printf (printf) import qualified Data.Text.Normalize as Normalize import qualified Text.Pandoc.Writers.AnnotatedTable as Ann -- | Convert Pandoc to LaTeX. writeLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeLaTeX options document = evalStateT (pandocToLaTeX options document) $ startingState options -- | Convert Pandoc to LaTeX Beamer. writeBeamer :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeBeamer options document = evalStateT (pandocToLaTeX options document) $ (startingState options){ stBeamer = True } pandocToLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> LW m Text pandocToLaTeX options (Pandoc meta blocks) = do -- Strip off final 'references' header if --natbib or --biblatex let method = writerCiteMethod options let blocks' = if method == Biblatex || method == Natbib then case reverse blocks of Div ("refs",_,_) _:xs -> reverse xs _ -> blocks else blocks -- see if there are internal links let isInternalLink (Link _ _ (s,_)) | Just ('#', xs) <- T.uncons s = [xs] isInternalLink _ = [] modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' } let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing metadata <- metaToContext options blockListToLaTeX (fmap chomp . inlineListToLaTeX) meta let chaptersClasses = ["memoir","book","report","scrreprt","scrbook","extreport","extbook","tufte-book"] let frontmatterClasses = ["memoir","book","scrbook","extbook","tufte-book"] -- these have \frontmatter etc. beamer <- gets stBeamer let documentClass = case lookupContext "documentclass" (writerVariables options) `mplus` (stringify <$> lookupMeta "documentclass" meta) of Just x -> x Nothing | beamer -> "beamer" | otherwise -> case writerTopLevelDivision options of TopLevelPart -> "book" TopLevelChapter -> "book" _ -> "article" when (documentClass `elem` chaptersClasses) $ modify $ \s -> s{ stHasChapters = True } case lookupContext "csquotes" (writerVariables options) `mplus` (stringify <$> lookupMeta "csquotes" meta) of Nothing -> return () Just "false" -> return () Just _ -> modify $ \s -> s{stCsquotes = True} let (blocks'', lastHeader) = if writerCiteMethod options == Citeproc then (blocks', []) else case reverse blocks' of Header 1 _ il : _ -> (init blocks', il) _ -> (blocks', []) blocks''' <- if beamer then toSlides blocks'' else return $ makeSections False Nothing blocks'' main <- blockListToLaTeX blocks''' biblioTitle <- inlineListToLaTeX lastHeader st <- get titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta docLangs <- catMaybes <$> mapM (toLang . Just) (ordNub (query (extract "lang") blocks)) let hasStringValue x = isJust (getField x metadata :: Maybe (Doc Text)) let geometryFromMargins = mconcat $ intersperse ("," :: Doc Text) $ mapMaybe (\(x,y) -> ((x <> "=") <>) <$> getField y metadata) [("lmargin","margin-left") ,("rmargin","margin-right") ,("tmargin","margin-top") ,("bmargin","margin-bottom") ] let toPolyObj :: Lang -> Val Text toPolyObj lang = MapVal $ Context $ M.fromList [ ("name" , SimpleVal $ literal name) , ("options" , SimpleVal $ literal opts) ] where (name, opts) = toPolyglossia lang mblang <- toLang $ case getLang options meta of Just l -> Just l Nothing | null docLangs -> Nothing | otherwise -> Just "en" -- we need a default here since lang is used in template conditionals let dirs = query (extract "dir") blocks let context = defField "toc" (writerTableOfContents options) $ defField "toc-depth" (tshow (writerTOCDepth options - if stHasChapters st then 1 else 0)) $ defField "body" main $ defField "title-meta" titleMeta $ defField "author-meta" (T.intercalate "; " authorsMeta) $ defField "documentclass" documentClass $ defField "verbatim-in-note" (stVerbInNote st) $ defField "tables" (stTable st) $ defField "multirow" (stMultiRow st) $ defField "strikeout" (stStrikeout st) $ defField "url" (stUrl st) $ defField "numbersections" (writerNumberSections options) $ defField "lhs" (stLHS st) $ defField "graphics" (stGraphics st) $ defField "has-chapters" (stHasChapters st) $ defField "has-frontmatter" (documentClass `elem` frontmatterClasses) $ defField "listings" (writerListings options || stLHS st) $ defField "beamer" beamer $ (if stHighlighting st then case writerHighlightStyle options of Just sty -> defField "highlighting-macros" (T.stripEnd $ styleToLaTeX sty) Nothing -> id else id) $ (case writerCiteMethod options of Natbib -> defField "biblio-title" biblioTitle . defField "natbib" True Biblatex -> defField "biblio-title" biblioTitle . defField "biblatex" True _ -> id) $ defField "colorlinks" (any hasStringValue ["citecolor", "urlcolor", "linkcolor", "toccolor", "filecolor"]) $ (if null dirs then id else defField "dir" ("ltr" :: Text)) $ defField "section-titles" True $ defField "csl-refs" (stHasCslRefs st) $ defField "geometry" geometryFromMargins $ (case T.uncons . render Nothing <$> getField "papersize" metadata of -- uppercase a4, a5, etc. Just (Just ('A', ds)) | not (T.null ds) && T.all isDigit ds -> resetField "papersize" ("a" <> ds) _ -> id) metadata let context' = -- note: lang is used in some conditionals in the template, -- so we need to set it if we have any babel/polyglossia: maybe id (\l -> defField "lang" (literal $ renderLang l)) mblang $ maybe id (\l -> defField "babel-lang" (literal $ toBabel l)) mblang $ defField "babel-otherlangs" (map (literal . toBabel) docLangs) $ defField "babel-newcommands" (vcat $ map (\(poly, babel) -> literal $ -- \textspanish and \textgalician are already used by babel -- save them as \oritext... and let babel use that if poly `elem` ["spanish", "galician"] then "\\let\\oritext" <> poly <> "\\text" <> poly <> "\n" <> "\\AddBabelHook{" <> poly <> "}{beforeextras}" <> "{\\renewcommand{\\text" <> poly <> "}{\\oritext" <> poly <> "}}\n" <> "\\AddBabelHook{" <> poly <> "}{afterextras}" <> "{\\renewcommand{\\text" <> poly <> "}[2][]{\\foreignlanguage{" <> poly <> "}{##2}}}" else (if poly == "latin" -- see #4161 then "\\providecommand{\\textlatin}{}\n\\renewcommand" else "\\newcommand") <> "{\\text" <> poly <> "}[2][]{\\foreignlanguage{" <> babel <> "}{#2}}\n" <> "\\newenvironment{" <> poly <> "}[2][]{\\begin{otherlanguage}{" <> babel <> "}}{\\end{otherlanguage}}" ) -- eliminate duplicates that have same polyglossia name $ nubBy (\a b -> fst a == fst b) -- find polyglossia and babel names of languages used in the document $ map (\l -> (fst $ toPolyglossia l, toBabel l)) docLangs ) $ maybe id (defField "polyglossia-lang" . toPolyObj) mblang $ defField "polyglossia-otherlangs" (ListVal (map toPolyObj docLangs :: [Val Text])) $ defField "latex-dir-rtl" ((render Nothing <$> getField "dir" context) == Just ("rtl" :: Text)) context return $ render colwidth $ case writerTemplate options of Nothing -> main Just tpl -> renderTemplate tpl context' data StringContext = TextString | URLString | CodeString deriving (Eq) -- escape things as needed for LaTeX stringToLaTeX :: PandocMonad m => StringContext -> Text -> LW m Text stringToLaTeX context zs = do opts <- gets stOptions return $ T.pack $ foldr (go opts context) mempty $ T.unpack $ if writerPreferAscii opts then Normalize.normalize Normalize.NFD zs else zs where go :: WriterOptions -> StringContext -> Char -> String -> String go opts ctx x xs = let ligatures = isEnabled Ext_smart opts && ctx == TextString isUrl = ctx == URLString mbAccentCmd = if writerPreferAscii opts && ctx == TextString then uncons xs >>= \(c,_) -> lookupAccent c else Nothing emits s = case mbAccentCmd of Just cmd -> cmd <> "{" <> s <> "}" <> drop 1 xs -- drop combining accent Nothing -> s <> xs emitc c = case mbAccentCmd of Just cmd -> cmd <> "{" <> [c] <> "}" <> drop 1 xs -- drop combining accent Nothing -> c : xs emitcseq cs = case xs of c:_ | isLetter c , ctx == TextString -> cs <> " " <> xs | isSpace c -> cs <> "{}" <> xs | ctx == TextString -> cs <> xs _ -> cs <> "{}" <> xs emitquote cs = case xs of '`':_ -> cs <> "\\," <> xs -- add thin space '\'':_ -> cs <> "\\," <> xs -- add thin space _ -> cs <> xs in case x of '?' | ligatures -> -- avoid ?` ligature case xs of '`':_ -> emits "?{}" _ -> emitc x '!' | ligatures -> -- avoid !` ligature case xs of '`':_ -> emits "!{}" _ -> emitc x '{' -> emits "\\{" '}' -> emits "\\}" '`' | ctx == CodeString -> emitcseq "\\textasciigrave" '$' | not isUrl -> emits "\\$" '%' -> emits "\\%" '&' -> emits "\\&" '_' | not isUrl -> emits "\\_" '#' -> emits "\\#" '-' | not isUrl -> case xs of -- prevent adjacent hyphens from forming ligatures ('-':_) -> emits "-\\/" _ -> emitc '-' '~' | not isUrl -> emitcseq "\\textasciitilde" '^' -> emits "\\^{}" '\\'| isUrl -> emitc '/' -- NB. / works as path sep even on Windows | otherwise -> emitcseq "\\textbackslash" '|' | not isUrl -> emitcseq "\\textbar" '<' -> emitcseq "\\textless" '>' -> emitcseq "\\textgreater" '[' -> emits "{[}" -- to avoid interpretation as ']' -> emits "{]}" -- optional arguments '\'' | ctx == CodeString -> emitcseq "\\textquotesingle" '\160' -> emits "~" '\x200B' -> emits "\\hspace{0pt}" -- zero-width space '\x202F' -> emits "\\," '\x2026' -> emitcseq "\\ldots" '\x2018' | ligatures -> emitquote "`" '\x2019' | ligatures -> emitquote "'" '\x201C' | ligatures -> emitquote "``" '\x201D' | ligatures -> emitquote "''" '\x2014' | ligatures -> emits "---" '\x2013' | ligatures -> emits "--" _ | writerPreferAscii opts -> case x of 'ı' -> emitcseq "\\i" 'ȷ' -> emitcseq "\\j" 'å' -> emitcseq "\\aa" 'Å' -> emitcseq "\\AA" 'ß' -> emitcseq "\\ss" 'ø' -> emitcseq "\\o" 'Ø' -> emitcseq "\\O" 'Ł' -> emitcseq "\\L" 'ł' -> emitcseq "\\l" 'æ' -> emitcseq "\\ae" 'Æ' -> emitcseq "\\AE" 'œ' -> emitcseq "\\oe" 'Œ' -> emitcseq "\\OE" '£' -> emitcseq "\\pounds" '€' -> emitcseq "\\euro" '©' -> emitcseq "\\copyright" _ -> emitc x | otherwise -> emitc x lookupAccent :: Char -> Maybe String lookupAccent '\779' = Just "\\H" lookupAccent '\768' = Just "\\`" lookupAccent '\769' = Just "\\'" lookupAccent '\770' = Just "\\^" lookupAccent '\771' = Just "\\~" lookupAccent '\776' = Just "\\\"" lookupAccent '\775' = Just "\\." lookupAccent '\772' = Just "\\=" lookupAccent '\781' = Just "\\|" lookupAccent '\817' = Just "\\b" lookupAccent '\807' = Just "\\c" lookupAccent '\783' = Just "\\G" lookupAccent '\777' = Just "\\h" lookupAccent '\803' = Just "\\d" lookupAccent '\785' = Just "\\f" lookupAccent '\778' = Just "\\r" lookupAccent '\865' = Just "\\t" lookupAccent '\782' = Just "\\U" lookupAccent '\780' = Just "\\v" lookupAccent '\774' = Just "\\u" lookupAccent '\808' = Just "\\k" lookupAccent '\8413' = Just "\\textcircled" lookupAccent _ = Nothing toLabel :: PandocMonad m => Text -> LW m Text toLabel z = go `fmap` stringToLaTeX URLString z where go = T.concatMap $ \x -> case x of _ | (isLetter x || isDigit x) && isAscii x -> T.singleton x | x `elemText` "_-+=:;." -> T.singleton x | otherwise -> T.pack $ "ux" <> printf "%x" (ord x) -- | Puts contents into LaTeX command. inCmd :: Text -> Doc Text -> Doc Text inCmd cmd contents = char '\\' <> literal cmd <> braces contents toSlides :: PandocMonad m => [Block] -> LW m [Block] toSlides bs = do opts <- gets stOptions let slideLevel = fromMaybe (getSlideLevel bs) $ writerSlideLevel opts let bs' = prepSlides slideLevel bs walkM (elementToBeamer slideLevel) $ makeSections False Nothing bs' -- this creates section slides and marks slides with class "slide","block" elementToBeamer :: PandocMonad m => Int -> Block -> LW m Block elementToBeamer slideLevel (Div (ident,"section":dclasses,dkvs) xs@(h@(Header lvl _ _) : ys)) | lvl > slideLevel = return $ Div (ident,"block":dclasses,dkvs) xs | lvl < slideLevel = do let isSlide (Div (_,"slide":_,_) _) = True isSlide (Div (_,"section":_,_) _) = True isSlide _ = False let (titleBs, slideBs) = break isSlide ys return $ if null titleBs then Div (ident,"section":dclasses,dkvs) xs else Div (ident,"section":dclasses,dkvs) (h : Div ("","slide":dclasses,dkvs) (h:titleBs) : slideBs) | otherwise = return $ Div (ident,"slide":dclasses,dkvs) xs elementToBeamer _ x = return x isListBlock :: Block -> Bool isListBlock (BulletList _) = True isListBlock (OrderedList _ _) = True isListBlock (DefinitionList _) = True isListBlock _ = False -- | Convert Pandoc block element to LaTeX. blockToLaTeX :: PandocMonad m => Block -- ^ Block to convert -> LW m (Doc Text) blockToLaTeX Null = return empty blockToLaTeX (Div attr@(identifier,"block":_,_) (Header _ _ ils : bs)) = do ref <- toLabel identifier let anchor = if T.null identifier then empty else cr <> "\\protect\\hypertarget" <> braces (literal ref) <> braces empty title' <- inlineListToLaTeX ils contents <- blockListToLaTeX bs wrapDiv attr $ ("\\begin{block}" <> braces title' <> anchor) $$ contents $$ "\\end{block}" blockToLaTeX (Div (identifier,"slide":dclasses,dkvs) (Header _ (_,hclasses,hkvs) ils : bs)) = do -- note: [fragile] is required or verbatim breaks let hasCodeBlock (CodeBlock _ _) = [True] hasCodeBlock _ = [] let hasCode (Code _ _) = [True] hasCode _ = [] let classes = ordNub $ dclasses ++ hclasses let kvs = ordNub $ dkvs ++ hkvs let fragile = "fragile" `elem` classes || not (null $ query hasCodeBlock bs ++ query hasCode bs) let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "fragile", "b", "c", "t", "environment", "label", "plain", "shrink", "standout", "noframenumbering"] let optionslist = ["fragile" | fragile , isNothing (lookup "fragile" kvs) , "fragile" `notElem` classes] ++ [k | k <- classes, k `elem` frameoptions] ++ [k <> "=" <> v | (k,v) <- kvs, k `elem` frameoptions] let options = if null optionslist then empty else brackets (literal (T.intercalate "," optionslist)) slideTitle <- if ils == [Str "\0"] -- marker for hrule then return empty else braces <$> inlineListToLaTeX ils ref <- toLabel identifier let slideAnchor = if T.null identifier then empty else cr <> "\\protect\\hypertarget" <> braces (literal ref) <> braces empty contents <- blockListToLaTeX bs >>= wrapDiv (identifier,classes,kvs) return $ ("\\begin{frame}" <> options <> slideTitle <> slideAnchor) $$ contents $$ "\\end{frame}" blockToLaTeX (Div (identifier@(T.uncons -> Just (_,_)),dclasses,dkvs) (Header lvl ("",hclasses,hkvs) ils : bs)) = -- move identifier from div to header blockToLaTeX (Div ("",dclasses,dkvs) (Header lvl (identifier,hclasses,hkvs) ils : bs)) blockToLaTeX (Div (identifier,classes,kvs) bs) = do beamer <- gets stBeamer oldIncremental <- gets stIncremental if beamer && "incremental" `elem` classes then modify $ \st -> st{ stIncremental = True } else when (beamer && "nonincremental" `elem` classes) $ modify $ \st -> st { stIncremental = False } result <- if identifier == "refs" || -- <- for backwards compatibility "csl-bib-body" `elem` classes then do modify $ \st -> st{ stHasCslRefs = True } inner <- blockListToLaTeX bs return $ "\\begin{CSLReferences}" <> (if "hanging-indent" `elem` classes then braces "1" else braces "0") <> (case lookup "entry-spacing" kvs of Nothing -> braces "0" Just s -> braces (literal s)) $$ inner $+$ "\\end{CSLReferences}" else blockListToLaTeX bs modify $ \st -> st{ stIncremental = oldIncremental } linkAnchor' <- hypertarget True identifier empty -- see #2704 for the motivation for adding \leavevmode -- and #7078 for \vadjust pre let linkAnchor = case bs of Para _ : _ | not (isEmpty linkAnchor') -> "\\leavevmode\\vadjust pre{" <> linkAnchor' <> "}%" _ -> linkAnchor' wrapNotes txt = if beamer && "notes" `elem` classes then "\\note" <> braces txt -- speaker notes else linkAnchor $$ txt wrapNotes <$> wrapDiv (identifier,classes,kvs) result blockToLaTeX (Plain lst) = inlineListToLaTeX lst -- title beginning with fig: indicates that the image is a figure blockToLaTeX (Para [Image attr@(ident, _, _) txt (src,tgt)]) | Just tit <- T.stripPrefix "fig:" tgt = do (capt, captForLof, footnotes) <- getCaption inlineListToLaTeX True txt lab <- labelFor ident let caption = "\\caption" <> captForLof <> braces capt <> lab img <- inlineToLaTeX (Image attr txt (src,tit)) innards <- hypertarget True ident $ "\\centering" $$ img $$ caption <> cr let figure = cr <> "\\begin{figure}" $$ innards $$ "\\end{figure}" st <- get return $ (if stInMinipage st -- can't have figures in notes or minipage (here, table cell) -- http://www.tex.ac.uk/FAQ-ouparmd.html then cr <> "\\begin{center}" $$ img $+$ capt $$ "\\end{center}" else figure) $$ footnotes -- . . . indicates pause in beamer slides blockToLaTeX (Para [Str ".",Space,Str ".",Space,Str "."]) = do beamer <- gets stBeamer if beamer then blockToLaTeX (RawBlock "latex" "\\pause") else inlineListToLaTeX [Str ".",Space,Str ".",Space,Str "."] blockToLaTeX (Para lst) = inlineListToLaTeX lst blockToLaTeX (LineBlock lns) = blockToLaTeX $ linesToPara lns blockToLaTeX (BlockQuote lst) = do beamer <- gets stBeamer case lst of [b] | beamer && isListBlock b -> do oldIncremental <- gets stIncremental modify $ \s -> s{ stIncremental = not oldIncremental } result <- blockToLaTeX b modify $ \s -> s{ stIncremental = oldIncremental } return result _ -> do oldInQuote <- gets stInQuote modify (\s -> s{stInQuote = True}) contents <- blockListToLaTeX lst modify (\s -> s{stInQuote = oldInQuote}) return $ "\\begin{quote}" $$ contents $$ "\\end{quote}" blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do opts <- gets stOptions lab <- labelFor identifier linkAnchor' <- hypertarget True identifier lab let linkAnchor = if isEmpty linkAnchor' then empty else linkAnchor' <> "%" let lhsCodeBlock = do modify $ \s -> s{ stLHS = True } return $ flush (linkAnchor $$ "\\begin{code}" $$ literal str $$ "\\end{code}") $$ cr let rawCodeBlock = do st <- get env <- if stInNote st then modify (\s -> s{ stVerbInNote = True }) >> return "Verbatim" else return "verbatim" return $ flush (linkAnchor $$ literal ("\\begin{" <> env <> "}") $$ literal str $$ literal ("\\end{" <> env <> "}")) <> cr let listingsCodeBlock = do st <- get ref <- toLabel identifier kvs <- mapM (\(k,v) -> (k,) <$> stringToLaTeX TextString v) keyvalAttr let params = if writerListings (stOptions st) then (case getListingsLanguage classes of Just l -> [ "language=" <> mbBraced l ] Nothing -> []) ++ [ "numbers=left" | "numberLines" `elem` classes || "number" `elem` classes || "number-lines" `elem` classes ] ++ [ (if key == "startFrom" then "firstnumber" else key) <> "=" <> mbBraced attr | (key,attr) <- kvs, key `notElem` ["exports", "tangle", "results"] -- see #4889 ] ++ ["label=" <> ref | not (T.null identifier)] else [] printParams | null params = empty | otherwise = brackets $ hcat (intersperse ", " (map literal params)) return $ flush ("\\begin{lstlisting}" <> printParams $$ literal str $$ "\\end{lstlisting}") $$ cr let highlightedCodeBlock = case highlight (writerSyntaxMap opts) formatLaTeXBlock ("",classes,keyvalAttr) str of Left msg -> do unless (T.null msg) $ report $ CouldNotHighlight msg rawCodeBlock Right h -> do st <- get when (stInNote st) $ modify (\s -> s{ stVerbInNote = True }) modify (\s -> s{ stHighlighting = True }) return (flush $ linkAnchor $$ text (T.unpack h)) case () of _ | isEnabled Ext_literate_haskell opts && "haskell" `elem` classes && "literate" `elem` classes -> lhsCodeBlock | writerListings opts -> listingsCodeBlock | not (null classes) && isJust (writerHighlightStyle opts) -> highlightedCodeBlock | otherwise -> rawCodeBlock blockToLaTeX b@(RawBlock f x) = do beamer <- gets stBeamer if f == Format "latex" || f == Format "tex" || (f == Format "beamer" && beamer) then return $ literal x else do report $ BlockNotRendered b return empty blockToLaTeX (BulletList []) = return empty -- otherwise latex error blockToLaTeX (BulletList lst) = do incremental <- gets stIncremental isFirstInDefinition <- gets stIsFirstInDefinition beamer <- gets stBeamer let inc = if beamer && incremental then "[<+->]" else "" items <- mapM listItemToLaTeX lst let spacing = if isTightList lst then text "\\tightlist" else empty return $ text ("\\begin{itemize}" <> inc) $$ spacing $$ -- force list at beginning of definition to start on new line (if isFirstInDefinition then "\\item[]" else mempty) $$ vcat items $$ "\\end{itemize}" blockToLaTeX (OrderedList _ []) = return empty -- otherwise latex error blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do st <- get let inc = if stBeamer st && stIncremental st then "[<+->]" else "" let oldlevel = stOLLevel st isFirstInDefinition <- gets stIsFirstInDefinition put $ st {stOLLevel = oldlevel + 1} items <- mapM listItemToLaTeX lst modify (\s -> s {stOLLevel = oldlevel}) let beamer = stBeamer st let tostyle x = case numstyle of Decimal -> "\\arabic" <> braces x UpperRoman -> "\\Roman" <> braces x LowerRoman -> "\\roman" <> braces x UpperAlpha -> "\\Alph" <> braces x LowerAlpha -> "\\alph" <> braces x Example -> "\\arabic" <> braces x DefaultStyle -> "\\arabic" <> braces x let todelim x = case numdelim of OneParen -> x <> ")" TwoParens -> parens x Period -> x <> "." _ -> x <> "." let exemplar = case numstyle of Decimal -> "1" UpperRoman -> "I" LowerRoman -> "i" UpperAlpha -> "A" LowerAlpha -> "a" Example -> "1" DefaultStyle -> "1" let enum = literal $ "enum" <> T.toLower (toRomanNumeral oldlevel) let stylecommand | numstyle == DefaultStyle && numdelim == DefaultDelim = empty | beamer && numstyle == Decimal && numdelim == Period = empty | beamer = brackets (todelim exemplar) | otherwise = "\\def" <> "\\label" <> enum <> braces (todelim $ tostyle enum) let resetcounter = if start == 1 || oldlevel > 4 then empty else "\\setcounter" <> braces enum <> braces (text $ show $ start - 1) let spacing = if isTightList lst then text "\\tightlist" else empty return $ text ("\\begin{enumerate}" <> inc) $$ stylecommand $$ resetcounter $$ spacing -- force list at beginning of definition to start on new line $$ (if isFirstInDefinition then "\\item[]" else mempty) $$ vcat items $$ "\\end{enumerate}" blockToLaTeX (DefinitionList []) = return empty blockToLaTeX (DefinitionList lst) = do incremental <- gets stIncremental beamer <- gets stBeamer let inc = if beamer && incremental then "[<+->]" else "" items <- mapM defListItemToLaTeX lst let spacing = if all (isTightList . snd) lst then text "\\tightlist" else empty return $ text ("\\begin{description}" <> inc) $$ spacing $$ vcat items $$ "\\end{description}" blockToLaTeX HorizontalRule = return "\\begin{center}\\rule{0.5\\linewidth}{0.5pt}\\end{center}" blockToLaTeX (Header level (id',classes,_) lst) = do modify $ \s -> s{stInHeading = True} hdr <- sectionHeader classes id' level lst modify $ \s -> s{stInHeading = False} return hdr blockToLaTeX (Table attr blkCapt specs thead tbodies tfoot) = tableToLaTeX inlineListToLaTeX blockListToLaTeX (Ann.toTable attr blkCapt specs thead tbodies tfoot) blockListToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text) blockListToLaTeX lst = vsep `fmap` mapM (\b -> setEmptyLine True >> blockToLaTeX b) lst listItemToLaTeX :: PandocMonad m => [Block] -> LW m (Doc Text) listItemToLaTeX lst -- we need to put some text before a header if it's the first -- element in an item. This will look ugly in LaTeX regardless, but -- this will keep the typesetter from throwing an error. | (Header{} :_) <- lst = (text "\\item ~" $$) . nest 2 <$> blockListToLaTeX lst | Plain (Str "☐":Space:is) : bs <- lst = taskListItem False is bs | Plain (Str "☒":Space:is) : bs <- lst = taskListItem True is bs | Para (Str "☐":Space:is) : bs <- lst = taskListItem False is bs | Para (Str "☒":Space:is) : bs <- lst = taskListItem True is bs | otherwise = (text "\\item" $$) . nest 2 <$> blockListToLaTeX lst where taskListItem checked is bs = do let checkbox = if checked then "$\\boxtimes$" else "$\\square$" isContents <- inlineListToLaTeX is bsContents <- blockListToLaTeX bs return $ "\\item" <> brackets checkbox $$ nest 2 (isContents $+$ bsContents) defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m (Doc Text) defListItemToLaTeX (term, defs) = do -- needed to turn off 'listings' because it breaks inside \item[...]: modify $ \s -> s{stInItem = True} term' <- inlineListToLaTeX term modify $ \s -> s{stInItem = False} -- put braces around term if it contains an internal link, -- since otherwise we get bad bracket interactions: \item[\hyperref[..] let isInternalLink (Link _ _ (src,_)) | Just ('#', _) <- T.uncons src = True isInternalLink _ = False let term'' = if any isInternalLink term then braces term' else term' def' <- case concat defs of [] -> return mempty (x:xs) -> do modify $ \s -> s{stIsFirstInDefinition = True } firstitem <- blockToLaTeX x modify $ \s -> s{stIsFirstInDefinition = False } rest <- blockListToLaTeX xs return $ firstitem $+$ rest return $ case defs of ((Header{} : _) : _) -> "\\item" <> brackets term'' <> " ~ " $$ def' ((CodeBlock{} : _) : _) -> -- see #4662 "\\item" <> brackets term'' <> " ~ " $$ def' _ -> "\\item" <> brackets term'' $$ def' -- | Craft the section header, inserting the secton reference, if supplied. sectionHeader :: PandocMonad m => [Text] -- classes -> Text -> Int -> [Inline] -> LW m (Doc Text) sectionHeader classes ident level lst = do let unnumbered = "unnumbered" `elem` classes let unlisted = "unlisted" `elem` classes txt <- inlineListToLaTeX lst plain <- stringToLaTeX TextString $ T.concat $ map stringify lst let removeInvalidInline (Note _) = [] removeInvalidInline (Span (id', _, _) _) | not (T.null id') = [] removeInvalidInline Image{} = [] removeInvalidInline x = [x] let lstNoNotes = foldr (mappend . (\x -> walkM removeInvalidInline x)) mempty lst txtNoNotes <- inlineListToLaTeX lstNoNotes -- footnotes in sections don't work (except for starred variants) -- unless you specify an optional argument: -- \section[mysec]{mysec\footnote{blah}} optional <- if unnumbered || lstNoNotes == lst || null lstNoNotes then return empty else return $ brackets txtNoNotes let contents = if render Nothing txt == plain then braces txt else braces (text "\\texorpdfstring" <> braces txt <> braces (literal plain)) book <- gets stHasChapters opts <- gets stOptions let topLevelDivision = if book && writerTopLevelDivision opts == TopLevelDefault then TopLevelChapter else writerTopLevelDivision opts beamer <- gets stBeamer let level' = if beamer && topLevelDivision `elem` [TopLevelPart, TopLevelChapter] -- beamer has parts but no chapters then if level == 1 then -1 else level - 1 else case topLevelDivision of TopLevelPart -> level - 2 TopLevelChapter -> level - 1 TopLevelSection -> level TopLevelDefault -> level let sectionType = case level' of -1 -> "part" 0 -> "chapter" 1 -> "section" 2 -> "subsection" 3 -> "subsubsection" 4 -> "paragraph" 5 -> "subparagraph" _ -> "" inQuote <- gets stInQuote let prefix = if inQuote && level' >= 4 then text "\\mbox{}%" -- needed for \paragraph, \subparagraph in quote environment -- see http://tex.stackexchange.com/questions/169830/ else empty lab <- labelFor ident let star = if unnumbered then text "*" else empty let stuffing = star <> optional <> contents stuffing' <- hypertarget True ident $ text ('\\':sectionType) <> stuffing <> lab return $ if level' > 5 then txt else prefix $$ stuffing' $$ if unnumbered && not unlisted then "\\addcontentsline{toc}" <> braces (text sectionType) <> braces txtNoNotes else empty mapAlignment :: Text -> Text mapAlignment a = case a of "top" -> "T" "top-baseline" -> "t" "bottom" -> "b" "center" -> "c" _ -> a wrapDiv :: PandocMonad m => Attr -> Doc Text -> LW m (Doc Text) wrapDiv (_,classes,kvs) t = do beamer <- gets stBeamer let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir lang <- toLang $ lookup "lang" kvs let wrapColumns = if beamer && "columns" `elem` classes then \contents -> let valign = maybe "T" mapAlignment (lookup "align" kvs) totalwidth = maybe [] (\x -> ["totalwidth=" <> x]) (lookup "totalwidth" kvs) onlytextwidth = filter ("onlytextwidth" ==) classes options = text $ T.unpack $ T.intercalate "," $ valign : totalwidth ++ onlytextwidth in inCmd "begin" "columns" <> brackets options $$ contents $$ inCmd "end" "columns" else id wrapColumn = if beamer && "column" `elem` classes then \contents -> let valign = maybe "" (brackets . text . T.unpack . mapAlignment) (lookup "align" kvs) w = maybe "0.48" fromPct (lookup "width" kvs) in inCmd "begin" "column" <> valign <> braces (literal w <> "\\textwidth") $$ contents $$ inCmd "end" "column" else id fromPct xs = case T.unsnoc xs of Just (ds, '%') -> case safeRead ds of Just digits -> showFl (digits / 100 :: Double) Nothing -> xs _ -> xs wrapDir = case lookup "dir" kvs of Just "rtl" -> align "RTL" Just "ltr" -> align "LTR" _ -> id wrapLang txt = case lang of Just lng -> let (l, o) = toPolyglossiaEnv lng ops = if T.null o then "" else brackets $ literal o in inCmd "begin" (literal l) <> ops $$ blankline <> txt <> blankline $$ inCmd "end" (literal l) Nothing -> txt return $ wrapColumns . wrapColumn . wrapDir . wrapLang $ t hypertarget :: PandocMonad m => Bool -> Text -> Doc Text -> LW m (Doc Text) hypertarget _ "" x = return x hypertarget addnewline ident x = do ref <- literal `fmap` toLabel ident return $ text "\\hypertarget" <> braces ref <> braces ((if addnewline && not (isEmpty x) then "%" <> cr else empty) <> x) labelFor :: PandocMonad m => Text -> LW m (Doc Text) labelFor "" = return empty labelFor ident = do ref <- literal `fmap` toLabel ident return $ text "\\label" <> braces ref -- Determine listings language from list of class attributes. getListingsLanguage :: [Text] -> Maybe Text getListingsLanguage xs = foldr ((<|>) . toListingsLanguage) Nothing xs mbBraced :: Text -> Text mbBraced x = if not (T.all isAlphaNum x) then "{" <> x <> "}" else x -- | Convert list of inline elements to LaTeX. inlineListToLaTeX :: PandocMonad m => [Inline] -- ^ Inlines to convert -> LW m (Doc Text) inlineListToLaTeX lst = hcat <$> mapM inlineToLaTeX (fixLineInitialSpaces . fixInitialLineBreaks $ lst) -- nonbreaking spaces (~) in LaTeX don't work after line breaks, -- so we turn nbsps after hard breaks to \hspace commands. -- this is mostly used in verse. where fixLineInitialSpaces [] = [] fixLineInitialSpaces (LineBreak : Str s : xs) | Just ('\160', _) <- T.uncons s = LineBreak : fixNbsps s <> fixLineInitialSpaces xs fixLineInitialSpaces (x:xs) = x : fixLineInitialSpaces xs fixNbsps s = let (ys,zs) = T.span (=='\160') s in replicate (T.length ys) hspace <> [Str zs] hspace = RawInline "latex" "\\hspace*{0.333em}" -- We need \hfill\break for a line break at the start -- of a paragraph. See #5591. fixInitialLineBreaks (LineBreak:xs) = RawInline (Format "latex") "\\hfill\\break\n" : fixInitialLineBreaks xs fixInitialLineBreaks xs = xs isQuoted :: Inline -> Bool isQuoted (Quoted _ _) = True isQuoted _ = False -- | Convert inline element to LaTeX inlineToLaTeX :: PandocMonad m => Inline -- ^ Inline to convert -> LW m (Doc Text) inlineToLaTeX (Span (id',classes,kvs) ils) = do linkAnchor <- hypertarget False id' empty lang <- toLang $ lookup "lang" kvs let classToCmd "csl-no-emph" = Just "textup" classToCmd "csl-no-strong" = Just "textnormal" classToCmd "csl-no-smallcaps" = Just "textnormal" classToCmd "csl-block" = Just "CSLBlock" classToCmd "csl-left-margin" = Just "CSLLeftMargin" classToCmd "csl-right-inline" = Just "CSLRightInline" classToCmd "csl-indent" = Just "CSLIndent" classToCmd _ = Nothing kvToCmd ("dir","rtl") = Just "RL" kvToCmd ("dir","ltr") = Just "LR" kvToCmd _ = Nothing langCmds = case lang of Just lng -> let (l, o) = toPolyglossia lng ops = if T.null o then "" else "[" <> o <> "]" in ["text" <> l <> ops] Nothing -> [] let cmds = mapMaybe classToCmd classes ++ mapMaybe kvToCmd kvs ++ langCmds contents <- inlineListToLaTeX ils return $ (case classes of ["csl-block"] -> (cr <>) ["csl-left-margin"] -> (cr <>) ["csl-right-inline"] -> (cr <>) ["csl-indent"] -> (cr <>) _ -> id) $ (if T.null id' then empty else "\\protect" <> linkAnchor) <> (if null cmds then braces contents else foldr inCmd contents cmds) inlineToLaTeX (Emph lst) = inCmd "emph" <$> inlineListToLaTeX lst inlineToLaTeX (Underline lst) = inCmd "underline" <$> inlineListToLaTeX lst inlineToLaTeX (Strong lst) = inCmd "textbf" <$> inlineListToLaTeX lst inlineToLaTeX (Strikeout lst) = do -- we need to protect VERB in an mbox or we get an error -- see #1294 -- with regular texttt we don't get an error, but we get -- incorrect results if there is a space, see #5529 contents <- inlineListToLaTeX $ walk (concatMap protectCode) lst modify $ \s -> s{ stStrikeout = True } return $ inCmd "sout" contents inlineToLaTeX (Superscript lst) = inCmd "textsuperscript" <$> inlineListToLaTeX lst inlineToLaTeX (Subscript lst) = inCmd "textsubscript" <$> inlineListToLaTeX lst inlineToLaTeX (SmallCaps lst) = inCmd "textsc"<$> inlineListToLaTeX lst inlineToLaTeX (Cite cits lst) = do st <- get let opts = stOptions st case writerCiteMethod opts of Natbib -> citationsToNatbib cits Biblatex -> citationsToBiblatex cits _ -> inlineListToLaTeX lst inlineToLaTeX (Code (_,classes,kvs) str) = do opts <- gets stOptions inHeading <- gets stInHeading inItem <- gets stInItem let listingsCode = do let listingsopts = (case getListingsLanguage classes of Just l -> (("language", mbBraced l):) Nothing -> id) [(k,v) | (k,v) <- kvs , k `notElem` ["exports","tangle","results"]] let listingsopt = if null listingsopts then "" else "[" <> T.intercalate ", " (map (\(k,v) -> k <> "=" <> v) listingsopts) <> "]" inNote <- gets stInNote when inNote $ modify $ \s -> s{ stVerbInNote = True } let chr = case "!\"'()*,-./:;?@" \\ T.unpack str of (c:_) -> c [] -> '!' let str' = escapeStringUsing (backslashEscapes "\\{}%~_&#^") str -- we always put lstinline in a dummy 'passthrough' command -- (defined in the default template) so that we don't have -- to change the way we escape characters depending on whether -- the lstinline is inside another command. See #1629: return $ literal $ "\\passthrough{\\lstinline" <> listingsopt <> T.singleton chr <> str' <> T.singleton chr <> "}" let rawCode = liftM (literal . (\s -> "\\texttt{" <> escapeSpaces s <> "}")) $ stringToLaTeX CodeString str where escapeSpaces = T.concatMap (\c -> if c == ' ' then "\\ " else T.singleton c) let highlightCode = case highlight (writerSyntaxMap opts) formatLaTeXInline ("",classes,[]) str of Left msg -> do unless (T.null msg) $ report $ CouldNotHighlight msg rawCode Right h -> modify (\st -> st{ stHighlighting = True }) >> return (text (T.unpack h)) case () of _ | inHeading || inItem -> rawCode -- see #5574 | writerListings opts -> listingsCode | isJust (writerHighlightStyle opts) && not (null classes) -> highlightCode | otherwise -> rawCode inlineToLaTeX (Quoted qt lst) = do contents <- inlineListToLaTeX lst csquotes <- liftM stCsquotes get opts <- gets stOptions if csquotes then return $ case qt of DoubleQuote -> "\\enquote" <> braces contents SingleQuote -> "\\enquote*" <> braces contents else do let s1 = if not (null lst) && isQuoted (head lst) then "\\," else empty let s2 = if not (null lst) && isQuoted (last lst) then "\\," else empty let inner = s1 <> contents <> s2 return $ case qt of DoubleQuote -> if isEnabled Ext_smart opts then text "``" <> inner <> text "''" else char '\x201C' <> inner <> char '\x201D' SingleQuote -> if isEnabled Ext_smart opts then char '`' <> inner <> char '\'' else char '\x2018' <> inner <> char '\x2019' inlineToLaTeX (Str str) = do setEmptyLine False liftM literal $ stringToLaTeX TextString str inlineToLaTeX (Math InlineMath str) = do setEmptyLine False return $ "\\(" <> literal (handleMathComment str) <> "\\)" inlineToLaTeX (Math DisplayMath str) = do setEmptyLine False return $ "\\[" <> literal (handleMathComment str) <> "\\]" inlineToLaTeX il@(RawInline f str) = do beamer <- gets stBeamer if f == Format "latex" || f == Format "tex" || (f == Format "beamer" && beamer) then do setEmptyLine False return $ literal str else do report $ InlineNotRendered il return empty inlineToLaTeX LineBreak = do emptyLine <- gets stEmptyLine setEmptyLine True return $ (if emptyLine then "~" else "") <> "\\\\" <> cr inlineToLaTeX SoftBreak = do wrapText <- gets (writerWrapText . stOptions) case wrapText of WrapAuto -> return space WrapNone -> return space WrapPreserve -> return cr inlineToLaTeX Space = return space inlineToLaTeX (Link (id',_,_) txt (src,_)) = (case T.uncons src of Just ('#', ident) -> do contents <- inlineListToLaTeX txt lab <- toLabel ident return $ text "\\protect\\hyperlink" <> braces (literal lab) <> braces contents _ -> case txt of [Str x] | unEscapeString (T.unpack x) == unEscapeString (T.unpack src) -> -- autolink do modify $ \s -> s{ stUrl = True } src' <- stringToLaTeX URLString (escapeURI src) return $ literal $ "\\url{" <> src' <> "}" [Str x] | Just rest <- T.stripPrefix "mailto:" src, unEscapeString (T.unpack x) == unEscapeString (T.unpack rest) -> -- email autolink do modify $ \s -> s{ stUrl = True } src' <- stringToLaTeX URLString (escapeURI src) contents <- inlineListToLaTeX txt return $ "\\href" <> braces (literal src') <> braces ("\\nolinkurl" <> braces contents) _ -> do contents <- inlineListToLaTeX txt src' <- stringToLaTeX URLString (escapeURI src) return $ literal ("\\href{" <> src' <> "}{") <> contents <> char '}') >>= (if T.null id' then return else \x -> do linkAnchor <- hypertarget False id' x return ("\\protect" <> linkAnchor)) inlineToLaTeX il@(Image _ _ (src, _)) | Just _ <- T.stripPrefix "data:" src = do report $ InlineNotRendered il return empty inlineToLaTeX (Image attr _ (source, _)) = do setEmptyLine False modify $ \s -> s{ stGraphics = True } opts <- gets stOptions let showDim dir = let d = text (show dir) <> "=" in case dimension dir attr of Just (Pixel a) -> [d <> literal (showInInch opts (Pixel a)) <> "in"] Just (Percent a) -> [d <> literal (showFl (a / 100)) <> case dir of Width -> "\\textwidth" Height -> "\\textheight" ] Just dim -> [d <> text (show dim)] Nothing -> case dir of Width | isJust (dimension Height attr) -> [d <> "\\textwidth"] Height | isJust (dimension Width attr) -> [d <> "\\textheight"] _ -> [] dimList = showDim Width <> showDim Height dims = if null dimList then empty else brackets $ mconcat (intersperse "," dimList) source' = if isURI source then source else T.pack $ unEscapeString $ T.unpack source source'' <- stringToLaTeX URLString source' inHeading <- gets stInHeading return $ (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") <> dims <> braces (literal source'') inlineToLaTeX (Note contents) = do setEmptyLine False externalNotes <- gets stExternalNotes modify (\s -> s{stInNote = True, stExternalNotes = True}) contents' <- blockListToLaTeX contents modify (\s -> s {stInNote = False, stExternalNotes = externalNotes}) let optnl = case reverse contents of (CodeBlock _ _ : _) -> cr _ -> empty let noteContents = nest 2 contents' <> optnl beamer <- gets stBeamer -- in beamer slides, display footnote from current overlay forward let beamerMark = if beamer then text "<.->" else empty if externalNotes then do modify $ \st -> st{ stNotes = noteContents : stNotes st } return "\\footnotemark{}" -- note: a \n before } needed when note ends with a Verbatim environment else return $ "\\footnote" <> beamerMark <> braces noteContents -- A comment at the end of math needs to be followed by a newline, -- or the closing delimiter gets swallowed. handleMathComment :: Text -> Text handleMathComment s = let (_, ys) = T.break (\c -> c == '\n' || c == '%') $ T.reverse s -- no T.breakEnd in case T.uncons ys of Just ('%', ys') -> case T.uncons ys' of Just ('\\', _) -> s _ -> s <> "\n" _ -> s protectCode :: Inline -> [Inline] protectCode x@(Code _ _) = [ltx "\\mbox{" , x , ltx "}"] where ltx = RawInline (Format "latex") protectCode x = [x] setEmptyLine :: PandocMonad m => Bool -> LW m () setEmptyLine b = modify $ \st -> st{ stEmptyLine = b } citationsToNatbib :: PandocMonad m => [Citation] -> LW m (Doc Text) citationsToNatbib [one] = citeCommand c p s k where Citation { citationId = k , citationPrefix = p , citationSuffix = s , citationMode = m } = one c = case m of AuthorInText -> "citet" SuppressAuthor -> "citeyearpar" NormalCitation -> "citep" citationsToNatbib cits | noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits = citeCommand "citep" p s ks where noPrefix = all (null . citationPrefix) noSuffix = all (null . citationSuffix) ismode m = all ((==) m . citationMode) p = citationPrefix $ head cits s = citationSuffix $ last cits ks = T.intercalate ", " $ map citationId cits citationsToNatbib (c:cs) | citationMode c == AuthorInText = do author <- citeCommand "citeauthor" [] [] (citationId c) cits <- citationsToNatbib (c { citationMode = SuppressAuthor } : cs) return $ author <+> cits citationsToNatbib cits = do cits' <- mapM convertOne cits return $ text "\\citetext{" <> foldl' combineTwo empty cits' <> text "}" where combineTwo a b | isEmpty a = b | otherwise = a <> text "; " <> b convertOne Citation { citationId = k , citationPrefix = p , citationSuffix = s , citationMode = m } = case m of AuthorInText -> citeCommand "citealt" p s k SuppressAuthor -> citeCommand "citeyear" p s k NormalCitation -> citeCommand "citealp" p s k citeCommand :: PandocMonad m => Text -> [Inline] -> [Inline] -> Text -> LW m (Doc Text) citeCommand c p s k = do args <- citeArguments p s k return $ literal ("\\" <> c) <> args type Prefix = [Inline] type Suffix = [Inline] type CiteId = Text data CiteGroup = CiteGroup Prefix Suffix [CiteId] citeArgumentsList :: PandocMonad m => CiteGroup -> LW m (Doc Text) citeArgumentsList (CiteGroup _ _ []) = return empty citeArgumentsList (CiteGroup pfxs sfxs ids) = do pdoc <- inlineListToLaTeX pfxs sdoc <- inlineListToLaTeX sfxs' return $ optargs pdoc sdoc <> braces (literal (T.intercalate "," (reverse ids))) where sfxs' = stripLocatorBraces $ case sfxs of (Str t : r) -> case T.uncons t of Just (x, xs) | T.null xs , isPunctuation x -> dropWhile (== Space) r | isPunctuation x -> Str xs : r _ -> sfxs _ -> sfxs optargs pdoc sdoc = case (isEmpty pdoc, isEmpty sdoc) of (True, True ) -> empty (True, False) -> brackets sdoc (_ , _ ) -> brackets pdoc <> brackets sdoc citeArguments :: PandocMonad m => [Inline] -> [Inline] -> Text -> LW m (Doc Text) citeArguments p s k = citeArgumentsList (CiteGroup p s [k]) -- strip off {} used to define locator in pandoc-citeproc; see #5722 stripLocatorBraces :: [Inline] -> [Inline] stripLocatorBraces = walk go where go (Str xs) = Str $ T.filter (\c -> c /= '{' && c /= '}') xs go x = x citationsToBiblatex :: PandocMonad m => [Citation] -> LW m (Doc Text) citationsToBiblatex [one] = citeCommand cmd p s k where Citation { citationId = k , citationPrefix = p , citationSuffix = s , citationMode = m } = one cmd = case m of SuppressAuthor -> "autocite*" AuthorInText -> "textcite" NormalCitation -> "autocite" citationsToBiblatex (c:cs) | all (\cit -> null (citationPrefix cit) && null (citationSuffix cit)) (c:cs) = do let cmd = case citationMode c of SuppressAuthor -> "\\autocite*" AuthorInText -> "\\textcite" NormalCitation -> "\\autocite" return $ text cmd <> braces (literal (T.intercalate "," (map citationId (c:cs)))) | otherwise = do let cmd = case citationMode c of SuppressAuthor -> "\\autocites*" AuthorInText -> "\\textcites" NormalCitation -> "\\autocites" groups <- mapM citeArgumentsList (reverse (foldl' grouper [] (c:cs))) return $ text cmd <> mconcat groups where grouper prev cit = case prev of ((CiteGroup oPfx oSfx ids):rest) | null oSfx && null pfx -> CiteGroup oPfx sfx (cid:ids) : rest _ -> CiteGroup pfx sfx [cid] : prev where pfx = citationPrefix cit sfx = citationSuffix cit cid = citationId cit citationsToBiblatex _ = return empty -- Extract a key from divs and spans extract :: Text -> Block -> [Text] extract key (Div attr _) = lookKey key attr extract key (Plain ils) = query (extractInline key) ils extract key (Para ils) = query (extractInline key) ils extract key (Header _ _ ils) = query (extractInline key) ils extract _ _ = [] -- Extract a key from spans extractInline :: Text -> Inline -> [Text] extractInline key (Span attr _) = lookKey key attr extractInline _ _ = [] -- Look up a key in an attribute and give a list of its values lookKey :: Text -> Attr -> [Text] lookKey key (_,_,kvs) = maybe [] T.words $ lookup key kvs