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 module Text.Pandoc.Citeproc
( processCitations, ( processCitations,
getReferences, getReferences,
getStyle getStyle,
getCiteprocLang
) )
where where
import Citeproc import Citeproc
import Citeproc.Pandoc () 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.CslJson (cslJsonToReferences)
import Text.Pandoc.Citeproc.BibTeX (readBibtexString, Variant(..)) import Text.Pandoc.Citeproc.BibTeX (readBibtexString, Variant(..))
import Text.Pandoc.Citeproc.MetaValue (metaValueToReference, metaValueToText) import Text.Pandoc.Citeproc.MetaValue (metaValueToReference, metaValueToText)
@ -49,12 +51,10 @@ import qualified Data.Text as T
import System.FilePath (takeExtension) import System.FilePath (takeExtension)
import Safe (lastMay, initSafe) import Safe (lastMay, initSafe)
processCitations :: PandocMonad m => Pandoc -> m Pandoc processCitations :: PandocMonad m => Pandoc -> m Pandoc
processCitations (Pandoc meta bs) = do processCitations (Pandoc meta bs) = do
style <- getStyle (Pandoc meta bs) style <- getStyle (Pandoc meta bs)
mblang <- getCiteprocLang meta
mblang <- getLang meta
let locale = Citeproc.mergeLocales mblang style let locale = Citeproc.mergeLocales mblang style
refs <- getReferences (Just locale) (Pandoc meta bs) refs <- getReferences (Just locale) (Pandoc meta bs)
@ -166,10 +166,9 @@ getStyle (Pandoc meta _) = do
-- Retrieve citeproc lang based on metadata. -- Retrieve citeproc lang based on metadata.
getLang :: PandocMonad m => Meta -> m (Maybe Lang) getCiteprocLang :: PandocMonad m => Meta -> m (Maybe Lang)
getLang meta = maybe (return Nothing) bcp47LangToIETF getCiteprocLang meta = maybe (return Nothing) bcp47LangToIETF
((lookupMeta "lang" meta <|> lookupMeta "locale" meta) >>= ((lookupMeta "lang" meta <|> lookupMeta "locale" meta) >>= metaValueToText)
metaValueToText)
-- | Get references defined inline in the metadata and via an external -- | Get references defined inline in the metadata and via an external
-- bibliography. Only references that are actually cited in the document -- bibliography. Only references that are actually cited in the document
@ -181,7 +180,7 @@ getReferences mblocale (Pandoc meta bs) = do
locale <- case mblocale of locale <- case mblocale of
Just l -> return l Just l -> return l
Nothing -> do Nothing -> do
mblang <- getLang meta mblang <- getCiteprocLang meta
case mblang of case mblang of
Just lang -> return $ either mempty id $ getLocale lang Just lang -> return $ either mempty id $ getLocale lang
Nothing -> return mempty Nothing -> return mempty
@ -307,17 +306,15 @@ fromPandocCitations :: Locale
-> [CitationItem Inlines] -> [CitationItem Inlines]
fromPandocCitations locale otherIdsMap = concatMap go fromPandocCitations locale otherIdsMap = concatMap go
where where
locmap = toLocatorMap locale
go c = go c =
let (loclab, suffix) = parseLocator locale (citationSuffix c) let (mblocinfo, suffix) = parseLocator locmap (citationSuffix c)
(mblab, mbloc) = case loclab of
Just (loc, lab) -> (Just loc, Just lab)
Nothing -> (Nothing, Nothing)
cit = CitationItem cit = CitationItem
{ citationItemId = fromMaybe { citationItemId = fromMaybe
(ItemId $ Pandoc.citationId c) (ItemId $ Pandoc.citationId c)
(M.lookup (Pandoc.citationId c) otherIdsMap) (M.lookup (Pandoc.citationId c) otherIdsMap)
, citationItemLabel = mblab , citationItemLabel = locatorLabel <$> mblocinfo
, citationItemLocator = mbloc , citationItemLocator = locatorLoc <$> mblocinfo
, citationItemType = NormalCite , citationItemType = NormalCite
, citationItemPrefix = case citationPrefix c of , citationItemPrefix = case citationPrefix c of
[] -> Nothing [] -> Nothing

View file

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