diff options
Diffstat (limited to 'src/Text/Pandoc/Biblio.hs')
| -rw-r--r-- | src/Text/Pandoc/Biblio.hs | 160 |
1 files changed, 68 insertions, 92 deletions
diff --git a/src/Text/Pandoc/Biblio.hs b/src/Text/Pandoc/Biblio.hs index c8e87b2a0..13569a4d9 100644 --- a/src/Text/Pandoc/Biblio.hs +++ b/src/Text/Pandoc/Biblio.hs @@ -31,14 +31,14 @@ module Text.Pandoc.Biblio ( processBiblio ) where import Data.List import Data.Unique -import Data.Char ( isDigit ) +import Data.Char ( isDigit, isPunctuation ) import qualified Data.Map as M import Text.CSL hiding ( Cite(..), Citation(..) ) import qualified Text.CSL as CSL ( Cite(..) ) import Text.Pandoc.Definition import Text.Pandoc.Generic import Text.Pandoc.Shared (stringify) -import Text.ParserCombinators.Parsec +import Text.Parsec import Control.Monad -- | Process a 'Pandoc' document by adding citations formatted @@ -53,42 +53,66 @@ processBiblio cslfile abrfile r p Just f -> readJsonAbbrevFile f Nothing -> return [] p' <- bottomUpM setHash p - let (nts,grps) = if styleClass csl == "note" - then let cits = queryWith getCite p' - ncits = map (queryWith getCite) $ queryWith getNote p' - needNt = cits \\ concat ncits - in (,) needNt $ getNoteCitations needNt p' - else (,) [] $ queryWith getCitation p' + let grps = queryWith getCitation p' style = csl { styleAbbrevs = abbrevs } result = citeproc procOpts style r (setNearNote style $ map (map toCslCite) grps) cits_map = M.fromList $ zip grps (citations result) biblioList = map (renderPandoc' style) (bibliography result) - Pandoc m b = bottomUp (procInlines $ processCite style cits_map) p' - return . generateNotes nts . Pandoc m $ b ++ biblioList + Pandoc m b = bottomUp (processCite style cits_map) p' + b' = bottomUp mvPunct $ deNote b + return $ Pandoc m $ b' ++ biblioList -- | Substitute 'Cite' elements with formatted citations. -processCite :: Style -> M.Map [Citation] [FormattedOutput] -> [Inline] -> [Inline] -processCite s cs (Cite t _ : rest) = +processCite :: Style -> M.Map [Citation] [FormattedOutput] -> Inline -> Inline +processCite s cs (Cite t _) = case M.lookup t cs of - Just (x:xs) -> - if isTextualCitation t - then renderPandoc s [x] ++ - if null xs - then processCite s cs rest - else [Space, Cite t (renderPandoc s xs)] - ++ processCite s cs rest - else Cite t (renderPandoc s (x:xs)) : processCite s cs rest - _ -> Str ("Error processing " ++ show t) : processCite s cs rest -processCite s cs (x:xs) = x : processCite s cs xs -processCite _ _ [] = [] - -procInlines :: ([Inline] -> [Inline]) -> Block -> Block -procInlines f b - | Plain inls <- b = Plain $ f inls - | Para inls <- b = Para $ f inls - | Header i inls <- b = Header i $ f inls - | otherwise = b + Just (x:xs) + | isTextualCitation t && not (null xs) -> + let xs' = renderPandoc s xs + in if styleClass s == "note" + then Cite t (renderPandoc s [x] ++ [Note [Para xs']]) + else Cite t (renderPandoc s [x] ++ [Space | not (startWithPunct xs')] ++ xs') + | otherwise -> if styleClass s == "note" + then Cite t [Note [Para $ renderPandoc s (x:xs)]] + else Cite t (renderPandoc s (x:xs)) + _ -> Strong [Str "???"] -- TODO raise error instead? +processCite _ _ x = x + +isNote :: Inline -> Bool +isNote (Note _) = True +isNote (Cite _ [Note _]) = True +isNote _ = False + +mvPunct :: [Inline] -> [Inline] +mvPunct (Space : Space : xs) = Space : xs +mvPunct (Space : x : ys) | isNote x, startWithPunct ys = + Str (headInline ys) : x : tailFirstInlineStr ys +mvPunct (Space : x : ys) | isNote x = x : ys +mvPunct xs = xs + +sanitize :: [Inline] -> [Inline] +sanitize xs | endWithPunct xs = toCapital' xs + | otherwise = toCapital' (xs ++ [Str "."]) + +-- NOTE: toCapital' works around a bug in toCapital from citeproc-hs 0.3.4. +-- When citeproc-hs is fixed, we can return to using toCapital in sanitize. +toCapital' :: [Inline] -> [Inline] +toCapital' [] = [] +toCapital' xs = case toCapital xs of + [] -> xs + ys -> ys + +deNote :: [Block] -> [Block] +deNote = topDown go + where go (Note [Para xs]) = Note $ bottomUp go' [Para $ sanitize xs] + go (Note xs) = Note $ bottomUp go' xs + go x = x + go' (Note [Para xs]:ys) = + if startWithPunct ys && endWithPunct xs + then initInline xs ++ ys + else xs ++ ys + go' xs = xs isTextualCitation :: [Citation] -> Bool isTextualCitation (c:_) = citationMode c == AuthorInText @@ -100,77 +124,29 @@ getCitation :: Inline -> [[Citation]] getCitation i | Cite t _ <- i = [t] | otherwise = [] -getNote :: Inline -> [Inline] -getNote i | Note _ <- i = [i] - | otherwise = [] - -getCite :: Inline -> [Inline] -getCite i | Cite _ _ <- i = [i] - | otherwise = [] - -getNoteCitations :: [Inline] -> Pandoc -> [[Citation]] -getNoteCitations needNote - = let mvCite i = if i `elem` needNote then Note [Para [i]] else i - setNote = bottomUp mvCite - getCits = concat . flip (zipWith $ setCiteNoteNum) [1..] . - map (queryWith getCite) . queryWith getNote . setNote - in queryWith getCitation . getCits - setHash :: Citation -> IO Citation setHash (Citation i p s cm nn _) = hashUnique `fmap` newUnique >>= return . Citation i p s cm nn -generateNotes :: [Inline] -> Pandoc -> Pandoc -generateNotes needNote = bottomUp (mvCiteInNote needNote) - -mvCiteInNote :: [Inline] -> Block -> Block -mvCiteInNote is = procInlines mvCite - where - mvCite :: [Inline] -> [Inline] - mvCite inls - | x:i:xs <- inls, startWithPunct xs - , x == Space, i `elem_` is = switch i xs ++ mvCite (tailFirstInlineStr xs) - | x:i:xs <- inls - , x == Space, i `elem_` is = mvInNote i : mvCite xs - | i:xs <- inls, i `elem_` is - , startWithPunct xs = switch i xs ++ mvCite (tailFirstInlineStr xs) - | i:xs <- inls, Note _ <- i = checkNt i : mvCite xs - | i:xs <- inls = i : mvCite xs - | otherwise = [] - elem_ x xs = case x of Cite cs _ -> (Cite cs []) `elem` xs; _ -> False - switch i xs = Str (headInline xs) : mvInNote i : [] - mvInNote i - | Cite t o <- i = Note [Para [Cite t $ sanitize o]] - | otherwise = Note [Para [i ]] - sanitize i - | endWithPunct i = toCapital i - | otherwise = toCapital (i ++ [Str "."]) - - checkPt i - | Cite c o : xs <- i , endWithPunct o, startWithPunct xs - = Cite c (initInline o) : checkPt xs - | x:xs <- i = x : checkPt xs - | otherwise = [] - checkNt = bottomUp $ procInlines checkPt - -setCiteNoteNum :: [Inline] -> Int -> [Inline] -setCiteNoteNum ((Cite cs o):xs) n = Cite (setCitationNoteNum n cs) o : setCiteNoteNum xs n -setCiteNoteNum _ _ = [] - -setCitationNoteNum :: Int -> [Citation] -> [Citation] -setCitationNoteNum i = map $ \c -> c { citationNoteNum = i} - toCslCite :: Citation -> CSL.Cite toCslCite c = let (l, s) = locatorWords $ citationSuffix c (la,lo) = parseLocator l + s' = case (l,s,citationMode c) of + -- treat a bare locator as if it begins with comma + -- so @item1 [blah] is like [@item1, blah] + ("",(x:_),AuthorInText) | not (isPunct x) + -> [Str ",",Space] ++ s + _ -> s + isPunct (Str (x:_)) = isPunctuation x + isPunct _ = False citMode = case citationMode c of AuthorInText -> (True, False) SuppressAuthor -> (False,True ) NormalCitation -> (False,False) in emptyCite { CSL.citeId = citationId c , CSL.citePrefix = PandocText $ citationPrefix c - , CSL.citeSuffix = PandocText $ s + , CSL.citeSuffix = PandocText s' , CSL.citeLabel = la , CSL.citeLocator = lo , CSL.citeNoteNumber = show $ citationNoteNum c @@ -189,7 +165,7 @@ locatorWords inp = breakup (x : xs) = x : breakup xs splitup = groupBy (\x y -> x /= '\160' && y /= '\160') -pLocatorWords :: GenParser Inline st (String, [Inline]) +pLocatorWords :: Parsec [Inline] st (String, [Inline]) pLocatorWords = do l <- pLocator s <- getInput -- rest is suffix @@ -197,16 +173,16 @@ pLocatorWords = do then return (init l, Str "," : s) else return (l, s) -pMatch :: (Inline -> Bool) -> GenParser Inline st Inline +pMatch :: (Inline -> Bool) -> Parsec [Inline] st Inline pMatch condition = try $ do t <- anyToken guard $ condition t return t -pSpace :: GenParser Inline st Inline +pSpace :: Parsec [Inline] st Inline pSpace = pMatch (\t -> t == Space || t == Str "\160") -pLocator :: GenParser Inline st String +pLocator :: Parsec [Inline] st String pLocator = try $ do optional $ pMatch (== Str ",") optional pSpace @@ -214,7 +190,7 @@ pLocator = try $ do gs <- many1 pWordWithDigits return $ stringify f ++ (' ' : unwords gs) -pWordWithDigits :: GenParser Inline st String +pWordWithDigits :: Parsec [Inline] st String pWordWithDigits = try $ do pSpace r <- many1 (notFollowedBy pSpace >> anyToken) |