git.iko.soy/typeable/pandoc
on master help sign in
T.P.Citeproc: factor out and export `getStyle`.
commitd98ec4feb80ae0a9bf192c9b14aaef033ba7fd6e authorJohn MacFarlane <jgm@berkeley.edu> dateSun 10 Jan 2021, 11:48 (6 years ago) parent402d984
1 file changed+55−45
src/Text/Pandoc/Citeproc.hs+55−45
src/Text/Pandoc/Citeproc.hs+55−45
@@ -6,7 +6,8 @@
66{-# LANGUAGE OverloadedStrings #-}
77module Text.Pandoc.Citeproc
88 ( processCitations,
9− getReferences
9+ getReferences,
10+ getStyle
1011 )
1112where
1213
@@ -50,50 +51,7 @@ import Safe (lastMay, initSafe)
5051
5152processCitations :: PandocMonad m => Pandoc -> m Pandoc
5253processCitations (Pandoc meta bs) = do
53− let cslfile = (lookupMeta "csl" meta <|> lookupMeta "citation-style" meta)
54− >>= metaValueToText
55−
56− let getFile defaultExtension fp = do
57− oldRp <- getResourcePath
58− mbUdd <- getUserDataDir
59− setResourcePath $ oldRp ++ maybe []
60− (\u -> [u <> "/csl",
61− u <> "/csl/dependent"]) mbUdd
62− let fp' = if T.any (=='.') fp || "data:" `T.isPrefixOf` fp
63− then fp
64− else fp <> defaultExtension
65− (result, _) <- fetchItem fp'
66− setResourcePath oldRp
67− return result
68−
69− let getCslDefault = readDataFile "default.csl"
70−
71− cslContents <- UTF8.toText <$> maybe getCslDefault (getFile ".csl") cslfile
72−
73− let abbrevFile = lookupMeta "citation-abbreviations" meta >>= metaValueToText
74−
75− mbAbbrevs <- case abbrevFile of
76− Nothing -> return Nothing
77− Just fp -> do
78− rawAbbr <- getFile ".json" fp
79− case eitherDecode (L.fromStrict rawAbbr) of
80− Left err -> throwError $ PandocCiteprocError $
81− CiteprocParseError $
82− "Could not parse abbreviations file " <> fp
83− <> "\n" <> T.pack err
84− Right abbr -> return $ Just abbr
85−
86− let getParentStyle url = do
87− -- first, try to retrieve the style locally, then use HTTP.
88− let basename = T.takeWhileEnd (/='/') url
89− UTF8.toText <$>
90− catchError (getFile ".csl" basename) (\_ -> fst <$> fetchItem url)
91−
92− styleRes <- Citeproc.parseStyle getParentStyle cslContents
93− style <-
94− case styleRes of
95− Left err -> throwError $ PandocAppError $ prettyCiteprocError err
96− Right style -> return style{ styleAbbreviations = mbAbbrevs }
54+ style <- getStyle (Pandoc meta bs)
9755
9856 mblang <- getLang meta
9957 let locale = Citeproc.mergeLocales mblang style
@@ -154,6 +112,58 @@ processCitations (Pandoc meta bs) = do
154112 $ insertRefs refkvs classes meta''
155113 (walk fixLinks $ B.toList bibs) bs'
156114
115+-- | Retrieve the CSL style specified by the csl or citation-style
116+-- metadata field in a pandoc document, or the default CSL style
117+-- if none is specified. Retrieve the parent style
118+-- if the style is a dependent style. Add abbreviations defined
119+-- in an abbreviation file if one has been specified.
120+getStyle :: PandocMonad m => Pandoc -> m (Style Inlines)
121+getStyle (Pandoc meta _) = do
122+ let cslfile = (lookupMeta "csl" meta <|> lookupMeta "citation-style" meta)
123+ >>= metaValueToText
124+
125+ let getFile defaultExtension fp = do
126+ oldRp <- getResourcePath
127+ mbUdd <- getUserDataDir
128+ setResourcePath $ oldRp ++ maybe []
129+ (\u -> [u <> "/csl",
130+ u <> "/csl/dependent"]) mbUdd
131+ let fp' = if T.any (=='.') fp || "data:" `T.isPrefixOf` fp
132+ then fp
133+ else fp <> defaultExtension
134+ (result, _) <- fetchItem fp'
135+ setResourcePath oldRp
136+ return result
137+
138+ let getCslDefault = readDataFile "default.csl"
139+
140+ cslContents <- UTF8.toText <$> maybe getCslDefault (getFile ".csl") cslfile
141+
142+ let abbrevFile = lookupMeta "citation-abbreviations" meta >>= metaValueToText
143+
144+ mbAbbrevs <- case abbrevFile of
145+ Nothing -> return Nothing
146+ Just fp -> do
147+ rawAbbr <- getFile ".json" fp
148+ case eitherDecode (L.fromStrict rawAbbr) of
149+ Left err -> throwError $ PandocCiteprocError $
150+ CiteprocParseError $
151+ "Could not parse abbreviations file " <> fp
152+ <> "\n" <> T.pack err
153+ Right abbr -> return $ Just abbr
154+
155+ let getParentStyle url = do
156+ -- first, try to retrieve the style locally, then use HTTP.
157+ let basename = T.takeWhileEnd (/='/') url
158+ UTF8.toText <$>
159+ catchError (getFile ".csl" basename) (\_ -> fst <$> fetchItem url)
160+
161+ styleRes <- Citeproc.parseStyle getParentStyle cslContents
162+ case styleRes of
163+ Left err -> throwError $ PandocAppError $ prettyCiteprocError err
164+ Right style -> return style{ styleAbbreviations = mbAbbrevs }
165+
166+
157167-- Retrieve citeproc lang based on metadata.
158168getLang :: PandocMonad m => Meta -> m (Maybe Lang)
159169getLang meta = maybe (return Nothing) bcp47LangToIETF