Citeproc changes:

T.P.Citeproc exports `getCiteprocLang` and `getStyle` [API change].

T.P.Citeproc.Locator now exports `toLocatorMap`, `LocatorInfo`,
and `LocatorMap`.  The type of `parseLocator` has changed, so
it now takes a `LocatorMap` rather than a `Locale` as parameter,
and returns a `LocatorInfo` instead of a tuple.
This commit is contained in:
John MacFarlane 2021-12-13 12:07:24 -08:00
parent b8ada284b1
commit ea77f2e6f6
2 changed files with 53 additions and 41 deletions

View file

@ -7,13 +7,15 @@
module Text.Pandoc.Citeproc
( processCitations,
getReferences,
getStyle
getStyle,
getCiteprocLang
)
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,12 +51,10 @@ 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)
@ -166,10 +166,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
@ -181,7 +180,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
@ -307,17 +306,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

View file

@ -2,7 +2,10 @@
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Citeproc.Locator
( parseLocator )
( parseLocator
, toLocatorMap
, LocatorInfo(..)
, LocatorMap(..) )
where
import Citeproc.Types
import Text.Pandoc.Citeproc.Util (splitStrWhen)
@ -17,9 +20,17 @@ import Control.Monad (mzero)
import qualified Data.Map as M
import Data.Char (isSpace, isPunctuation, isDigit)
parseLocator :: Locale -> [Inline] -> (Maybe (Text, Text), [Inline])
parseLocator locale inp =
case parse (pLocatorWords (toLocatorMap locale)) "suffix" $ splitInp inp of
data LocatorInfo =
LocatorInfo{ locatorRaw :: Text
, locatorLabel :: Text
, locatorLoc :: Text
}
deriving (Show)
parseLocator :: LocatorMap -> [Inline] -> (Maybe LocatorInfo, [Inline])
parseLocator locmap inp =
case parse (pLocatorWords locmap) "suffix" $ splitInp inp of
Right r -> r
Left _ -> (Nothing, maybeAddComma inp)
@ -33,18 +44,16 @@ splitInp = splitStrWhen (\c -> isSpace c || (isPunctuation c && c /= ':'))
type LocatorParser = Parsec [Inline] ()
pLocatorWords :: LocatorMap
-> LocatorParser (Maybe (Text, Text), [Inline])
-> LocatorParser (Maybe LocatorInfo, [Inline])
pLocatorWords locMap = do
optional $ pMatchChar "," (== ',')
optional pSpace
(la, lo) <- pLocatorDelimited locMap <|> pLocatorIntegrated locMap
info <- pLocatorDelimited locMap <|> pLocatorIntegrated locMap
s <- getInput -- rest is suffix
-- need to trim, otherwise "p. 9" and "9" will have 'different' locators later on
-- i.e. the first one will be " 9"
return $
if T.null la && T.null lo
if T.null (locatorLabel info) && T.null (locatorLoc info)
then (Nothing, maybeAddComma s)
else (Just (la, T.strip lo), s)
else (Just info, s)
maybeAddComma :: [Inline] -> [Inline]
maybeAddComma [] = []
@ -54,28 +63,30 @@ maybeAddComma ils@(Str t : _)
, isPunctuation c = ils
maybeAddComma ils = Str "," : Space : ils
pLocatorDelimited :: LocatorMap -> LocatorParser (Text, Text)
pLocatorDelimited :: LocatorMap -> LocatorParser LocatorInfo
pLocatorDelimited locMap = try $ do
_ <- pMatchChar "{" (== '{')
skipMany pSpace -- gobble pre-spaces so label doesn't try to include them
(la, _) <- pLocatorLabelDelimited locMap
(rawlab, la, _) <- pLocatorLabelDelimited locMap
-- we only care about balancing {} and [] (because of the outer [] scope);
-- the rest can be anything
let inner = do { t <- anyToken; return (True, stringify t) }
gs <- many (pBalancedBraces [('{','}'), ('[',']')] inner)
_ <- pMatchChar "}" (== '}')
let lo = T.concat $ map snd gs
return (la, lo)
return $ LocatorInfo{ locatorLoc = lo,
locatorLabel = la,
locatorRaw = rawlab <> "{" <> lo <> "}" }
pLocatorLabelDelimited :: LocatorMap -> LocatorParser (Text, Bool)
pLocatorLabelDelimited :: LocatorMap -> LocatorParser (Text, Text, Bool)
pLocatorLabelDelimited locMap
= pLocatorLabel' locMap lim <|> return ("page", True)
= pLocatorLabel' locMap lim <|> return ("", "page", True)
where
lim = stringify <$> anyToken
pLocatorIntegrated :: LocatorMap -> LocatorParser (Text, Text)
pLocatorIntegrated :: LocatorMap -> LocatorParser LocatorInfo
pLocatorIntegrated locMap = try $ do
(la, wasImplicit) <- pLocatorLabelIntegrated locMap
(rawlab, la, wasImplicit) <- pLocatorLabelIntegrated locMap
-- if we got the label implicitly, we have presupposed the first one is
-- going to have a digit, so guarantee that. You _can_ have p. (a)
-- because you specified it.
@ -85,17 +96,20 @@ pLocatorIntegrated locMap = try $ do
g <- try $ pLocatorWordIntegrated (not wasImplicit) >>= modifier
gs <- many (try $ pLocatorWordIntegrated False >>= modifier)
let lo = T.concat (g:gs)
return (la, lo)
return $ LocatorInfo{ locatorLabel = la,
locatorLoc = lo,
locatorRaw = rawlab <> lo }
pLocatorLabelIntegrated :: LocatorMap -> LocatorParser (Text, Bool)
pLocatorLabelIntegrated :: LocatorMap -> LocatorParser (Text, Text, Bool)
pLocatorLabelIntegrated locMap
= pLocatorLabel' locMap lim <|> (lookAhead digital >> return ("page", True))
= pLocatorLabel' locMap lim <|>
(lookAhead digital >> return ("", "page", True))
where
lim = try $ pLocatorWordIntegrated True >>= requireRomansOrDigits
digital = try $ pLocatorWordIntegrated True >>= requireDigits
pLocatorLabel' :: LocatorMap -> LocatorParser Text
-> LocatorParser (Text, Bool)
-> LocatorParser (Text, Text, Bool)
pLocatorLabel' locMap lim = go ""
where
-- grow the match string until we hit the end
@ -106,9 +120,9 @@ pLocatorLabel' locMap lim = go ""
t <- anyToken
ts <- manyTill anyToken (try $ lookAhead lim)
let s = acc <> stringify (t:ts)
case M.lookup (T.toCaseFold $ T.strip s) locMap of
case M.lookup (T.toCaseFold $ T.strip s) (unLocatorMap locMap) of
-- try to find a longer one, or return this one
Just l -> go s <|> return (l, False)
Just l -> go s <|> return (s, l, False)
Nothing -> go s
-- hard requirement for a locator to have some real digits in it
@ -252,11 +266,12 @@ isLocatorSep _ = False
-- Locator Map
--
type LocatorMap = M.Map Text Text
newtype LocatorMap = LocatorMap { unLocatorMap :: M.Map Text Text }
deriving (Show)
toLocatorMap :: Locale -> LocatorMap
toLocatorMap locale =
foldr go mempty locatorTerms
LocatorMap $ foldr go mempty locatorTerms
where
go tname locmap =
case M.lookup tname (localeTerms locale) of