aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Citeproc
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2021-12-13 12:07:24 -0800
committerJohn MacFarlane <jgm@berkeley.edu>2021-12-13 12:11:58 -0800
commitea77f2e6f653d5b570109fa208dc427d99f95b51 (patch)
treee1859c0970008eebfa07053fdf6d7c44ff5e5370 /src/Text/Pandoc/Citeproc
parentb8ada284b1f6a4b37cd72f4f2f0e6707a1a7160b (diff)
downloadpandoc-ea77f2e6f653d5b570109fa208dc427d99f95b51.tar.gz
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.
Diffstat (limited to 'src/Text/Pandoc/Citeproc')
-rw-r--r--src/Text/Pandoc/Citeproc/Locator.hs65
1 files changed, 40 insertions, 25 deletions
diff --git a/src/Text/Pandoc/Citeproc/Locator.hs b/src/Text/Pandoc/Citeproc/Locator.hs
index ce606197b..0b8f79922 100644
--- a/src/Text/Pandoc/Citeproc/Locator.hs
+++ b/src/Text/Pandoc/Citeproc/Locator.hs
@@ -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