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
parent
9cf27c92c1
commit
ac06ca2b00
4 changed files with 101 additions and 24 deletions
|
|
@ -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,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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"],
|
||||
|
|
|
|||
Loading…
Reference in a new issue