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:
parent
b8ada284b1
commit
ea77f2e6f6
2 changed files with 53 additions and 41 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue