{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} {- Copyright (C) 2006-2015 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Writers.LaTeX Copyright : Copyright (C) 2006-2015 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 import Data.Aeson (FromJSON, object, (.=)) import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isPunctuation, ord, toLower) import Data.List (foldl', intercalate, intersperse, isInfixOf, nub, nubBy, stripPrefix, (\\)) import Data.Maybe (catMaybes, fromMaybe, isJust) import qualified Data.Text as T import Network.URI (isURI, unEscapeString) import Text.Pandoc.Class (PandocMonad, report) 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.Pandoc.Pretty import Text.Pandoc.Shared import Text.Pandoc.Slides import Text.Pandoc.Templates import Text.Pandoc.Walk import Text.Pandoc.Writers.Shared import qualified Text.Parsec as P import Text.Printf (printf) data WriterState = WriterState { stInNote :: Bool -- true if we're in a note , stInQuote :: Bool -- true if in a blockquote , stInMinipage :: Bool -- true if in minipage , stInHeading :: Bool -- true if in a section heading , stNotes :: [Doc] -- notes in a minipage , stOLLevel :: Int -- level of ordered list nesting , stOptions :: WriterOptions -- writer options, so they don't have to be parameter , stVerbInNote :: Bool -- true if document has verbatim text in note , stTable :: Bool -- true if document has a table , stStrikeout :: Bool -- true if document has strikeout , stUrl :: Bool -- true if document has visible URL link , stGraphics :: Bool -- true if document contains images , stLHS :: Bool -- true if document has literate haskell code , stBook :: Bool -- true if document uses book or memoir class , stCsquotes :: Bool -- true if document uses csquotes , stHighlighting :: Bool -- true if document has highlighted code , stIncremental :: Bool -- true if beamer lists should be displayed bit by bit , stInternalLinks :: [String] -- list of internal link targets , stUsesEuro :: Bool -- true if euro symbol used , stBeamer :: Bool -- produce beamer } startingState :: WriterOptions -> WriterState startingState options = WriterState { stInNote = False , stInQuote = False , stInMinipage = False , stInHeading = False , stNotes = [] , stOLLevel = 1 , stOptions = options , stVerbInNote = False , stTable = False , stStrikeout = False , stUrl = False , stGraphics = False , stLHS = False , stBook = (case writerTopLevelDivision options of TopLevelPart -> True TopLevelChapter -> True _ -> False) , stCsquotes = False , stHighlighting = False , stIncremental = writerIncremental options , stInternalLinks = [] , stUsesEuro = False , stBeamer = False } -- | Convert Pandoc to LaTeX. writeLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m String writeLaTeX options document = evalStateT (pandocToLaTeX options document) $ startingState options -- | Convert Pandoc to LaTeX Beamer. writeBeamer :: PandocMonad m => WriterOptions -> Pandoc -> m String writeBeamer options document = evalStateT (pandocToLaTeX options document) $ (startingState options){ stBeamer = True } type LW m = StateT WriterState m pandocToLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> LW m String 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 (_,["references"],_) _):xs -> reverse xs _ -> blocks else blocks -- see if there are internal links let isInternalLink (Link _ _ ('#':xs,_)) = [xs] isInternalLink _ = [] modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' } let template = maybe "" id $ writerTemplate options -- set stBook depending on documentclass let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing metadata <- metaToJSON options (fmap (render colwidth) . blockListToLaTeX) (fmap (render colwidth) . inlineListToLaTeX) meta let bookClasses = ["memoir","book","report","scrreprt","scrbook"] let documentClass = case P.parse pDocumentClass "template" template of Right r -> r Left _ -> "" case lookup "documentclass" (writerVariables options) `mplus` fmap stringify (lookupMeta "documentclass" meta) of Just x | x `elem` bookClasses -> modify $ \s -> s{stBook = True} | otherwise -> return () Nothing | documentClass `elem` bookClasses -> modify $ \s -> s{stBook = True} | otherwise -> return () -- check for \usepackage...{csquotes}; if present, we'll use -- \enquote{...} for smart quotes: let headerIncludesField :: FromJSON a => Maybe a headerIncludesField = getField "header-includes" metadata let headerIncludes = fromMaybe [] $ mplus (fmap return headerIncludesField) headerIncludesField when (any (isInfixOf "{csquotes}") (template : headerIncludes)) $ modify $ \s -> s{stCsquotes = True} let (blocks'', lastHeader) = if writerCiteMethod options == Citeproc then (blocks', []) else case last blocks' of Header 1 _ il -> (init blocks', il) _ -> (blocks', []) beamer <- gets stBeamer blocks''' <- if beamer then toSlides blocks'' else return blocks'' body <- mapM (elementToLaTeX options) $ hierarchicalize blocks''' (biblioTitle :: String) <- liftM (render colwidth) $ inlineListToLaTeX lastHeader let main = render colwidth $ vsep body st <- get titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta let docLangs = nub $ query (extract "lang") blocks let hasStringValue x = isJust (getField x metadata :: Maybe String) let geometryFromMargins = intercalate [','] $ catMaybes $ map (\(x,y) -> ((x ++ "=") ++) <$> getField y metadata) [("lmargin","margin-left") ,("rmargin","margin-right") ,("tmargin","margin-top") ,("bmargin","margin-bottom") ] let context = defField "toc" (writerTableOfContents options) $ defField "toc-depth" (show (writerTOCDepth options - if stBook st then 1 else 0)) $ defField "body" main $ defField "title-meta" titleMeta $ defField "author-meta" (intercalate "; " authorsMeta) $ defField "documentclass" (if beamer then ("beamer" :: String) else if stBook st then "book" else "article") $ defField "verbatim-in-note" (stVerbInNote st) $ defField "tables" (stTable st) $ defField "strikeout" (stStrikeout st) $ defField "url" (stUrl st) $ defField "numbersections" (writerNumberSections options) $ defField "lhs" (stLHS st) $ defField "graphics" (stGraphics st) $ defField "book-class" (stBook st) $ defField "euro" (stUsesEuro st) $ defField "listings" (writerListings options || stLHS st) $ defField "beamer" beamer $ (if stHighlighting st then case writerHighlightStyle options of Just sty -> defField "highlighting-macros" (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) $ -- set lang to something so polyglossia/babel is included defField "lang" (if null docLangs then ""::String else "en") $ defField "otherlangs" docLangs $ defField "colorlinks" (any hasStringValue ["citecolor", "urlcolor", "linkcolor", "toccolor"]) $ defField "dir" (if (null $ query (extract "dir") blocks) then ""::String else "ltr") $ defField "section-titles" True $ defField "geometry" geometryFromMargins $ metadata let toPolyObj lang = object [ "name" .= T.pack name , "options" .= T.pack opts ] where (name, opts) = toPolyglossia lang let lang = maybe [] (splitBy (=='-')) $ getField "lang" context otherlangs = maybe [] (map $ splitBy (=='-')) $ getField "otherlangs" context let context' = defField "babel-lang" (toBabel lang) $ defField "babel-otherlangs" (map toBabel otherlangs) $ defField "babel-newcommands" (concatMap (\(poly, babel) -> -- \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}}}\n" else "\\newcommand{\\text" ++ poly ++ "}[2][]{\\foreignlanguage{" ++ babel ++ "}{#2}}\n" ++ "\\newenvironment{" ++ poly ++ "}[2][]{\\begin{otherlanguage}{" ++ babel ++ "}}{\\end{otherlanguage}}\n" ) -- 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 -> let lng = splitBy (=='-') l in (fst $ toPolyglossia lng, toBabel lng) ) docLangs ) $ defField "polyglossia-lang" (toPolyObj lang) $ defField "polyglossia-otherlangs" (map toPolyObj otherlangs) $ defField "latex-dir-rtl" (case (getField "dir" context)::Maybe String of Just "rtl" -> True _ -> False) $ context return $ case writerTemplate options of Nothing -> main Just tpl -> renderTemplate' tpl context' -- | Convert Elements to LaTeX elementToLaTeX :: PandocMonad m => WriterOptions -> Element -> LW m Doc elementToLaTeX _ (Blk block) = blockToLaTeX block elementToLaTeX opts (Sec level _ (id',classes,_) title' elements) = do modify $ \s -> s{stInHeading = True} header' <- sectionHeader ("unnumbered" `elem` classes) id' level title' modify $ \s -> s{stInHeading = False} innerContents <- mapM (elementToLaTeX opts) elements return $ vsep (header' : innerContents) data StringContext = TextString | URLString | CodeString deriving (Eq) -- escape things as needed for LaTeX stringToLaTeX :: PandocMonad m => StringContext -> String -> LW m String stringToLaTeX _ [] = return "" stringToLaTeX ctx (x:xs) = do opts <- gets stOptions rest <- stringToLaTeX ctx xs let ligatures = isEnabled Ext_smart opts && ctx == TextString let isUrl = ctx == URLString when (x == '€') $ modify $ \st -> st{ stUsesEuro = True } return $ case x of '€' -> "\\euro{}" ++ rest '{' -> "\\{" ++ rest '}' -> "\\}" ++ rest '`' | ctx == CodeString -> "\\textasciigrave{}" ++ rest '$' | not isUrl -> "\\$" ++ rest '%' -> "\\%" ++ rest '&' -> "\\&" ++ rest '_' | not isUrl -> "\\_" ++ rest '#' -> "\\#" ++ rest '-' | not isUrl -> case xs of -- prevent adjacent hyphens from forming ligatures ('-':_) -> "-\\/" ++ rest _ -> '-' : rest '~' | not isUrl -> "\\textasciitilde{}" ++ rest '^' -> "\\^{}" ++ rest '\\'| isUrl -> '/' : rest -- NB. / works as path sep even on Windows | otherwise -> "\\textbackslash{}" ++ rest '|' | not isUrl -> "\\textbar{}" ++ rest '<' -> "\\textless{}" ++ rest '>' -> "\\textgreater{}" ++ rest '[' -> "{[}" ++ rest -- to avoid interpretation as ']' -> "{]}" ++ rest -- optional arguments '\'' | ctx == CodeString -> "\\textquotesingle{}" ++ rest '\160' -> "~" ++ rest '\x202F' -> "\\," ++ rest '\x2026' -> "\\ldots{}" ++ rest '\x2018' | ligatures -> "`" ++ rest '\x2019' | ligatures -> "'" ++ rest '\x201C' | ligatures -> "``" ++ rest '\x201D' | ligatures -> "''" ++ rest '\x2014' | ligatures -> "---" ++ rest '\x2013' | ligatures -> "--" ++ rest _ -> x : rest toLabel :: PandocMonad m => String -> LW m String toLabel z = go `fmap` stringToLaTeX URLString z where go [] = "" go (x:xs) | (isLetter x || isDigit x) && isAscii x = x:go xs | elem x ("_-+=:;." :: String) = x:go xs | otherwise = "ux" ++ printf "%x" (ord x) ++ go xs -- | Puts contents into LaTeX command. inCmd :: String -> Doc -> Doc inCmd cmd contents = char '\\' <> text 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 concat `fmap` (mapM (elementToBeamer slideLevel) $ hierarchicalize bs') elementToBeamer :: PandocMonad m => Int -> Element -> LW m [Block] elementToBeamer _slideLevel (Blk b) = return [b] elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) | lvl > slideLevel = do bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts return $ Para ( RawInline "latex" "\\begin{block}{" : tit ++ [RawInline "latex" "}"] ) : bs ++ [RawBlock "latex" "\\end{block}"] | lvl < slideLevel = do bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts return $ (Header lvl (ident,classes,kvs) tit) : bs | otherwise = do -- lvl == slideLevel -- note: [fragile] is required or verbatim breaks let hasCodeBlock (CodeBlock _ _) = [True] hasCodeBlock _ = [] let hasCode (Code _ _) = [True] hasCode _ = [] let fragile = "fragile" `elem` classes || not (null $ query hasCodeBlock elts ++ query hasCode elts) let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "b", "c", "t", "environment", "label", "plain", "shrink", "standout"] let optionslist = ["fragile" | fragile] ++ [k | k <- classes, k `elem` frameoptions] ++ [k ++ "=" ++ v | (k,v) <- kvs, k `elem` frameoptions] let options = if null optionslist then "" else "[" ++ intercalate "," optionslist ++ "]" let latex = RawInline (Format "latex") slideTitle <- if tit == [Str "\0"] -- marker for hrule then return [] else if null ident then return $ latex "{" : tit ++ [latex "}"] else do ref <- toLabel ident return $ latex ("{%\n\\protect\\hypertarget{" ++ ref ++ "}{%\n") : tit ++ [latex "}}"] let slideStart = Para $ RawInline "latex" ("\\begin{frame}" ++ options) : slideTitle let slideEnd = RawBlock "latex" "\\end{frame}" -- now carve up slide into blocks if there are sections inside bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts return $ slideStart : bs ++ [slideEnd] isListBlock :: Block -> Bool isListBlock (BulletList _) = True isListBlock (OrderedList _ _) = True isListBlock (DefinitionList _) = True isListBlock _ = False isLineBreakOrSpace :: Inline -> Bool isLineBreakOrSpace LineBreak = True isLineBreakOrSpace SoftBreak = True isLineBreakOrSpace Space = True isLineBreakOrSpace _ = False -- | Convert Pandoc block element to LaTeX. blockToLaTeX :: PandocMonad m => Block -- ^ Block to convert -> LW m Doc blockToLaTeX Null = return empty blockToLaTeX (Div (identifier,classes,kvs) bs) = do beamer <- gets stBeamer linkAnchor' <- hypertarget True identifier empty -- see #2704 for the motivation for adding \leavevmode: let linkAnchor = case bs of Para _ : _ | not (isEmpty linkAnchor') -> "\\leavevmode" <> linkAnchor' <> "%" _ -> linkAnchor' let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir let wrapDir = case lookup "dir" kvs of Just "rtl" -> align "RTL" Just "ltr" -> align "LTR" _ -> id wrapLang txt = case lookup "lang" kvs of Just lng -> let (l, o) = toPolyglossiaEnv lng ops = if null o then "" else brackets $ text o in inCmd "begin" (text l) <> ops $$ blankline <> txt <> blankline $$ inCmd "end" (text l) Nothing -> txt wrapNotes txt = if beamer && "notes" `elem` classes then "\\note" <> braces txt -- speaker notes else linkAnchor $$ txt fmap (wrapDir . wrapLang . wrapNotes) $ blockListToLaTeX bs blockToLaTeX (Plain lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -- title beginning with fig: indicates that the image is a figure blockToLaTeX (Para [Image attr@(ident, _, _) txt (src,'f':'i':'g':':':tit)]) = do inNote <- gets stInNote modify $ \st -> st{ stInMinipage = True, stNotes = [] } capt <- inlineListToLaTeX txt notes <- gets stNotes modify $ \st -> st{ stInMinipage = False, stNotes = [] } -- We can't have footnotes in the list of figures, so remove them: captForLof <- if null notes then return empty else brackets <$> inlineListToLaTeX (walk deNote txt) img <- inlineToLaTeX (Image attr txt (src,tit)) let footnotes = notesToLaTeX notes lab <- labelFor ident let caption = "\\caption" <> captForLof <> braces capt <> lab let figure = cr <> "\\begin{figure}" $$ "\\centering" $$ img $$ caption $$ "\\end{figure}" <> cr figure' <- hypertarget True ident figure return $ if inNote -- can't have figures in notes then "\\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 $ dropWhile isLineBreakOrSpace lst blockToLaTeX (LineBlock lns) = do 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}" $$ text 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 $$ text ("\\begin{" ++ env ++ "}") $$ text str $$ text ("\\end{" ++ env ++ "}")) <> cr let listingsCodeBlock = do st <- get ref <- toLabel identifier 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) <- keyvalAttr ] ++ (if identifier == "" then [] else [ "label=" ++ ref ]) else [] printParams | null params = empty | otherwise = brackets $ hcat (intersperse ", " (map text params)) return $ flush ("\\begin{lstlisting}" <> printParams $$ text str $$ "\\end{lstlisting}") $$ cr let highlightedCodeBlock = case highlight (writerSyntaxMap opts) formatLaTeXBlock ("",classes,keyvalAttr) str of Left msg -> do unless (null msg) $ report $ CouldNotHighlight msg rawCodeBlock Right h -> modify (\st -> st{ 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) | f == Format "latex" || f == Format "tex" = return $ text x | otherwise = do report $ BlockNotRendered b return empty blockToLaTeX (BulletList []) = return empty -- otherwise latex error blockToLaTeX (BulletList lst) = do incremental <- gets stIncremental 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 $$ vcat items $$ "\\end{itemize}" blockToLaTeX (OrderedList _ []) = return empty -- otherwise latex error blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do st <- get let inc = if stIncremental st then "[<+->]" else "" let oldlevel = stOLLevel st put $ st {stOLLevel = oldlevel + 1} items <- mapM listItemToLaTeX lst modify (\s -> s {stOLLevel = oldlevel}) 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 enum = text $ "enum" ++ map toLower (toRomanNumeral oldlevel) let stylecommand = if numstyle == DefaultStyle && numdelim == DefaultDelim then empty else "\\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 $$ vcat items $$ "\\end{enumerate}" blockToLaTeX (DefinitionList []) = return empty blockToLaTeX (DefinitionList lst) = do incremental <- gets stIncremental let inc = if incremental then "[<+->]" else "" items <- mapM defListItemToLaTeX lst let spacing = if all isTightList (map 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}{\\linethickness}\\end{center}" blockToLaTeX (Header level (id',classes,_) lst) = do modify $ \s -> s{stInHeading = True} hdr <- sectionHeader ("unnumbered" `elem` classes) id' level lst modify $ \s -> s{stInHeading = False} return hdr blockToLaTeX (Table caption aligns widths heads rows) = do headers <- if all null heads then return empty else do contents <- (tableRowToLaTeX True aligns widths) heads return ("\\toprule" $$ contents $$ "\\midrule") let endhead = if all null heads then empty else text "\\endhead" let endfirsthead = if all null heads then empty else text "\\endfirsthead" captionText <- inlineListToLaTeX caption let capt = if isEmpty captionText then empty else text "\\caption" <> braces captionText <> "\\tabularnewline" $$ headers $$ endfirsthead rows' <- mapM (tableRowToLaTeX False aligns widths) rows let colDescriptors = text $ concat $ map toColDescriptor aligns modify $ \s -> s{ stTable = True } return $ "\\begin{longtable}[]" <> braces ("@{}" <> colDescriptors <> "@{}") -- the @{} removes extra space at beginning and end $$ capt $$ (if all null heads then "\\toprule" else empty) $$ headers $$ endhead $$ vcat rows' $$ "\\bottomrule" $$ "\\end{longtable}" toColDescriptor :: Alignment -> String toColDescriptor align = case align of AlignLeft -> "l" AlignRight -> "r" AlignCenter -> "c" AlignDefault -> "l" blockListToLaTeX :: PandocMonad m => [Block] -> LW m Doc blockListToLaTeX lst = vsep `fmap` mapM blockToLaTeX lst tableRowToLaTeX :: PandocMonad m => Bool -> [Alignment] -> [Double] -> [[Block]] -> LW m Doc tableRowToLaTeX header aligns widths cols = do -- scale factor compensates for extra space between columns -- so the whole table isn't larger than columnwidth let scaleFactor = 0.97 ** fromIntegral (length aligns) let isSimple [Plain _] = True isSimple [Para _] = True isSimple [] = True isSimple _ = False -- simple tables have to have simple cells: let widths' = if not (all isSimple cols) then replicate (length aligns) (0.97 / fromIntegral (length aligns)) else map (scaleFactor *) widths cells <- mapM (tableCellToLaTeX header) $ zip3 widths' aligns cols return $ hsep (intersperse "&" cells) <> "\\tabularnewline" -- For simple latex tables (without minipages or parboxes), -- we need to go to some lengths to get line breaks working: -- as LineBreak bs = \vtop{\hbox{\strut as}\hbox{\strut bs}}. fixLineBreaks :: Block -> Block fixLineBreaks (Para ils) = Para $ fixLineBreaks' ils fixLineBreaks (Plain ils) = Plain $ fixLineBreaks' ils fixLineBreaks x = x fixLineBreaks' :: [Inline] -> [Inline] fixLineBreaks' ils = case splitBy (== LineBreak) ils of [] -> [] [xs] -> xs chunks -> RawInline "tex" "\\vtop{" : concatMap tohbox chunks ++ [RawInline "tex" "}"] where tohbox ys = RawInline "tex" "\\hbox{\\strut " : ys ++ [RawInline "tex" "}"] -- We also change display math to inline math, since display -- math breaks in simple tables. displayMathToInline :: Inline -> Inline displayMathToInline (Math DisplayMath x) = Math InlineMath x displayMathToInline x = x tableCellToLaTeX :: PandocMonad m => Bool -> (Double, Alignment, [Block]) -> LW m Doc tableCellToLaTeX _ (0, _, blocks) = blockListToLaTeX $ walk fixLineBreaks $ walk displayMathToInline blocks tableCellToLaTeX header (width, align, blocks) = do modify $ \st -> st{ stInMinipage = True, stNotes = [] } cellContents <- blockListToLaTeX blocks notes <- gets stNotes modify $ \st -> st{ stInMinipage = False, stNotes = [] } let valign = text $ if header then "[b]" else "[t]" let halign = case align of AlignLeft -> "\\raggedright" AlignRight -> "\\raggedleft" AlignCenter -> "\\centering" AlignDefault -> "\\raggedright" return $ ("\\begin{minipage}" <> valign <> braces (text (printf "%.2f\\columnwidth" width)) <> (halign <> cr <> cellContents <> "\\strut" <> cr) <> "\\end{minipage}") $$ notesToLaTeX notes notesToLaTeX :: [Doc] -> Doc notesToLaTeX [] = empty notesToLaTeX ns = (case length ns of n | n > 1 -> "\\addtocounter" <> braces "footnote" <> braces (text $ show $ 1 - n) | otherwise -> empty) $$ vcat (intersperse ("\\addtocounter" <> braces "footnote" <> braces "1") $ map (\x -> "\\footnotetext" <> braces x) $ reverse ns) listItemToLaTeX :: PandocMonad m => [Block] -> LW m Doc 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 = blockListToLaTeX lst >>= return . (text "\\item ~" $$) . (nest 2) | otherwise = blockListToLaTeX lst >>= return . (text "\\item" $$) . (nest 2) defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m Doc defListItemToLaTeX (term, defs) = do term' <- inlineListToLaTeX term -- put braces around term if it contains an internal link, -- since otherwise we get bad bracket interactions: \item[\hyperref[..] let isInternalLink (Link _ _ ('#':_,_)) = True isInternalLink _ = False let term'' = if any isInternalLink term then braces term' else term' def' <- liftM vsep $ mapM blockListToLaTeX defs return $ case defs of (((Header _ _ _) : _) : _) -> "\\item" <> brackets term'' <> " ~ " $$ def' _ -> "\\item" <> brackets term'' $$ def' -- | Craft the section header, inserting the secton reference, if supplied. sectionHeader :: PandocMonad m => Bool -- True for unnumbered -> [Char] -> Int -> [Inline] -> LW m Doc sectionHeader unnumbered ident level lst = do txt <- inlineListToLaTeX lst plain <- stringToLaTeX TextString $ concatMap stringify lst let removeInvalidInline (Note _) = [] removeInvalidInline (Span (id', _, _) _) | not (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 || lstNoNotes == [] then return empty else do return $ brackets txtNoNotes let contents = if render Nothing txt == plain then braces txt else braces (text "\\texorpdfstring" <> braces txt <> braces (text plain)) book <- gets stBook 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 && level' < 4 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 then "\\addcontentsline{toc}" <> braces (text sectionType) <> braces txtNoNotes else empty hypertarget :: PandocMonad m => Bool -> String -> Doc -> LW m Doc hypertarget _ "" x = return x hypertarget addnewline ident x = do ref <- text `fmap` toLabel ident return $ text "\\hypertarget" <> braces ref <> braces ((if addnewline && not (isEmpty x) then ("%" <> cr) else empty) <> x) labelFor :: PandocMonad m => String -> LW m Doc labelFor "" = return empty labelFor ident = do ref <- text `fmap` toLabel ident return $ text "\\label" <> braces ref -- | Convert list of inline elements to LaTeX. inlineListToLaTeX :: PandocMonad m => [Inline] -- ^ Inlines to convert -> LW m Doc inlineListToLaTeX lst = mapM inlineToLaTeX (fixBreaks $ fixLineInitialSpaces lst) >>= return . hcat -- 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@('\160':_) : xs) = LineBreak : fixNbsps s ++ fixLineInitialSpaces xs fixLineInitialSpaces (x:xs) = x : fixLineInitialSpaces xs fixNbsps s = let (ys,zs) = span (=='\160') s in replicate (length ys) hspace ++ [Str zs] hspace = RawInline "latex" "\\hspace*{0.333em}" -- linebreaks after blank lines cause problems: fixBreaks [] = [] fixBreaks ys@(LineBreak : LineBreak : _) = case span (== LineBreak) ys of (lbs, rest) -> RawInline "latex" ("\\\\[" ++ show (length lbs) ++ "\\baselineskip]") : fixBreaks rest fixBreaks (y:ys) = y : fixBreaks ys isQuoted :: Inline -> Bool isQuoted (Quoted _ _) = True isQuoted _ = False -- | Convert inline element to LaTeX inlineToLaTeX :: PandocMonad m => Inline -- ^ Inline to convert -> LW m Doc inlineToLaTeX (Span (id',classes,kvs) ils) = do linkAnchor <- hypertarget False id' empty let cmds = ["textup" | "csl-no-emph" `elem` classes] ++ ["textnormal" | "csl-no-strong" `elem` classes || "csl-no-smallcaps" `elem` classes] ++ ["RL" | ("dir", "rtl") `elem` kvs] ++ ["LR" | ("dir", "ltr") `elem` kvs] ++ (case lookup "lang" kvs of Just lng -> let (l, o) = toPolyglossia $ splitBy (=='-') lng ops = if null o then "" else ("[" ++ o ++ "]") in ["text" ++ l ++ ops] Nothing -> []) contents <- inlineListToLaTeX ils return $ (if null id' then empty else "\\protect" <> linkAnchor) <> if null cmds then braces contents else foldr inCmd contents cmds inlineToLaTeX (Emph lst) = inlineListToLaTeX lst >>= return . inCmd "emph" inlineToLaTeX (Strong lst) = inlineListToLaTeX lst >>= return . inCmd "textbf" inlineToLaTeX (Strikeout lst) = do -- we need to protect VERB in an mbox or we get an error -- see #1294 contents <- inlineListToLaTeX $ protectCode lst modify $ \s -> s{ stStrikeout = True } return $ inCmd "sout" contents inlineToLaTeX (Superscript lst) = inlineListToLaTeX lst >>= return . inCmd "textsuperscript" inlineToLaTeX (Subscript lst) = do inlineListToLaTeX lst >>= return . inCmd "textsubscript" inlineToLaTeX (SmallCaps lst) = inlineListToLaTeX lst >>= return . inCmd "textsc" 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,_) str) = do opts <- gets stOptions inHeading <- gets stInHeading let listingsCode = do let listingsopt = case getListingsLanguage classes of Just l -> "[language=" ++ mbBraced l ++ "]" Nothing -> "" inNote <- gets stInNote when inNote $ modify $ \s -> s{ stVerbInNote = True } let chr = case "!\"&'()*,-./:;?@_" \\ str of (c:_) -> c [] -> '!' return $ text $ "\\lstinline" ++ listingsopt ++ [chr] ++ str ++ [chr] let rawCode = liftM (text . (\s -> "\\texttt{" ++ escapeSpaces s ++ "}")) $ stringToLaTeX CodeString str where escapeSpaces = concatMap (\c -> if c == ' ' then "\\ " else [c]) let highlightCode = do case highlight (writerSyntaxMap opts) formatLaTeXInline ("",classes,[]) str of Left msg -> do unless (null msg) $ report $ CouldNotHighlight msg rawCode Right h -> modify (\st -> st{ stHighlighting = True }) >> return (text (T.unpack h)) case () of _ | writerListings opts && not inHeading -> 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 $ "\\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) = liftM text $ stringToLaTeX TextString str inlineToLaTeX (Math InlineMath str) = return $ "\\(" <> text str <> "\\)" inlineToLaTeX (Math DisplayMath str) = return $ "\\[" <> text str <> "\\]" inlineToLaTeX il@(RawInline f str) | f == Format "latex" || f == Format "tex" = return $ text str | otherwise = do report $ InlineNotRendered il return empty inlineToLaTeX (LineBreak) = return $ "\\\\" <> 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 _ txt ('#':ident, _)) = do contents <- inlineListToLaTeX txt lab <- toLabel ident return $ text "\\protect\\hyperlink" <> braces (text lab) <> braces contents inlineToLaTeX (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> -- autolink do modify $ \s -> s{ stUrl = True } src' <- stringToLaTeX URLString (escapeURI src) return $ text $ "\\url{" ++ src' ++ "}" [Str x] | Just rest <- stripPrefix "mailto:" src, escapeURI x == rest -> -- email autolink do modify $ \s -> s{ stUrl = True } src' <- stringToLaTeX URLString (escapeURI src) contents <- inlineListToLaTeX txt return $ "\\href" <> braces (text src') <> braces ("\\nolinkurl" <> braces contents) _ -> do contents <- inlineListToLaTeX txt src' <- stringToLaTeX URLString (escapeURI src) return $ text ("\\href{" ++ src' ++ "}{") <> contents <> char '}' inlineToLaTeX (Image attr _ (source, _)) = do 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 <> text (showInInch opts (Pixel a)) <> "in"] Just (Percent a) -> [d <> text (showFl (a / 100)) <> "\\textwidth"] Just dim -> [d <> text (show dim)] Nothing -> [] dimList = showDim Width ++ showDim Height dims = if null dimList then empty else brackets $ cat (intersperse "," dimList) source' = if isURI source then source else unEscapeString source source'' <- stringToLaTeX URLString source' inHeading <- gets stInHeading return $ (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") <> dims <> braces (text source'') inlineToLaTeX (Note contents) = do inMinipage <- gets stInMinipage modify (\s -> s{stInNote = True}) contents' <- blockListToLaTeX contents modify (\s -> s {stInNote = False}) 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 modify $ \st -> st{ stNotes = noteContents : stNotes st } return $ if inMinipage then "\\footnotemark{}" -- note: a \n before } needed when note ends with a Verbatim environment else "\\footnote" <> beamerMark <> braces noteContents protectCode :: [Inline] -> [Inline] protectCode [] = [] protectCode (x@(Code ("",[],[]) _) : xs) = x : protectCode xs protectCode (x@(Code _ _) : xs) = ltx "\\mbox{" : x : ltx "}" : xs where ltx = RawInline (Format "latex") protectCode (x : xs) = x : protectCode xs citationsToNatbib :: PandocMonad m => [Citation] -> LW m Doc 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 = 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 => String -> [Inline] -> [Inline] -> String -> LW m Doc citeCommand c p s k = do args <- citeArguments p s k return $ text ("\\" ++ c) <> args citeArguments :: PandocMonad m => [Inline] -> [Inline] -> String -> LW m Doc citeArguments p s k = do let s' = case s of (Str (x:[]) : r) | isPunctuation x -> dropWhile (== Space) r (Str (x:xs) : r) | isPunctuation x -> Str xs : r _ -> s pdoc <- inlineListToLaTeX p sdoc <- inlineListToLaTeX s' let optargs = case (isEmpty pdoc, isEmpty sdoc) of (True, True ) -> empty (True, False) -> brackets sdoc (_ , _ ) -> brackets pdoc <> brackets sdoc return $ optargs <> braces (text k) citationsToBiblatex :: PandocMonad m => [Citation] -> LW m Doc 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) = do args <- mapM convertOne (c:cs) return $ text cmd <> foldl' (<>) empty args where cmd = case citationMode c of SuppressAuthor -> "\\autocites*" AuthorInText -> "\\textcites" NormalCitation -> "\\autocites" convertOne Citation { citationId = k , citationPrefix = p , citationSuffix = s } = citeArguments p s k citationsToBiblatex _ = return empty -- Determine listings language from list of class attributes. getListingsLanguage :: [String] -> Maybe String getListingsLanguage [] = Nothing getListingsLanguage (x:xs) = toListingsLanguage x <|> getListingsLanguage xs mbBraced :: String -> String mbBraced x = if not (all isAlphaNum x) then "{" <> x <> "}" else x -- Extract a key from divs and spans extract :: String -> Block -> [String] extract key (Div attr _) = lookKey key attr extract key (Plain ils) = concatMap (extractInline key) ils extract key (Para ils) = concatMap (extractInline key) ils extract key (Header _ _ ils) = concatMap (extractInline key) ils extract _ _ = [] -- Extract a key from spans extractInline :: String -> Inline -> [String] extractInline key (Span attr _) = lookKey key attr extractInline _ _ = [] -- Look up a key in an attribute and give a list of its values lookKey :: String -> Attr -> [String] lookKey key (_,_,kvs) = maybe [] words $ lookup key kvs -- In environments \Arabic instead of \arabic is used toPolyglossiaEnv :: String -> (String, String) toPolyglossiaEnv l = case toPolyglossia $ (splitBy (=='-')) l of ("arabic", o) -> ("Arabic", o) x -> x -- Takes a list of the constituents of a BCP 47 language code and -- converts it to a Polyglossia (language, options) tuple -- http://mirrors.ctan.org/macros/latex/contrib/polyglossia/polyglossia.pdf toPolyglossia :: [String] -> (String, String) toPolyglossia ("ar":"DZ":_) = ("arabic", "locale=algeria") toPolyglossia ("ar":"IQ":_) = ("arabic", "locale=mashriq") toPolyglossia ("ar":"JO":_) = ("arabic", "locale=mashriq") toPolyglossia ("ar":"LB":_) = ("arabic", "locale=mashriq") toPolyglossia ("ar":"LY":_) = ("arabic", "locale=libya") toPolyglossia ("ar":"MA":_) = ("arabic", "locale=morocco") toPolyglossia ("ar":"MR":_) = ("arabic", "locale=mauritania") toPolyglossia ("ar":"PS":_) = ("arabic", "locale=mashriq") toPolyglossia ("ar":"SY":_) = ("arabic", "locale=mashriq") toPolyglossia ("ar":"TN":_) = ("arabic", "locale=tunisia") toPolyglossia ("de":"1901":_) = ("german", "spelling=old") toPolyglossia ("de":"AT":"1901":_) = ("german", "variant=austrian, spelling=old") toPolyglossia ("de":"AT":_) = ("german", "variant=austrian") toPolyglossia ("de":"CH":"1901":_) = ("german", "variant=swiss, spelling=old") toPolyglossia ("de":"CH":_) = ("german", "variant=swiss") toPolyglossia ("de":_) = ("german", "") toPolyglossia ("dsb":_) = ("lsorbian", "") toPolyglossia ("el":"polyton":_) = ("greek", "variant=poly") toPolyglossia ("en":"AU":_) = ("english", "variant=australian") toPolyglossia ("en":"CA":_) = ("english", "variant=canadian") toPolyglossia ("en":"GB":_) = ("english", "variant=british") toPolyglossia ("en":"NZ":_) = ("english", "variant=newzealand") toPolyglossia ("en":"UK":_) = ("english", "variant=british") toPolyglossia ("en":"US":_) = ("english", "variant=american") toPolyglossia ("grc":_) = ("greek", "variant=ancient") toPolyglossia ("hsb":_) = ("usorbian", "") toPolyglossia ("la":"x":"classic":_) = ("latin", "variant=classic") toPolyglossia ("sl":_) = ("slovenian", "") toPolyglossia x = (commonFromBcp47 x, "") -- Takes a list of the constituents of a BCP 47 language code and -- converts it to a Babel language string. -- http://mirrors.ctan.org/macros/latex/required/babel/base/babel.pdf -- List of supported languages (slightly outdated): -- http://tug.ctan.org/language/hyph-utf8/doc/generic/hyph-utf8/hyphenation.pdf toBabel :: [String] -> String toBabel ("de":"1901":_) = "german" toBabel ("de":"AT":"1901":_) = "austrian" toBabel ("de":"AT":_) = "naustrian" toBabel ("de":"CH":"1901":_) = "swissgerman" toBabel ("de":"CH":_) = "nswissgerman" toBabel ("de":_) = "ngerman" toBabel ("dsb":_) = "lowersorbian" toBabel ("el":"polyton":_) = "polutonikogreek" toBabel ("en":"AU":_) = "australian" toBabel ("en":"CA":_) = "canadian" toBabel ("en":"GB":_) = "british" toBabel ("en":"NZ":_) = "newzealand" toBabel ("en":"UK":_) = "british" toBabel ("en":"US":_) = "american" toBabel ("fr":"CA":_) = "canadien" toBabel ("fra":"aca":_) = "acadian" toBabel ("grc":_) = "polutonikogreek" toBabel ("hsb":_) = "uppersorbian" toBabel ("la":"x":"classic":_) = "classiclatin" toBabel ("sl":_) = "slovene" toBabel x = commonFromBcp47 x -- Takes a list of the constituents of a BCP 47 language code -- and converts it to a string shared by Babel and Polyglossia. -- https://tools.ietf.org/html/bcp47#section-2.1 commonFromBcp47 :: [String] -> String commonFromBcp47 [] = "" commonFromBcp47 ("pt":"BR":_) = "brazil" -- Note: documentation says "brazilian" works too, but it doesn't seem to work -- on some systems. See #2953. commonFromBcp47 ("sr":"Cyrl":_) = "serbianc" commonFromBcp47 ("zh":"Latn":"pinyin":_) = "pinyin" commonFromBcp47 x = fromIso $ head x where fromIso "af" = "afrikaans" fromIso "am" = "amharic" fromIso "ar" = "arabic" fromIso "as" = "assamese" fromIso "ast" = "asturian" fromIso "bg" = "bulgarian" fromIso "bn" = "bengali" fromIso "bo" = "tibetan" fromIso "br" = "breton" fromIso "ca" = "catalan" fromIso "cy" = "welsh" fromIso "cs" = "czech" fromIso "cop" = "coptic" fromIso "da" = "danish" fromIso "dv" = "divehi" fromIso "el" = "greek" fromIso "en" = "english" fromIso "eo" = "esperanto" fromIso "es" = "spanish" fromIso "et" = "estonian" fromIso "eu" = "basque" fromIso "fa" = "farsi" fromIso "fi" = "finnish" fromIso "fr" = "french" fromIso "fur" = "friulan" fromIso "ga" = "irish" fromIso "gd" = "scottish" fromIso "gez" = "ethiopic" fromIso "gl" = "galician" fromIso "he" = "hebrew" fromIso "hi" = "hindi" fromIso "hr" = "croatian" fromIso "hu" = "magyar" fromIso "hy" = "armenian" fromIso "ia" = "interlingua" fromIso "id" = "indonesian" fromIso "ie" = "interlingua" fromIso "is" = "icelandic" fromIso "it" = "italian" fromIso "jp" = "japanese" fromIso "km" = "khmer" fromIso "kmr" = "kurmanji" fromIso "kn" = "kannada" fromIso "ko" = "korean" fromIso "la" = "latin" fromIso "lo" = "lao" fromIso "lt" = "lithuanian" fromIso "lv" = "latvian" fromIso "ml" = "malayalam" fromIso "mn" = "mongolian" fromIso "mr" = "marathi" fromIso "nb" = "norsk" fromIso "nl" = "dutch" fromIso "nn" = "nynorsk" fromIso "no" = "norsk" fromIso "nqo" = "nko" fromIso "oc" = "occitan" fromIso "pa" = "panjabi" fromIso "pl" = "polish" fromIso "pms" = "piedmontese" fromIso "pt" = "portuguese" fromIso "rm" = "romansh" fromIso "ro" = "romanian" fromIso "ru" = "russian" fromIso "sa" = "sanskrit" fromIso "se" = "samin" fromIso "sk" = "slovak" fromIso "sq" = "albanian" fromIso "sr" = "serbian" fromIso "sv" = "swedish" fromIso "syr" = "syriac" fromIso "ta" = "tamil" fromIso "te" = "telugu" fromIso "th" = "thai" fromIso "ti" = "ethiopic" fromIso "tk" = "turkmen" fromIso "tr" = "turkish" fromIso "uk" = "ukrainian" fromIso "ur" = "urdu" fromIso "vi" = "vietnamese" fromIso _ = "" pDocumentOptions :: P.Parsec String () [String] pDocumentOptions = do P.char '[' opts <- P.sepBy (P.many $ P.spaces *> P.noneOf (" ,]" :: String) <* P.spaces) (P.char ',') P.char ']' return opts pDocumentClass :: P.Parsec String () String pDocumentClass = do P.skipMany (P.satisfy (/='\\')) P.string "\\documentclass" classOptions <- pDocumentOptions <|> return [] if ("article" :: String) `elem` classOptions then return "article" else do P.skipMany (P.satisfy (/='{')) P.char '{' P.manyTill P.letter (P.char '}')