diff options
Diffstat (limited to 'src/Text/Pandoc/Citeproc.hs')
| -rw-r--r-- | src/Text/Pandoc/Citeproc.hs | 129 |
1 files changed, 44 insertions, 85 deletions
diff --git a/src/Text/Pandoc/Citeproc.hs b/src/Text/Pandoc/Citeproc.hs index 246f54516..2530ef46f 100644 --- a/src/Text/Pandoc/Citeproc.hs +++ b/src/Text/Pandoc/Citeproc.hs @@ -7,13 +7,13 @@ module Text.Pandoc.Citeproc ( processCitations, getReferences, - getStyle ) where import Citeproc import Citeproc.Pandoc () -import Text.Pandoc.Citeproc.Locator (parseLocator) +import Text.Pandoc.Citeproc.Locator (parseLocator, toLocatorMap, + LocatorInfo(..)) import Text.Pandoc.Citeproc.CslJson (cslJsonToReferences) import Text.Pandoc.Citeproc.BibTeX (readBibtexString, Variant(..)) import Text.Pandoc.Citeproc.MetaValue (metaValueToReference, metaValueToText) @@ -49,15 +49,16 @@ import qualified Data.Text as T import System.FilePath (takeExtension) import Safe (lastMay, initSafe) - processCitations :: PandocMonad m => Pandoc -> m Pandoc processCitations (Pandoc meta bs) = do style <- getStyle (Pandoc meta bs) - - mblang <- getLang meta + mblang <- getCiteprocLang meta let locale = Citeproc.mergeLocales mblang style - refs <- getReferences (Just locale) (Pandoc meta bs) + let addQuoteSpan (Quoted _ xs) = Span ("",["csl-quoted"],[]) xs + addQuoteSpan x = x + refs <- map (walk addQuoteSpan) <$> + getReferences (Just locale) (Pandoc meta bs) let otherIdsMap = foldr (\ref m -> case T.words . extractText <$> @@ -73,7 +74,9 @@ processCitations (Pandoc meta bs) = do let linkCites = maybe False truish $ lookupMeta "link-citations" meta - let opts = defaultCiteprocOptions{ linkCitations = linkCites } + let linkBib = maybe True truish $ lookupMeta "link-bibliography" meta + let opts = defaultCiteprocOptions{ linkCitations = linkCites + , linkBibliography = linkBib } let result = Citeproc.citeproc opts style mblang refs citations mapM_ (report . CiteprocWarning) (resultWarnings result) let sopts = styleOptions style @@ -88,13 +91,11 @@ processCitations (Pandoc meta bs) = do _ -> id) $ [] let bibs = mconcat $ map (\(ident, out) -> B.divWith ("ref-" <> ident,["csl-entry"],[]) . B.para . - walk (convertQuotes locale) . insertSpace $ out) (resultBibliography result) let moveNotes = styleIsNoteStyle sopts && maybe True truish (lookupMeta "notes-after-punctuation" meta) - let cits = map (walk (convertQuotes locale)) $ - resultCitations result + let cits = resultCitations result let metanocites = lookupMeta "nocite" meta let Pandoc meta'' bs' = @@ -105,9 +106,13 @@ processCitations (Pandoc meta bs) = do else id) . evalState (walkM insertResolvedCitations $ Pandoc meta' bs) $ cits - return $ Pandoc meta'' - $ insertRefs refkvs classes meta'' - (walk fixLinks $ B.toList bibs) bs' + return $ walk removeQuoteSpan + $ Pandoc meta'' + $ insertRefs refkvs classes meta'' (B.toList bibs) bs' + +removeQuoteSpan :: Inline -> Inline +removeQuoteSpan (Span ("",["csl-quoted"],[]) xs) = Span nullAttr xs +removeQuoteSpan x = x -- | Retrieve the CSL style specified by the csl or citation-style -- metadata field in a pandoc document, or the default CSL style @@ -162,10 +167,9 @@ getStyle (Pandoc meta _) = do -- Retrieve citeproc lang based on metadata. -getLang :: PandocMonad m => Meta -> m (Maybe Lang) -getLang meta = maybe (return Nothing) bcp47LangToIETF - ((lookupMeta "lang" meta <|> lookupMeta "locale" meta) >>= - metaValueToText) +getCiteprocLang :: PandocMonad m => Meta -> m (Maybe Lang) +getCiteprocLang meta = maybe (return Nothing) bcp47LangToIETF + ((lookupMeta "lang" meta <|> lookupMeta "locale" meta) >>= metaValueToText) -- | Get references defined inline in the metadata and via an external -- bibliography. Only references that are actually cited in the document @@ -177,7 +181,7 @@ getReferences mblocale (Pandoc meta bs) = do locale <- case mblocale of Just l -> return l Nothing -> do - mblang <- getLang meta + mblang <- getCiteprocLang meta case mblang of Just lang -> return $ either mempty id $ getLocale lang Nothing -> return mempty @@ -205,8 +209,7 @@ getReferences mblocale (Pandoc meta bs) = do Just fp -> getRefsFromBib locale idpred fp Nothing -> return [] Nothing -> return [] - return $ map (linkifyVariables . legacyDateRanges) - (externalRefs ++ inlineRefs) + return $ map legacyDateRanges (externalRefs ++ inlineRefs) -- note that inlineRefs can override externalRefs @@ -262,26 +265,9 @@ getRefs locale format idpred mbfp raw = do rs <- yamlToRefs idpred def{ readerExtensions = pandocExtensions } (T.unpack <$> mbfp) - (L.fromStrict raw) + raw return $ mapMaybe metaValueToReference rs --- localized quotes -convertQuotes :: Locale -> Inline -> Inline -convertQuotes locale (Quoted qt ils) = - case (M.lookup openterm terms, M.lookup closeterm terms) of - (Just ((_,oq):_), Just ((_,cq):_)) -> - Span ("",[],[]) (Str oq : ils ++ [Str cq]) - _ -> Quoted qt ils - where - terms = localeTerms locale - openterm = case qt of - DoubleQuote -> "open-quote" - SingleQuote -> "open-inner-quote" - closeterm = case qt of - DoubleQuote -> "close-quote" - SingleQuote -> "close-inner-quote" -convertQuotes _ x = x - -- assumes we walk in same order as query insertResolvedCitations :: Inline -> State [Inlines] Inline insertResolvedCitations (Cite cs ils) = do @@ -290,7 +276,7 @@ insertResolvedCitations (Cite cs ils) = do [] -> return (Cite cs ils) (x:xs) -> do put xs - return $ Cite cs (walk fixLinks $ B.toList x) + return $ Cite cs (B.toList x) insertResolvedCitations x = return x getCitations :: Locale @@ -318,17 +304,15 @@ fromPandocCitations :: Locale -> [CitationItem Inlines] fromPandocCitations locale otherIdsMap = concatMap go where + locmap = toLocatorMap locale go c = - let (loclab, suffix) = parseLocator locale (citationSuffix c) - (mblab, mbloc) = case loclab of - Just (loc, lab) -> (Just loc, Just lab) - Nothing -> (Nothing, Nothing) + let (mblocinfo, suffix) = parseLocator locmap (citationSuffix c) cit = CitationItem { citationItemId = fromMaybe (ItemId $ Pandoc.citationId c) (M.lookup (Pandoc.citationId c) otherIdsMap) - , citationItemLabel = mblab - , citationItemLocator = mbloc + , citationItemLabel = locatorLabel <$> mblocinfo + , citationItemLocator = locatorLoc <$> mblocinfo , citationItemType = NormalCite , citationItemPrefix = case citationPrefix c of [] -> Nothing @@ -368,6 +352,7 @@ formatFromExtension fp = case dropWhile (== '.') $ takeExtension fp of "bib" -> Just Format_biblatex "json" -> Just Format_json "yaml" -> Just Format_yaml + "yml" -> Just Format_yaml _ -> Nothing @@ -431,15 +416,6 @@ mvPunct moveNotes locale (Cite cs ils : Str "." : ys) mvPunct moveNotes locale (x:xs) = x : mvPunct moveNotes locale xs mvPunct _ _ [] = [] --- move https://doi.org etc. prefix inside link text (#6723): -fixLinks :: [Inline] -> [Inline] -fixLinks (Str t : Link attr [Str u1] (u2,tit) : xs) - | u2 == t <> u1 - = Link attr [Str (t <> u1)] (u2,tit) : fixLinks xs -fixLinks (x:xs) = x : fixLinks xs -fixLinks [] = [] - - endWithPunct :: Bool -> [Inline] -> Bool endWithPunct _ [] = False endWithPunct onlyFinal xs@(_:_) = @@ -535,29 +511,6 @@ legacyDateRanges ref = _ -> DateVal d go x = x -linkifyVariables :: Reference Inlines -> Reference Inlines -linkifyVariables ref = - ref{ referenceVariables = M.mapWithKey go $ referenceVariables ref } - where - go "URL" x = tolink "https://" x - go "DOI" x = tolink "https://doi.org/" (fixShortDOI x) - go "ISBN" x = tolink "https://worldcat.org/isbn/" x - go "PMID" x = tolink "https://www.ncbi.nlm.nih.gov/pubmed/" x - go "PMCID" x = tolink "https://www.ncbi.nlm.nih.gov/pmc/articles/" x - go _ x = x - fixShortDOI x = let x' = extractText x - in if "10/" `T.isPrefixOf` x' - then TextVal $ T.drop 3 x' - -- see https://shortdoi.org - else TextVal x' - tolink pref x = let x' = extractText x - x'' = if "://" `T.isInfixOf` x' - then x' - else pref <> x' - in if T.null x' - then x - else FancyVal (B.link x'' "" (B.str x')) - extractText :: Val Inlines -> Text extractText (TextVal x) = x extractText (FancyVal x) = toText x @@ -590,7 +543,7 @@ deNote (Note bs) = addParens [] = [] addParens (Cite (c:cs) ils : zs) | citationMode c == AuthorInText - = Cite (c:cs) (concatMap (noteAfterComma (needsPeriod zs)) ils) : + = Cite (c:cs) (addCommas (needsPeriod zs) ils) : addParens zs | otherwise = Cite (c:cs) (concatMap noteInParens ils) : addParens zs @@ -611,13 +564,19 @@ deNote (Note bs) = removeFinalPeriod ils ++ [Str ")"] noteInParens x = [x] - noteAfterComma needsPer (Span ("",["csl-note"],[]) ils) - | not (null ils) - = Str "," : Space : - if needsPer - then ils - else removeFinalPeriod ils - noteAfterComma _ x = [x] + -- We want to add a comma before a CSL note citation, but not + -- before the author name, and not before the first citation + -- if it doesn't begin with an author name. + addCommas = addCommas' True -- boolean == "at beginning" + + addCommas' _ _ [] = [] + addCommas' atBeginning needsPer + (Span ("",["csl-note"],[]) ils : rest) + | not (null ils) + = (if atBeginning then id else ([Str "," , Space] ++)) $ + (if needsPer then ils else removeFinalPeriod ils) ++ + addCommas' False needsPer rest + addCommas' _ needsPer (il : rest) = il : addCommas' False needsPer rest deNote x = x |