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.hs180
1 files changed, 159 insertions, 21 deletions
diff --git a/src/Text/Pandoc/Biblio.hs b/src/Text/Pandoc/Biblio.hs
index 436eadd68..4a8cea4da 100644
--- a/src/Text/Pandoc/Biblio.hs
+++ b/src/Text/Pandoc/Biblio.hs
@@ -22,45 +22,183 @@ 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
-}
module Text.Pandoc.Biblio ( processBiblio ) where
-import Control.Monad ( when )
import Data.List
-import Text.CSL
+import Data.Unique
+import Data.Char ( isDigit )
+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.Shared (stringify)
+import Text.ParserCombinators.Parsec
+import Control.Monad
-- | Process a 'Pandoc' document by adding citations formatted
-- according to a CSL style, using 'citeproc' from citeproc-hs.
-processBiblio :: String -> [Reference] -> Pandoc -> IO Pandoc
-processBiblio cf r p
+processBiblio :: FilePath -> [Reference] -> Pandoc -> IO Pandoc
+processBiblio cslfile r p
= if null r then return 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
+ csl <- readCSLFile cslfile
+ p' <- processWithM 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'
+ 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)
+ addNt t x = if null x then [] else [Cite t $ renderPandoc s x]
+ process t = case M.lookup t cs of
+ Just x -> if isTextualCitation t && x /= []
+ then renderPandoc s [head x] ++ [Space] ++ addNt t (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 s cm nn _)
+ = hashUnique `fmap` newUnique >>= return . Citation i p s 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 c
+ = let (l, s) = locatorWords $ citationSuffix c
+ (la,lo) = parseLocator l
+ 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.citeLabel = la
+ , CSL.citeLocator = lo
+ , CSL.citeNoteNumber = show $ citationNoteNum c
+ , CSL.authorInText = fst citMode
+ , CSL.suppressAuthor = snd citMode
+ , CSL.citeHash = citationHash c
+ }
+
+locatorWords :: [Inline] -> (String, [Inline])
+locatorWords inp =
+ case parse (liftM2 (,) pLocator getInput) "suffix" inp of
+ Right r -> r
+ Left _ -> ("",inp)
+
+pMatch :: (Inline -> Bool) -> GenParser Inline st Inline
+pMatch condition = try $ do
+ t <- anyToken
+ guard $ condition t
+ return t
+
+pSpace :: GenParser Inline st Inline
+pSpace = pMatch (== Space)
+
+pLocator :: GenParser Inline st String
+pLocator = try $ do
+ optional $ pMatch (== Str ",")
+ optional pSpace
+ f <- many1 (notFollowedBy pSpace >> anyToken)
+ gs <- many1 pWordWithDigits
+ return $ stringify f ++ (' ' : unwords gs)
+
+pWordWithDigits :: GenParser Inline st String
+pWordWithDigits = try $ do
+ pSpace
+ r <- many1 (notFollowedBy pSpace >> anyToken)
+ let s = stringify r
+ guard $ any isDigit s
+ return s
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-08 13:08:26 +0000