diff options
author | John MacFarlane <jgm@berkeley.edu> | 2021-01-10 11:48:53 -0800 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2021-01-10 11:48:53 -0800 |
commit | d98ec4feb80ae0a9bf192c9b14aaef033ba7fd6e (patch) | |
tree | 3c544c0ab33370f79cb07e13a37f826d9bb3bcaa /src/Text | |
parent | 402d984bc53773e1876000d0d9857b053c002904 (diff) | |
download | pandoc-d98ec4feb80ae0a9bf192c9b14aaef033ba7fd6e.tar.gz |
T.P.Citeproc: factor out and export `getStyle`.
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Citeproc.hs | 100 |
1 files changed, 55 insertions, 45 deletions
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 |