diff options
Diffstat (limited to 'src/Text/Pandoc/Citeproc/BibTeX.hs')
| -rw-r--r-- | src/Text/Pandoc/Citeproc/BibTeX.hs | 81 |
1 files changed, 39 insertions, 42 deletions
diff --git a/src/Text/Pandoc/Citeproc/BibTeX.hs b/src/Text/Pandoc/Citeproc/BibTeX.hs index c178de6e9..a8e5622ed 100644 --- a/src/Text/Pandoc/Citeproc/BibTeX.hs +++ b/src/Text/Pandoc/Citeproc/BibTeX.hs @@ -34,7 +34,7 @@ import Text.Pandoc.Class (runPure) import qualified Text.Pandoc.Walk as Walk import Citeproc.Types import Citeproc.Pandoc () -import Text.Pandoc.Citeproc.Util (toIETF) +import Text.Pandoc.Citeproc.Util (toIETF, splitStrWhen) import Text.Pandoc.Citeproc.Data (biblatexStringMap) import Data.Default import Data.Text (Text) @@ -48,13 +48,12 @@ import Control.Monad.RWS hiding ((<>)) import qualified Data.Sequence as Seq import Data.Char (isAlphaNum, isDigit, isLetter, isUpper, toLower, toUpper, - isLower, isPunctuation) + isLower, isPunctuation, isSpace) import Data.List (foldl', intercalate, intersperse) import Safe (readMay) import Text.Printf (printf) import Text.DocLayout (literal, hsep, nest, hang, Doc(..), braces, ($$), cr) - data Variant = Bibtex | Biblatex deriving (Show, Eq, Ord) @@ -527,9 +526,9 @@ itemToReference locale variant item = do let fixSeriesTitle [Str xs] | isNumber xs = [Str (ordinalize locale xs), Space, Str (resolveKey' lang "jourser")] fixSeriesTitle xs = xs - seriesTitle' <- (Just . B.fromList . fixSeriesTitle . - B.toList . resolveKey lang <$> - getTitle "series") <|> + + seriesTitle' <- (Just . B.fromList . fixSeriesTitle . B.toList + <$> getTitle "series") <|> return Nothing shortTitle' <- (Just <$> (guard (not hasMaintitle || isChapterlike) >> getTitle "shorttitle")) @@ -805,30 +804,34 @@ bibEntries = do skipMany nonEntry many (bibItem <* skipMany nonEntry) where nonEntry = bibSkip <|> + comment <|> try (char '@' >> (bibComment <|> bibPreamble <|> bibString)) bibSkip :: BibParser () -bibSkip = skipMany1 (satisfy (/='@')) +bibSkip = skipMany1 (satisfy (\c -> c /='@' && c /='%')) + +comment :: BibParser () +comment = char '%' *> void anyLine bibComment :: BibParser () bibComment = do cistring "comment" - spaces + spaces' void inBraces <|> bibSkip <|> return () bibPreamble :: BibParser () bibPreamble = do cistring "preamble" - spaces + spaces' void inBraces bibString :: BibParser () bibString = do cistring "string" - spaces + spaces' char '{' - spaces + spaces' (k,v) <- entField char '}' updateState (\(l,m) -> (l, Map.insert k v m)) @@ -842,9 +845,9 @@ inBraces = do char '{' res <- manyTill ( take1WhileP (\c -> c /= '{' && c /= '}' && c /= '\\') - <|> (char '\\' >> ( (char '{' >> return "\\{") - <|> (char '}' >> return "\\}") - <|> return "\\")) + <|> (char '\\' >> (do c <- oneOf "{}" + return $ T.pack ['\\',c]) + <|> return "\\") <|> (braced <$> inBraces) ) (char '}') return $ T.concat res @@ -856,8 +859,9 @@ inQuotes :: BibParser Text inQuotes = do char '"' T.concat <$> manyTill - ( take1WhileP (\c -> c /= '{' && c /= '"' && c /= '\\') + ( take1WhileP (\c -> c /= '{' && c /= '"' && c /= '\\' && c /= '%') <|> (char '\\' >> T.cons '\\' . T.singleton <$> anyChar) + <|> ("" <$ (char '%' >> anyLine)) <|> braced <$> inBraces ) (char '"') @@ -870,32 +874,35 @@ isBibtexKeyChar :: Char -> Bool isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()$/*@_+=-[]*&" :: [Char]) +spaces' :: BibParser () +spaces' = skipMany (void (satisfy isSpace) <|> comment) + bibItem :: BibParser Item bibItem = do char '@' pos <- getPosition enttype <- T.toLower <$> take1WhileP isLetter - spaces + spaces' char '{' - spaces + spaces' entid <- take1WhileP isBibtexKeyChar - spaces + spaces' char ',' - spaces - entfields <- entField `sepEndBy` (char ',' >> spaces) - spaces + spaces' + entfields <- entField `sepEndBy` (char ',' >> spaces') + spaces' char '}' return $ Item entid pos enttype (Map.fromList entfields) entField :: BibParser (Text, Text) entField = do k <- fieldName - spaces + spaces' char '=' - spaces + spaces' vs <- (expandString <|> inQuotes <|> inBraces <|> rawWord) `sepBy` - try (spaces >> char '#' >> spaces) - spaces + try (spaces' >> char '#' >> spaces') + spaces' return (k, T.concat vs) resolveAlias :: Text -> Text @@ -984,8 +991,12 @@ getTitle f = do ils <- getField f utc <- gets untitlecase lang <- gets localeLang + let ils' = + if f == "series" + then resolveKey lang ils + else ils let processTitle = if utc then unTitlecase (Just lang) else id - return $ processTitle ils + return $ processTitle ils' getShortTitle :: Bool -> Text -> Bib (Maybe Inlines) getShortTitle requireColon f = do @@ -1253,20 +1264,6 @@ toName opts ils = do , nameStaticOrdering = False } -splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline] -splitStrWhen _ [] = [] -splitStrWhen p (Str xs : ys) = map Str (go xs) ++ splitStrWhen p ys - where go s = - let (w,z) = T.break p s - in if T.null z - then if T.null w - then [] - else [w] - else if T.null w - then (T.take 1 z : go (T.drop 1 z)) - else (w : T.take 1 z : go (T.drop 1 z)) -splitStrWhen p (x : ys) = x : splitStrWhen p ys - ordinalize :: Locale -> Text -> Text ordinalize locale n = let terms = localeTerms locale @@ -1460,14 +1457,14 @@ bookTrans z = _ -> [z] resolveKey :: Lang -> Inlines -> Inlines -resolveKey lang ils = Walk.walk go ils +resolveKey lang (Many ils) = Many $ fmap go ils where go (Str s) = Str $ resolveKey' lang s go x = x resolveKey' :: Lang -> Text -> Text resolveKey' lang k = case Map.lookup (langLanguage lang) biblatexStringMap >>= - Map.lookup (T.toLower k) of + Map.lookup k of Nothing -> k Just (x, _) -> either (const k) stringify $ parseLaTeX lang x |