From ac06ca2b00f1c0b25b02b1e25aca8dd28961240d Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 27 Oct 2010 18:22:45 -0700 Subject: [PATCH] Changes to use citeproc 0.3. Patch from Andrea Rossato. Note: the markdown syntax is preliminary and will probably change. --- src/Text/Pandoc/Biblio.hs | 75 +++++++++++++++++++++++++---- src/Text/Pandoc/Definition.hs | 16 +++++- src/Text/Pandoc/Readers/Markdown.hs | 32 +++++++----- src/pandoc.hs | 2 +- 4 files changed, 101 insertions(+), 24 deletions(-) diff --git a/src/Text/Pandoc/Biblio.hs b/src/Text/Pandoc/Biblio.hs index 436eadd68..cbf6191f8 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 + Maintainer : Andrea Rossato 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,78 @@ 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 + p' <- if styleClass csl == "note" + then processNote p + else processWithM setHash p + let groups = if styleClass csl /= "note" + then queryWith getCitation p' + else getNoteCitations p' + result = citeproc' csl r (setNearNote csl $ map (map toCslCite) groups) cits_map = zip groups (citations result) biblioList = map (read . renderPandoc' csl) (bibliography result) - Pandoc m b = processWith (processCite csl cits_map) p + Pandoc m b = processWith (processCite csl cits_map) p' return $ Pandoc m $ b ++ biblioList -- | Substitute 'Cite' elements with formatted citations. -processCite :: Style -> [([Target],[FormattedOutput])] -> Inline -> Inline +processCite :: Style -> [([Citation],[FormattedOutput])] -> Inline -> Inline processCite s cs il | Cite t _ <- il = Cite t (process t) | otherwise = il 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 i -> read $ renderPandoc s i Nothing -> [Str ("Error processing " ++ show t)] -- | 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 :: Pandoc -> [[Citation]] +getNoteCitations + = let cits = concat . flip (zipWith $ setCiteNoteNum) [1..] . + map (queryWith getCite) . queryWith getNote + in queryWith getCitation . cits + +setHash :: Citation -> IO Citation +setHash (Citation i p l nn ao na _) + = hashUnique `fmap` newUnique >>= return . Citation i p l nn ao na + +processNote :: Pandoc -> IO Pandoc +processNote p = do + p' <- processWithM setHash p + let cits = queryWith getCite p' + ncits = map (queryWith getCite) $ queryWith getNote p' + needNote = cits \\ concat ncits + return $ processWith (mvCiteInNote needNote) p' + +mvCiteInNote :: [Inline] -> Inline -> Inline +mvCiteInNote is i = if i `elem` is then Note [Para [i]] else i + +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 nn ao na _) + = let (la,lo) = parseLocator l + in emptyCite { CSL.citeId = i + , CSL.citePrefix = p + , CSL.citeLabel = la + , CSL.citeLocator = lo + , CSL.citeNoteNumber = show nn + , CSL.authorOnly = ao + , CSL.suppressAuthor = na + } diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs index fffca3b2e..bec216b5d 100644 --- a/src/Text/Pandoc/Definition.hs +++ b/src/Text/Pandoc/Definition.hs @@ -112,7 +112,7 @@ data Inline | Subscript [Inline] -- ^ Subscripted text (list of inlines) | SmallCaps [Inline] -- ^ Small caps text (list of inlines) | Quoted QuoteType [Inline] -- ^ Quoted text (list of inlines) - | Cite [Target] [Inline] -- ^ Citation (list of inlines) + | Cite [Citation] [Inline] -- ^ Citation (list of inlines) | Code String -- ^ Inline code (literal) | Space -- ^ Inter-word space | EmDash -- ^ Em dash @@ -129,6 +129,20 @@ data Inline | Note [Block] -- ^ Footnote or endnote deriving (Show, Eq, Ord, Read, Typeable, Data) +data Citation = Citation { citationId :: String + , citationPrefix :: String + , citationLocator :: String + , citationNoteNum :: Int + , citationAutOnly :: Bool + , citationNoAut :: Bool + , citationHash :: Int + } + deriving (Show, Ord, Read, Typeable, Data) + +instance Eq Citation where + (==) (Citation _ _ _ _ _ _ ha) + (Citation _ _ _ _ _ _ hb) = ha == hb + -- | Applies a transformation on @a@s to matching elements in a @b@. processWith :: (Data a, Data b) => (a -> a) -> b -> b processWith f = everywhere (mkT f) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 8c6a90edb..030da9167 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1316,27 +1316,35 @@ inlineCitation = try $ do then return $ Cite citations [] else fail "no citation found" -chkCit :: Target -> GenParser Char ParserState (Maybe Target) +chkCit :: Citation -> GenParser Char ParserState (Maybe Citation) chkCit t = do st <- getState - case lookupKeySrc (stateKeys st) (Key [Str $ fst t]) of + case lookupKeySrc (stateKeys st) (Key [Str $ citationId t]) of Just _ -> fail "This is a link" - Nothing -> if elem (fst t) $ stateCitations st + Nothing -> if elem (citationId t) $ stateCitations st then return $ Just t else return $ Nothing citeMarker :: GenParser Char ParserState String citeMarker = char '[' >> manyTill ( noneOf "\n" <|> (newline >>~ notFollowedBy blankline) ) (char ']') -parseCitation :: GenParser Char ParserState [(String,String)] -parseCitation = try $ sepBy (parseLabel) (oneOf ";") +parseCitation :: GenParser Char ParserState [Citation] +parseCitation = try $ sepBy (parseLabel) (skipMany1 $ char ';') -parseLabel :: GenParser Char ParserState (String,String) +parseLabel :: GenParser Char ParserState Citation parseLabel = try $ do - res <- sepBy (skipSpaces >> optional newline >> skipSpaces >> many1 (noneOf "@;")) (oneOf "@") - case res of - [lab,loc] -> return (lab, loc) - [lab] -> return (lab, "" ) - _ -> return ("" , "" ) - + r <- many (noneOf ";") + let t' s = if s /= [] then tail s else [] + trim = unwords . words + pref = takeWhile (/= '@') r + rest = t' $ dropWhile (/= '@') r + cit = takeWhile (/= ',') rest + loc = t' $ dropWhile (/= ',') rest + (p,na) = if pref /= [] && last pref == '-' + then (init pref, True ) + else (pref , False) + (p',o) = if p /= [] && last p == '+' + then (init p , True ) + else (p , False) + return $ Citation cit (trim p') (trim loc) 0 o na 0 #endif diff --git a/src/pandoc.hs b/src/pandoc.hs index 082e337f5..c8c414a2e 100644 --- a/src/pandoc.hs +++ b/src/pandoc.hs @@ -789,7 +789,7 @@ main = do lhsExtension sources, stateStandalone = standalone', #ifdef _CITEPROC - stateCitations = map citeKey refs, + stateCitations = map refId refs, #endif stateSmart = smart || writerName' `elem` ["latex", "context", "latex+lhs", "man"],