aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Biblio.hs133
-rw-r--r--src/Text/Pandoc/Definition.hs151
-rw-r--r--src/Text/Pandoc/Parsing.hs4
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs40
4 files changed, 141 insertions, 187 deletions
diff --git a/src/Text/Pandoc/Biblio.hs b/src/Text/Pandoc/Biblio.hs
index 436eadd68..c334d89ce 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,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,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 = 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 -> [([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 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
+ }
diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs
deleted file mode 100644
index fffca3b2e..000000000
--- a/src/Text/Pandoc/Definition.hs
+++ /dev/null
@@ -1,151 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable
-{-
-Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--}
-
-{- |
- Module : Text.Pandoc.Definition
- Copyright : Copyright (C) 2006-2010 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Definition of 'Pandoc' data structure for format-neutral representation
-of documents.
--}
-module Text.Pandoc.Definition where
-
-import Data.Generics
-
-data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data)
-
--- | Bibliographic information for the document: title, authors, date.
-data Meta = Meta { docTitle :: [Inline]
- , docAuthors :: [[Inline]]
- , docDate :: [Inline] }
- deriving (Eq, Ord, Show, Read, Typeable, Data)
-
--- | Alignment of a table column.
-data Alignment = AlignLeft
- | AlignRight
- | AlignCenter
- | AlignDefault deriving (Eq, Ord, Show, Read, Typeable, Data)
-
--- | List attributes.
-type ListAttributes = (Int, ListNumberStyle, ListNumberDelim)
-
--- | Style of list numbers.
-data ListNumberStyle = DefaultStyle
- | Example
- | Decimal
- | LowerRoman
- | UpperRoman
- | LowerAlpha
- | UpperAlpha deriving (Eq, Ord, Show, Read, Typeable, Data)
-
--- | Delimiter of list numbers.
-data ListNumberDelim = DefaultDelim
- | Period
- | OneParen
- | TwoParens deriving (Eq, Ord, Show, Read, Typeable, Data)
-
--- | Attributes: identifier, classes, key-value pairs
-type Attr = (String, [String], [(String, String)])
-
--- | Block element.
-data Block
- = Plain [Inline] -- ^ Plain text, not a paragraph
- | Para [Inline] -- ^ Paragraph
- | CodeBlock Attr String -- ^ Code block (literal) with attributes
- | RawHtml String -- ^ Raw HTML block (literal)
- | BlockQuote [Block] -- ^ Block quote (list of blocks)
- | OrderedList ListAttributes [[Block]] -- ^ Ordered list (attributes
- -- and a list of items, each a list of blocks)
- | BulletList [[Block]] -- ^ Bullet list (list of items, each
- -- a list of blocks)
- | DefinitionList [([Inline],[[Block]])] -- ^ Definition list
- -- Each list item is a pair consisting of a
- -- term (a list of inlines) and one or more
- -- definitions (each a list of blocks)
- | Header Int [Inline] -- ^ Header - level (integer) and text (inlines)
- | HorizontalRule -- ^ Horizontal rule
- | Table [Inline] [Alignment] [Double] [[Block]] [[[Block]]] -- ^ Table,
- -- with caption, column alignments,
- -- relative column widths (0 = default),
- -- column headers (each a list of blocks), and
- -- rows (each a list of lists of blocks)
- | Null -- ^ Nothing
- deriving (Eq, Ord, Read, Show, Typeable, Data)
-
--- | Type of quotation marks to use in Quoted inline.
-data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Ord, Read, Typeable, Data)
-
--- | Link target (URL, title).
-type Target = (String, String)
-
--- | Type of math element (display or inline).
-data MathType = DisplayMath | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data)
-
--- | Inline elements.
-data Inline
- = Str String -- ^ Text (string)
- | Emph [Inline] -- ^ Emphasized text (list of inlines)
- | Strong [Inline] -- ^ Strongly emphasized text (list of inlines)
- | Strikeout [Inline] -- ^ Strikeout text (list of inlines)
- | Superscript [Inline] -- ^ Superscripted text (list of inlines)
- | 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)
- | Code String -- ^ Inline code (literal)
- | Space -- ^ Inter-word space
- | EmDash -- ^ Em dash
- | EnDash -- ^ En dash
- | Apostrophe -- ^ Apostrophe
- | Ellipses -- ^ Ellipses
- | LineBreak -- ^ Hard line break
- | Math MathType String -- ^ TeX math (literal)
- | TeX String -- ^ LaTeX code (literal)
- | HtmlInline String -- ^ HTML code (literal)
- | Link [Inline] Target -- ^ Hyperlink: text (list of inlines), target
- | Image [Inline] Target -- ^ Image: alt text (list of inlines), target
- -- and target
- | Note [Block] -- ^ Footnote or endnote
- deriving (Show, Eq, Ord, Read, Typeable, Data)
-
--- | 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)
-
--- | Like 'processWith', but with monadic transformations.
-processWithM :: (Monad m, Data a, Data b) => (a -> m a) -> b -> m b
-processWithM f = everywhereM (mkM f)
-
--- | Runs a query on matching @a@ elements in a @c@.
-queryWith :: (Data a, Data c) => (a -> [b]) -> c -> [b]
-queryWith f = everything (++) ([] `mkQ` f)
-
-{-# DEPRECATED processPandoc "Use processWith instead" #-}
-processPandoc :: Data a => (a -> a) -> Pandoc -> Pandoc
-processPandoc = processWith
-
-{-# DEPRECATED queryPandoc "Use queryWith instead" #-}
-queryPandoc :: Data a => (a -> [b]) -> Pandoc -> [b]
-queryPandoc = queryWith
-
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index dce99fd75..47e97c7cc 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -586,9 +586,7 @@ data ParserState = ParserState
stateQuoteContext :: QuoteContext, -- ^ Inside quoted environment?
stateSanitizeHTML :: Bool, -- ^ Sanitize HTML?
stateKeys :: KeyTable, -- ^ List of reference keys
-#ifdef _CITEPROC
stateCitations :: [String], -- ^ List of available citations
-#endif
stateNotes :: NoteTable, -- ^ List of notes
stateTabStop :: Int, -- ^ Tab stop
stateStandalone :: Bool, -- ^ Parse bibliographic info?
@@ -616,9 +614,7 @@ defaultParserState =
stateQuoteContext = NoQuote,
stateSanitizeHTML = False,
stateKeys = M.empty,
-#ifdef _CITEPROC
stateCitations = [],
-#endif
stateNotes = [],
stateTabStop = 4,
stateStandalone = False,
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index b655ea1a9..7a42d903e 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -912,9 +912,7 @@ inlineParsers = [ str
, note
, inlineNote
, link
-#ifdef _CITEPROC
, inlineCitation
-#endif
, image
, math
, strikeout
@@ -1305,7 +1303,6 @@ rawHtmlInline' = do
else choice [htmlComment, anyHtmlInlineTag]
return $ HtmlInline result
-#ifdef _CITEPROC
inlineCitation :: GenParser Char ParserState Inline
inlineCitation = try $ do
failIfStrict
@@ -1316,27 +1313,38 @@ 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 ("" , "" )
-
-#endif
+ 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)
+ mode = case (na,o) of
+ (True, False) -> SuppressAuthor
+ (False,True ) -> AuthorInText
+ _ -> NormalCitation
+ return $ Citation cit (trim p') (trim loc) mode 0 0
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-10 02:35:05 +0000