module Text.CSL.Input.Bibtex
( readBibtexInput
, readBibtexInputString
)
where
import Text.Parsec hiding (optional, (<|>), many)
import Control.Applicative
import Text.Pandoc
import Data.List.Split (splitOn, splitWhen, wordsBy, whenElt,
dropBlanks, split)
import Data.List (intercalate)
import Data.Maybe
import Data.Char (toLower, isUpper, toUpper, isDigit, isLower, isPunctuation)
import Control.Monad
import Control.Monad.Reader
import System.Environment (getEnvironment)
import Text.CSL.Reference
import Text.CSL.Input.Pandoc (blocksToString, inlinesToString)
data Item = Item{ identifier :: String
, entryType :: String
, fields :: [(String, String)]
}
readBibtexInput :: Bool -> FilePath -> IO [Reference]
readBibtexInput isBibtex f = readFile f >>= readBibtexInputString isBibtex
readBibtexInputString :: Bool -> String -> IO [Reference]
readBibtexInputString isBibtex bibstring = do
env <- getEnvironment
let lang = case lookup "LANG" env of
Just x -> case splitWhen (\c -> c == '.' || c == '_') x of
(w:z:_) -> Lang w z
[w] -> Lang w ""
_ -> Lang "en" "US"
Nothing -> Lang "en" "US"
let items = case runParser (bibEntries <* eof) [] "stdin" bibstring of
Left err -> error (show err)
Right xs -> resolveCrossRefs isBibtex xs
return $ mapMaybe (itemToReference lang isBibtex) items
type BibParser = Parsec [Char] [(String, String)]
bibEntries :: BibParser [Item]
bibEntries = many (try (skipMany nonEntry >> bibItem)) <* skipMany nonEntry
where nonEntry = bibSkip <|> bibComment <|> bibPreamble <|> bibString
bibSkip :: BibParser ()
bibSkip = skipMany1 (satisfy (/='@'))
bibComment :: BibParser ()
bibComment = try $ do
char '@'
cistring "comment"
skipMany (satisfy (/='\n'))
bibPreamble :: BibParser ()
bibPreamble = try $ do
char '@'
cistring "preamble"
spaces
void inBraces
return ()
bibString :: BibParser ()
bibString = try $ do
char '@'
cistring "string"
spaces
char '{'
spaces
f <- entField
spaces
char '}'
updateState $ (f:)
return ()
inBraces :: BibParser String
inBraces = try $ do
char '{'
res <- manyTill
( many1 (noneOf "{}\\")
<|> (char '\\' >> ( (char '{' >> return "\\{")
<|> (char '}' >> return "\\}")
<|> return "\\"))
<|> (braced <$> inBraces)
) (char '}')
return $ concat res
braced :: String -> String
braced s = "{" ++ s ++ "}"
inQuotes :: BibParser String
inQuotes = do
char '"'
concat <$> manyTill (try (string "\\\"")
<|> many1 (noneOf "\"\\")
<|> count 1 anyChar) (char '"')
fieldName :: BibParser String
fieldName = do
c <- letter
cs <- many1 (letter <|> digit <|> oneOf "-_")
return $ map toLower (c:cs)
bibItem :: BibParser Item
bibItem = do
char '@'
enttype <- map toLower <$> many1 letter
spaces
char '{'
spaces
entid <- many1 (noneOf " \t\n\r,")
spaces
char ','
spaces
entfields <- entField `sepEndBy` (char ',')
spaces
char '}'
return $ Item entid enttype entfields
entField :: BibParser (String, String)
entField = try $ do
spaces
k <- fieldName
spaces
char '='
spaces
vs <- (expandString <|> inQuotes <|> inBraces <|> rawWord) `sepBy`
(try $ spaces >> char '#' >> spaces)
spaces
return (k, concat vs)
rawWord :: BibParser String
rawWord = many1 alphaNum
expandString :: BibParser String
expandString = do
k <- fieldName
strs <- getState
case lookup k strs of
Just v -> return v
Nothing -> return k
cistring :: String -> BibParser String
cistring [] = return []
cistring (c:cs) = do
x <- (char (toLower c) <|> char (toUpper c))
xs <- cistring cs
return (x:xs)
resolveCrossRefs :: Bool -> [Item] -> [Item]
resolveCrossRefs isBibtex entries =
map (resolveCrossRef isBibtex entries) entries
splitKeys :: String -> [String]
splitKeys = wordsBy (\c -> c == ' ' || c == ',')
getXrefFields :: Bool -> Item -> [Item] -> String -> [(String, String)]
getXrefFields isBibtex baseEntry entries keys = do
let keys' = splitKeys keys
xrefEntry <- [e | e <- entries, identifier e `elem` keys']
(k, v) <- fields xrefEntry
if k == "crossref" || k == "xdata"
then do
xs <- mapM (getXrefFields isBibtex baseEntry entries)
(splitKeys v)
(x, y) <- xs
return (x, y)
else do
k' <- if isBibtex
then return k
else transformKey (entryType xrefEntry) (entryType baseEntry) k
guard $ isNothing $ lookup k' $ fields baseEntry
return (k',v)
resolveCrossRef :: Bool -> [Item] -> Item -> Item
resolveCrossRef isBibtex entries entry = foldl go entry (fields entry)
where go entry' (key, val) =
if key == "crossref" || key == "xdata"
then entry'{ fields = fields entry ++
getXrefFields isBibtex entry entries val }
else entry'
transformKey :: String -> String -> String -> [String]
transformKey _ _ "crossref" = []
transformKey _ _ "xref" = []
transformKey _ _ "entryset" = []
transformKey _ _ "entrysubtype" = []
transformKey _ _ "execute" = []
transformKey _ _ "label" = []
transformKey _ _ "options" = []
transformKey _ _ "presort" = []
transformKey _ _ "related" = []
transformKey _ _ "relatedstring" = []
transformKey _ _ "relatedtype" = []
transformKey _ _ "shorthand" = []
transformKey _ _ "shorthandintro" = []
transformKey _ _ "sortkey" = []
transformKey x y "author"
| x `elem` ["mvbook", "book"] &&
y `elem` ["inbook", "bookinbook", "suppbook"] = ["bookauthor"]
transformKey "mvbook" y z
| y `elem` ["book", "inbook", "bookinbook", "suppbook"] = standardTrans z
transformKey x y z
| x `elem` ["mvcollection", "mvreference"] &&
y `elem` ["collection", "reference", "incollection", "suppbook"] =
standardTrans z
transformKey "mvproceedings" y z
| y `elem` ["proceedings", "inproceedings"] = standardTrans z
transformKey "book" y z
| y `elem` ["inbook", "bookinbook", "suppbook"] = standardTrans z
transformKey x y z
| x `elem` ["collection", "reference"] &&
y `elem` ["incollection", "inreference", "suppcollection"] = standardTrans z
transformKey "proceedings" "inproceedings" z = standardTrans z
transformKey "periodical" y z
| y `elem` ["article", "suppperiodical"] =
case z of
"title" -> ["journaltitle"]
"subtitle" -> ["journalsubtitle"]
"shorttitle" -> []
"sorttitle" -> []
"indextitle" -> []
"indexsorttitle" -> []
_ -> [z]
transformKey _ _ x = [x]
standardTrans :: String -> [String]
standardTrans z =
case z of
"title" -> ["maintitle"]
"subtitle" -> ["mainsubtitle"]
"titleaddon" -> ["maintitleaddon"]
"shorttitle" -> []
"sorttitle" -> []
"indextitle" -> []
"indexsorttitle" -> []
_ -> [z]
trim :: String -> String
trim = unwords . words
data Lang = Lang String String
resolveKey :: Lang -> String -> String
resolveKey (Lang "en" "US") k =
case k of
"inpreparation" -> "in preparation"
"submitted" -> "submitted"
"forthcoming" -> "forthcoming"
"inpress" -> "in press"
"prepublished" -> "pre-published"
"mathesis" -> "Master’s thesis"
"phdthesis" -> "PhD thesis"
"candthesis" -> "Candidate thesis"
"techreport" -> "technical report"
"resreport" -> "research report"
"software" -> "computer software"
"datacd" -> "data CD"
"audiocd" -> "audio CD"
"patent" -> "patent"
"patentde" -> "German patent"
"patenteu" -> "European patent"
"patentfr" -> "French patent"
"patentuk" -> "British patent"
"patentus" -> "U.S. patent"
"patreq" -> "patent request"
"patreqde" -> "German patent request"
"patreqeu" -> "European patent request"
"patreqfr" -> "French patent request"
"patrequk" -> "British patent request"
"patrequs" -> "U.S. patent request"
"countryde" -> "Germany"
"countryeu" -> "European Union"
"countryep" -> "European Union"
"countryfr" -> "France"
"countryuk" -> "United Kingdom"
"countryus" -> "United States of America"
"newseries" -> "new series"
"oldseries" -> "old series"
_ -> k
resolveKey _ k = resolveKey (Lang "en" "US") k
parseMonth :: String -> String
parseMonth "jan" = "1"
parseMonth "feb" = "2"
parseMonth "mar" = "3"
parseMonth "apr" = "4"
parseMonth "may" = "5"
parseMonth "jun" = "6"
parseMonth "jul" = "7"
parseMonth "aug" = "8"
parseMonth "sep" = "9"
parseMonth "oct" = "10"
parseMonth "nov" = "11"
parseMonth "dec" = "12"
parseMonth x = x
type Bib = ReaderT Item Maybe
notFound :: String -> Bib a
notFound f = fail $ f ++ " not found"
getField :: String -> Bib String
getField f = do
fs <- asks fields
case lookup f fs >>= latex of
Just x -> return x
Nothing -> notFound f
getTitle :: Lang -> String -> Bib String
getTitle lang f = do
fs <- asks fields
case lookup f fs >>= latexTitle lang of
Just x -> return x
Nothing -> notFound f
getDates :: String -> Bib [RefDate]
getDates f = do
fs <- asks fields
case lookup f fs >>= parseDates of
Just x -> return x
Nothing -> notFound f
parseDates :: String -> Maybe [RefDate]
parseDates s = mapM parseDate $ splitWhen (=='/') s
parseDate :: String -> Maybe RefDate
parseDate s = do
let (year', month', day') =
case splitWhen (== '-') s of
[y] -> (y, "", "")
[y,m] -> (y, m, "")
[y,m,d] -> (y, m, d)
_ -> ("", "", "")
return RefDate { year = year'
, month = month'
, season = ""
, day = day'
, other = ""
, circa = ""
}
getOldDates :: String -> Bib [RefDate]
getOldDates prefix = do
year' <- getField (prefix ++ "year")
month' <- (parseMonth <$> getField (prefix ++ "month")) <|> return ""
day' <- getField (prefix ++ "day") <|> return ""
endyear' <- getField (prefix ++ "endyear") <|> return ""
endmonth' <- getField (prefix ++ "endmonth") <|> return ""
endday' <- getField (prefix ++ "endday") <|> return ""
let start' = RefDate { year = year'
, month = month'
, season = ""
, day = day'
, other = ""
, circa = ""
}
let end' = if null endyear'
then []
else [RefDate { year = endyear'
, month = endmonth'
, day = endday'
, season = ""
, other = ""
, circa = ""
}]
return (start':end')
getRawField :: String -> Bib String
getRawField f = do
fs <- asks fields
case lookup f fs of
Just x -> return x
Nothing -> notFound f
getAuthorList :: Options -> String -> Bib [Agent]
getAuthorList opts f = do
fs <- asks fields
case lookup f fs >>= latexAuthors opts of
Just xs -> return xs
Nothing -> notFound f
getLiteralList :: String -> Bib [String]
getLiteralList f = do
fs <- asks fields
case lookup f fs of
Just x -> latex' x >>= toLiteralList
Nothing -> notFound f
getLiteralList' :: String -> Bib String
getLiteralList' f = intercalate "; " <$> getLiteralList f
splitByAnd :: [Inline] -> [[Inline]]
splitByAnd = splitOn [Space, Str "and", Space]
toLiteralList :: (Functor m, MonadPlus m) => [Block] -> m [String]
toLiteralList [Para xs] =
mapM inlinesToString $ splitByAnd xs
toLiteralList [Plain xs] = toLiteralList [Para xs]
toLiteralList _ = mzero
toAuthorList :: MonadPlus m => Options -> [Block] -> m [Agent]
toAuthorList opts [Para xs] =
return $ map (toAuthor opts) $ splitByAnd xs
toAuthorList opts [Plain xs] = toAuthorList opts [Para xs]
toAuthorList _ _ = mzero
toAuthor :: Options -> [Inline] -> Agent
toAuthor _ [Str "others"] =
Agent { givenName = []
, droppingPart = ""
, nonDroppingPart = ""
, familyName = ""
, nameSuffix = ""
, literal = "others"
, commaSuffix = False
}
toAuthor _ [Span ("",[],[]) ils] =
Agent { givenName = []
, droppingPart = ""
, nonDroppingPart = ""
, familyName = ""
, nameSuffix = ""
, literal = maybe "" id $ inlinesToString ils
, commaSuffix = False
}
toAuthor opts ils =
Agent { givenName = givens
, droppingPart = if useprefix then "" else prefix
, nonDroppingPart = if useprefix then prefix else ""
, familyName = family
, nameSuffix = suffix
, literal = ""
, commaSuffix = usecomma
}
where useprefix = maybe False (== "true") $ lookup "useprefix" opts
usecomma = maybe False (== "true") $ lookup "juniorcomma" opts
commaParts = map words' $ splitWhen (== Str ",")
$ splitStrWhen (== ',') ils
words' = wordsBy (== Space)
isCapitalized (Str (c:cs) : rest)
| isUpper c = True
| isDigit c = isCapitalized (Str cs : rest)
| otherwise = False
isCapitalized (_:rest) = isCapitalized rest
isCapitalized [] = True
inlinesToString' = maybe "" id . inlinesToString
prefix = inlinesToString' $ intercalate [Space] von
family = inlinesToString' $ intercalate [Space] lastname
suffix = inlinesToString' $ intercalate [Space] jr
givens = map inlinesToString' first
(first, vonlast, jr) =
case commaParts of
[fvl] -> let (caps', rest') = span isCapitalized fvl
in if null rest' && not (null caps')
then (init caps', [last caps'], [])
else (caps', rest', [])
[vl,f] -> (f, vl, [])
(vl:j:f:_) -> (f, vl, j )
[] -> ([], [], [])
(rlast, rvon) = span isCapitalized $ reverse vonlast
(von, lastname) = case (reverse rvon, reverse rlast) of
(ws@(_:_),[]) -> (init ws, [last ws])
(ws, vs) -> (ws, vs)
splitStrWhen :: (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen _ [] = []
splitStrWhen p (Str xs : ys)
| any p xs = map Str ((split . dropBlanks) (whenElt p) xs) ++ splitStrWhen p ys
splitStrWhen p (x : ys) = x : splitStrWhen p ys
latex' :: (MonadPlus m, Functor m) => String -> m [Block]
latex' s = return bs
where Pandoc _ bs = readLaTeX def{readerParseRaw = True} s
latex :: (MonadPlus m, Functor m) => String -> m String
latex s = latex' (trim s) >>= blocksToString
latexTitle :: (MonadPlus m, Functor m) => Lang -> String -> m String
latexTitle (Lang l _) s =
trim `fmap` (latex' s >>= blocksToString . processTitle)
where processTitle = case l of
'e':'n':_ -> unTitlecase
_ -> id
latexAuthors :: (MonadPlus m, Functor m) => Options -> String -> m [Agent]
latexAuthors opts s = latex' s >>= toAuthorList opts
bib :: Bib Reference -> Item -> Maybe Reference
bib m entry = runReaderT m entry
unTitlecase :: [Block] -> [Block]
unTitlecase [Para ils] = [Para $ untc $ splitStrWhen isPunctuation ils]
unTitlecase [Plain ils] = [Para $ untc $ splitStrWhen isPunctuation ils]
unTitlecase xs = xs
untc :: [Inline] -> [Inline]
untc [] = []
untc (x:xs) = x : map go xs
where go (Str (y:ys)) | isUpper y = Str $ toLower y : ys
go (Quoted qt ys) = Quoted qt $ map go ys
go (Emph ys) = Emph $ map go ys
go (Strong ys) = Strong $ map go ys
go (Span _ ys)
| hasLowercaseWord ys = Span ("",["nocase"],[]) ys
go z = z
hasLowercaseWord = any isLowercaseWord
isLowercaseWord (Str (y:_)) = isLower y
isLowercaseWord _ = False
toLocale :: String -> String
toLocale "english" = "en-US"
toLocale "USenglish" = "en-US"
toLocale "american" = "en-US"
toLocale "british" = "en-GB"
toLocale "UKenglish" = "en-GB"
toLocale "canadian" = "en-US"
toLocale "australian" = "en-GB"
toLocale "newzealand" = "en-GB"
toLocale "afrikaans" = "af-ZA"
toLocale "arabic" = "ar"
toLocale "basque" = "eu"
toLocale "bulgarian" = "bg-BG"
toLocale "catalan" = "ca-AD"
toLocale "croatian" = "hr-HR"
toLocale "czech" = "cs-CZ"
toLocale "danish" = "da-DK"
toLocale "dutch" = "nl-NL"
toLocale "estonian" = "et-EE"
toLocale "finnish" = "fi-FI"
toLocale "canadien" = "fr-CA"
toLocale "acadian" = "fr-CA"
toLocale "french" = "fr-FR"
toLocale "francais" = "fr-FR"
toLocale "austrian" = "de-AT"
toLocale "naustrian" = "de-AT"
toLocale "german" = "de-DE"
toLocale "germanb" = "de-DE"
toLocale "ngerman" = "de-DE"
toLocale "greek" = "el-GR"
toLocale "polutonikogreek" = "el-GR"
toLocale "hebrew" = "he-IL"
toLocale "hungarian" = "hu-HU"
toLocale "icelandic" = "is-IS"
toLocale "italian" = "it-IT"
toLocale "japanese" = "ja-JP"
toLocale "latvian" = "lv-LV"
toLocale "lithuanian" = "lt-LT"
toLocale "magyar" = "hu-HU"
toLocale "mongolian" = "mn-MN"
toLocale "norsk" = "nb-NO"
toLocale "nynorsk" = "nn-NO"
toLocale "farsi" = "fa-IR"
toLocale "polish" = "pl-PL"
toLocale "brazil" = "pt-BR"
toLocale "brazilian" = "pt-BR"
toLocale "portugues" = "pt-PT"
toLocale "portuguese" = "pt-PT"
toLocale "romanian" = "ro-RO"
toLocale "russian" = "ru-RU"
toLocale "serbian" = "sr-RS"
toLocale "serbianc" = "sr-RS"
toLocale "slovak" = "sk-SK"
toLocale "slovene" = "sl-SL"
toLocale "spanish" = "es-ES"
toLocale "swedish" = "sv-SE"
toLocale "thai" = "th-TH"
toLocale "turkish" = "tr-TR"
toLocale "ukrainian" = "uk-UA"
toLocale "vietnamese" = "vi-VN"
toLocale _ = ""
concatWith :: Char -> [String] -> String
concatWith sep xs = foldl go "" xs
where go :: String -> String -> String
go accum "" = accum
go accum s = case reverse accum of
[] -> s
(x:_) | x `elem` "!?.,:;" -> accum ++ " " ++ s
| otherwise -> accum ++ [sep, ' '] ++ s
type Options = [(String, String)]
parseOptions :: String -> Options
parseOptions = map breakOpt . splitWhen (==',')
where breakOpt x = case break (=='=') x of
(w,v) -> (map toLower $ trim w,
map toLower $ trim $ drop 1 v)
itemToReference :: Lang -> Bool -> Item -> Maybe Reference
itemToReference lang bibtex = bib $ do
id' <- asks identifier
et <- asks entryType
guard $ et /= "xdata"
opts <- (parseOptions <$> getRawField "options") <|> return []
let getAuthorList' = getAuthorList opts
st <- getRawField "entrysubtype" <|> return ""
let (reftype, refgenre) = case et of
"article"
| st == "magazine" -> (ArticleMagazine,"")
| st == "newspaper" -> (ArticleNewspaper,"")
| otherwise -> (ArticleJournal,"")
"book" -> (Book,"")
"booklet" -> (Pamphlet,"")
"bookinbook" -> (Book,"")
"collection" -> (Book,"")
"electronic" -> (Webpage,"")
"inbook" -> (Chapter,"")
"incollection" -> (Chapter,"")
"inreference " -> (Chapter,"")
"inproceedings" -> (PaperConference,"")
"manual" -> (Book,"")
"mastersthesis" -> (Thesis, resolveKey lang "mathesis")
"misc" -> (NoType,"")
"mvbook" -> (Book,"")
"mvcollection" -> (Book,"")
"mvproceedings" -> (Book,"")
"mvreference" -> (Book,"")
"online" -> (Webpage,"")
"patent" -> (Patent,"")
"periodical"
| st == "magazine" -> (ArticleMagazine,"")
| st == "newspaper" -> (ArticleNewspaper,"")
| otherwise -> (ArticleJournal,"")
"phdthesis" -> (Thesis, resolveKey lang "phdthesis")
"proceedings" -> (Book,"")
"reference" -> (Book,"")
"report" -> (Report,"")
"suppbook" -> (Chapter,"")
"suppcollection" -> (Chapter,"")
"suppperiodical"
| st == "magazine" -> (ArticleMagazine,"")
| st == "newspaper" -> (ArticleNewspaper,"")
| otherwise -> (ArticleJournal,"")
"techreport" -> (Report,"")
"thesis" -> (Thesis,"")
"unpublished" -> (Manuscript,"")
"www" -> (Webpage,"")
"artwork" -> (Graphic,"")
"audio" -> (Song,"")
"commentary" -> (Book,"")
"image" -> (Graphic,"")
"jurisdiction" -> (LegalCase,"")
"legislation" -> (Legislation,"")
"legal" -> (Treaty,"")
"letter" -> (PersonalCommunication,"")
"movie" -> (MotionPicture,"")
"music" -> (Song,"")
"performance" -> (Speech,"")
"review" -> (Review,"")
"software" -> (Book,"")
"standard" -> (Legislation,"")
"video" -> (MotionPicture,"")
"data" -> (Dataset,"")
"letters" -> (PersonalCommunication,"")
"newsarticle" -> (ArticleNewspaper,"")
_ -> (NoType,"")
reftype' <- resolveKey lang <$> getField "type" <|> return ""
let isContainer = et `elem` ["book","collection","proceedings","reference",
"mvbook","mvcollection","mvproceedings", "mvreference",
"suppbook","suppcollection"]
let defaultHyphenation = case lang of
Lang x y -> x ++ "-" ++ y
hyphenation <- (toLocale <$> getRawField "hyphenation")
<|> return ""
author' <- getAuthorList' "author" <|> return []
containerAuthor' <- getAuthorList' "bookauthor" <|> return []
translator' <- getAuthorList' "translator" <|> return []
editortype <- getRawField "editortype" <|> return ""
editor'' <- getAuthorList' "editor" <|> return []
director'' <- getAuthorList' "director" <|> return []
let (editor', director') = case editortype of
"director" -> ([], editor'')
_ -> (editor'', director'')
let isArticle = et `elem` ["article", "periodical", "suppperiodical"]
let isPeriodical = et == "periodical"
let hasVolumes = et `elem`
["inbook","incollection","inproceedings","bookinbook"]
let hyphenation' = if null hyphenation
then defaultHyphenation
else hyphenation
let (la, co) = case splitWhen (== '-') hyphenation' of
[x] -> (x, "")
(x:y:_) -> (x, y)
[] -> ("", "")
let getTitle' = getTitle (Lang la co)
title' <- getTitle' (if isPeriodical then "issuetitle" else "title")
<|> return ""
subtitle' <- getTitle' (if isPeriodical then "issuesubtitle" else "subtitle")
<|> return ""
titleaddon' <- getTitle' "titleaddon"
<|> return ""
volumeTitle' <- (getTitle' "maintitle" >> guard hasVolumes
>> getTitle' "booktitle")
<|> return ""
volumeSubtitle' <- (getTitle' "maintitle" >> guard hasVolumes
>> getTitle' "booksubtitle")
<|> return ""
volumeTitleAddon' <- (getTitle' "maintitle" >> guard hasVolumes
>> getTitle' "booktitleaddon")
<|> return ""
containerTitle' <- (guard isPeriodical >> getField "title")
<|> getTitle' "maintitle"
<|> (guard (not isContainer) >>
guard (null volumeTitle') >> getTitle' "booktitle")
<|> getField "journaltitle"
<|> getField "journal"
<|> return ""
containerSubtitle' <- (guard isPeriodical >> getField "subtitle")
<|> getTitle' "mainsubtitle"
<|> (guard (not isContainer) >>
guard (null volumeSubtitle') >>
getTitle' "booksubtitle")
<|> getField "journalsubtitle"
<|> return ""
containerTitleAddon' <- (guard isPeriodical >> getField "titleaddon")
<|> getTitle' "maintitleaddon"
<|> (guard (not isContainer) >>
guard (null volumeTitleAddon') >>
getTitle' "booktitleaddon")
<|> return ""
containerTitleShort' <- (guard isPeriodical >> getField "shorttitle")
<|> (guard (not isContainer) >>
getTitle' "booktitleshort")
<|> getField "journaltitleshort"
<|> getField "shortjournal"
<|> return ""
seriesTitle' <- resolveKey lang <$> getTitle' "series" <|> return ""
shortTitle' <- getTitle' "shorttitle"
<|> if ':' `elem` title'
then return (takeWhile (/=':') title')
else return ""
eventTitle' <- getTitle' "eventtitle" <|> return ""
origTitle' <- getTitle' "origtitle" <|> return ""
pubfields <- mapM (\f -> Just `fmap`
(if bibtex || f == "howpublished"
then getField f
else getLiteralList' f)
<|> return Nothing)
["school","institution","organization", "howpublished","publisher"]
let publisher' = intercalate "; " [p | Just p <- pubfields]
origpublisher' <- getField "origpublisher" <|> return ""
venue' <- getField "venue" <|> return ""
address' <- (if bibtex
then getField "address"
else getLiteralList' "address"
<|> (guard (et /= "patent") >>
getLiteralList' "location"))
<|> return ""
origLocation' <- (if bibtex
then getField "origlocation"
else getLiteralList' "origlocation")
<|> return ""
jurisdiction' <- if et == "patent"
then ((intercalate "; " . map (resolveKey lang)) <$>
getLiteralList "location") <|> return ""
else return ""
pages' <- getField "pages" <|> return ""
volume' <- getField "volume" <|> return ""
part' <- getField "part" <|> return ""
volumes' <- getField "volumes" <|> return ""
pagetotal' <- getField "pagetotal" <|> return ""
chapter' <- getField "chapter" <|> return ""
edition' <- getField "edition" <|> return ""
version' <- getField "version" <|> return ""
(number', collectionNumber', issue') <-
(getField "number" <|> return "") >>= \x ->
if et `elem` ["book","collection","proceedings","reference",
"mvbook","mvcollection","mvproceedings", "mvreference",
"bookinbook","inbook", "incollection","inproceedings",
"inreference", "suppbook","suppcollection"]
then return ("",x,"")
else if isArticle
then (getField "issue" >>= \y ->
return ("","",concatWith ',' [x,y]))
<|> return ("","",x)
else return (x,"","")
issued' <- getDates "date" <|> getOldDates "" <|> return []
eventDate' <- getDates "eventdate" <|> getOldDates "event"
<|> return []
origDate' <- getDates "origdate" <|> getOldDates "orig"
<|> return []
accessed' <- getDates "urldate" <|> getOldDates "url" <|> return []
url' <- getRawField "url" <|> return ""
doi' <- (("doi:" ++) <$> getRawField "doi") <|> return ""
isbn' <- getRawField "isbn" <|> return ""
issn' <- getRawField "issn" <|> return ""
callNumber' <- getRawField "library" <|> return ""
annotation' <- getField "annotation" <|> getField "annote"
<|> return ""
abstract' <- getField "abstract" <|> return ""
keywords' <- getField "keywords" <|> return ""
note' <- if et == "periodical"
then return ""
else (getField "note" <|> return "")
addendum' <- if bibtex
then return ""
else getField "addendum"
<|> return ""
pubstate' <- resolveKey lang `fmap`
getRawField "pubstate" <|> return ""
let convertEnDash = map (\c -> if c == '–' then '-' else c)
return $ emptyReference
{ refId = id'
, refType = reftype
, author = author'
, editor = editor'
, translator = translator'
, director = director'
, containerAuthor = containerAuthor'
, issued = issued'
, eventDate = eventDate'
, accessed = accessed'
, originalDate = origDate'
, title = concatWith '.' [
concatWith ':' [title', subtitle']
, titleaddon' ]
, titleShort = shortTitle'
, containerTitle = concatWith '.' [
concatWith ':' [ containerTitle'
, containerSubtitle']
, containerTitleAddon' ]
++ if isArticle && not (null seriesTitle')
then if null containerTitle'
then seriesTitle'
else ", " ++ seriesTitle'
else ""
, collectionTitle = if isArticle then "" else seriesTitle'
, volumeTitle = concatWith '.' [
concatWith ':' [ volumeTitle'
, volumeSubtitle']
, volumeTitleAddon' ]
, containerTitleShort = containerTitleShort'
, collectionNumber = collectionNumber'
, originalTitle = origTitle'
, publisher = publisher'
, originalPublisher = origpublisher'
, publisherPlace = address'
, originalPublisherPlace = origLocation'
, jurisdiction = jurisdiction'
, event = eventTitle'
, eventPlace = venue'
, page = convertEnDash pages'
, numberOfPages = pagetotal'
, version = version'
, volume = intercalate "." $ filter (not . null)
[volume',part']
, numberOfVolumes = volumes'
, issue = issue'
, chapterNumber = chapter'
, status = pubstate'
, edition = edition'
, genre = if null refgenre
then reftype'
else refgenre
, note = concatWith '.' [note', addendum']
, annote = annotation'
, abstract = abstract'
, keyword = keywords'
, number = number'
, url = url'
, doi = doi'
, isbn = isbn'
, issn = issn'
, language = hyphenation
, callNumber = callNumber'
}