From d98ec4feb80ae0a9bf192c9b14aaef033ba7fd6e Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sun, 10 Jan 2021 11:48:53 -0800
Subject: T.P.Citeproc: factor out and export `getStyle`.
---
src/Text/Pandoc/Citeproc.hs | 100 ++++++++++++++++++++++++--------------------
1 file changed, 55 insertions(+), 45 deletions(-)
(limited to 'src/Text/Pandoc')
diff --git a/src/Text/Pandoc/Citeproc.hs b/src/Text/Pandoc/Citeproc.hs
index e81f93cdd..9649c6971 100644
--- a/src/Text/Pandoc/Citeproc.hs
+++ b/src/Text/Pandoc/Citeproc.hs
@@ -6,7 +6,8 @@
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Citeproc
( processCitations,
- getReferences
+ getReferences,
+ getStyle
)
where
@@ -50,50 +51,7 @@ import Safe (lastMay, initSafe)
processCitations :: PandocMonad m => Pandoc -> m Pandoc
processCitations (Pandoc meta bs) = do
- let cslfile = (lookupMeta "csl" meta <|> lookupMeta "citation-style" meta)
- >>= metaValueToText
-
- let getFile defaultExtension fp = do
- oldRp <- getResourcePath
- mbUdd <- getUserDataDir
- setResourcePath $ oldRp ++ maybe []
- (\u -> [u <> "/csl",
- u <> "/csl/dependent"]) mbUdd
- let fp' = if T.any (=='.') fp || "data:" `T.isPrefixOf` fp
- then fp
- else fp <> defaultExtension
- (result, _) <- fetchItem fp'
- setResourcePath oldRp
- return result
-
- let getCslDefault = readDataFile "default.csl"
-
- cslContents <- UTF8.toText <$> maybe getCslDefault (getFile ".csl") cslfile
-
- let abbrevFile = lookupMeta "citation-abbreviations" meta >>= metaValueToText
-
- mbAbbrevs <- case abbrevFile of
- Nothing -> return Nothing
- Just fp -> do
- rawAbbr <- getFile ".json" fp
- case eitherDecode (L.fromStrict rawAbbr) of
- Left err -> throwError $ PandocCiteprocError $
- CiteprocParseError $
- "Could not parse abbreviations file " <> fp
- <> "\n" <> T.pack err
- Right abbr -> return $ Just abbr
-
- let getParentStyle url = do
- -- first, try to retrieve the style locally, then use HTTP.
- let basename = T.takeWhileEnd (/='/') url
- UTF8.toText <$>
- catchError (getFile ".csl" basename) (\_ -> fst <$> fetchItem url)
-
- styleRes <- Citeproc.parseStyle getParentStyle cslContents
- style <-
- case styleRes of
- Left err -> throwError $ PandocAppError $ prettyCiteprocError err
- Right style -> return style{ styleAbbreviations = mbAbbrevs }
+ style <- getStyle (Pandoc meta bs)
mblang <- getLang meta
let locale = Citeproc.mergeLocales mblang style
@@ -154,6 +112,58 @@ processCitations (Pandoc meta bs) = do
$ insertRefs refkvs classes meta''
(walk fixLinks $ B.toList bibs) bs'
+-- | Retrieve the CSL style specified by the csl or citation-style
+-- metadata field in a pandoc document, or the default CSL style
+-- if none is specified. Retrieve the parent style
+-- if the style is a dependent style. Add abbreviations defined
+-- in an abbreviation file if one has been specified.
+getStyle :: PandocMonad m => Pandoc -> m (Style Inlines)
+getStyle (Pandoc meta _) = do
+ let cslfile = (lookupMeta "csl" meta <|> lookupMeta "citation-style" meta)
+ >>= metaValueToText
+
+ let getFile defaultExtension fp = do
+ oldRp <- getResourcePath
+ mbUdd <- getUserDataDir
+ setResourcePath $ oldRp ++ maybe []
+ (\u -> [u <> "/csl",
+ u <> "/csl/dependent"]) mbUdd
+ let fp' = if T.any (=='.') fp || "data:" `T.isPrefixOf` fp
+ then fp
+ else fp <> defaultExtension
+ (result, _) <- fetchItem fp'
+ setResourcePath oldRp
+ return result
+
+ let getCslDefault = readDataFile "default.csl"
+
+ cslContents <- UTF8.toText <$> maybe getCslDefault (getFile ".csl") cslfile
+
+ let abbrevFile = lookupMeta "citation-abbreviations" meta >>= metaValueToText
+
+ mbAbbrevs <- case abbrevFile of
+ Nothing -> return Nothing
+ Just fp -> do
+ rawAbbr <- getFile ".json" fp
+ case eitherDecode (L.fromStrict rawAbbr) of
+ Left err -> throwError $ PandocCiteprocError $
+ CiteprocParseError $
+ "Could not parse abbreviations file " <> fp
+ <> "\n" <> T.pack err
+ Right abbr -> return $ Just abbr
+
+ let getParentStyle url = do
+ -- first, try to retrieve the style locally, then use HTTP.
+ let basename = T.takeWhileEnd (/='/') url
+ UTF8.toText <$>
+ catchError (getFile ".csl" basename) (\_ -> fst <$> fetchItem url)
+
+ styleRes <- Citeproc.parseStyle getParentStyle cslContents
+ case styleRes of
+ Left err -> throwError $ PandocAppError $ prettyCiteprocError err
+ Right style -> return style{ styleAbbreviations = mbAbbrevs }
+
+
-- Retrieve citeproc lang based on metadata.
getLang :: PandocMonad m => Meta -> m (Maybe Lang)
getLang meta = maybe (return Nothing) bcp47LangToIETF
--
cgit v1.2.3