Changes to use citeproc 0.3.

Patch from Andrea Rossato.
Note: the markdown syntax is preliminary and will probably change.
This commit is contained in:
John MacFarlane 2010-10-27 18:22:45 -07:00
parent 9cf27c92c1
commit ac06ca2b00
4 changed files with 101 additions and 24 deletions

View file

@ -22,7 +22,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Copyright : Copyright (C) 2008 Andrea Rossato Copyright : Copyright (C) 2008 Andrea Rossato
License : GNU GPL, version 2 or above License : GNU GPL, version 2 or above
Maintainer : Andrea Rossato <andrea.rossato@ing.unitn.it> Maintainer : Andrea Rossato <andrea.rossato@unitn.it>
Stability : alpha Stability : alpha
Portability : portable Portability : portable
-} -}
@ -31,7 +31,9 @@ module Text.Pandoc.Biblio ( processBiblio ) where
import Control.Monad ( when ) import Control.Monad ( when )
import Data.List 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 import Text.Pandoc.Definition
-- | Process a 'Pandoc' document by adding citations formatted -- | Process a 'Pandoc' document by adding citations formatted
@ -42,25 +44,78 @@ processBiblio cf r p
else do else do
when (null cf) $ error "Missing the needed citation style file" when (null cf) $ error "Missing the needed citation style file"
csl <- readCSLFile cf csl <- readCSLFile cf
let groups = queryWith getCite p p' <- if styleClass csl == "note"
result = citeproc csl r groups 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) cits_map = zip groups (citations result)
biblioList = map (read . renderPandoc' csl) (bibliography 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 return $ Pandoc m $ b ++ biblioList
-- | Substitute 'Cite' elements with formatted citations. -- | Substitute 'Cite' elements with formatted citations.
processCite :: Style -> [([Target],[FormattedOutput])] -> Inline -> Inline processCite :: Style -> [([Citation],[FormattedOutput])] -> Inline -> Inline
processCite s cs il processCite s cs il
| Cite t _ <- il = Cite t (process t) | Cite t _ <- il = Cite t (process t)
| otherwise = il | otherwise = il
where where
process t = case elemIndex t (map fst cs) of process t = case lookup t cs of
Just i -> read . renderPandoc s $ snd (cs !! i) Just i -> read $ renderPandoc s i
Nothing -> [Str ("Error processing " ++ show t)] Nothing -> [Str ("Error processing " ++ show t)]
-- | Retrieve all citations from a 'Pandoc' docuument. To be used with -- | Retrieve all citations from a 'Pandoc' docuument. To be used with
-- 'queryWith'. -- 'queryWith'.
getCite :: Inline -> [[(String,String)]] getCitation :: Inline -> [[Citation]]
getCite i | Cite t _ <- i = [t] 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 = [] | 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
}

View file

@ -112,7 +112,7 @@ data Inline
| Subscript [Inline] -- ^ Subscripted text (list of inlines) | Subscript [Inline] -- ^ Subscripted text (list of inlines)
| SmallCaps [Inline] -- ^ Small caps text (list of inlines) | SmallCaps [Inline] -- ^ Small caps text (list of inlines)
| Quoted QuoteType [Inline] -- ^ Quoted 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) | Code String -- ^ Inline code (literal)
| Space -- ^ Inter-word space | Space -- ^ Inter-word space
| EmDash -- ^ Em dash | EmDash -- ^ Em dash
@ -129,6 +129,20 @@ data Inline
| Note [Block] -- ^ Footnote or endnote | Note [Block] -- ^ Footnote or endnote
deriving (Show, Eq, Ord, Read, Typeable, Data) 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@. -- | Applies a transformation on @a@s to matching elements in a @b@.
processWith :: (Data a, Data b) => (a -> a) -> b -> b processWith :: (Data a, Data b) => (a -> a) -> b -> b
processWith f = everywhere (mkT f) processWith f = everywhere (mkT f)

View file

@ -1316,27 +1316,35 @@ inlineCitation = try $ do
then return $ Cite citations [] then return $ Cite citations []
else fail "no citation found" else fail "no citation found"
chkCit :: Target -> GenParser Char ParserState (Maybe Target) chkCit :: Citation -> GenParser Char ParserState (Maybe Citation)
chkCit t = do chkCit t = do
st <- getState 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" Just _ -> fail "This is a link"
Nothing -> if elem (fst t) $ stateCitations st Nothing -> if elem (citationId t) $ stateCitations st
then return $ Just t then return $ Just t
else return $ Nothing else return $ Nothing
citeMarker :: GenParser Char ParserState String citeMarker :: GenParser Char ParserState String
citeMarker = char '[' >> manyTill ( noneOf "\n" <|> (newline >>~ notFollowedBy blankline) ) (char ']') citeMarker = char '[' >> manyTill ( noneOf "\n" <|> (newline >>~ notFollowedBy blankline) ) (char ']')
parseCitation :: GenParser Char ParserState [(String,String)] parseCitation :: GenParser Char ParserState [Citation]
parseCitation = try $ sepBy (parseLabel) (oneOf ";") parseCitation = try $ sepBy (parseLabel) (skipMany1 $ char ';')
parseLabel :: GenParser Char ParserState (String,String) parseLabel :: GenParser Char ParserState Citation
parseLabel = try $ do parseLabel = try $ do
res <- sepBy (skipSpaces >> optional newline >> skipSpaces >> many1 (noneOf "@;")) (oneOf "@") r <- many (noneOf ";")
case res of let t' s = if s /= [] then tail s else []
[lab,loc] -> return (lab, loc) trim = unwords . words
[lab] -> return (lab, "" ) pref = takeWhile (/= '@') r
_ -> return ("" , "" ) 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 #endif

View file

@ -789,7 +789,7 @@ main = do
lhsExtension sources, lhsExtension sources,
stateStandalone = standalone', stateStandalone = standalone',
#ifdef _CITEPROC #ifdef _CITEPROC
stateCitations = map citeKey refs, stateCitations = map refId refs,
#endif #endif
stateSmart = smart || writerName' `elem` stateSmart = smart || writerName' `elem`
["latex", "context", "latex+lhs", "man"], ["latex", "context", "latex+lhs", "man"],