diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Pandoc/Citeproc/BibTeX.hs | 254 | ||||
-rw-r--r-- | src/Text/Pandoc/Templates.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers.hs | 5 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/BibTeX.hs | 48 |
4 files changed, 306 insertions, 3 deletions
diff --git a/src/Text/Pandoc/Citeproc/BibTeX.hs b/src/Text/Pandoc/Citeproc/BibTeX.hs index ed723a11c..10730a1e9 100644 --- a/src/Text/Pandoc/Citeproc/BibTeX.hs +++ b/src/Text/Pandoc/Citeproc/BibTeX.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} @@ -17,6 +18,7 @@ module Text.Pandoc.Citeproc.BibTeX ( Variant(..) , readBibtexString + , writeBibtexString ) where @@ -24,10 +26,11 @@ import Text.Pandoc.Definition import Text.Pandoc.Builder as B import Text.Pandoc.Readers.LaTeX (readLaTeX) import Text.Pandoc.Extensions (Extension(..), extensionsFromList) -import Text.Pandoc.Options (ReaderOptions(..)) -import Text.Pandoc.Class (runPure) +import Text.Pandoc.Options (ReaderOptions(..), WriterOptions) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Shared (stringify) +import Text.Pandoc.Writers.LaTeX (writeLaTeX) +import Text.Pandoc.Class (runPure) import qualified Text.Pandoc.Walk as Walk import Citeproc.Types import Citeproc.Pandoc () @@ -46,8 +49,9 @@ import qualified Data.Sequence as Seq import Data.Char (isAlphaNum, isDigit, isLetter, isUpper, toLower, toUpper, isLower, isPunctuation) -import Data.List (foldl', intercalate) +import Data.List (foldl', intercalate, intersperse) import Safe (readMay) +import Text.Printf (printf) data Variant = Bibtex | Biblatex deriving (Show, Eq, Ord) @@ -68,6 +72,250 @@ readBibtexString variant locale idpred contents = do Left err -> Left err Right xs -> return xs +-- | Write BibTeX or BibLaTeX given given a 'Reference'. +writeBibtexString :: WriterOptions -- ^ options (for writing LaTex) + -> Variant -- ^ bibtex or biblatex + -> Maybe Lang -- ^ Language + -> Reference Inlines -- ^ Reference to write + -> Text +writeBibtexString opts variant mblang ref = + "@" <> bibtexType <> "{" <> unItemId (referenceId ref) <> ",\n " <> + renderFields fs <> "\n}\n" + + where + bibtexType = + case referenceType ref of + "article-magazine" -> "article" + "article-newspaper" -> "article" + "article-journal" -> "article" + "book" -> "book" + "pamphlet" -> "booklet" + "dataset" | variant == Biblatex -> "dataset" + "webpage" | variant == Biblatex -> "online" + "chapter" -> case getVariable "editor" of + Just _ -> "incollection" + Nothing -> "inbook" + "entry-encyclopedia" | variant == Biblatex -> "inreference" + | otherwise -> "inbook" + "paper-conference" -> "inproceedings" + "thesis" -> case getVariableAsText "genre" of + Just "mathesis" -> "mastersthesis" + _ -> "phdthesis" + "patent" | variant == Biblatex -> "patent" + "report" | variant == Biblatex -> "report" + | otherwise -> "techreport" + "speech" -> "unpublished" + "manuscript" -> "unpublished" + "graphic" | variant == Biblatex -> "artwork" + "song" | variant == Biblatex -> "music" + "legal_case" | variant == Biblatex -> "jurisdictionN" + "legislation" | variant == Biblatex -> "legislation" + "treaty" | variant == Biblatex -> "legal" + "personal_communication" | variant == Biblatex -> "letter" + "motion_picture" | variant == Biblatex -> "movie" + "review" | variant == Biblatex -> "review" + _ -> "misc" + + mbSubtype = + case referenceType ref of + "article-magazine" -> Just "magazine" + "article-newspaper" -> Just "newspaper" + _ -> Nothing + + fs = + case variant of + Biblatex -> + [ "author" + , "editor" + , "translator" + , "publisher" + , "title" + , "booktitle" + , "journal" + , "series" + , "edition" + , "volume" + , "volumes" + , "number" + , "pages" + , "date" + , "eventdate" + , "urldate" + , "address" + , "url" + , "doi" + , "isbn" + , "issn" + , "type" + , "entrysubtype" + , "note" + , "language" + , "abstract" + , "keywords" + ] + Bibtex -> + [ "author" + , "editor" + , "translator" + , "publisher" + , "title" + , "booktitle" + , "journal" + , "series" + , "edition" + , "volume" + , "number" + , "pages" + , "year" + , "month" + , "address" + , "type" + , "note" + ] + + valToInlines (TextVal t) = B.text t + valToInlines (FancyVal ils) = ils + valToInlines (NumVal n) = B.text (T.pack $ show n) + valToInlines (NamesVal names) = + mconcat $ intersperse (B.space <> B.text "and" <> B.space) + $ map renderName names + valToInlines (DateVal date) = B.text $ + case dateLiteral date of + Just t -> t + Nothing -> T.intercalate "/" (map renderDatePart (dateParts date)) <> + (if dateCirca date then "~" else mempty) + + renderDatePart (DateParts xs) = T.intercalate "-" $ + map (T.pack . printf "%02d") xs + + renderName name = + case nameLiteral name of + Just t -> B.text t + Nothing -> spacedMaybes + [ nameNonDroppingParticle name + , nameFamily name + , if nameCommaSuffix name + then (", " <>) <$> nameSuffix name + else nameSuffix name ] + <> + spacedMaybes + [ (", " <>) <$> nameGiven name, + nameDroppingParticle name ] + + titlecase = case mblang of + Just (Lang "en" _) -> titlecase' + Nothing -> titlecase' + _ -> id + + titlecase' = addTextCase mblang TitleCase . + (\ils -> B.fromList + (case B.toList ils of + Str t : xs -> Str t : Walk.walk spanAroundCapitalizedWords xs + xs -> Walk.walk spanAroundCapitalizedWords xs)) + + -- protect capitalized words when we titlecase + spanAroundCapitalizedWords (Str t) + | not (T.all (\c -> isLower c || not (isLetter c)) t) = + Span ("",["nocase"],[]) [Str t] + spanAroundCapitalizedWords x = x + + spacedMaybes = mconcat . intersperse B.space . mapMaybe (fmap B.text) + + toLaTeX x = + case runPure (writeLaTeX opts $ doc (B.plain x)) of + Left _ -> Nothing + Right t -> Just t + + renderField name = (\contents -> name <> " = {" <> contents <> "}") + <$> getContentsFor name + + getVariable v = lookupVariable (toVariable v) ref + + getVariableAsText v = (stringify . valToInlines) <$> getVariable v + + getYear val = + case val of + DateVal date -> + case dateLiteral date of + Just t -> toLaTeX (B.text t) + Nothing -> + case dateParts date of + [DateParts (y1:_), DateParts (y2:_)] -> + Just (T.pack (printf "%04d" y1) <> "--" <> + T.pack (printf "%04d" y2)) + [DateParts (y1:_)] -> + Just (T.pack (printf "%04d" y1)) + _ -> Nothing + _ -> Nothing + + toMonth 1 = "jan" + toMonth 2 = "feb" + toMonth 3 = "mar" + toMonth 4 = "apr" + toMonth 5 = "may" + toMonth 6 = "jun" + toMonth 7 = "jul" + toMonth 8 = "aug" + toMonth 9 = "sep" + toMonth 10 = "oct" + toMonth 11 = "nov" + toMonth 12 = "dec" + toMonth x = T.pack $ show x + + getMonth val = + case val of + DateVal date -> + case dateParts date of + [DateParts (_:m1:_), DateParts (_:m2:_)] -> + Just (toMonth m1 <> "--" <> toMonth m2) + [DateParts (_:m1:_)] -> Just (toMonth m1) + _ -> Nothing + _ -> Nothing + + getContentsFor :: Text -> Maybe Text + getContentsFor "type" = + getVariableAsText "genre" >>= + \case + "mathesis" -> Just "mastersthesis" + "phdthesis" -> Just "phdthesis" + _ -> Nothing + getContentsFor "entrysubtype" = mbSubtype + getContentsFor "journal" + | bibtexType `elem` ["article", "periodical", "suppperiodical", "review"] + = getVariable "container-title" >>= toLaTeX . valToInlines + | otherwise = Nothing + getContentsFor "booktitle" + | bibtexType `elem` + ["inbook","incollection","inproceedings","inreference","bookinbook"] + = (getVariable "volume-title" <|> getVariable "container-title") + >>= toLaTeX . valToInlines + | otherwise = Nothing + getContentsFor "series" = getVariable "collection-title" + >>= toLaTeX . valToInlines + getContentsFor "address" = getVariable "publisher-place" + >>= toLaTeX . valToInlines + getContentsFor "date" = getVariable "issued" >>= toLaTeX . valToInlines + getContentsFor "eventdate" = getVariable "event-date" >>= toLaTeX . valToInlines + getContentsFor "urldate" = getVariable "accessed" >>= toLaTeX . valToInlines + getContentsFor "year" = getVariable "issued" >>= getYear + getContentsFor "month" = getVariable "issued" >>= getMonth + getContentsFor "number" = (getVariable "number" + <|> getVariable "collection-number" + <|> getVariable "issue") >>= toLaTeX . valToInlines + + getContentsFor x = getVariable x >>= + if isURL x + then Just . stringify . valToInlines + else toLaTeX . + (if x == "title" + then titlecase + else id) . + valToInlines + + isURL x = x `elem` ["url","doi","issn","isbn"] + + renderFields = T.intercalate ",\n " . mapMaybe renderField + defaultLang :: Lang defaultLang = Lang "en" (Just "US") diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index e83f26329..3e539bff7 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -81,6 +81,8 @@ getDefaultTemplate writer = do case format of "native" -> return "" "csljson" -> return "" + "bibtex" -> return "" + "biblatex" -> return "" "json" -> return "" "docx" -> return "" "fb2" -> return "" diff --git a/src/Text/Pandoc/Writers.hs b/src/Text/Pandoc/Writers.hs index 49531d924..95d6270b5 100644 --- a/src/Text/Pandoc/Writers.hs +++ b/src/Text/Pandoc/Writers.hs @@ -21,6 +21,8 @@ module Text.Pandoc.Writers , writeAsciiDoc , writeAsciiDoctor , writeBeamer + , writeBibTeX + , writeBibLaTeX , writeCommonMark , writeConTeXt , writeCustom @@ -85,6 +87,7 @@ import Text.Pandoc.Options import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Error import Text.Pandoc.Writers.AsciiDoc +import Text.Pandoc.Writers.BibTeX import Text.Pandoc.Writers.CommonMark import Text.Pandoc.Writers.ConTeXt import Text.Pandoc.Writers.CslJson @@ -185,6 +188,8 @@ writers = [ ,("tei" , TextWriter writeTEI) ,("muse" , TextWriter writeMuse) ,("csljson" , TextWriter writeCslJson) + ,("bibtex" , TextWriter writeBibTeX) + ,("biblatex" , TextWriter writeBibLaTeX) ] -- | Retrieve writer, extensions based on formatSpec (format+extensions). diff --git a/src/Text/Pandoc/Writers/BibTeX.hs b/src/Text/Pandoc/Writers/BibTeX.hs new file mode 100644 index 000000000..e1cb47ca1 --- /dev/null +++ b/src/Text/Pandoc/Writers/BibTeX.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Text.Pandoc.Writers.BibTeX + Copyright : Copyright (C) 2021 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley.edu> + Stability : alpha + Portability : portable + +Writes a BibTeX or BibLaTeX bibliographies based on the +'references' metadata in a Pandoc document. +-} +module Text.Pandoc.Writers.BibTeX + ( writeBibTeX + , writeBibLaTeX + ) +where + +import Text.Pandoc.Options +import Text.Pandoc.Definition +import Data.Text (Text) +import Data.Maybe (mapMaybe) +import Citeproc (parseLang) +import Text.Pandoc.Class (PandocMonad) +import Text.Pandoc.Citeproc.BibTeX as BibTeX +import Text.Pandoc.Citeproc.MetaValue (metaValueToReference) +import Text.Pandoc.Writers.Shared (lookupMetaString) + +-- | Write BibTeX based on the references metadata from a Pandoc document. +writeBibTeX :: PandocMonad m => WriterOptions -> Pandoc -> m Text +writeBibTeX = writeBibTeX' BibTeX.Bibtex + +-- | Write BibLaTeX based on the references metadata from a Pandoc document. +writeBibLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m Text +writeBibLaTeX = writeBibTeX' BibTeX.Biblatex + +writeBibTeX' :: PandocMonad m => Variant -> WriterOptions -> Pandoc -> m Text +writeBibTeX' variant opts (Pandoc meta _) = do + let mblang = case lookupMetaString "lang" meta of + "" -> Nothing + t -> Just $ parseLang t + let refs = case lookupMeta "references" meta of + Just (MetaList xs) -> mapMaybe metaValueToReference xs + _ -> [] + return $ mconcat $ + map (BibTeX.writeBibtexString opts variant mblang) refs + |