aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/LaTeX/Citation.hs
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2021-03-02 21:57:13 -0800
committerJohn MacFarlane <jgm@berkeley.edu>2021-03-02 21:57:37 -0800
commitfe483c653b34897346e3ab6e0e26de88ecee4447 (patch)
treee3a0dbcce55e526e33e1b8fd8699919cf115e3ce /src/Text/Pandoc/Writers/LaTeX/Citation.hs
parent827ecdd2de935d377399a68aaa52b3fb6ab5b607 (diff)
downloadpandoc-fe483c653b34897346e3ab6e0e26de88ecee4447.tar.gz
Split out T.P.Writers.LaTeX.Citation.
Diffstat (limited to 'src/Text/Pandoc/Writers/LaTeX/Citation.hs')
-rw-r--r--src/Text/Pandoc/Writers/LaTeX/Citation.hs181
1 files changed, 181 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Writers/LaTeX/Citation.hs b/src/Text/Pandoc/Writers/LaTeX/Citation.hs
new file mode 100644
index 000000000..f48a43d7a
--- /dev/null
+++ b/src/Text/Pandoc/Writers/LaTeX/Citation.hs
@@ -0,0 +1,181 @@
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+ Module : Text.Pandoc.Writers.LaTeX.Citation
+ Copyright : Copyright (C) 2006-2021 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+ Portability : portable
+-}
+module Text.Pandoc.Writers.LaTeX.Citation
+ ( citationsToNatbib,
+ citationsToBiblatex
+ ) where
+
+import Data.Text (Text)
+import Data.Char (isPunctuation)
+import qualified Data.Text as T
+import Text.Pandoc.Class.PandocMonad (PandocMonad)
+import Text.Pandoc.Definition
+import Data.List (foldl')
+import Text.DocLayout (Doc, brackets, empty, (<+>), text, isEmpty, literal,
+ braces)
+import Text.Pandoc.Walk
+import Text.Pandoc.Writers.LaTeX.Types ( LW )
+
+citationsToNatbib :: PandocMonad m
+ => ([Inline] -> LW m (Doc Text))
+ -> [Citation]
+ -> LW m (Doc Text)
+citationsToNatbib inlineListToLaTeX [one]
+ = citeCommand inlineListToLaTeX 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 inlineListToLaTeX cits
+ | noPrefix (tail cits) && noSuffix (init cits) && ismode NormalCitation cits
+ = citeCommand inlineListToLaTeX "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 inlineListToLaTeX (c:cs)
+ | citationMode c == AuthorInText = do
+ author <- citeCommand inlineListToLaTeX "citeauthor" [] [] (citationId c)
+ cits <- citationsToNatbib inlineListToLaTeX
+ (c { citationMode = SuppressAuthor } : cs)
+ return $ author <+> cits
+
+citationsToNatbib inlineListToLaTeX cits = do
+ cits' <- mapM convertOne cits
+ return $ text "\\citetext{" <> foldl' combineTwo empty cits' <> text "}"
+ where
+ citeCommand' = citeCommand inlineListToLaTeX
+ 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
+ => ([Inline] -> LW m (Doc Text))
+ -> Text
+ -> [Inline]
+ -> [Inline]
+ -> Text
+ -> LW m (Doc Text)
+citeCommand inlineListToLaTeX c p s k = do
+ args <- citeArguments inlineListToLaTeX 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
+ => ([Inline] -> LW m (Doc Text))
+ -> CiteGroup
+ -> LW m (Doc Text)
+citeArgumentsList _inlineListToLaTeX (CiteGroup _ _ []) = return empty
+citeArgumentsList inlineListToLaTeX (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] -> LW m (Doc Text))
+ -> [Inline]
+ -> [Inline]
+ -> Text
+ -> LW m (Doc Text)
+citeArguments inlineListToLaTeX p s k =
+ citeArgumentsList inlineListToLaTeX (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
+ => ([Inline] -> LW m (Doc Text))
+ -> [Citation] -> LW m (Doc Text)
+citationsToBiblatex inlineListToLaTeX [one]
+ = citeCommand inlineListToLaTeX 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 inlineListToLaTeX (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 inlineListToLaTeX)
+ (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