aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Biblio.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Biblio.hs')
-rw-r--r--src/Text/Pandoc/Biblio.hs134
1 files changed, 118 insertions, 16 deletions
diff --git a/src/Text/Pandoc/Biblio.hs b/src/Text/Pandoc/Biblio.hs
index 436eadd68..bca24d815 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,10 @@ module Text.Pandoc.Biblio ( processBiblio ) where
import Control.Monad ( when )
import Data.List
-import Text.CSL
+import Data.Unique
+import qualified Data.Map as M
+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 +45,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 = M.fromList $ 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 -> M.Map [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 M.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
+ }