{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Input.Bibtex -- Copyright : (c) John MacFarlane -- License : BSD-style (see LICENSE) -- -- Maintainer : John MacFarlane -- Stability : unstable-- Portability : unportable -- ----------------------------------------------------------------------------- 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 -- return raw key if not found 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 source target key -- derived from Appendix C of bibtex manual 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 -- e.g. "en" "US" 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 -- separates items with semicolons 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] = -- corporate author Agent { givenName = [] , droppingPart = "" , nonDroppingPart = "" , familyName = "" , nameSuffix = "" , literal = maybe "" id $ inlinesToString ils , commaSuffix = False } -- First von Last -- von Last, First -- von Last, Jr ,First 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 --- First is the longest sequence of white-space separated -- words starting with an uppercase and that is not the -- whole string. von is the longest sequence of whitespace -- separated words whose last word starts with lower case -- and that is not the whole string. [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" -- "en-EN" unavailable in CSL toLocale "USenglish" = "en-US" toLocale "american" = "en-US" toLocale "british" = "en-GB" toLocale "UKenglish" = "en-GB" toLocale "canadian" = "en-US" -- "en-CA" unavailable in CSL toLocale "australian" = "en-GB" -- "en-AU" unavailable in CSL toLocale "newzealand" = "en-GB" -- "en-NZ" unavailable in CSL 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,"") -- biblatex, "unsupporEd" "artwork" -> (Graphic,"") "audio" -> (Song,"") -- for audio *recordings* "commentary" -> (Book,"") "image" -> (Graphic,"") -- or "figure" ? "jurisdiction" -> (LegalCase,"") "legislation" -> (Legislation,"") -- or "bill" ? "legal" -> (Treaty,"") "letter" -> (PersonalCommunication,"") "movie" -> (MotionPicture,"") "music" -> (Song,"") -- for musical *recordings* "performance" -> (Speech,"") "review" -> (Review,"") -- or "review-book" ? "software" -> (Book,"") -- for lack of any better match "standard" -> (Legislation,"") "video" -> (MotionPicture,"") -- biblatex-apa: "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"] -- hyphenation: let defaultHyphenation = case lang of Lang x y -> x ++ "-" ++ y hyphenation <- (toLocale <$> getRawField "hyphenation") <|> return "" -- authors: 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'') -- FIXME: add same for editora, editorb, editorc -- titles 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 "" -- publisher 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 "" -- places 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 "" -- locators 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,"","") -- dates issued' <- getDates "date" <|> getOldDates "" <|> return [] eventDate' <- getDates "eventdate" <|> getOldDates "event" <|> return [] origDate' <- getDates "origdate" <|> getOldDates "orig" <|> return [] accessed' <- getDates "urldate" <|> getOldDates "url" <|> return [] -- url, doi, isbn, etc.: url' <- getRawField "url" <|> return "" -- the doi: prefix causes citeproc-hs to create a link doi' <- (("doi:" ++) <$> getRawField "doi") <|> return "" isbn' <- getRawField "isbn" <|> return "" issn' <- getRawField "issn" <|> return "" callNumber' <- getRawField "library" <|> return "" -- notes 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' -- , recipient = undefined -- :: [Agent] -- , interviewer = undefined -- :: [Agent] -- , composer = undefined -- :: [Agent] , director = director' -- , illustrator = undefined -- :: [Agent] -- , originalAuthor = undefined -- :: [Agent] , containerAuthor = containerAuthor' -- , collectionEditor = undefined -- :: [Agent] -- , editorialDirector = undefined -- :: [Agent] -- , reviewedAuthor = undefined -- :: [Agent] , issued = issued' , eventDate = eventDate' , accessed = accessed' -- , container = undefined -- :: [RefDate] , originalDate = origDate' -- , submitted = undefined -- :: [RefDate] , title = concatWith '.' [ concatWith ':' [title', subtitle'] , titleaddon' ] , titleShort = shortTitle' -- , reviewedTitle = undefined -- :: String , 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' -- , pageFirst = undefined -- :: String , numberOfPages = pagetotal' , version = version' , volume = intercalate "." $ filter (not . null) [volume',part'] , numberOfVolumes = volumes' , issue = issue' , chapterNumber = chapter' -- , medium = undefined -- :: String , status = pubstate' , edition = edition' -- , section = undefined -- :: String -- , source = undefined -- :: String , 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' }