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) 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 ident :: BibParser String ident = do c <- letter cs <- many (letter <|> digit <|> char '_') return (c:cs) expandString :: BibParser String expandString = do k <- ident 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 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 case [e | e <- entries, identifier e == val] of [] -> entry' (e':_) | isBibtex -> entry'{ fields = fields entry' ++ [(k,v) | (k,v) <- fields e', isNothing (lookup k $ fields entry')] } | otherwise -> entry'{ fields = fields entry' ++ [(k',v) | (k,v) <- fields e', k' <- transformKey (entryType e') (entryType entry') k, isNothing (lookup k' (fields entry'))] } 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" _ -> k resolveKey _ k = resolveKey (Lang "en" "US") k 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 $ splitOn "/" s parseDate :: String -> Maybe RefDate parseDate s = do let (year', month', day') = case splitOn "-" 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' <- 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 :: Bool -> String -> Bib [Agent] getAuthorList useprefix f = do fs <- asks fields case lookup f fs >>= latexAuthors useprefix 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 -> return $ mapMaybe latex $ splitOn " and " x 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] toAuthorList :: Bool -> [Block] -> Maybe [Agent] toAuthorList useprefix [Para xs] = Just $ map (toAuthor useprefix) $ splitByAnd xs toAuthorList useprefix [Plain xs] = toAuthorList useprefix [Para xs] toAuthorList _ _ = Nothing toAuthor :: Bool -> [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 useprefix ils = Agent { givenName = givens , droppingPart = if useprefix then "" else prefix , nonDroppingPart = if useprefix then prefix else "" , familyName = family , nameSuffix = suffix , literal = "" , commaSuffix = not (null suffix) } where commaParts = map words' $ splitWhen (== Str ",") $ separateCommas 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) separateCommas :: [Inline] -> [Inline] separateCommas [] = [] separateCommas (Str xs : ys) | ',' `elem` xs = map Str ((split . dropBlanks) (whenElt (==',')) xs) ++ separateCommas ys separateCommas (x : ys) = x : separateCommas ys latex :: String -> Maybe String latex s = trim `fmap` blocksToString bs where Pandoc _ bs = readLaTeX def s latexTitle :: Lang -> String -> Maybe String latexTitle (Lang l _) s = trim `fmap` blocksToString (processTitle bs) where Pandoc _ bs = readLaTeX def s processTitle = case l of 'e':'n':_ -> unTitlecase _ -> id latexAuthors :: Bool -> String -> Maybe [Agent] latexAuthors useprefix s = toAuthorList useprefix bs where Pandoc _ bs = readLaTeX def s bib :: Bib Reference -> Item -> Maybe Reference bib m entry = runReaderT m entry unTitlecase :: [Block] -> [Block] unTitlecase [Para ils] = [Para $ untc ils] unTitlecase [Plain ils] = [Para $ untc ils] unTitlecase xs = xs untc :: [Inline] -> [Inline] untc [] = [] untc (x:xs) = x : map go xs where go (Str ys) = Str $ map toLower ys go z = z 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 _ = "" parseOptions :: String -> [(String, String)] 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 useprefix = maybe False (=="true") $ lookup "useprefix" opts let getAuthorList' = getAuthorList useprefix 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 <$> getRawField "type" <|> return "" -- hyphenation: let defaultHyphenation = case lang of Lang x y -> x ++ "-" ++ y hyphenation <- (toLocale <$> getRawField "hyphenation") <|> return defaultHyphenation -- 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 addColon = fmap (": " ++) let addPeriod = fmap (". " ++) let (la, co) = case splitOn "-" hyphenation of [x] -> (x, "") (x:y:_) -> (x, y) [] -> ("", "") let getTitle' = getTitle (Lang la co) title' <- (if isPeriodical then getTitle' "issuetitle" else getTitle' "title") <|> return "" subtitle' <- addColon (if isPeriodical then getTitle' "issuesubtitle" else getTitle' "subtitle") <|> return "" titleaddon' <- addPeriod (if isPeriodical then getTitle' "issuetitleaddon" else getTitle' "titleaddon") <|> return "" containerTitle' <- (guard isPeriodical >> getField "title") <|> getTitle' "maintitle" <|> getTitle' "booktitle" <|> getField "journal" <|> getField "journaltitle" <|> (guard isArticle >> getTitle' "series") <|> return "" containerSubtitle' <- addColon ((guard isPeriodical >> getField "subtitle") <|> getTitle' "mainsubtitle" <|> getTitle' "booksubtitle" <|> getField "journalsubtitle") <|> return "" containerTitleAddon' <- addPeriod ( (guard isPeriodical >> getField "titleaddon") <|> getTitle' "maintitleaddon" <|> getTitle' "booktitleaddon") <|> return "" containerTitleShort' <- (guard isPeriodical >> getField "shorttitle") <|> getTitle' "booktitleshort" <|> getField "journaltitleshort" <|> getField "shortjournal" <|> return "" seriesTitle' <- (guard (not isArticle) >> getTitle' "series") <|> return "" volumeTitle' <- (getTitle' "maintitle" >> guard hasVolumes >> getTitle' "booktitle") <|> return "" volumeSubtitle' <- addColon (getTitle' "maintitle" >> guard hasVolumes >> getTitle' "booksubtitle") <|> return "" volumeTitleAddon' <- addPeriod (getTitle' "maintitle" >> guard hasVolumes >> getTitle' "booktitleaddon") <|> 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 resolveKey lang <$> getLiteralList' "location" <|> return "" else return "" -- locators pages' <- getField "pages" <|> return "" volume' <- getField "volume" <|> 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 ("","",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 "" 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 addPeriodSpace "" y = y addPeriodSpace x "" = x addPeriodSpace x y = if last x == '.' then x ++ " " ++ y else x ++ ". " ++ y 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 = title' ++ subtitle' ++ titleaddon' , titleShort = shortTitle' -- , reviewedTitle = undefined -- :: String , containerTitle = containerTitle' ++ containerSubtitle' ++ containerTitleAddon' , collectionTitle = seriesTitle' , volumeTitle = 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 = volume' , 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 = addPeriodSpace note' addendum' , annote = annotation' , abstract = abstract' , keyword = keywords' , number = number' , url = url' , doi = doi' , isbn = isbn' , issn = issn' , language = if hyphenation == defaultHyphenation then "" else hyphenation , callNumber = callNumber' }