diff options
Diffstat (limited to 'src/Text/Pandoc/Biblio.hs')
| -rw-r--r-- | src/Text/Pandoc/Biblio.hs | 133 |
1 files changed, 117 insertions, 16 deletions
diff --git a/src/Text/Pandoc/Biblio.hs b/src/Text/Pandoc/Biblio.hs index 436eadd68..c334d89ce 100644 --- a/src/Text/Pandoc/Biblio.hs +++ b/src/Text/Pandoc/Biblio.hs @@ -22,7 +22,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Copyright : Copyright (C) 2008 Andrea Rossato License : GNU GPL, version 2 or above - Maintainer : Andrea Rossato <andrea.rossato@ing.unitn.it> + Maintainer : Andrea Rossato <andrea.rossato@unitn.it> Stability : alpha Portability : portable -} @@ -31,7 +31,9 @@ module Text.Pandoc.Biblio ( processBiblio ) where import Control.Monad ( when ) import Data.List -import Text.CSL +import Data.Unique +import Text.CSL hiding ( Cite(..), Citation(..) ) +import qualified Text.CSL as CSL ( Cite(..) ) import Text.Pandoc.Definition -- | Process a 'Pandoc' document by adding citations formatted @@ -42,25 +44,124 @@ processBiblio cf r p else do when (null cf) $ error "Missing the needed citation style file" csl <- readCSLFile cf - let groups = queryWith getCite p - result = citeproc csl r groups - cits_map = zip groups (citations result) - biblioList = map (read . renderPandoc' csl) (bibliography result) - Pandoc m b = processWith (processCite csl cits_map) p - return $ Pandoc m $ b ++ biblioList + p' <- processWithM setHash p + let (nts,grps) = if styleClass csl /= "note" + then (,) [] $ queryWith getCitation p' + else let cits = queryWith getCite p' + ncits = map (queryWith getCite) $ queryWith getNote p' + needNt = cits \\ concat ncits + in (,) needNt $ getNoteCitations needNt p' + result = citeproc csl r (setNearNote csl $ map (map toCslCite) grps) + cits_map = zip grps (citations result) + biblioList = map (renderPandoc' csl) (bibliography result) + Pandoc m b = processWith (procInlines $ processCite csl cits_map) p' + return . generateNotes nts . Pandoc m $ b ++ biblioList -- | Substitute 'Cite' elements with formatted citations. -processCite :: Style -> [([Target],[FormattedOutput])] -> Inline -> Inline -processCite s cs il - | Cite t _ <- il = Cite t (process t) - | otherwise = il +processCite :: Style -> [([Citation],[FormattedOutput])] -> [Inline] -> [Inline] +processCite _ _ [] = [] +processCite s cs (i:is) + | Cite t _ <- i = process t ++ processCite s cs is + | otherwise = i : processCite s cs is where - process t = case elemIndex t (map fst cs) of - Just i -> read . renderPandoc s $ snd (cs !! i) + process t = case lookup t cs of + Just x -> if isTextualCitation t && x /= [] + then renderPandoc s [head x] ++ [Space] ++ + [Cite t $ renderPandoc s $ tail x] + else [Cite t $ renderPandoc s x] Nothing -> [Str ("Error processing " ++ show t)] +isTextualCitation :: [Citation] -> Bool +isTextualCitation (c:_) = citationMode c == AuthorInText +isTextualCitation _ = False + -- | Retrieve all citations from a 'Pandoc' docuument. To be used with -- 'queryWith'. -getCite :: Inline -> [[(String,String)]] -getCite i | Cite t _ <- i = [t] +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 = processWith 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 l cm nn _) + = hashUnique `fmap` newUnique >>= return . Citation i p l cm nn + +generateNotes :: [Inline] -> Pandoc -> Pandoc +generateNotes needNote = processWith (mvCiteInNote needNote) + +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 + +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 + , endWithPunct o = Cite c (initInline o) : checkPt xs + | x:xs <- i = x : checkPt xs + | otherwise = [] + checkNt = processWith $ 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 (Citation i p l cm nn h) + = let (la,lo) = parseLocator l + citMode = case cm of + AuthorInText -> (True, False) + SuppressAuthor -> (False,True ) + NormalCitation -> (False,False) + in emptyCite { CSL.citeId = i + , CSL.citePrefix = p + , CSL.citeLabel = la + , CSL.citeLocator = lo + , CSL.citeNoteNumber = show nn + , CSL.authorInText = fst citMode + , CSL.suppressAuthor = snd citMode + , CSL.citeHash = h + } |