Added support for Cite to Markdown reader, and conditional support for citeproc module.

+ The citeproc cabal configuration option sets the _CITEPROC macro, which conditionally
  includes code for handling citations.
+ Added Text.Pandoc.Biblio module.
+ Made highlighting option default to False.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@1376 788f1e2b-df1e-0410-8736-df70ead52e1b
This commit is contained in:
fiddlosopher 2008-08-04 03:15:34 +00:00
parent 4719c78417
commit 1bfe1b84a8
7 changed files with 197 additions and 16 deletions

71
Main.hs
View file

@ -47,6 +47,10 @@ import System.IO ( stdout, stderr )
#else
import System.IO
#endif
#ifdef _CITEPROC
import Text.CSL
import Text.Pandoc.Biblio
#endif
copyrightMessage :: String
copyrightMessage = "\nCopyright (C) 2006-7 John MacFarlane\n" ++
@ -55,15 +59,25 @@ copyrightMessage = "\nCopyright (C) 2006-7 John MacFarlane\n" ++
"warranty, not even for merchantability or fitness for a particular purpose."
compileInfo :: String
compileInfo = "Compiled" ++
compileInfo =
#ifdef _UTF8
" with UTF-8 support" ++
" +utf8" ++
#else
" without UTF-8 support" ++
" -utf8" ++
#endif
#ifdef _CITEPROC
" +citeproc" ++
#else
" -citeproc" ++
#endif
#ifdef _HIGHLIGHTING
" +highlighting" ++
#else
" -highlighting" ++
#endif
if null languages
then " and without syntax highlighting support."
else " and with syntax highlighting support for:\n" ++
then "\n"
else "\nCompiled with syntax highlighting support for:\n" ++
(unlines $ map unwords $ chunk 5 $ map (\s -> s ++ replicate (15 - length s) ' ') languages)
-- | Splits a list into groups of at most n.
@ -137,6 +151,10 @@ data Opt = Opt
, optReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst
, optWrapText :: Bool -- ^ Wrap text
, optSanitizeHTML :: Bool -- ^ Sanitize HTML
#ifdef _CITEPROC
, optModsFile :: String
, optCslFile :: String
#endif
}
-- | Defaults for command-line options.
@ -166,6 +184,10 @@ defaultOpts = Opt
, optReferenceLinks = False
, optWrapText = True
, optSanitizeHTML = False
#ifdef _CITEPROC
, optModsFile = []
, optCslFile = []
#endif
}
-- | A list of functions, each transforming the options data structure
@ -333,13 +355,24 @@ options =
exitWith ExitSuccess)
"FORMAT")
"" -- "Print default header for FORMAT"
#ifdef _CITEPROC
, Option "" ["mods"]
(ReqArg
(\arg opt -> return opt { optModsFile = arg} )
"FILENAME")
""
, Option "" ["csl"]
(ReqArg
(\arg opt -> return opt { optCslFile = arg} )
"FILENAME")
""
#endif
, Option "" ["dump-args"]
(NoArg
(\opt -> return opt { optDumpArgs = True }))
"" -- "Print output filename and arguments to stdout."
, Option "" ["ignore-args"]
, Option "" ["ignore-args"]
(NoArg
(\opt -> return opt { optIgnoreArgs = True }))
"" -- "Ignore command-line arguments."
@ -348,7 +381,7 @@ options =
(NoArg
(\_ -> do
prg <- getProgName
hPutStrLn stderr (prg ++ " " ++ pandocVersion ++ "\n" ++ compileInfo ++
hPutStrLn stderr (prg ++ " " ++ pandocVersion ++ compileInfo ++
copyrightMessage)
exitWith $ ExitFailure 4))
"" -- "Print version"
@ -464,6 +497,10 @@ main = do
, optReferenceLinks = referenceLinks
, optWrapText = wrap
, optSanitizeHTML = sanitize
#ifdef _CITEPROC
, optModsFile = modsFile
, optCslFile = cslFile
#endif
} = opts
if dumpArgs
@ -513,11 +550,18 @@ main = do
let standalone' = (standalone && not strict) || writerName' == "odt"
#ifdef _CITEPROC
refs <- if null modsFile then return [] else readModsColletionFile modsFile
#endif
let startParserState =
defaultParserState { stateParseRaw = parseRaw,
stateTabStop = tabStop,
stateSanitizeHTML = sanitize,
stateStandalone = standalone',
#ifdef _CITEPROC
stateCitations = map citeKey refs,
#endif
stateSmart = smart || writerName' `elem`
["latex", "context"],
stateColumns = columns,
@ -564,11 +608,12 @@ main = do
then putStrLn
else writeFile outputFile . (++ "\n")
(readSources sources) >>= writeOutput .
writer writerOptions .
reader startParserState .
tabFilter tabStop .
joinWithSep "\n"
fmap (reader startParserState . tabFilter tabStop . joinWithSep "\n")
(readSources sources) >>=
#ifdef _CITEPROC
processBiblio cslFile refs >>=
#endif
writeOutput . writer writerOptions
where
readSources [] = mapM readSource ["-"]

76
Text/Pandoc/Biblio.hs Normal file
View file

@ -0,0 +1,76 @@
{-# LANGUAGE PatternGuards, CPP #-}
{-
Copyright (C) 2008 Andrea Rossato <andrea.rossato@ing.unitn.it>
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.Biblio
Copyright : Copyright (C) 2008 Andrea Rossato
License : GNU GPL, version 2 or above
Maintainer : Andrea Rossato <andrea.rossato@ing.unitn.it>
Stability : alpha
Portability : portable
-}
#ifdef _CITEPROC
module Text.Pandoc.Biblio ( processBiblio ) where
import Control.Monad ( when )
import Data.List
import Text.CSL
import Text.Pandoc.Definition
#else
module Text.Pandoc.Biblio () where
#endif
#ifdef _CITEPROC
processBiblio :: String -> [Reference] -> Pandoc -> IO Pandoc
processBiblio cf 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 = queryPandoc getCite p
citations = zip groups . processCitations csl r $ groups
Pandoc m b = processPandoc (processCite citations) p
return $ Pandoc m $ b ++ renderBiblio csl r p
renderBiblio :: Style -> [Reference] -> Pandoc -> [Block]
renderBiblio s r p
= map (read . renderPandoc') $ processBibliography s refs
where cits = nub . map fst . concat . queryPandoc getCite $ p
refs = getRefs r $ zip cits (repeat "")
processCite :: [([Target],[FormattedOutput])] -> Inline -> Inline
processCite 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 $ snd (cs !! i)
Nothing -> [Str ("Error processing " ++ show t)]
getCite :: Inline -> [[(String,String)]]
getCite i | Cite t _ <- i = [t]
| otherwise = []
getRefs :: [Reference] -> [Target] -> [Reference]
getRefs r = map $ getReference r
#endif

View file

@ -125,8 +125,10 @@ data Inline
| Note [Block] -- ^ Footnote or endnote
deriving (Show, Eq, Read, Typeable, Data)
-- | Applies a transformation to matching elements in a Pandoc document.
processPandoc :: Typeable a => (a -> a) -> Pandoc -> Pandoc
processPandoc f = everywhere (mkT f)
-- | Runs a query on matching elements in a Pandoc document.
queryPandoc :: Typeable a => (a -> [b]) -> Pandoc -> [b]
queryPandoc f = everything (++) ([] `mkQ` f)

View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-
Copyright (C) 2006-8 John MacFarlane <jgm@berkeley.edu>
@ -34,7 +35,7 @@ module Text.Pandoc.Readers.Markdown (
import Data.List ( transpose, isPrefixOf, isSuffixOf, lookup, sortBy, findIndex )
import Data.Ord ( comparing )
import Data.Char ( isAlphaNum, isAlpha, isLower, isDigit )
import Data.Maybe ( fromMaybe )
import Data.Maybe
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment )
@ -173,7 +174,7 @@ parseMarkdown = do
setPosition startPos
-- now parse it for real...
(title, author, date) <- option ([],[],"") titleBlock
blocks <- parseBlocks
blocks <- parseBlocks
return $ Pandoc (Meta title author date) $ filter (/= Null) blocks
--
@ -804,6 +805,9 @@ inlineParsers = [ abbrev
, note
, inlineNote
, link
#ifdef _CITEPROC
, inlineCitation
#endif
, image
, math
, strikeout
@ -1152,3 +1156,38 @@ rawHtmlInline' = do
else anyHtmlInlineTag
return $ HtmlInline result
#ifdef _CITEPROC
inlineCitation :: GenParser Char ParserState Inline
inlineCitation = try $ do
failIfStrict
cit <- citeMarker
let citations = readWith parseCitation defaultParserState cit
mr <- mapM chkCit citations
if catMaybes mr /= []
then return $ Cite citations []
else fail "no citation found"
chkCit :: Target -> GenParser Char ParserState (Maybe Target)
chkCit t = do
st <- getState
case lookupKeySrc (stateKeys st) [Str $ fst t] of
Just _ -> fail "This is a link"
Nothing -> if elem (fst t) $ stateCitations st
then return $ Just t
else return $ Nothing
citeMarker :: GenParser Char ParserState String
citeMarker = string "[" >> manyTill (noneOf "\t\n") (string "]")
parseCitation :: GenParser Char ParserState [(String,String)]
parseCitation = try $ sepBy (parseLabel) (oneOf ";")
parseLabel :: GenParser Char ParserState (String,String)
parseLabel = try $ do
res <- sepBy (skipSpaces >> many1 (noneOf "@;\n\t")) (oneOf "@")
case res of
[lab,loc] -> return (lab, loc)
[lab] -> return (lab, "" )
_ -> return ("" , "" )
#endif

View file

@ -629,6 +629,9 @@ 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?
@ -649,6 +652,9 @@ defaultParserState =
stateQuoteContext = NoQuote,
stateSanitizeHTML = False,
stateKeys = [],
#ifdef _CITEPROC
stateCitations = [],
#endif
stateNotes = [],
stateTabStop = 4,
stateStandalone = False,

View file

@ -342,6 +342,8 @@ inlineToMediaWiki opts (Quoted DoubleQuote lst) = do
contents <- inlineListToMediaWiki opts lst
return $ "&ldquo;" ++ contents ++ "&rdquo;"
inlineToMediaWiki opts (Cite _ lst) = inlineListToMediaWiki opts lst
inlineToMediaWiki _ EmDash = return "&mdash;"
inlineToMediaWiki _ EnDash = return "&ndash;"

View file

@ -57,7 +57,7 @@ Flag splitBase
Default: True
Flag highlighting
Description: Compile in support for syntax highlighting of code blocks.
Default: True
Default: False
Flag executable
Description: Build the pandoc executable.
Default: True
@ -67,6 +67,9 @@ Flag library
Flag utf8
Description: Compile in support for UTF-8 input and output.
Default: True
Flag citeproc
Description: Compile in support for citeproc-hs bibliographic formatting.
Default: False
Library
if flag(splitBase)
@ -79,10 +82,14 @@ Library
if flag(utf8)
Build-depends: utf8-string
cpp-options: -D_UTF8
if flag(citeproc)
Build-depends: citeproc-hs
cpp-options: -D_CITEPROC
Build-Depends: parsec < 3, xhtml, mtl, network, filepath, process, directory,
template-haskell, bytestring
Hs-Source-Dirs: .
Exposed-Modules: Text.Pandoc,
Text.Pandoc.Biblio,
Text.Pandoc.Blocks,
Text.Pandoc.Definition,
Text.Pandoc.CharacterReferences,
@ -136,7 +143,11 @@ Executable pandoc
cpp-options: -D_HIGHLIGHTING
if flag(utf8)
cpp-options: -D_UTF8
if flag(citeproc)
Build-depends: citeproc-hs
cpp-options: -D_CITEPROC
if flag(executable)
Buildable: True
else
Buildable: False