diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,36 @@ +pandoc-citeproc (0.13) + + * Made bibliography parsing more efficient. (API change) + This commit adds an extra parameter to the bibliography parsing + functions: readBibtex, readBibtexString, readBiblioString, + readBiblioFile. The extra (first) parameter is a function + from strings to booleans that acts as a filter on citation + identifiers, so that non-matching identifiers are not parsed + in full. pandoc-citeproc now gets a list of the citation + identifiers in a document and passes it to readBiblio*, + which gives a very substantial speed increase with large + bibliographies. This is most noticable with bibtex, + biblatex, and yaml bibliographies. + + * Improved RefDate type (#313, API change). RefDate fields + (month, day, season, year) were previously strings; they've + been changed to Maybe Int. In addition, the AddYaml class + is exported from Text.CSL.Util; (&=) is now a method of that + class. Finally, parseEDTFDate is exported from Text.CSL.Reference, + and is used instead of the old date parsing code in + Text.CSL.Input.Bibtex. + + * Link to bibliographies in undated citations, like + (Doe, n.d.) (#250). + + * Bibtex parser: a few efficiency improvements. + + * pandoc-citeproc.hs - better exception messages for -y and -j. + + * Added needed import of fromMaybe without embed_data_files. + This makes it possible to build pandoc-citeproc without + the embed_data_files flag again. + pandoc-citeproc (0.12.2.5) * Fixed spurious disambiguation on some date ranges (#312). diff --git a/man/man1/pandoc-citeproc.1 b/man/man1/pandoc-citeproc.1 --- a/man/man1/pandoc-citeproc.1 +++ b/man/man1/pandoc-citeproc.1 @@ -1,14 +1,14 @@ .\"t -.\" Automatically generated by Pandoc 2.0 +.\" Automatically generated by Pandoc 2.1 .\" -.TH "pandoc\-citeproc" "1" "2017-06-04" "pandoc-citeproc 0.10.5" "" +.TH "pandoc\-citeproc" "1" "2018-01-09" "pandoc-citeproc 0.13" "" .hy .SH NAME .PP pandoc\-citeproc \- filter to resolve citations in a pandoc document. .SH SYNOPSIS .PP -pandoc\-citeproc options (#options) [file..] +pandoc\-citeproc options [file..] .SH DESCRIPTION .PP The \f[C]pandoc\-citeproc\f[] executable has two modes, filter mode and diff --git a/pandoc-citeproc.cabal b/pandoc-citeproc.cabal --- a/pandoc-citeproc.cabal +++ b/pandoc-citeproc.cabal @@ -1,5 +1,5 @@ name: pandoc-citeproc -version: 0.12.2.5 +version: 0.13 cabal-version: >= 1.12 synopsis: Supports using pandoc with citeproc diff --git a/pandoc-citeproc.hs b/pandoc-citeproc.hs --- a/pandoc-citeproc.hs +++ b/pandoc-citeproc.hs @@ -1,34 +1,38 @@ -{-# LANGUAGE CPP, ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} module Main where -import Text.CSL.Input.Bibutils (readBiblioString, BibFormat(..)) -import Text.CSL.Reference (Reference(refId), Literal(..)) -import Text.CSL.Exception -import Data.List (group, sort) -import Data.Char (chr, toLower) -import Data.Yaml.Builder (toByteString) -import Control.Applicative ((<|>), many) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Char8 as B8 -import Data.Attoparsec.ByteString.Char8 as Attoparsec -import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) -import Data.Aeson.Encode.Pretty (encodePretty', defConfig, Config(..), - Indent(Spaces), NumberFormat(Generic)) -import System.Console.GetOpt -import Control.Exception as E -import Control.Monad -import System.IO -import System.FilePath (takeExtension) -import System.Environment (getArgs) -import System.Exit -import Data.Version (showVersion) -import Paths_pandoc_citeproc (version) -import Text.CSL.Pandoc (processCites') -import Text.CSL.Data (getManPage, getLicense) -import Text.Pandoc.JSON hiding (Format) -import Text.Pandoc.Walk -import qualified Text.Pandoc.UTF8 as UTF8 +import Control.Applicative (many, (<|>)) +import Control.Exception as E +import Control.Monad +import Data.Aeson.Encode.Pretty (Config (..), Indent (Spaces), + NumberFormat (Generic), + defConfig, encodePretty') +import Data.Attoparsec.ByteString.Char8 as Attoparsec +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as BL +import Data.Char (chr, toLower) +import Data.List (group, sort) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Version (showVersion) +import Data.Yaml.Builder (toByteString) +import Paths_pandoc_citeproc (version) +import System.Console.GetOpt +import System.Environment (getArgs) +import System.Exit +import System.FilePath (takeExtension) +import System.IO +import Text.CSL.Data (getLicense, getManPage) +import Text.CSL.Exception +import Text.CSL.Input.Bibutils (BibFormat (..), + readBiblioString) +import Text.CSL.Pandoc (processCites') +import Text.CSL.Reference (Literal (..), + Reference (refId)) +import Text.Pandoc.JSON hiding (Format) +import qualified Text.Pandoc.UTF8 as UTF8 +import Text.Pandoc.Walk main :: IO () main = do @@ -40,69 +44,71 @@ exitWith $ ExitFailure 1 when (Version `elem` flags) $ do UTF8.putStrLn $ "pandoc-citeproc " ++ showVersion version - exitWith ExitSuccess + exitSuccess when (Help `elem` flags) $ do UTF8.putStrLn $ usageInfo header options - exitWith ExitSuccess + exitSuccess when (Man `elem` flags) $ do getManPage >>= BL.putStr - exitWith ExitSuccess + exitSuccess when (License `elem` flags) $ do getLicense >>= BL.putStr - exitWith ExitSuccess - if Bib2YAML `elem` flags || Bib2JSON `elem` flags - then do - let mbformat = case [f | Format f <- flags] of - [x] -> readFormat x - _ -> Nothing - bibformat <- case mbformat <|> - msum (map formatFromExtension args) of - Just f -> return f - Nothing -> do - UTF8.hPutStrLn stderr $ usageInfo - ("Unknown format\n" ++ header) options - exitWith $ ExitFailure 3 - bibstring <- case args of - [] -> UTF8.getContents - xs -> mconcat <$> mapM UTF8.readFile xs - readBiblioString bibformat bibstring >>= - warnDuplicateKeys >>= - if Bib2YAML `elem` flags - then outputYamlBlock . - B8.intercalate (B.singleton 10) . - map (unescapeTags . toByteString . (:[])) - else B8.putStrLn . unescapeUnicode . B.concat . BL.toChunks . - encodePretty' defConfig{ confIndent = Spaces 2 - , confCompare = compare - , confNumFormat = Generic } - else E.catch (toJSONFilter doCites) - (\(e :: CiteprocException) -> do - UTF8.hPutStrLn stderr $ renderError e - exitWith (ExitFailure 1)) + exitSuccess + E.handle + (\(e :: CiteprocException) -> do + UTF8.hPutStrLn stderr $ renderError e + exitWith (ExitFailure 1)) $ + if Bib2YAML `elem` flags || Bib2JSON `elem` flags + then do + let mbformat = case [f | Format f <- flags] of + [x] -> readFormat x + _ -> Nothing + bibformat <- case mbformat <|> + msum (map formatFromExtension args) of + Just f -> return f + Nothing -> do + UTF8.hPutStrLn stderr $ usageInfo + ("Unknown format\n" ++ header) options + exitWith $ ExitFailure 3 + bibstring <- case args of + [] -> UTF8.getContents + xs -> mconcat <$> mapM UTF8.readFile xs + readBiblioString (const True) bibformat bibstring >>= + warnDuplicateKeys >>= + if Bib2YAML `elem` flags + then outputYamlBlock . + B8.intercalate (B.singleton 10) . + map (unescapeTags . toByteString . (:[])) + else B8.putStrLn . unescapeUnicode . B.concat . BL.toChunks . + encodePretty' defConfig{ confIndent = Spaces 2 + , confCompare = compare + , confNumFormat = Generic } + else toJSONFilter doCites + formatFromExtension :: FilePath -> Maybe BibFormat formatFromExtension = readFormat . dropWhile (=='.') . takeExtension readFormat :: String -> Maybe BibFormat readFormat = go . map toLower - where go "biblatex" = Just BibLatex - go "bib" = Just BibLatex - go "bibtex" = Just Bibtex - go "json" = Just Json - go "yaml" = Just Yaml + where go "biblatex" = Just BibLatex + go "bib" = Just BibLatex + go "bibtex" = Just Bibtex + go "json" = Just Json + go "yaml" = Just Yaml #ifdef USE_BIBUTILS - go "ris" = Just Ris - go "endnote" = Just Endnote - go "enl" = Just Endnote + go "ris" = Just Ris + go "endnote" = Just Endnote + go "enl" = Just Endnote go "endnotexml" = Just EndnotXml - go "xml" = Just EndnotXml - go "wos" = Just Isi - go "isi" = Just Isi - go "medline" = Just Medline - go "copac" = Just Copac - go "mods" = Just Mods + go "xml" = Just EndnotXml + go "wos" = Just Isi + go "isi" = Just Isi + go "medline" = Just Medline + go "copac" = Just Copac + go "mods" = Just Mods #endif - go _ = Nothing + go _ = Nothing doCites :: Pandoc -> IO Pandoc @@ -191,3 +197,4 @@ regchar :: Attoparsec.Parser B.ByteString regchar = B8.singleton <$> anyChar + diff --git a/src/Text/CSL.hs b/src/Text/CSL.hs --- a/src/Text/CSL.hs +++ b/src/Text/CSL.hs @@ -63,13 +63,13 @@ , renderPandoc' ) where -import Text.CSL.Proc -import Text.CSL.Reference -import Text.CSL.Style -import Text.CSL.Parser -import Text.CSL.Input.Bibutils -import Text.CSL.Output.Pandoc -import Text.CSL.Output.Plain +import Text.CSL.Input.Bibutils +import Text.CSL.Output.Pandoc +import Text.CSL.Output.Plain +import Text.CSL.Parser +import Text.CSL.Proc +import Text.CSL.Reference +import Text.CSL.Style -- $intro diff --git a/src/Text/CSL/Data.hs b/src/Text/CSL/Data.hs --- a/src/Text/CSL/Data.hs +++ b/src/Text/CSL/Data.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | @@ -21,16 +21,17 @@ , langBase ) where -import System.FilePath () -import Data.Typeable -import qualified Data.ByteString.Lazy as L -import qualified Control.Exception as E +import qualified Control.Exception as E +import qualified Data.ByteString.Lazy as L +import Data.Typeable +import System.FilePath () +import Data.Maybe (fromMaybe) #ifdef EMBED_DATA_FILES -import Data.Maybe (fromMaybe) -import Text.CSL.Data.Embedded (localeFiles, defaultCSL, manpage, license) +import Text.CSL.Data.Embedded (defaultCSL, license, localeFiles, + manpage) #else -import Paths_pandoc_citeproc (getDataFileName) -import System.Directory (doesFileExist) +import Paths_pandoc_citeproc (getDataFileName) +import System.Directory (doesFileExist) #endif data CSLLocaleException = @@ -38,7 +39,7 @@ | CSLLocaleReadError E.IOException deriving Typeable instance Show CSLLocaleException where - show (CSLLocaleNotFound s) = "Could not find locale data for " ++ s + show (CSLLocaleNotFound s) = "Could not find locale data for " ++ s show (CSLLocaleReadError e) = show e instance E.Exception CSLLocaleException @@ -67,12 +68,12 @@ f <- case length s of 0 -> return "locales/locales-en-US.xml" 2 -> getDataFileName ("locales/locales-" ++ - maybe s id (lookup s langBase) ++ ".xml") + fromMaybe s (lookup s langBase) ++ ".xml") _ -> getDataFileName ("locales/locales-" ++ take 5 s ++ ".xml") exists <- doesFileExist f if not exists && length s > 2 then getLocale $ take 2 s -- try again with base locale - else E.handle (\e -> E.throwIO (CSLLocaleReadError e)) $ L.readFile f + else E.handle (E.throwIO . CSLLocaleReadError) $ L.readFile f #endif getDefaultCSL :: IO L.ByteString @@ -142,3 +143,4 @@ ,("vi", "vi-VN") ,("zh", "zh-CN") ] + diff --git a/src/Text/CSL/Data/Embedded.hs b/src/Text/CSL/Data/Embedded.hs --- a/src/Text/CSL/Data/Embedded.hs +++ b/src/Text/CSL/Data/Embedded.hs @@ -2,8 +2,8 @@ module Text.CSL.Data.Embedded (localeFiles, defaultCSL, manpage, license) where -import Data.FileEmbed import qualified Data.ByteString.Char8 as S +import Data.FileEmbed localeFiles :: [(FilePath, S.ByteString)] localeFiles = $(embedDir "locales") diff --git a/src/Text/CSL/Eval.hs b/src/Text/CSL/Eval.hs --- a/src/Text/CSL/Eval.hs +++ b/src/Text/CSL/Eval.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE PatternGuards, FlexibleContexts, ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Eval @@ -20,28 +22,28 @@ , module Text.CSL.Eval.Output ) where -import Control.Arrow -import Control.Monad.State -import qualified Control.Exception as E -import Data.Monoid (Any(..)) -import Data.Char ( toLower, isDigit, isLetter ) -import Data.Maybe -import Data.String ( fromString ) -import Text.Pandoc.Definition (Inline(Str, Link), nullAttr) -import Text.Pandoc.Walk (walk) -import Text.Pandoc.Shared (stringify) -import qualified Data.Text as T +import Control.Arrow +import qualified Control.Exception as E +import Control.Monad.State +import Data.Char (isDigit, isLetter, toLower) +import Data.Maybe +import Data.Monoid (Any (..)) +import Data.String (fromString) +import qualified Data.Text as T +import Text.Pandoc.Definition (Inline (Link, Str), nullAttr) +import Text.Pandoc.Shared (stringify) +import Text.Pandoc.Walk (walk) -import Text.CSL.Exception -import Text.CSL.Eval.Common -import Text.CSL.Eval.Output -import Text.CSL.Eval.Date -import Text.CSL.Eval.Names -import Text.CSL.Output.Plain -import Text.CSL.Reference -import Text.CSL.Style hiding (Any) -import Text.CSL.Util ( readNum, last', proc, proc', query, betterThan, - safeRead, isRange ) +import Text.CSL.Eval.Common +import Text.CSL.Eval.Date +import Text.CSL.Eval.Names +import Text.CSL.Eval.Output +import Text.CSL.Exception +import Text.CSL.Output.Plain +import Text.CSL.Reference +import Text.CSL.Style hiding (Any) +import Text.CSL.Util (betterThan, isRange, last', proc, + proc', query, readNum, safeRead) -- | Produce the output with a 'Layout', the 'EvalMode', a 'Bool' -- 'True' if the evaluation happens for disambiguation purposes, the @@ -80,8 +82,8 @@ = map (format . sorting) ss where render = renderPlain . formatOutputList . proc removeDelimAndLabel - removeDelimAndLabel (OLabel{}) = ONull - removeDelimAndLabel (ODel{}) = ONull + removeDelimAndLabel OLabel{} = ONull + removeDelimAndLabel ODel{} = ONull removeDelimAndLabel x = x format (s,e) = applaySort s . render $ uncurry eval e eval o e = evalLayout (Layout emptyFormatting [] [e]) m False l ms o as mbr @@ -118,9 +120,9 @@ then getLocVar >>= formatRange fm . snd else formatNumber f fm s =<< getStringVar s - | Variable s f fm d <- el = return . addDelim d =<< concatMapM (getVariable f fm) s + | Variable s f fm d <- el = addDelim d <$> concatMapM (getVariable f fm) s | Group fm d l <- el = outputList fm d <$> tryGroup l - | Date _ _ _ _ _ _ <- el = evalDate el + | Date{} <- el = evalDate el | Label s f fm _ <- el = formatLabel f fm True s -- FIXME !! | Term s f fm p <- el = formatTerm f fm p s | Names s n fm d sub <- el = modify (\st -> st { contNum = [] }) >> @@ -151,7 +153,7 @@ where addSpaces strng = (if take 1 strng == " " then (OSpace:) else id) . (if last' strng == " " then (++[OSpace]) else id) - substituteWith e = head <$> gets (names . env) >>= \(Names _ ns fm d _) -> do + substituteWith e = head <$> gets (names . env) >>= \(Names _ ns fm d _) -> case e of Names rs [Name NotSet fm'' [] [] []] fm' d' [] -> let nfm = mergeFM fm'' $ mergeFM fm' fm in @@ -177,8 +179,8 @@ nums <- mapM getStringVar numVars let pluralizeTerm (Term s f fm _) = Term s f fm $ case numVars of - ["number-of-volumes"] -> not $ any (== "1") nums - ["number-of-pages"] -> not $ any (== "1") nums + ["number-of-volumes"] -> "1" `notElem` nums + ["number-of-pages"] -> "1" `notElem` nums _ -> any isRange nums pluralizeTerm x = x if null res @@ -197,7 +199,7 @@ | Const {} <- e = True | otherwise = False - ifEmpty p t e = p >>= \r -> if r == [] then t else return (e r) + ifEmpty p t e = p >>= \r -> if null r then t else return (e r) withNames e n f = modify (\s -> s { authSub = e ++ authSub s , env = (env s) @@ -269,14 +271,16 @@ in getVar False chk "ref-type" chkNumeric v = do val <- getStringVar v as <- gets (abbrevs . env) - let val' = if getAbbreviation as v val == [] then val else getAbbreviation as v val + let val' = if null (getAbbreviation as v val) + then val + else getAbbreviation as v val return (isNumericString val') - chkDate v = getDateVar v >>= return . not . null . filter circa + chkDate v = any circa <$> getDateVar v chkPosition s = if s == "near-note" then gets (nearNote . cite . env) - else gets (citePosition . cite . env) >>= return . compPosition s - chkDisambiguate s = gets disamb >>= return . (==) (formatVariable s) . map toLower . show - chkLocator v = getLocVar >>= return . (==) v . fst + else compPosition s <$> gets (citePosition . cite . env) + chkDisambiguate s = (==) (formatVariable s) . map toLower . show <$> gets disamb + chkLocator v = (==) v . fst <$> getLocVar isIbid s = not (s == "first" || s == "subsequent") compPosition a b | "first" <- a = b == "first" @@ -290,13 +294,13 @@ | Just v <- fromValue val :: Maybe Formatted = if v == mempty then [] - else let ys = maybe (unFormatted v) (unFormatted . fromString) + else let ys = unFormatted . maybe v fromString $ getAbbr (stringify $ unFormatted v) in if null ys then [] else [Output [OPan $ walk value' ys] fm] - | Just v <- fromValue val :: Maybe String = (:[]) . flip OStr fm . maybe v id . getAbbr $ value v - | Just v <- fromValue val :: Maybe Literal = (:[]) . flip OStr fm . maybe (unLiteral v) id . getAbbr $ value $ unLiteral v + | Just v <- fromValue val :: Maybe String = (:[]) . flip OStr fm . Data.Maybe.fromMaybe v . getAbbr $ value v + | Just v <- fromValue val :: Maybe Literal = (:[]) . flip OStr fm . Data.Maybe.fromMaybe (unLiteral v) . getAbbr $ value $ unLiteral v | Just v <- fromValue val :: Maybe Int = output fm (if v == 0 then [] else show v) | Just v <- fromValue val :: Maybe Int = output fm (if v == 0 then [] else show v) | Just v <- fromValue val :: Maybe CNum = if v == 0 then [] else [OCitNum (unCNum v) fm] @@ -311,8 +315,8 @@ value' x = x getAbbr v = if f == Short then case getAbbreviation as s v of - [] -> Nothing - y -> Just y + [] -> Nothing + y -> Just y else Nothing nameOpts = ("name-as-sort-order","all") : o sortDate = [ DatePart "year" "numeric-leading-zeros" "" emptyFormatting @@ -323,10 +327,10 @@ formatTitle s f fm | Short <- f , isTitleVar s = try (getIt $ s ++ "-short") $ getIt s - | isTitleShortVar s = try (getIt s) $ return . (:[]) . flip OStr fm =<< getTitleShort s + | isTitleShortVar s = try (getIt s) $ (:[]) . flip OStr fm <$> getTitleShort s | otherwise = getIt s where - try g h = g >>= \r -> if r == [] then h else return r + try g h = g >>= \r -> if null r then h else return r getIt x = do o <- gets (options . env) a <- gets (abbrevs . env) @@ -336,24 +340,29 @@ formatNumber f fm v n = gets (abbrevs . env) >>= \as -> if isNumericString (getAbbr as n) - then gets (terms . env) >>= - return . output fm . flip process (getAbbr as n) + then output fm . flip process (getAbbr as n) <$> gets (terms . env) else return . output fm . getAbbr as $ n where - getAbbr as = if getAbbreviation as v n == [] then id else getAbbreviation as v + getAbbr as = if null (getAbbreviation as v n) + then id + else getAbbreviation as v checkRange' ts = if v == "page" then checkRange ts else id process ts = checkRange' ts . printNumStr . map (renderNumber ts) . breakNumericString . words renderNumber ts x = if isTransNumber x then format ts x else x format tm = case f of - Ordinal -> ordinal tm v - LongOrdinal -> longOrdinal tm v - Roman -> if readNum n < 6000 then roman else id - _ -> id + Ordinal -> maybe "" (ordinal tm v) . safeRead + LongOrdinal -> maybe "" (longOrdinal tm v) . safeRead + Roman -> maybe "" + (\x -> if x < 6000 then roman x else show x) . + safeRead + _ -> maybe "" show . (safeRead :: String -> Maybe Int) + roman :: Int -> String roman = foldr (++) [] . reverse . map (uncurry (!!)) . zip romanList . - map (readNum . return) . take 4 . reverse + map (readNum . return) . take 4 . + reverse . show romanList = [[ "", "i", "ii", "iii", "iv", "v", "vi", "vii", "viii", "ix" ] ,[ "", "x", "xx", "xxx", "xl", "l", "lx", "lxx", "lxxx", "xc" ] ,[ "", "c", "cc", "ccc", "cd", "d", "dc", "dcc", "dccc", "cm" ] @@ -369,7 +378,7 @@ printNumStr :: [String] -> String printNumStr [] = [] -printNumStr (x:[]) = x +printNumStr [x] = x printNumStr (x:"-":y:xs) = x ++ "-" ++ y ++ printNumStr xs printNumStr (x:",":y:xs) = x ++ ", " ++ y ++ printNumStr xs printNumStr (x:xs) @@ -388,9 +397,9 @@ isSpecialChar = all (`elem` "&-,.\x2013") isNumber cs = case [c | c <- cs , not (isLetter c) - , not (c `elem` "&-.,\x2013")] of - [] -> False - xs -> all isDigit xs + , c `notElem` "&-.,\x2013"] of + [] -> False + xs -> all isDigit xs breakNumericString :: [String] -> [String] breakNumericString [] = [] @@ -411,7 +420,7 @@ pages = tupleRange . breakNumericString . words $ p tupleRange [] = [] - tupleRange (x:cs:[] ) + tupleRange [x, cs] | cs `elem` ["-", "--", "\x2013"] = return (x,[]) tupleRange (x:cs:y:xs) | cs `elem` ["-", "--", "\x2013"] = (x, y) : tupleRange xs @@ -421,12 +430,12 @@ joinRange (a, b) = a ++ "-" ++ b process = checkRange ts . printNumStr . case opt of - "expanded" -> map (joinRange . expandedRange) - "chicago" -> map (joinRange . chicagoRange ) - "minimal" -> map (joinRange . minimalRange 1) - "minimal-two" -> map (joinRange . minimalRange 2) - _ -> map joinRange - return [flip OLoc fm $ [OStr (process pages) emptyFormatting]] + "expanded" -> map (joinRange . expandedRange) + "chicago" -> map (joinRange . chicagoRange ) + "minimal" -> map (joinRange . minimalRange 1) + "minimal-two" -> map (joinRange . minimalRange 2) + _ -> map joinRange + return [OLoc [OStr (process pages) emptyFormatting] fm] -- Abbreviated page ranges are expanded to their non-abbreviated form: -- 42–45, 321–328, 2787–2816 @@ -446,7 +455,7 @@ -- a minimum number of digits for the second number; thus, with -- minDigits = 2, we have 328-28. minimalRange :: Int -> (String, String) -> (String, String) -minimalRange minDigits ((a:as), (b:bs)) +minimalRange minDigits (a:as, b:bs) | a == b , length as == length bs , length bs >= minDigits = diff --git a/src/Text/CSL/Eval/Common.hs b/src/Text/CSL/Eval/Common.hs --- a/src/Text/CSL/Eval/Common.hs +++ b/src/Text/CSL/Eval/Common.hs @@ -18,18 +18,18 @@ module Text.CSL.Eval.Common where -import Control.Arrow ( (&&&), (>>>) ) -import Control.Monad.State -import Data.Char ( toLower ) -import Data.List ( elemIndex ) -import qualified Data.Map as M -import Data.Maybe +import Control.Arrow ((&&&), (>>>)) +import Control.Monad.State +import Data.Char (toLower) +import Data.List (elemIndex) +import qualified Data.Map as M +import Data.Maybe -import Text.Pandoc.Shared ( stringify ) -import Text.CSL.Reference -import Text.CSL.Style +import Text.CSL.Reference +import Text.CSL.Style +import Text.Pandoc.Shared (stringify) -import Debug.Trace +import Debug.Trace data EvalState = EvalState diff --git a/src/Text/CSL/Eval/Date.hs b/src/Text/CSL/Eval/Date.hs --- a/src/Text/CSL/Eval/Date.hs +++ b/src/Text/CSL/Eval/Date.hs @@ -15,19 +15,21 @@ module Text.CSL.Eval.Date where -import Control.Monad.State -import qualified Control.Exception as E +import qualified Control.Exception as E +import Control.Monad.State -import Data.List -import Data.List.Split +import Data.List +import Data.List.Split +import Data.Maybe (fromMaybe, isNothing) -import Text.CSL.Exception -import Text.CSL.Eval.Common -import Text.CSL.Eval.Output -import Text.CSL.Style -import Text.CSL.Reference -import Text.CSL.Util ( readNum, toRead, last') -import Text.Pandoc.Definition ( Inline (Str) ) +import Text.CSL.Exception +import Text.CSL.Eval.Common +import Text.CSL.Eval.Output +import Text.CSL.Style +import Text.CSL.Reference +import Text.CSL.Util ( toRead, last' ) +import Text.Pandoc.Definition ( Inline (Str) ) +import Text.Printf (printf) evalDate :: Element -> State EvalState [Output] evalDate (Date s f fm dl dp dp') = do @@ -48,8 +50,8 @@ al am an ahl updateS a b = if b /= a && b /= [] then b else a case f of - NoFormDate -> mapM getDateVar s >>= return . outputList fm dl . - concatMap (formatDate em k tm dp) + NoFormDate -> outputList fm dl . + concatMap (formatDate em k tm dp) <$> mapM getDateVar s _ -> do Date _ _ lfm ldl ldp _ <- getDate f let go dps = return . outputList (updateFM fm lfm) (if ldl /= [] then ldl else dl) . concatMap (formatDate em k tm dps) @@ -81,8 +83,8 @@ | (a:b:_) <- date = addODate . concat $ doRange a b | otherwise = [] where - addODate [] = [] - addODate xs = [ODate xs] + addODate [] = [] + addODate xs = [ODate xs] splitDate a b = case split (onSublist $ diff a b dp) dp of [x,y,z] -> (x,y,z) _ -> E.throw ErrorSplittingDate @@ -111,7 +113,7 @@ case () of _ | ya /= yb -> ["year","month","day"] | ma /= mb || sa /= sb -> - if da == mempty && db == mempty + if isNothing da && isNothing db then ["month"] else ["month","day"] | da /= db -> ["day"] @@ -122,16 +124,12 @@ else Long in maybe [] termPlural $ findTerm t f' tm - addZero n = if length n == 1 then '0' : n else n - addZeros = reverse . take 5 . flip (++) (repeat '0') . reverse - formatDatePart (RefDate (Literal y) (Literal m) - (Literal e) (Literal d) (Literal o) _) (DatePart n f _ fm) - | "year" <- n, y /= mempty = return $ OYear (formatYear f y) k fm - | "month" <- n, m /= mempty = output fm (formatMonth f fm m) - | "day" <- n, d /= mempty = output fm (formatDay f m d) - | "month" <- n, m == mempty - , e /= mempty = output fm $ term f ("season-0" ++ e) - | "year" <- n, o /= mempty = output fm o + formatDatePart (RefDate y m e d o _) (DatePart n f _ fm) + | "year" <- n, Just y' <- y = return $ OYear (formatYear f y') k fm + | "month" <- n, Just m' <- m = output fm (formatMonth f fm m') + | "month" <- n, Just e' <- e = output fm $ term f (printf "season-%02d" e') + | "day" <- n, Just d' <- d = output fm (formatDay f m d') + | "year" <- n, o /= mempty = output fm (unLiteral o) | otherwise = [] withDelim xs o1 o2 @@ -142,81 +140,78 @@ _ -> []) ++ o2 formatYear f y - | "short" <- f = drop 2 y + | "short" <- f = printf "%02d" y | isSorting em - , iy < 0 = '-' : addZeros (tail y) - | isSorting em = addZeros y - | iy < 0 = show (abs iy) ++ term [] "bc" - | length y < 4 - , iy /= 0 = y ++ term [] "ad" - | iy == 0 = [] - | otherwise = y - where - iy = readNum y + , y < 0 = printf "-%04d" (abs y) + | isSorting em = printf "%04d" y + | y < 0 = printf "%d" (abs y) ++ term [] "bc" + | y < 1000 + , y > 0 = printf "%d" y ++ term [] "ad" + | y == 0 = "" + | otherwise = printf "%d" y + formatMonth f fm m | "short" <- f = getMonth $ period . termPlural | "long" <- f = getMonth termPlural - | "numeric" <- f = m - | otherwise = addZero m + | "numeric" <- f = printf "%d" m + | otherwise = printf "%02d" m where period = if stripPeriods fm then filter (/= '.') else id - getMonth g = maybe m g $ findTerm ("month-" ++ addZero m) (read $ toRead f) tm + getMonth g = maybe (show m) g $ findTerm ("month-" ++ printf "%02d" m) (read $ toRead f) tm + formatDay f m d - | "numeric-leading-zeros" <- f = addZero d - | "ordinal" <- f = ordinal tm ("month-" ++ addZero m) d - | otherwise = d + | "numeric-leading-zeros" <- f = printf "%02d" d + | "ordinal" <- f = ordinal tm ("month-" ++ maybe "0" (printf "%02d") m) d + | otherwise = printf "%d" d -ordinal :: [CslTerm] -> String -> String -> String -ordinal _ _ [] = [] +ordinal :: [CslTerm] -> String -> Int -> String ordinal ts v s - | length s == 1 = let a = termPlural (getWith1 s) in - if a == [] then setOrd (term []) else s ++ a - | length s == 2 = let a = termPlural (getWith2 s) - b = getWith1 [last s] in + | s < 10 = let a = termPlural (getWith1 (show s)) in + if a == [] then setOrd (term []) else show s ++ a + | s < 100 = let a = termPlural (getWith2 (show s)) + b = getWith1 [last (show s)] in if a /= [] - then s ++ a + then show s ++ a else if termPlural b == [] || (termMatch b /= [] && termMatch b /= "last-digit") then setOrd (term []) else setOrd b | otherwise = let a = getWith2 last2 - b = getWith1 [last s] in + b = getWith1 [last (show s)] in if termPlural a /= [] && termMatch a /= "whole-number" then setOrd a - else if termPlural b == [] || (termMatch b /= [] && termMatch b /= "last-digit") - then setOrd (term []) else setOrd b + else if null (termPlural b) || + (termMatch b /= [] && + termMatch b /= "last-digit") + then setOrd (term []) + else setOrd b where - setOrd = (++) s . termPlural + setOrd = (++) (show s) . termPlural getWith1 = term . (++) "-0" getWith2 = term . (++) "-" - last2 = reverse . take 2 . reverse $ s + last2 = reverse . take 2 . reverse $ show s term t = getOrdinal v ("ordinal" ++ t) ts -longOrdinal :: [CslTerm] -> String -> String -> String -longOrdinal _ _ [] = [] +longOrdinal :: [CslTerm] -> String -> Int -> String longOrdinal ts v s - | num > 10 || - num == 0 = ordinal ts v s - | otherwise = case last s of - '1' -> term "01" - '2' -> term "02" - '3' -> term "03" - '4' -> term "04" - '5' -> term "05" - '6' -> term "06" - '7' -> term "07" - '8' -> term "08" - '9' -> term "09" - _ -> term "10" + | s > 10 || + s == 0 = ordinal ts v s + | otherwise = case s `mod` 10 of + 1 -> term "01" + 2 -> term "02" + 3 -> term "03" + 4 -> term "04" + 5 -> term "05" + 6 -> term "06" + 7 -> term "07" + 8 -> term "08" + 9 -> term "09" + _ -> term "10" where - num = readNum s term t = termPlural $ getOrdinal v ("long-ordinal-" ++ t) ts getOrdinal :: String -> String -> [CslTerm] -> CslTerm getOrdinal v s ts - = case findTerm' s Long gender ts of - Just x -> x - Nothing -> case findTerm' s Long Neuter ts of - Just x -> x - Nothing -> newTerm + = fromMaybe newTerm $ findTerm' s Long gender ts `mplus` + findTerm' s Long Neuter ts where gender = if v `elem` numericVars || "month" `isPrefixOf` v then maybe Neuter termGender $ findTerm v Long ts diff --git a/src/Text/CSL/Eval/Names.hs b/src/Text/CSL/Eval/Names.hs --- a/src/Text/CSL/Eval/Names.hs +++ b/src/Text/CSL/Eval/Names.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE PatternGuards, FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Eval.Names @@ -15,20 +16,20 @@ module Text.CSL.Eval.Names where -import Control.Monad.State -import Data.Char ( isLower, isUpper, isLetter ) -import Data.List ( nub, intersperse ) -import Data.List.Split ( wordsBy ) -import Data.Maybe ( isJust ) +import Control.Monad.State +import Data.Char (isLetter, isLower, isUpper) +import Data.List (intersperse, nub) +import Data.List.Split (wordsBy) +import Data.Maybe (isJust) -import Text.CSL.Eval.Common -import Text.CSL.Eval.Output -import Text.CSL.Util ( headInline, lastInline, readNum, (<^>), query, toRead, - splitStrWhen, isRange ) -import Text.CSL.Style -import Text.Pandoc.Definition -import Text.Pandoc.Shared ( stringify ) -import qualified Text.Pandoc.Builder as B +import Text.CSL.Eval.Common +import Text.CSL.Eval.Output +import Text.CSL.Style +import Text.CSL.Util (headInline, isRange, lastInline, query, + readNum, splitStrWhen, toRead, (<^>)) +import qualified Text.Pandoc.Builder as B +import Text.Pandoc.Definition +import Text.Pandoc.Shared (stringify) evalNames :: Bool -> [String] -> [Name] -> String -> State EvalState [Output] evalNames skipEdTrans ns nl d @@ -55,7 +56,7 @@ if null res then return [] else let role = if aus == ["author"] then "authorsub" else s - in return . return . OContrib k role res fb =<< gets etal + in return . OContrib k role res fb <$> gets etal r' <- evalNames skipEdTrans xs nl d num <- gets contNum return $ if r /= [] && r' /= [] @@ -64,7 +65,7 @@ | otherwise = return [] where agents p s a = concatMapM (formatNames (hasEtAl nl) d p s a) nl - delim ops = if d == [] then getOptionVal "names-delimiter" ops else d + delim ops = if null d then getOptionVal "names-delimiter" ops else d resetEtal = modify (\s -> s { etal = [] }) count num x = if hasCount nl && num /= [] -- FIXME!! le zero!! then [OContrib [] [] [ONum (length num) emptyFormatting] [] []] @@ -81,16 +82,19 @@ formatNames ea del p s as n | Name f _ ns _ _ <- n, Count <- f = do b <- isBib <$> gets mode - o <- gets (options . env) >>= return . mergeOptions ns + o <- mergeOptions ns <$> gets (options . env) modify $ \st -> st { contNum = nub $ (++) (take (snd $ isEtAl b o p as) as) $ contNum st } return [] | Name f fm ns d np <- n = do b <- isBib <$> gets mode - o <- gets (options . env) >>= return . mergeOptions ns + o <- mergeOptions ns <$> gets (options . env) m <- gets mode let odel = if del /= [] then del else getOptionVal "name-delimiter" o - del' = if d /= [] then d else if odel == [] then ", " else odel + del' + | d /= [] = d + | null odel = ", " + | otherwise = odel (_,i) = isEtAl b o p as form = case f of NotSet -> case getOptionVal "name-form" o of @@ -100,8 +104,11 @@ genName x = do etal' <- formatEtAl o ea "et-al" fm del' x if null etal' then do t <- getTerm False Long "and" - return $ delim t o del' $ format m o form fm np x - else return $ (addDelim del' $ format m o form fm np x) ++ etal' + return $ delim t o del' + $ format m o form fm np x + else return $ + addDelim del' (format m o form fm np x) + ++ etal' setLastName o $ formatName m False f fm o np (last as) updateEtal =<< mapM genName [1 + i .. length as] genName i @@ -136,8 +143,8 @@ updateEtal x = modify $ \st -> let x' = if length x == 1 then repeat $ head x else x in st { etal = case etal st of - [] -> x - ys -> zipWith (++) ys x' + [] -> x + ys -> zipWith (++) ys x' } isWithLastName os | "true" <- getOptionVal "et-al-use-last" os @@ -166,7 +173,7 @@ | "text" <- getOptionVal "and" os = " " ++ t ++ " " | "symbol" <- getOptionVal "and" os = " & " | otherwise = [] - andStr' t d os = if andStr t os == [] then d else andStr t os + andStr' t d os = if null (andStr t os) then d else andStr t os formatEtAl o b t fm d i = do ln <- gets lastName @@ -177,8 +184,8 @@ | otherwise -> return [] else et_al o b t fm d i et_al o b t fm d i - = when' (gets mode >>= return . not . isSorting) $ - if (b || length as <= i) + = when' ( not . isSorting <$> gets mode) $ + if b || length as <= i then return [] else do x <- getTerm False Long t when' (return $ x /= []) $ @@ -217,7 +224,7 @@ etAlMin' x y = if b then etAlMin x else read $ getOptionVal' x y isOptionSet' s1 s2 = if b then isOptionSet s1 os - else or $ (isOptionSet s1 os) : [(isOptionSet s2 os)] + else or $ isOptionSet s1 os : [isOptionSet s2 os] getOptionVal' s1 s2 = if null (getOptionVal s1 os) then getOptionVal s2 os else getOptionVal s1 os @@ -264,10 +271,9 @@ Nothing | isInit x -> addIn x [Space] -- default _ -> Space : x ++ [Space] - addIn x i = foldr hyphenate [] - $ map (\z -> Str (headInline z) : i) - $ wordsBy (== Str "-") - $ splitStrWhen (=='-') x + addIn x i = foldr (hyphenate . (\z -> Str (headInline z) : i)) [] + $ wordsBy (== Str "-") + $ splitStrWhen (=='-') x sortSep g s = when_ g $ separator ++ addAffixes (g <+> s) "given" mempty separator = if null (getOptionVal "sort-separator" ops) @@ -281,13 +287,13 @@ oPan' (unFormatted $ nameSuffix n) fm suffNoCom = when_ (nameSuffix n) $ OSpace : oPan' (unFormatted $ nameSuffix n) fm - onlyGiven = not (givenName n == mempty) && family == mempty + onlyGiven = givenName n /= mempty && family == mempty given = if onlyGiven then givenLong else when_ (givenName n) . Formatted . trimsp . fixsp . concatMap initial $ givenName n fixsp (Space:Space:xs) = fixsp (Space:xs) - fixsp (x:xs) = x : fixsp xs - fixsp [] = [] + fixsp (x:xs) = x : fixsp xs + fixsp [] = [] trimsp = reverse . dropWhile (==Space) . reverse . dropWhile (==Space) givenLong = when_ (givenName n) . mconcat . intersperse (Formatted [Space]) $ givenName n family = familyName n @@ -298,23 +304,23 @@ c <= '\x5FF' || (c >= '\x1e00' && c <= '\x1fff') shortName = oPan' (unFormatted $ nondropping <+> family) (form "family") - longName g = if isSorting m - then let firstPart = case getOptionVal "demote-non-dropping-particle" ops of + + longName g + | isSorting m = let firstPart = case getOptionVal "demote-non-dropping-particle" ops of "never" -> nondropping <+> family <+> dropping _ -> family <+> dropping <+> nondropping in oPan' (unFormatted firstPart) (form "family") <++> oPan' (unFormatted g) (form "given") <> suffCom - else if (b && getOptionVal "name-as-sort-order" ops == "first") || - getOptionVal "name-as-sort-order" ops == "all" - then let (fam,par) = case getOptionVal "demote-non-dropping-particle" ops of - "never" -> (nondropping <+> family, dropping) - "sort-only" -> (nondropping <+> family, dropping) - _ -> (family, dropping <+> nondropping) - in oPan' (unFormatted fam) (form "family") <> sortSep g par <> suffCom - else let fam = addAffixes (dropping <+> nondropping <+> family) "family" suff - gvn = oPan' (unFormatted g) (form "given") - in if all isByzantine $ stringify $ unFormatted family - then gvn <++> fam - else fam <> gvn + | (b && getOptionVal "name-as-sort-order" ops == "first") || + getOptionVal "name-as-sort-order" ops == "all" = let (fam,par) = case getOptionVal "demote-non-dropping-particle" ops of + "never" -> (nondropping <+> family, dropping) + "sort-only" -> (nondropping <+> family, dropping) + _ -> (family, dropping <+> nondropping) + in oPan' (unFormatted fam) (form "family") <> sortSep g par <> suffCom + | otherwise = let fam = addAffixes (dropping <+> nondropping <+> family) "family" suff + gvn = oPan' (unFormatted g) (form "given") + in if all isByzantine $ stringify $ unFormatted family + then gvn <++> fam + else fam <> gvn disWithGiven = getOptionVal "disambiguate-add-givenname" ops == "true" initialize = isJust (lookup "initialize-with" ops) && not onlyGiven @@ -349,7 +355,7 @@ formatLabel :: Form -> Formatting -> Bool -> String -> State EvalState [Output] formatLabel f fm p s - | "locator" <- s = when' (gets (citeLocator . cite . env) >>= return . (/=) []) $ do + | "locator" <- s = when' ( (/=) [] <$> gets (citeLocator . cite . env)) $ do (l,v) <- getLocVar form (\fm' -> return . flip OLoc emptyFormatting . output fm') id l (isRange v) | "page" <- s = checkPlural @@ -372,7 +378,7 @@ v <- getStringVar s format s (isRange v) format = form output id - form o g t b = return . o fm =<< g . period <$> getTerm (b && p) f t + form o g t b = o fm . g . period <$> getTerm (b && p) f t period = if stripPeriods fm then filter (/= '.') else id (<+>) :: Formatted -> Formatted -> Formatted @@ -380,9 +386,9 @@ s <+> Formatted [] = s Formatted xs <+> Formatted ys = case lastInline xs of - "’" -> Formatted (xs ++ ys) - "-" -> Formatted (xs ++ ys) - _ -> Formatted (xs ++ [Space] ++ ys) + "’" -> Formatted (xs ++ ys) + "-" -> Formatted (xs ++ ys) + _ -> Formatted (xs ++ [Space] ++ ys) (<++>) :: [Output] -> [Output] -> [Output] [] <++> o = o diff --git a/src/Text/CSL/Eval/Output.hs b/src/Text/CSL/Eval/Output.hs --- a/src/Text/CSL/Eval/Output.hs +++ b/src/Text/CSL/Eval/Output.hs @@ -15,15 +15,16 @@ module Text.CSL.Eval.Output where -import Text.CSL.Output.Pandoc (lastInline) -import Text.CSL.Style -import Data.Char (toLower, toUpper) -import Text.CSL.Util (capitalize, titlecase, unTitlecase, isPunct) -import Text.Pandoc.Definition -import Text.Pandoc.Walk (walk) -import Data.String (fromString) -import Data.Maybe (mapMaybe) -import Text.Parsec +import Data.Char (toLower, toUpper) +import Data.Maybe (mapMaybe) +import Data.String (fromString) +import Text.CSL.Output.Pandoc (lastInline) +import Text.CSL.Style +import Text.CSL.Util (capitalize, isPunct, titlecase, + unTitlecase) +import Text.Pandoc.Definition +import Text.Pandoc.Walk (walk) +import Text.Parsec -- Parse affix or delimiter into Formatted, splitting out -- raw components in @{{format}}...{{/format}}@. @@ -57,15 +58,15 @@ | otherwise = [OStr s fm] appendOutput :: Formatting -> [Output] -> [Output] -appendOutput fm xs = if xs /= [] then [Output xs fm] else [] +appendOutput fm xs = [Output xs fm | xs /= []] outputList :: Formatting -> Delimiter -> [Output] -> [Output] outputList fm d = appendOutput fm . addDelim d . mapMaybe cleanOutput' where cleanOutput' o | Output xs f <- o = case cleanOutput xs of - [] -> Nothing - ys -> Just (Output ys f) + [] -> Nothing + ys -> Just (Output ys f) | otherwise = rmEmptyOutput o cleanOutput :: [Output] -> [Output] @@ -115,7 +116,7 @@ oPan ils = [OPan ils] oPan' :: [Inline] -> Formatting -> [Output] -oPan' [] _ = [] +oPan' [] _ = [] oPan' ils f = [Output [OPan ils] f] formatOutputList :: [Output] -> Formatted @@ -199,17 +200,17 @@ | otherwise = Formatted $ font_variant . font_style . font_weight $ ils font_variant ils = case fontVariant f of - "small-caps" -> [SmallCaps ils] - _ -> ils + "small-caps" -> [SmallCaps ils] + _ -> ils font_style ils = case fontStyle f of - "italic" -> [Emph ils] - "oblique" -> [Emph ils] - _ -> ils + "italic" -> [Emph ils] + "oblique" -> [Emph ils] + _ -> ils font_weight ils = case fontWeight f of - "bold" -> [Strong ils] - _ -> ils + "bold" -> [Strong ils] + _ -> ils text_case (Formatted []) = Formatted [] text_case (Formatted ils@(i:is)) @@ -224,10 +225,10 @@ "sentence" -> unTitlecase ils _ -> ils - lowercaseStr (Str xs) = Str $ map toLower xs - lowercaseStr x = x - uppercaseStr (Str xs) = Str $ map toUpper xs - uppercaseStr x = x + lowercaseStr (Str xs) = Str $ map toLower xs + lowercaseStr x = x + uppercaseStr (Str xs) = Str $ map toUpper xs + uppercaseStr x = x capitalizeStr (Str xs) = Str $ capitalize xs capitalizeStr x = x diff --git a/src/Text/CSL/Exception.hs b/src/Text/CSL/Exception.hs --- a/src/Text/CSL/Exception.hs +++ b/src/Text/CSL/Exception.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} + module Text.CSL.Exception (CiteprocException(..), renderError) where -import Control.Exception (Exception) -import Data.Data +import Control.Exception (Exception) +import Data.Data data CiteprocException = ErrorParsingReferences String diff --git a/src/Text/CSL/Input/Bibtex.hs b/src/Text/CSL/Input/Bibtex.hs --- a/src/Text/CSL/Input/Bibtex.hs +++ b/src/Text/CSL/Input/Bibtex.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} ----------------------------------------------------------------------------- -- | @@ -20,35 +21,37 @@ ) where -import Text.Parsec hiding (optional, (<|>), many, State) -import Control.Applicative -import qualified Control.Exception as E -import Text.CSL.Compat.Pandoc (readLaTeX) -import Text.CSL.Exception - (CiteprocException (ErrorReadingBib, ErrorReadingBibFile)) -import Text.Pandoc.Definition -import Text.Pandoc.Generic (bottomUp) -import Data.List.Split (splitOn, splitWhen, wordsBy) -import Data.List (intercalate, foldl') -import Data.Maybe -import Data.Char (toLower, isUpper, toUpper, isDigit, isAlphaNum) -import Control.Monad -import Control.Monad.RWS -import System.Environment (getEnvironment) -import Text.CSL.Reference -import Text.CSL.Style (Formatted(..), Locale(..), CslTerm(..), Agent(..)) -import Text.CSL.Util (trim, onBlocks, unTitlecase, protectCase, splitStrWhen, - safeRead) -import Text.CSL.Parser (parseLocale) -import qualified Text.Pandoc.Walk as Walk -import qualified Text.Pandoc.UTF8 as UTF8 +import Control.Applicative +import qualified Control.Exception as E +import Control.Monad +import Control.Monad.RWS +import Data.Char (isAlphaNum, isDigit, isUpper, toLower, + toUpper) +import Data.List (foldl', intercalate) +import Data.List.Split (splitOn, splitWhen, wordsBy) +import qualified Data.Map as Map +import Data.Maybe +import System.Environment (getEnvironment) +import Text.CSL.Compat.Pandoc (readLaTeX) +import Text.CSL.Exception (CiteprocException (ErrorReadingBib, ErrorReadingBibFile)) +import Text.CSL.Parser (parseLocale) +import Text.CSL.Reference +import Text.CSL.Style (Agent (..), CslTerm (..), + Formatted (..), Locale (..)) +import Text.CSL.Util (onBlocks, protectCase, safeRead, + splitStrWhen, trim, unTitlecase) +import Text.Pandoc.Definition +import Text.Pandoc.Generic (bottomUp) +import qualified Text.Pandoc.UTF8 as UTF8 +import qualified Text.Pandoc.Walk as Walk +import Text.Parsec hiding (State, many, (<|>)) blocksToFormatted :: [Block] -> Bib Formatted blocksToFormatted bs = case bs of - [Plain xs] -> inlinesToFormatted xs - [Para xs] -> inlinesToFormatted xs - _ -> inlinesToFormatted $ Walk.query (:[]) bs + [Plain xs] -> inlinesToFormatted xs + [Para xs] -> inlinesToFormatted xs + _ -> inlinesToFormatted $ Walk.query (:[]) bs adjustSpans :: Lang -> Inline -> [Inline] adjustSpans _ (Span ("",[],[]) xs) = xs @@ -73,10 +76,10 @@ f "mkbibparens" ils = [Str "("] ++ ils ++ [Str ")"] -- TODO: ... f "mkbibbrackets" ils = [Str "["] ++ ils ++ [Str "]"] -- TODO: ... -- ... both should be nestable & should work in year fields - f "autocap" ils = ils -- TODO: should work in year fields - f "textnormal" ils = [Span ("",["nodecor"],[]) ils] + f "autocap" ils = ils -- TODO: should work in year fields + f "textnormal" ils = [Span ("",["nodecor"],[]) ils] f "bibstring" [Str s] = [Str $ resolveKey' lang s] - f _ ils = [Span nullAttr ils] + f _ ils = [Span nullAttr ils] parseRawLaTeX _ _ = [] inlinesToFormatted :: [Inline] -> Bib Formatted @@ -86,7 +89,7 @@ data Item = Item{ identifier :: String , entryType :: String - , fields :: [(String, String)] + , fields :: Map.Map String String } -- | Get 'Lang' from the environment variable LANG, defaulting to en-US. @@ -95,72 +98,73 @@ env <- getEnvironment return $ case lookup "LANG" env of Just x -> case splitWhen (\c -> c == '.' || c == '_' || c == '-') x of - (w:z:_) -> Lang w z - [w] | not (null w) -> Lang w mempty - _ -> Lang "en" "US" + (w:z:_) -> Lang w z + [w] | not (null w) -> Lang w mempty + _ -> Lang "en" "US" Nothing -> Lang "en" "US" -- | Parse a BibTeX or BibLaTeX file into a list of 'Reference's. --- If the first parameter is true, the file will be treated as --- BibTeX; otherwse as BibLaTeX. If the second parameter is +-- The first parameter is a predicate to filter identifiers. +-- If the second parameter is true, the file will be treated as +-- BibTeX; otherwse as BibLaTeX. If the third parameter is -- true, an "untitlecase" transformation will be performed. -readBibtex :: Bool -> Bool -> FilePath -> IO [Reference] -readBibtex isBibtex caseTransform f = do +readBibtex :: (String -> Bool) -> Bool -> Bool -> FilePath -> IO [Reference] +readBibtex idpred isBibtex caseTransform f = do contents <- UTF8.readFile f - E.catch (readBibtexString isBibtex caseTransform contents) + E.catch (readBibtexString idpred isBibtex caseTransform contents) (\e -> case e of ErrorReadingBib es -> E.throwIO $ ErrorReadingBibFile f es - _ -> E.throwIO e) + _ -> E.throwIO e) -- | Like 'readBibtex' but operates on a String rather than a file. -readBibtexString :: Bool -> Bool -> String -> IO [Reference] -readBibtexString isBibtex caseTransform contents = do +readBibtexString :: (String -> Bool) -> Bool -> Bool -> String + -> IO [Reference] +readBibtexString idpred isBibtex caseTransform contents = do lang <- getLangFromEnv locale <- parseLocale (langToLocale lang) - case runParser (bibEntries <* eof) [] "stdin" contents of + case runParser (bibEntries <* eof) (Map.empty) "stdin" contents of -- drop 8 to remove "stdin" + space Left err -> E.throwIO $ ErrorReadingBib $ drop 8 $ show err Right xs -> return $ mapMaybe (itemToReference lang locale isBibtex caseTransform) - (resolveCrossRefs isBibtex xs) + (filter (idpred . identifier) + (resolveCrossRefs isBibtex + xs)) -type BibParser = Parsec [Char] [(String, String)] +type BibParser = Parsec String (Map.Map String String) bibEntries :: BibParser [Item] bibEntries = do skipMany nonEntry - items <- many (bibItem <* skipMany nonEntry) - return items - where nonEntry = bibSkip <|> bibComment <|> bibPreamble <|> bibString + many (bibItem <* skipMany nonEntry) + where nonEntry = bibSkip <|> + try (char '@' >> + (bibComment <|> bibPreamble <|> bibString)) bibSkip :: BibParser () bibSkip = skipMany1 (satisfy (/='@')) bibComment :: BibParser () -bibComment = try $ do - char '@' +bibComment = do cistring "comment" spaces void inBraces <|> bibSkip <|> return () bibPreamble :: BibParser () -bibPreamble = try $ do - char '@' +bibPreamble = do cistring "preamble" spaces void inBraces bibString :: BibParser () -bibString = try $ do - char '@' +bibString = do cistring "string" spaces char '{' spaces - f <- entField - spaces + (k,v) <- entField char '}' - updateState $ (f:) + updateState (Map.insert k v) return () inBraces :: BibParser String @@ -187,7 +191,7 @@ ) (char '"') fieldName :: BibParser String -fieldName = (map toLower) <$> many1 (letter <|> digit <|> oneOf "-_:+") +fieldName = map toLower <$> many1 (letter <|> digit <|> oneOf "-_:+") isBibtexKeyChar :: Char -> Bool isBibtexKeyChar c = isAlphaNum c || c `elem` ".:;?!`'()/*@_+=-[]*&" @@ -203,20 +207,19 @@ spaces char ',' spaces - entfields <- entField `sepEndBy` (char ',') + entfields <- entField `sepEndBy` (char ',' >> spaces) spaces char '}' - return $ Item entid enttype entfields + return $ Item entid enttype (Map.fromList entfields) entField :: BibParser (String, String) -entField = try $ do - spaces +entField = do k <- fieldName spaces char '=' spaces vs <- (expandString <|> inQuotes <|> inBraces <|> rawWord) `sepBy` - (try $ spaces >> char '#' >> spaces) + try (spaces >> char '#' >> spaces) spaces return (k, concat vs) @@ -227,16 +230,17 @@ expandString = do k <- fieldName strs <- getState - case lookup k strs of + case Map.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) +cistring s = try (go s) + where go [] = return [] + go (c:cs) = do + x <- char (toLower c) <|> char (toUpper c) + xs <- go cs + return (x:xs) resolveCrossRefs :: Bool -> [Item] -> [Item] resolveCrossRefs isBibtex entries = @@ -249,27 +253,29 @@ getXrefFields isBibtex baseEntry entries keys = do let keys' = splitKeys keys xrefEntry <- [e | e <- entries, identifier e `elem` keys'] - (k, v) <- fields xrefEntry + (k, v) <- Map.toList $ fields xrefEntry if k == "crossref" || k == "xdata" then do xs <- mapM (getXrefFields isBibtex baseEntry entries) (splitKeys v) (x, y) <- xs - guard $ isNothing $ lookup x $ fields xrefEntry + guard $ isNothing $ Map.lookup x $ fields xrefEntry return (x, y) else do k' <- if isBibtex then return k else transformKey (entryType xrefEntry) (entryType baseEntry) k - guard $ isNothing $ lookup k' $ fields baseEntry + guard $ isNothing $ Map.lookup k' $ fields baseEntry return (k',v) resolveCrossRef :: Bool -> [Item] -> Item -> Item -resolveCrossRef isBibtex entries entry = foldr go entry (fields entry) - where go (key, val) entry' = +resolveCrossRef isBibtex entries entry = + Map.foldrWithKey go entry (fields entry) + where go key val entry' = if key == "crossref" || key == "xdata" - then entry'{ fields = fields entry' ++ - getXrefFields isBibtex entry entries val } + then entry'{ fields = fields entry' <> + Map.fromList (getXrefFields isBibtex + entry entries val) } else entry' -- transformKey source target key @@ -409,38 +415,38 @@ case map toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing - "forthcoming" -> "kommende" -- csl - "inpress" -> "i tryk" -- csl + "forthcoming" -> "kommende" -- csl + "inpress" -> "i tryk" -- csl -- "prepublished" -> "" -- missing - "mathesis" -> "speciale" - "phdthesis" -> "ph.d.-afhandling" - "candthesis" -> "kandidatafhandling" - "techreport" -> "teknisk rapport" - "resreport" -> "forskningsrapport" - "software" -> "software" - "datacd" -> "data-cd" - "audiocd" -> "lyd-cd" - "patent" -> "patent" - "patentde" -> "tysk patent" - "patenteu" -> "europæisk patent" - "patentfr" -> "fransk patent" - "patentuk" -> "britisk patent" - "patentus" -> "amerikansk patent" - "patreq" -> "ansøgning om patent" - "patreqde" -> "ansøgning om tysk patent" - "patreqeu" -> "ansøgning om europæisk patent" - "patreqfr" -> "ansøgning om fransk patent" - "patrequk" -> "ansøgning om britisk patent" - "patrequs" -> "ansøgning om amerikansk patent" - "countryde" -> "Tyskland" - "countryeu" -> "Europæiske Union" - "countryep" -> "Europæiske Union" - "countryfr" -> "Frankrig" - "countryuk" -> "Storbritanien" - "countryus" -> "USA" - "newseries" -> "ny serie" - "oldseries" -> "gammel serie" - _ -> k + "mathesis" -> "speciale" + "phdthesis" -> "ph.d.-afhandling" + "candthesis" -> "kandidatafhandling" + "techreport" -> "teknisk rapport" + "resreport" -> "forskningsrapport" + "software" -> "software" + "datacd" -> "data-cd" + "audiocd" -> "lyd-cd" + "patent" -> "patent" + "patentde" -> "tysk patent" + "patenteu" -> "europæisk patent" + "patentfr" -> "fransk patent" + "patentuk" -> "britisk patent" + "patentus" -> "amerikansk patent" + "patreq" -> "ansøgning om patent" + "patreqde" -> "ansøgning om tysk patent" + "patreqeu" -> "ansøgning om europæisk patent" + "patreqfr" -> "ansøgning om fransk patent" + "patrequk" -> "ansøgning om britisk patent" + "patrequs" -> "ansøgning om amerikansk patent" + "countryde" -> "Tyskland" + "countryeu" -> "Europæiske Union" + "countryep" -> "Europæiske Union" + "countryfr" -> "Frankrig" + "countryuk" -> "Storbritanien" + "countryus" -> "USA" + "newseries" -> "ny serie" + "oldseries" -> "gammel serie" + _ -> k resolveKey' (Lang "de" "DE") k = case map toLower k of "inpreparation" -> "in Vorbereitung" @@ -524,79 +530,79 @@ "submitted" -> "submitted" "techreport" -> "technical report" "volume" -> "vol." - _ -> k + _ -> k resolveKey' (Lang "es" "ES") k = case map toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing - "forthcoming" -> "previsto" -- csl - "inpress" -> "en imprenta" -- csl + "forthcoming" -> "previsto" -- csl + "inpress" -> "en imprenta" -- csl -- "prepublished" -> "" -- missing - "mathesis" -> "Tesis de licenciatura" - "phdthesis" -> "Tesis doctoral" + "mathesis" -> "Tesis de licenciatura" + "phdthesis" -> "Tesis doctoral" -- "candthesis" -> "" -- missing - "techreport" -> "informe técnico" + "techreport" -> "informe técnico" -- "resreport" -> "" -- missing -- "software" -> "" -- missing -- "datacd" -> "" -- missing -- "audiocd" -> "" -- missing - "patent" -> "patente" - "patentde" -> "patente alemana" - "patenteu" -> "patente europea" - "patentfr" -> "patente francesa" - "patentuk" -> "patente británica" - "patentus" -> "patente americana" - "patreq" -> "solicitud de patente" - "patreqde" -> "solicitud de patente alemana" - "patreqeu" -> "solicitud de patente europea" - "patreqfr" -> "solicitud de patente francesa" - "patrequk" -> "solicitud de patente británica" - "patrequs" -> "solicitud de patente americana" - "countryde" -> "Alemania" - "countryeu" -> "Unión Europea" - "countryep" -> "Unión Europea" - "countryfr" -> "Francia" - "countryuk" -> "Reino Unido" - "countryus" -> "Estados Unidos de América" - "newseries" -> "nueva época" - "oldseries" -> "antigua época" - _ -> k + "patent" -> "patente" + "patentde" -> "patente alemana" + "patenteu" -> "patente europea" + "patentfr" -> "patente francesa" + "patentuk" -> "patente británica" + "patentus" -> "patente americana" + "patreq" -> "solicitud de patente" + "patreqde" -> "solicitud de patente alemana" + "patreqeu" -> "solicitud de patente europea" + "patreqfr" -> "solicitud de patente francesa" + "patrequk" -> "solicitud de patente británica" + "patrequs" -> "solicitud de patente americana" + "countryde" -> "Alemania" + "countryeu" -> "Unión Europea" + "countryep" -> "Unión Europea" + "countryfr" -> "Francia" + "countryuk" -> "Reino Unido" + "countryus" -> "Estados Unidos de América" + "newseries" -> "nueva época" + "oldseries" -> "antigua época" + _ -> k resolveKey' (Lang "fi" "FI") k = case map toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing - "forthcoming" -> "tulossa" -- csl - "inpress" -> "painossa" -- csl + "forthcoming" -> "tulossa" -- csl + "inpress" -> "painossa" -- csl -- "prepublished" -> "" -- missing - "mathesis" -> "tutkielma" - "phdthesis" -> "tohtorinväitöskirja" - "candthesis" -> "kandidat" - "techreport" -> "tekninen raportti" - "resreport" -> "tutkimusraportti" - "software" -> "ohjelmisto" - "datacd" -> "data-CD" - "audiocd" -> "ääni-CD" - "patent" -> "patentti" - "patentde" -> "saksalainen patentti" - "patenteu" -> "Euroopan Unionin patentti" - "patentfr" -> "ranskalainen patentti" - "patentuk" -> "englantilainen patentti" - "patentus" -> "yhdysvaltalainen patentti" - "patreq" -> "patenttihakemus" - "patreqde" -> "saksalainen patenttihakemus" - "patreqeu" -> "Euroopan Unionin patenttihakemus" - "patreqfr" -> "ranskalainen patenttihakemus" - "patrequk" -> "englantilainen patenttihakemus" - "patrequs" -> "yhdysvaltalainen patenttihakemus" - "countryde" -> "Saksa" - "countryeu" -> "Euroopan Unioni" - "countryep" -> "Euroopan Unioni" - "countryfr" -> "Ranska" - "countryuk" -> "Iso-Britannia" - "countryus" -> "Yhdysvallat" - "newseries" -> "uusi sarja" - "oldseries" -> "vanha sarja" - _ -> k + "mathesis" -> "tutkielma" + "phdthesis" -> "tohtorinväitöskirja" + "candthesis" -> "kandidat" + "techreport" -> "tekninen raportti" + "resreport" -> "tutkimusraportti" + "software" -> "ohjelmisto" + "datacd" -> "data-CD" + "audiocd" -> "ääni-CD" + "patent" -> "patentti" + "patentde" -> "saksalainen patentti" + "patenteu" -> "Euroopan Unionin patentti" + "patentfr" -> "ranskalainen patentti" + "patentuk" -> "englantilainen patentti" + "patentus" -> "yhdysvaltalainen patentti" + "patreq" -> "patenttihakemus" + "patreqde" -> "saksalainen patenttihakemus" + "patreqeu" -> "Euroopan Unionin patenttihakemus" + "patreqfr" -> "ranskalainen patenttihakemus" + "patrequk" -> "englantilainen patenttihakemus" + "patrequs" -> "yhdysvaltalainen patenttihakemus" + "countryde" -> "Saksa" + "countryeu" -> "Euroopan Unioni" + "countryep" -> "Euroopan Unioni" + "countryfr" -> "Ranska" + "countryuk" -> "Iso-Britannia" + "countryus" -> "Yhdysvallat" + "newseries" -> "uusi sarja" + "oldseries" -> "vanha sarja" + _ -> k resolveKey' (Lang "fr" "FR") k = case map toLower k of @@ -638,38 +644,38 @@ case map toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing - "forthcoming" -> "futuro" -- csl - "inpress" -> "in stampa" + "forthcoming" -> "futuro" -- csl + "inpress" -> "in stampa" -- "prepublished" -> "" -- missing - "mathesis" -> "tesi di laurea magistrale" - "phdthesis" -> "tesi di dottorato" + "mathesis" -> "tesi di laurea magistrale" + "phdthesis" -> "tesi di dottorato" -- "candthesis" -> "" -- missing - "techreport" -> "rapporto tecnico" - "resreport" -> "rapporto di ricerca" + "techreport" -> "rapporto tecnico" + "resreport" -> "rapporto di ricerca" -- "software" -> "" -- missing -- "datacd" -> "" -- missing -- "audiocd" -> "" -- missing - "patent" -> "brevetto" - "patentde" -> "brevetto tedesco" - "patenteu" -> "brevetto europeo" - "patentfr" -> "brevetto francese" - "patentuk" -> "brevetto britannico" - "patentus" -> "brevetto americano" - "patreq" -> "brevetto richiesto" - "patreqde" -> "brevetto tedesco richiesto" - "patreqeu" -> "brevetto europeo richiesto" - "patreqfr" -> "brevetto francese richiesto" - "patrequk" -> "brevetto britannico richiesto" - "patrequs" -> "brevetto U.S.A. richiesto" - "countryde" -> "Germania" - "countryeu" -> "Unione Europea" - "countryep" -> "Unione Europea" - "countryfr" -> "Francia" - "countryuk" -> "Regno Unito" - "countryus" -> "Stati Uniti d’America" - "newseries" -> "nuova serie" - "oldseries" -> "vecchia serie" - _ -> k + "patent" -> "brevetto" + "patentde" -> "brevetto tedesco" + "patenteu" -> "brevetto europeo" + "patentfr" -> "brevetto francese" + "patentuk" -> "brevetto britannico" + "patentus" -> "brevetto americano" + "patreq" -> "brevetto richiesto" + "patreqde" -> "brevetto tedesco richiesto" + "patreqeu" -> "brevetto europeo richiesto" + "patreqfr" -> "brevetto francese richiesto" + "patrequk" -> "brevetto britannico richiesto" + "patrequs" -> "brevetto U.S.A. richiesto" + "countryde" -> "Germania" + "countryeu" -> "Unione Europea" + "countryep" -> "Unione Europea" + "countryfr" -> "Francia" + "countryuk" -> "Regno Unito" + "countryus" -> "Stati Uniti d’America" + "newseries" -> "nuova serie" + "oldseries" -> "vecchia serie" + _ -> k resolveKey' (Lang "nl" "NL") k = case map toLower k of "inpreparation" -> "in voorbereiding" @@ -741,38 +747,38 @@ resolveKey' (Lang "pt" "PT") k = case map toLower k of -- "candthesis" -> "" -- missing - "techreport" -> "relatório técnico" - "resreport" -> "relatório de pesquisa" - "software" -> "software" - "datacd" -> "CD-ROM" - "patent" -> "patente" - "patentde" -> "patente alemã" - "patenteu" -> "patente européia" - "patentfr" -> "patente francesa" - "patentuk" -> "patente britânica" - "patentus" -> "patente americana" - "patreq" -> "pedido de patente" - "patreqde" -> "pedido de patente alemã" - "patreqeu" -> "pedido de patente européia" - "patreqfr" -> "pedido de patente francesa" - "patrequk" -> "pedido de patente britânica" - "patrequs" -> "pedido de patente americana" - "countryde" -> "Alemanha" - "countryeu" -> "União Europeia" - "countryep" -> "União Europeia" - "countryfr" -> "França" - "countryuk" -> "Reino Unido" - "countryus" -> "Estados Unidos da América" - "newseries" -> "nova série" - "oldseries" -> "série antiga" + "techreport" -> "relatório técnico" + "resreport" -> "relatório de pesquisa" + "software" -> "software" + "datacd" -> "CD-ROM" + "patent" -> "patente" + "patentde" -> "patente alemã" + "patenteu" -> "patente européia" + "patentfr" -> "patente francesa" + "patentuk" -> "patente britânica" + "patentus" -> "patente americana" + "patreq" -> "pedido de patente" + "patreqde" -> "pedido de patente alemã" + "patreqeu" -> "pedido de patente européia" + "patreqfr" -> "pedido de patente francesa" + "patrequk" -> "pedido de patente britânica" + "patrequs" -> "pedido de patente americana" + "countryde" -> "Alemanha" + "countryeu" -> "União Europeia" + "countryep" -> "União Europeia" + "countryfr" -> "França" + "countryuk" -> "Reino Unido" + "countryus" -> "Estados Unidos da América" + "newseries" -> "nova série" + "oldseries" -> "série antiga" -- "inpreparation" -> "" -- missing - "forthcoming" -> "a publicar" -- csl - "inpress" -> "na imprensa" + "forthcoming" -> "a publicar" -- csl + "inpress" -> "na imprensa" -- "prepublished" -> "" -- missing - "mathesis" -> "tese de mestrado" - "phdthesis" -> "tese de doutoramento" - "audiocd" -> "CD áudio" - _ -> k + "mathesis" -> "tese de mestrado" + "phdthesis" -> "tese de doutoramento" + "audiocd" -> "CD áudio" + _ -> k resolveKey' (Lang "pt" "BR") k = case map toLower k of -- "candthesis" -> "" -- missing @@ -812,60 +818,60 @@ case map toLower k of -- "inpreparation" -> "" -- missing -- "submitted" -> "" -- missing - "forthcoming" -> "kommande" -- csl - "inpress" -> "i tryck" -- csl + "forthcoming" -> "kommande" -- csl + "inpress" -> "i tryck" -- csl -- "prepublished" -> "" -- missing - "mathesis" -> "examensarbete" - "phdthesis" -> "doktorsavhandling" - "candthesis" -> "kandidatavhandling" - "techreport" -> "teknisk rapport" - "resreport" -> "forskningsrapport" - "software" -> "datorprogram" - "datacd" -> "data-cd" - "audiocd" -> "ljud-cd" - "patent" -> "patent" - "patentde" -> "tyskt patent" - "patenteu" -> "europeiskt patent" - "patentfr" -> "franskt patent" - "patentuk" -> "brittiskt patent" - "patentus" -> "amerikanskt patent" - "patreq" -> "patentansökan" - "patreqde" -> "ansökan om tyskt patent" - "patreqeu" -> "ansökan om europeiskt patent" - "patreqfr" -> "ansökan om franskt patent" - "patrequk" -> "ansökan om brittiskt patent" - "patrequs" -> "ansökan om amerikanskt patent" - "countryde" -> "Tyskland" - "countryeu" -> "Europeiska unionen" - "countryep" -> "Europeiska unionen" - "countryfr" -> "Frankrike" - "countryuk" -> "Storbritannien" - "countryus" -> "USA" - "newseries" -> "ny följd" - "oldseries" -> "gammal följd" - _ -> k + "mathesis" -> "examensarbete" + "phdthesis" -> "doktorsavhandling" + "candthesis" -> "kandidatavhandling" + "techreport" -> "teknisk rapport" + "resreport" -> "forskningsrapport" + "software" -> "datorprogram" + "datacd" -> "data-cd" + "audiocd" -> "ljud-cd" + "patent" -> "patent" + "patentde" -> "tyskt patent" + "patenteu" -> "europeiskt patent" + "patentfr" -> "franskt patent" + "patentuk" -> "brittiskt patent" + "patentus" -> "amerikanskt patent" + "patreq" -> "patentansökan" + "patreqde" -> "ansökan om tyskt patent" + "patreqeu" -> "ansökan om europeiskt patent" + "patreqfr" -> "ansökan om franskt patent" + "patrequk" -> "ansökan om brittiskt patent" + "patrequs" -> "ansökan om amerikanskt patent" + "countryde" -> "Tyskland" + "countryeu" -> "Europeiska unionen" + "countryep" -> "Europeiska unionen" + "countryfr" -> "Frankrike" + "countryuk" -> "Storbritannien" + "countryus" -> "USA" + "newseries" -> "ny följd" + "oldseries" -> "gammal följd" + _ -> k resolveKey' _ k = resolveKey' (Lang "en" "US") k -parseMonth :: String -> String +parseMonth :: String -> Maybe Int parseMonth s = case map toLower s of - "jan" -> "1" - "feb" -> "2" - "mar" -> "3" - "apr" -> "4" - "may" -> "5" - "jun" -> "6" - "jul" -> "7" - "aug" -> "8" - "sep" -> "9" - "oct" -> "10" - "nov" -> "11" - "dec" -> "12" - _ -> s + "jan" -> Just 1 + "feb" -> Just 2 + "mar" -> Just 3 + "apr" -> Just 4 + "may" -> Just 5 + "jun" -> Just 6 + "jul" -> Just 7 + "aug" -> Just 8 + "sep" -> Just 9 + "oct" -> Just 10 + "nov" -> Just 11 + "dec" -> Just 12 + _ -> safeRead s data BibState = BibState{ - untitlecase :: Bool - , localeLanguage :: Lang + untitlecase :: Bool + , localeLanguage :: Lang } type Bib = RWST Item () BibState Maybe @@ -876,21 +882,21 @@ getField :: String -> Bib Formatted getField f = do fs <- asks fields - case lookup f fs of + case Map.lookup f fs of Just x -> latex x Nothing -> notFound f getPeriodicalTitle :: String -> Bib Formatted getPeriodicalTitle f = do fs <- asks fields - case lookup f fs of + case Map.lookup f fs of Just x -> blocksToFormatted $ onBlocks protectCase $ latex' $ trim x Nothing -> notFound f getTitle :: String -> Bib Formatted getTitle f = do fs <- asks fields - case lookup f fs of + case Map.lookup f fs of Just x -> latexTitle x Nothing -> notFound f @@ -899,7 +905,7 @@ fs <- asks fields utc <- gets untitlecase let processTitle = if utc then onBlocks unTitlecase else id - case lookup f fs of + case Map.lookup f fs of Just x -> case processTitle $ latex' x of bs | not requireColon || containsColon bs -> blocksToFormatted $ upToColon bs @@ -907,67 +913,17 @@ Nothing -> notFound f containsColon :: [Block] -> Bool -containsColon [Para xs] = (Str ":") `elem` xs +containsColon [Para xs] = Str ":" `elem` xs containsColon [Plain xs] = containsColon [Para xs] containsColon _ = False upToColon :: [Block] -> [Block] -upToColon [Para xs] = [Para $ takeWhile (/= (Str ":")) xs] +upToColon [Para xs] = [Para $ takeWhile (/= Str ":") xs] upToColon [Plain xs] = upToColon [Para xs] upToColon bs = bs getDates :: String -> Bib [RefDate] -getDates f = getRawField f >>= parseDates - -parseDates :: Monad m => String-> m [RefDate] -parseDates s - | '/' `elem` s = mapM parseDate . splitWhen (== '/') $ s - -- 199u EDTF format for a range: - | 'u' `elem` s = let s1 = map (\c -> if c == 'u' then '0' else c) s - s2 = map (\c -> if c == 'u' then '9' else c) s - in mapM parseDate [s1, s2] - | otherwise = mapM parseDate [s] - -parseDate :: Monad m => String -> m RefDate --- EDTF format for year of more than 4 digits, starts with 'y': -parseDate ('y':xs) = parseDate xs -parseDate "open" = return RefDate { year = mempty, - month = mempty, season = mempty, day = mempty, - other = mempty, circa = False } -parseDate "unknown" = return RefDate { year = mempty, - month = mempty, season = mempty, day = mempty, - other = mempty, circa = False } -parseDate s = do - let circa' = '~' `elem` s - let (year', month', day') = - case splitWhen (== '-') $ filter (`notElem` "~?") - -- drop time component: - $ takeWhile (/='T') s of - -- initial - is negative year: - ["",y] -> ('-':y, mempty, mempty) - ["",y,m] -> ('-':y, m, mempty) - ["",y,m,d] -> ('-':y, m, d) - [y] -> (y, mempty, mempty) - [y,m] -> (y, m, mempty) - [y,m,d] -> (y, m, d) - _ -> (mempty, mempty, mempty) - let year'' = case safeRead year' of - -- EDTF 0 == CSL JSON -1 (1 BCE) - Just (n :: Integer) | n <= 0 -> show (n - 1) - _ -> year' - let (season'', month'') = case month' of - "21" -> ("1","") - "22" -> ("2","") - "23" -> ("3","") - "24" -> ("4","") - _ -> ("", month') - return RefDate { year = Literal $ dropWhile (=='0') year'' - , month = Literal $ dropWhile (=='0') month'' - , season = Literal season'' - , day = Literal $ dropWhile (=='0') day' - , other = mempty - , circa = circa' - } +getDates f = parseEDTFDate <$> getRawField f isNumber :: String -> Bool isNumber ('-':d:ds) = all isDigit (d:ds) @@ -982,49 +938,50 @@ getOldDates :: String -> Bib [RefDate] getOldDates prefix = do - year' <- fixLeadingDash <$> getRawField (prefix ++ "year") + year' <- fixLeadingDash <$> getRawField (prefix ++ "year") <|> return "" month' <- (parseMonth - <$> getRawField (prefix ++ "month")) <|> return "" - day' <- getRawField (prefix ++ "day") <|> return mempty - endyear' <- fixLeadingDash <$> getRawField (prefix ++ "endyear") <|> return "" - endmonth' <- (parseMonth <$> getRawField (prefix ++ "endmonth")) <|> return "" - endday' <- getRawField (prefix ++ "endday") <|> return "" - let start' = RefDate { year = Literal $ if isNumber year' then year' else "" - , month = Literal $ month' - , season = mempty - , day = Literal day' + <$> getRawField (prefix ++ "month")) <|> return Nothing + day' <- (safeRead <$> getRawField (prefix ++ "day")) <|> return Nothing + endyear' <- (fixLeadingDash <$> getRawField (prefix ++ "endyear")) + <|> return "" + endmonth' <- (parseMonth <$> getRawField (prefix ++ "endmonth")) + <|> return Nothing + endday' <- (safeRead <$> getRawField (prefix ++ "endday")) <|> return Nothing + let start' = RefDate { year = safeRead year' + , month = month' + , season = Nothing + , day = day' , other = Literal $ if isNumber year' then "" else year' , circa = False } - let end' = if null endyear' - then [] - else [RefDate { year = Literal $ if isNumber endyear' then endyear' else "" - , month = Literal $ endmonth' - , day = Literal $ endday' - , season = mempty - , other = Literal $ if isNumber endyear' then "" else endyear' - , circa = False - }] - return (start':end') + let end' = RefDate { year = safeRead endyear' + , month = endmonth' + , day = endday' + , season = Nothing + , other = Literal $ if isNumber endyear' then "" else endyear' + , circa = False + } + let hasyear r = isJust (year r) + return $ filter hasyear [start', end'] getRawField :: String -> Bib String getRawField f = do fs <- asks fields - case lookup f fs of + case Map.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 of + case Map.lookup f fs of Just x -> latexAuthors opts x Nothing -> notFound f getLiteralList :: String -> Bib [Formatted] getLiteralList f = do fs <- asks fields - case lookup f fs of + case Map.lookup f fs of Just x -> toLiteralList $ latex' x Nothing -> notFound f @@ -1049,7 +1006,8 @@ toAuthorList _ _ = mzero toAuthor :: Options -> [Inline] -> Bib Agent -toAuthor _ [Str "others"] = return $ +toAuthor _ [Str "others"] = + return Agent { givenName = [] , droppingPart = mempty , nonDroppingPart = mempty @@ -1060,7 +1018,7 @@ , parseNames = False } toAuthor _ [Span ("",[],[]) ils] = - return $ -- corporate author + return -- corporate author Agent { givenName = [] , droppingPart = mempty , nonDroppingPart = mempty @@ -1104,17 +1062,18 @@ let (von, lastname) = if bibtex then case span isCapitalized $ reverse vonlast of - ([],(w:ws)) -> (reverse ws, [w]) - (vs, ws) -> (reverse ws, reverse vs) - else case span (not . isCapitalized) vonlast of + ([],w:ws) -> (reverse ws, [w]) + (vs, ws) -> (reverse ws, reverse vs) + else case break isCapitalized vonlast of (vs@(_:_), []) -> (init vs, [last vs]) (vs, ws) -> (vs, ws) let prefix = Formatted $ intercalate [Space] von let family = Formatted $ intercalate [Space] lastname let suffix = Formatted $ intercalate [Space] jr let givens = map Formatted first - return $ - Agent { givenName = givens + + return Agent + { givenName = givens , droppingPart = if useprefix then mempty else prefix , nonDroppingPart = if useprefix then prefix else mempty , familyName = family @@ -1144,7 +1103,7 @@ removeSoftBreak :: Inline -> Inline removeSoftBreak SoftBreak = Space -removeSoftBreak x = x +removeSoftBreak x = x latex :: String -> Bib Formatted latex s = blocksToFormatted $ latex' $ trim s @@ -1159,70 +1118,70 @@ latexAuthors opts = toAuthorList opts . latex' . trim bib :: Bib Reference -> Item -> Maybe Reference -bib m entry = fmap fst $ evalRWST m entry (BibState True (Lang "en" "US")) +bib m entry = fst Control.Applicative.<$> evalRWST m entry (BibState True (Lang "en" "US")) 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 "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 "latin" = "la" -toLocale x = x +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 "latin" = "la" +toLocale x = x concatWith :: Char -> [Formatted] -> Formatted concatWith sep = Formatted . foldl' go mempty . map unFormatted @@ -1365,8 +1324,8 @@ editor'' <- getAuthorList' "editor" <|> return [] director'' <- getAuthorList' "director" <|> return [] let (editor', director') = case editortype of - "director" -> ([], editor'') - _ -> (editor'', director'') + "director" -> ([], editor'') + _ -> (editor'', director'') -- FIXME: add same for editora, editorb, editorc -- titles @@ -1374,7 +1333,7 @@ let isPeriodical = et == "periodical" let isChapterlike = et `elem` ["inbook","incollection","inproceedings","inreference","bookinbook"] - hasMaintitle <- (True <$ (getRawField "maintitle")) <|> return False + hasMaintitle <- (True <$ getRawField "maintitle") <|> return False let hyphenation' = if null hyphenation then defaultHyphenation else hyphenation @@ -1432,7 +1391,7 @@ shortTitle' <- (guard (not hasMaintitle || isChapterlike) >> getTitle "shorttitle") <|> if (subtitle' /= mempty || titleaddon' /= mempty) && - (not hasMaintitle) + not hasMaintitle then getShortTitle False "title" else getShortTitle True "title" <|> return mempty @@ -1447,7 +1406,7 @@ else getLiteralList' f) <|> return Nothing) ["school","institution","organization", "howpublished","publisher"] - let publisher' = concatWith ';' [p | Just p <- pubfields] + let publisher' = concatWith ';' $ catMaybes pubfields origpublisher' <- getField "origpublisher" <|> return mempty -- places @@ -1524,7 +1483,7 @@ keywords' <- getField "keywords" <|> return mempty note' <- if et == "periodical" then return mempty - else (getField "note" <|> return mempty) + else getField "note" <|> return mempty addendum' <- if bibtex then return mempty else getField "addendum" @@ -1542,8 +1501,8 @@ let takeDigits (Str xs : _) = case takeWhile isDigit xs of - [] -> [] - ds -> [Str ds] + [] -> [] + ds -> [Str ds] takeDigits x = x return $ emptyReference diff --git a/src/Text/CSL/Input/Bibutils.hs b/src/Text/CSL/Input/Bibutils.hs --- a/src/Text/CSL/Input/Bibutils.hs +++ b/src/Text/CSL/Input/Bibutils.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE CPP, ForeignFunctionInterface, PatternGuards #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Input.Bibutils @@ -18,51 +20,60 @@ , convertRefs ) where -import qualified Text.Pandoc.UTF8 as UTF8 -import Text.Pandoc hiding (readMarkdown) -import Text.CSL.Compat.Pandoc (readMarkdown) -import Data.Char -import System.FilePath ( takeExtension ) -import Text.CSL.Exception -import Text.CSL.Reference hiding ( Value ) -import Text.CSL.Input.Bibtex -import qualified Data.ByteString.Lazy as BL -import qualified Data.Map as M -import Data.Aeson -import qualified Control.Exception as E +import qualified Control.Exception as E +import Data.Aeson +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as BS +import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T +import qualified Data.Yaml as Yaml +import qualified Data.Vector as V +import Data.Char +import qualified Data.Map as M +import System.FilePath (takeExtension) +import Text.CSL.Compat.Pandoc (readMarkdown) +import Text.CSL.Exception +import Text.CSL.Input.Bibtex +import Text.CSL.Reference hiding (Value) +import Text.CSL.Util (parseString) +import Text.Pandoc hiding (readMarkdown) +import qualified Text.Pandoc.UTF8 as UTF8 #ifdef USE_BIBUTILS -import Control.Exception ( bracket, catch ) -import Control.Monad.Trans ( liftIO ) -import System.FilePath ( (), (<.>) ) -import System.IO.Error ( isAlreadyExistsError ) -import System.Directory -import Text.Bibutils +import Control.Exception (bracket, catch) +import Control.Monad.Trans (liftIO) +import System.Directory +import System.FilePath ((<.>), ()) +import System.IO.Error (isAlreadyExistsError) +import Text.Bibutils #endif -- | Read a file with a bibliographic database. The database format --- is recognized by the file extension. +-- is recognized by the file extension. The first argument is +-- a predicate to filter citation identifiers. -- -- Supported formats are: @json@, @mods@, @bibtex@, @biblatex@, @ris@, -- @endnote@, @endnotexml@, @isi@, @medline@, and @copac@. -readBiblioFile :: FilePath -> IO [Reference] -readBiblioFile f +readBiblioFile :: (String -> Bool) -> FilePath -> IO [Reference] +readBiblioFile idpred f = case getExt f of ".json" -> BL.readFile f >>= either - (E.throwIO . ErrorReadingBibFile f) return . eitherDecode + (E.throwIO . ErrorReadingBibFile f) + (return . filterEntries idpred) . eitherDecode ".yaml" -> UTF8.readFile f >>= either - (E.throwIO . ErrorReadingBibFile f) return . readYamlBib - ".bib" -> readBibtex False True f - ".bibtex" -> readBibtex True True f - ".biblatex" -> readBibtex False True f + (E.throwIO . ErrorReadingBibFile f) return . + readYamlBib idpred + ".bib" -> readBibtex idpred False True f + ".bibtex" -> readBibtex idpred True True f + ".biblatex" -> readBibtex idpred False True f #ifdef USE_BIBUTILS - ".mods" -> readBiblioFile' f mods_in - ".ris" -> readBiblioFile' f ris_in - ".enl" -> readBiblioFile' f endnote_in - ".xml" -> readBiblioFile' f endnotexml_in - ".wos" -> readBiblioFile' f isi_in - ".medline" -> readBiblioFile' f medline_in - ".copac" -> readBiblioFile' f copac_in + ".mods" -> readBiblioFile' idpred f mods_in + ".ris" -> readBiblioFile' idpred f ris_in + ".enl" -> readBiblioFile' idpred f endnote_in + ".xml" -> readBiblioFile' idpred f endnotexml_in + ".wos" -> readBiblioFile' idpred f isi_in + ".medline" -> readBiblioFile' idpred f medline_in + ".copac" -> readBiblioFile' idpred f copac_in _ -> E.throwIO $ ErrorReadingBibFile f "the format of the bibliographic database could not be recognized from the file extension" #else _ -> E.throwIO $ ErrorReadingBibFile f "bibliography format not supported" @@ -84,14 +95,14 @@ #endif deriving Show -readBiblioString :: BibFormat -> String -> IO [Reference] -readBiblioString b s +readBiblioString :: (String -> Bool) -> BibFormat -> String -> IO [Reference] +readBiblioString idpred b s | Json <- b = either (E.throwIO . ErrorReadingBib) return $ eitherDecode $ UTF8.fromStringLazy s | Yaml <- b = either (E.throwIO . ErrorReadingBib) - return $ readYamlBib s - | Bibtex <- b = readBibtexString True True s - | BibLatex <- b = readBibtexString False True s + return $ readYamlBib idpred s + | Bibtex <- b = readBibtexString idpred True True s + | BibLatex <- b = readBibtexString idpred False True s #ifdef USE_BIBUTILS | Ris <- b = go ris_in | Endnote <- b = go endnote_in @@ -108,13 +119,13 @@ go f = withTempDir "citeproc" $ \tdir -> do let tfile = tdir "bibutils-tmp.biblio" UTF8.writeFile tfile s - readBiblioFile' tfile f + readBiblioFile' idpred tfile f #endif #ifdef USE_BIBUTILS -readBiblioFile' :: FilePath -> BiblioIn -> IO [Reference] -readBiblioFile' fin bin - | bin == biblatex_in = readBibtex False True fin +readBiblioFile' :: (String -> Bool) -> FilePath -> BiblioIn -> IO [Reference] +readBiblioFile' idpred fin bin + | bin == biblatex_in = readBibtex idpred False True fin | otherwise = withTempDir "citeproc" $ \tdir -> do let tfile = tdir "bibutils-tmp" @@ -128,7 +139,7 @@ _ <- bibl_write param bibl tfile bibl_free bibl bibl_freeparams param - refs <- readBibtex True False tfile + refs <- readBibtex idpred True False tfile return $! refs where handleBibfileError :: E.SomeException -> IO () handleBibfileError e = E.throwIO $ ErrorReadingBibFile fin (show e) @@ -152,11 +163,44 @@ getExt :: String -> String getExt = takeExtension . map toLower -readYamlBib :: String -> Either String [Reference] -readYamlBib s = - case readMarkdown s of +readYamlBib :: (String -> Bool) -> String -> Either String [Reference] +readYamlBib idpred s = + case readMarkdown s' of (Pandoc meta _) -> convertRefs (lookupMeta "references" meta) + where s' = addTop $ addBottom + $ UTF8.toString + $ selectEntries idpred + $ UTF8.fromString + $ s + addTop = ("---\n" ++) + addBottom = (++ "...\n") +selectEntries :: (String -> Bool) -> BS.ByteString -> BS.ByteString +selectEntries idpred bs = + case Yaml.decodeEither bs of + Right (Array vs) -> Yaml.encode (filterObjects $ V.toList vs) + Right (Object o) -> + case HM.lookup (T.pack "references") o of + Just (Array vs) -> + Yaml.encode (HM.insert (T.pack "references") + (filterObjects $ V.toList vs) mempty) + _ -> BS.empty + Right _ -> BS.empty + Left e -> E.throw $ ErrorParsingReferences e + where filterObjects = filter + (\x -> case x of + Object o -> + case HM.lookup (T.pack "id") o of + Just i -> + case Yaml.parseMaybe parseString i of + Just s -> idpred s + Nothing -> False + _ -> False + _ -> False) + +filterEntries :: (String -> Bool) -> [Reference] -> [Reference] +filterEntries idpred = filter (\r -> idpred (unLiteral (refId r))) + convertRefs :: Maybe MetaValue -> Either String [Reference] convertRefs Nothing = Right [] convertRefs (Just v) = @@ -167,14 +211,15 @@ -- references: -- ... case fromJSON (metaValueToJSON v) of - Success "" -> Right [] - _ -> Left s + Success "" -> Right [] + _ -> Left s Success x -> Right x metaValueToJSON :: MetaValue -> Value -metaValueToJSON (MetaMap m) = toJSON $ M.map metaValueToJSON m -metaValueToJSON (MetaList xs) = toJSON $ map metaValueToJSON xs -metaValueToJSON (MetaString t) = toJSON t -metaValueToJSON (MetaBool b) = toJSON b +metaValueToJSON (MetaMap m) = toJSON $ M.map metaValueToJSON m +metaValueToJSON (MetaList xs) = toJSON $ map metaValueToJSON xs +metaValueToJSON (MetaString t) = toJSON t +metaValueToJSON (MetaBool b) = toJSON b metaValueToJSON (MetaInlines ils) = toJSON ils -metaValueToJSON (MetaBlocks bs) = toJSON bs +metaValueToJSON (MetaBlocks bs) = toJSON bs + diff --git a/src/Text/CSL/Output/Pandoc.hs b/src/Text/CSL/Output/Pandoc.hs --- a/src/Text/CSL/Output/Pandoc.hs +++ b/src/Text/CSL/Output/Pandoc.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE PatternGuards, DeriveDataTypeable #-} + +{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Output.Pandoc @@ -24,12 +25,13 @@ , toCapital ) where -import Text.CSL.Util ( proc, proc', tailInline, lastInline, - initInline, tailFirstInlineStr, headInline, toCapital ) -import Data.Maybe ( fromMaybe ) -import Text.CSL.Style -import Text.Pandoc.Definition -import Text.Pandoc.XML (fromEntities) +import Data.Maybe (fromMaybe) +import Text.CSL.Style +import Text.CSL.Util (headInline, initInline, lastInline, + proc, proc', tailFirstInlineStr, + tailInline, toCapital) +import Text.Pandoc.Definition +import Text.Pandoc.XML (fromEntities) renderPandoc :: Style -> Formatted -> [Inline] renderPandoc sty @@ -47,7 +49,7 @@ clean' :: Style -> [Inline] -> [Inline] clean' _ [] = [] clean' sty (i:is) = - case (i:is) of + case i:is of (Str "" : rest) -> clean' sty rest (Str xs : Str ys : rest) -> clean' sty $ Str (xs ++ ys) : rest (Link a1 lab1 ('#':r1, "") : Str "\8211" : Link a2 lab2 ('#':r2, "") : rest) diff --git a/src/Text/CSL/Output/Plain.hs b/src/Text/CSL/Output/Plain.hs --- a/src/Text/CSL/Output/Plain.hs +++ b/src/Text/CSL/Output/Plain.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards #-} + ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Output.Plain @@ -17,9 +17,9 @@ ( renderPlain ) where -import Text.CSL.Style -import Text.CSL.Compat.Pandoc (writePlain) -import Text.Pandoc (Block(Plain), Pandoc(..), nullMeta) +import Text.CSL.Compat.Pandoc (writePlain) +import Text.CSL.Style +import Text.Pandoc (Block (Plain), Pandoc (..), nullMeta) -- | Render the 'Formatted' into a plain text string. renderPlain :: Formatted -> String diff --git a/src/Text/CSL/Pandoc.hs b/src/Text/CSL/Pandoc.hs --- a/src/Text/CSL/Pandoc.hs +++ b/src/Text/CSL/Pandoc.hs @@ -1,41 +1,46 @@ -{-# LANGUAGE PatternGuards, OverloadedStrings, FlexibleInstances, - ScopedTypeVariables, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} module Text.CSL.Pandoc (processCites, processCites') where -import Text.Pandoc -import Text.Pandoc.Walk -import Text.Pandoc.Builder (setMeta, deleteMeta) -import Text.Pandoc.Shared (stringify) -import Text.HTML.TagSoup.Entity (lookupEntity) -import qualified Data.ByteString.Lazy as L -import System.SetEnv (setEnv) -import System.Environment (getEnv) -import Control.Applicative ((<|>)) -import Data.Aeson -import Data.Char ( isDigit, isPunctuation, toLower, isSpace ) -import qualified Data.Map as M -import Text.CSL.Reference hiding (processCites, Value) -import Text.CSL.Input.Bibutils (readBiblioFile, convertRefs) -import Text.CSL.Style hiding (Cite(..), Citation(..)) -import Text.CSL.Proc -import Text.CSL.Output.Pandoc (renderPandoc, renderPandoc') -import qualified Text.CSL.Style as CSL -import Text.CSL.Parser -import Text.CSL.Output.Pandoc ( headInline, tailInline, initInline, - toCapital ) -import Text.CSL.Data (getDefaultCSL) -import Text.Parsec hiding (State, (<|>)) -import Control.Monad -import qualified Control.Exception as E -import Control.Monad.State -import System.FilePath -import System.Directory (getAppUserDataDirectory) -import Text.CSL.Util (findFile, splitStrWhen, tr', parseRomanNumeral, trim, - lastInline) -import Text.CSL.Exception -import System.IO.Error (isDoesNotExistError) -import Data.Maybe (fromMaybe) +import Control.Applicative ((<|>)) +import qualified Control.Exception as E +import Control.Monad +import Control.Monad.State +import Data.Aeson +import qualified Data.ByteString.Lazy as L +import Data.Char (isDigit, isPunctuation, isSpace, + toLower) +import qualified Data.Map as M +import qualified Data.Set as Set +import Data.Maybe (fromMaybe) +import System.Directory (getAppUserDataDirectory) +import System.Environment (getEnv) +import System.FilePath +import System.IO.Error (isDoesNotExistError) +import System.SetEnv (setEnv) +import Text.CSL.Data (getDefaultCSL) +import Text.CSL.Exception +import Text.CSL.Input.Bibutils (convertRefs, readBiblioFile) +import Text.CSL.Output.Pandoc (renderPandoc, renderPandoc', + headInline, initInline, tailInline, toCapital) +import Text.CSL.Parser +import Text.CSL.Proc +import Text.CSL.Reference hiding (Value, processCites) +import Text.CSL.Style hiding (Citation (..), Cite (..)) +import qualified Text.CSL.Style as CSL +import Text.CSL.Util (findFile, lastInline, + parseRomanNumeral, splitStrWhen, tr', + trim) +import Text.HTML.TagSoup.Entity (lookupEntity) +import Text.Pandoc +import Text.Pandoc.Builder (deleteMeta, setMeta) +import Text.Pandoc.Shared (stringify) +import Text.Pandoc.Walk +import Text.Parsec hiding (State, (<|>)) -- | Process a 'Pandoc' document by adding citations formatted -- according to a CSL style. Add a bibliography (if one is called @@ -75,7 +80,7 @@ (bs', True) -> bs' (_, False) -> case reverse bs of - (Header lev (id',classes,kvs) ys) : xs -> + Header lev (id',classes,kvs) ys : xs -> reverse xs ++ [Header lev (id',addUnNumbered classes,kvs) ys, Div ("refs",["references"],[]) refs] @@ -121,7 +126,7 @@ -- create a cite with to all the references. mkNociteWildcards :: [Reference] -> [[Citation]] -> [[Citation]] mkNociteWildcards refs nocites = - map (\citgrp -> expandStar citgrp) nocites + map expandStar nocites where expandStar cs = case [c | c <- cs , citationId c == "*"] of @@ -137,7 +142,7 @@ removeNocaseSpans :: Inline -> [Inline] removeNocaseSpans (Span ("",["nocase"],[]) xs) = xs -removeNocaseSpans x = [x] +removeNocaseSpans x = [x] -- | Process a 'Pandoc' document by adding citations formatted -- according to a CSL style. The style filename is derived from @@ -183,10 +188,14 @@ -- Note that LANG needs to be set for bibtex conversion: setEnv "LANG" "en-US.UTF-8" setEnv "LC_ALL" "en-US.UTF-8" - else do + else setEnv "LC_ALL" envlang - bibRefs <- getBibRefs $ maybe (MetaList []) id - $ lookupMeta "bibliography" meta + let citids = query getCitationIds (Pandoc meta blocks) + let idpred = if "*" `Set.member` citids + then const True + else (`Set.member` citids) + bibRefs <- getBibRefs idpred $ Data.Maybe.fromMaybe (MetaList []) + $ lookupMeta "bibliography" meta let refs = inlineRefs ++ bibRefs let cslAbbrevFile = lookupMeta "citation-abbreviations" meta >>= toPath let skipLeadingSpace = L.dropWhile (\s -> s == 32 || (s >= 9 && s <= 13)) @@ -208,13 +217,13 @@ toPath (MetaInlines ils) = Just $ stringify ils toPath _ = Nothing -getBibRefs :: MetaValue -> IO [Reference] -getBibRefs (MetaList xs) = concat `fmap` mapM getBibRefs xs -getBibRefs (MetaInlines xs) = getBibRefs (MetaString $ stringify xs) -getBibRefs (MetaString s) = do +getBibRefs :: (String -> Bool) -> MetaValue -> IO [Reference] +getBibRefs idpred (MetaList xs) = concat `fmap` mapM (getBibRefs idpred) xs +getBibRefs idpred (MetaInlines xs) = getBibRefs idpred (MetaString $ stringify xs) +getBibRefs idpred (MetaString s) = do path <- findFile ["."] s >>= maybe (E.throwIO $ CouldNotFindBibFile s) return - map unescapeRefId `fmap` readBiblioFile path -getBibRefs _ = return [] + map unescapeRefId `fmap` readBiblioFile idpred path +getBibRefs _ _ = return [] -- unescape reference ids, which may contain XML entities, so -- that we can do lookups with regular string equality @@ -248,19 +257,19 @@ processCite _ _ x = x isNote :: Inline -> Bool -isNote (Note _) = True +isNote (Note _) = True isNote (Cite _ [Note _]) = True -isNote _ = False +isNote _ = False mvPunctInsideQuote :: Inline -> Inline -> [Inline] mvPunctInsideQuote (Quoted qt ils) (Str s) | s `elem` [".", ","] = - [Quoted qt (init ils ++ (mvPunctInsideQuote (last ils) (Str s)))] + [Quoted qt (init ils ++ mvPunctInsideQuote (last ils) (Str s))] mvPunctInsideQuote il il' = [il, il'] isSpacy :: Inline -> Bool -isSpacy Space = True +isSpacy Space = True isSpacy SoftBreak = True -isSpacy _ = False +isSpacy _ = False mvPunct :: Bool -> Style -> [Inline] -> [Inline] mvPunct _ _ (x : Space : xs) @@ -306,7 +315,7 @@ where isEndPunct c = c `elem` (".,;:!?" :: String) startWithPunct :: [Inline] -> Bool -startWithPunct = and . map (`elem` (".,;:!?" :: String)) . headInline +startWithPunct = all (`elem` (".,;:!?" :: String)) . headInline deNote :: Pandoc -> Pandoc deNote = topDown go @@ -338,6 +347,10 @@ getCitation i | Cite t _ <- i = [t] | otherwise = [] +getCitationIds :: Inline -> Set.Set String +getCitationIds (Cite cs _) = Set.fromList (map citationId cs) +getCitationIds _ = mempty + setHashes :: Inline -> State Int Inline setHashes i | Cite t ils <- i = do t' <- mapM setHash t return $ Cite t' ils @@ -355,7 +368,7 @@ s' = case (la,lo,s) of -- treat a bare locator as if it begins with space -- so @item1 [blah] is like [@item1, blah] - ("","",(x:_)) + ("","",x:_) | not (isPunct x) -> Space : s _ -> s isPunct (Str (x:_)) = isPunctuation x @@ -375,8 +388,8 @@ locatorWords locMap inp = case parse (pLocatorWords locMap) "suffix" $ splitStrWhen (\c -> isLocatorPunct c || isSpace c) inp of - Right r -> r - Left _ -> ("","",inp) + Right r -> r + Left _ -> ("","",inp) pLocatorWords :: LocatorMap -> Parsec [Inline] st (String, String, [Inline]) pLocatorWords locMap = do @@ -437,12 +450,12 @@ t <- anyToken case t of Str (d:_) | isDigit d -> return () - _ -> mzero + _ -> mzero pLocatorPunct :: Parsec [Inline] st Inline pLocatorPunct = pMatch isLocatorPunct' where isLocatorPunct' (Str [c]) = isLocatorPunct c - isLocatorPunct' _ = False + isLocatorPunct' _ = False isLocatorPunct :: Char -> Bool isLocatorPunct ':' = False diff --git a/src/Text/CSL/Parser.hs b/src/Text/CSL/Parser.hs --- a/src/Text/CSL/Parser.hs +++ b/src/Text/CSL/Parser.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings, TupleSections #-} +{-# LANGUAGE OverloadedStrings #-} + ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Parser @@ -15,25 +16,25 @@ module Text.CSL.Parser (readCSLFile, parseCSL, parseCSL', parseLocale, localizeCSL) where -import qualified Data.Text as T -import qualified Data.ByteString.Lazy as L -import qualified Data.Map as M -import qualified Control.Exception as E -import Control.Monad (when) -import Data.Either (lefts, rights) -import Data.Text (Text, unpack) -import Text.CSL.Style hiding (parseNames) -import Text.CSL.Util (toRead, findFile) -import System.Directory (getAppUserDataDirectory) -import qualified Text.XML as X -import Data.Default -import Text.Pandoc.Shared (safeRead) -import Text.XML.Cursor -import Data.Maybe (listToMaybe, fromMaybe) -import Text.Pandoc.UTF8 (fromStringLazy) -import Text.CSL.Compat.Pandoc (fetchItem) -import Text.CSL.Data (getLocale) -import Text.CSL.Exception +import qualified Control.Exception as E +import Control.Monad (when) +import qualified Data.ByteString.Lazy as L +import Data.Default +import Data.Either (lefts, rights) +import qualified Data.Map as M +import Data.Maybe (fromMaybe, listToMaybe) +import Data.Text (Text, unpack) +import qualified Data.Text as T +import System.Directory (getAppUserDataDirectory) +import Text.CSL.Compat.Pandoc (fetchItem) +import Text.CSL.Data (getLocale) +import Text.CSL.Exception +import Text.CSL.Style hiding (parseNames) +import Text.CSL.Util (findFile, toRead) +import Text.Pandoc.Shared (safeRead) +import Text.Pandoc.UTF8 (fromStringLazy) +import qualified Text.XML as X +import Text.XML.Cursor -- | Parse a 'String' into a 'Style' (with default locale). parseCSL :: String -> Style @@ -65,15 +66,15 @@ let pickParentCur = get "link" >=> attributeIs (X.Name "rel" Nothing Nothing) "independent-parent" let parentCur = cur $/ get "info" &/ pickParentCur let parent' = concatMap (stringAttr "href") parentCur - when (parent' == src) $ do + when (parent' == src) $ E.throwIO $ DependentStyleHasItselfAsParent src case parent' of "" -> localizeCSL mbLocale $ parseCSLCursor cur y -> do -- note, we insert locale from the dependent style: let mbLocale' = case stringAttr "default-locale" cur of - "" -> mbLocale - x -> Just x + "" -> mbLocale + x -> Just x readCSLFile mbLocale' y parseCSL' :: L.ByteString -> Style @@ -104,7 +105,7 @@ defaultLocale = case cur $| laxAttribute "default-locale" of (x:_) -> unpack x [] -> "en-US" - author = case (cur $// get "info" &/ get "author") of + author = case cur $// get "info" &/ get "author" of (x:_) -> CSAuthor (x $/ get "name" &/ string) (x $/ get "email" &/ string) (x $/ get "uri" &/ string) @@ -129,9 +130,7 @@ attrWithDefault :: Read a => Text -> a -> Cursor -> a attrWithDefault t d cur = - case safeRead (toRead $ stringAttr t cur) of - Just x -> x - Nothing -> d + fromMaybe d $ safeRead (toRead $ stringAttr t cur) stringAttr :: Text -> Cursor -> String stringAttr t cur = @@ -178,16 +177,16 @@ case node cur of X.NodeElement e -> case X.nameLocalName $ X.elementName e of - "term" -> parseTerm cur - "text" -> parseText cur - "choose" -> parseChoose cur - "group" -> parseGroup cur - "label" -> parseLabel cur - "number" -> parseNumber cur + "term" -> parseTerm cur + "text" -> parseText cur + "choose" -> parseChoose cur + "group" -> parseGroup cur + "label" -> parseLabel cur + "number" -> parseNumber cur "substitute" -> parseSubstitute cur - "names" -> parseNames cur - "date" -> parseDate cur - _ -> [] + "names" -> parseNames cur + "date" -> parseDate cur + _ -> [] _ -> [] getFormatting :: Cursor -> Formatting @@ -220,7 +219,7 @@ _ -> NoFormDate format = getFormatting cur delim = stringAttr "delimiter" cur - parts = cur $/ get "date-part" &| (parseDatePart form) + parts = cur $/ get "date-part" &| parseDatePart form partsAttr = stringAttr "date-parts" cur parseDatePart :: DateForm -> Cursor -> DatePart @@ -228,13 +227,13 @@ DatePart { dpName = stringAttr "name" cur , dpForm = case stringAttr "form" cur of "" -> case defaultForm of - TextDate -> "long" + TextDate -> "long" NumericDate -> "numeric" - _ -> "long" + _ -> "long" x -> x , dpRangeDelim = case stringAttr "range-delimiter" cur of - "" -> "-" - x -> x + "" -> "-" + x -> x , dpFormatting = getFormatting cur } @@ -314,9 +313,7 @@ then [Macro macro formatting] else if not (null variable) then [Variable (words variable) textForm formatting delim] - else if not (null value) - then [Const value formatting] - else [] + else [Const value formatting | not (null value)] parseChoose :: Cursor -> [Element] parseChoose cur = @@ -390,8 +387,8 @@ (stringAttr "names-use-last" cur)] x -> [SortVariable x sorting] where sorting = case stringAttr "sort" cur of - "descending" -> Descending "" - _ -> Ascending "" + "descending" -> Descending "" + _ -> Ascending "" parseBiblio :: Cursor -> Bibliography parseBiblio cur = diff --git a/src/Text/CSL/Proc.hs b/src/Text/CSL/Proc.hs --- a/src/Text/CSL/Proc.hs +++ b/src/Text/CSL/Proc.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE PatternGuards, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Proc @@ -16,24 +17,24 @@ module Text.CSL.Proc where -import Control.Arrow ( (&&&), (>>>), second ) -import Data.Char ( toLower, isLetter, isDigit ) -import Data.List -import Data.Ord ( comparing ) -import Data.Maybe ( mapMaybe ) -import Text.CSL.Eval -import Text.CSL.Util ( proc, proc', query, uncamelize, tr' ) -import Text.CSL.Proc.Collapse -import Text.CSL.Proc.Disamb -import Text.CSL.Reference -import Text.CSL.Style -import Data.Aeson -import Control.Applicative ((<|>)) -import Text.Pandoc.Definition (Inline(Space, Str, Note), Block(Para)) - +import Control.Applicative ((<|>)) +import Control.Arrow (second, (&&&), (>>>)) +import Data.Aeson +import Data.Char (isDigit, isLetter, toLower) +import Data.List +import Data.Maybe (mapMaybe) +import Data.Ord (comparing) +import Text.CSL.Eval +import Text.CSL.Proc.Collapse +import Text.CSL.Proc.Disamb +import Text.CSL.Reference +import Text.CSL.Style +import Text.CSL.Util (proc, proc', query, tr', uncamelize) +import Text.Pandoc.Definition (Block (Para), + Inline (Note, Space, Str)) data ProcOpts = ProcOpts - { bibOpts :: BibOpts + { bibOpts :: BibOpts , linkCitations :: Bool } deriving ( Show, Read, Eq ) @@ -125,13 +126,15 @@ OCitNum n f{hyperlink = "#ref-" ++ citeid} addLink' citeid (OCitLabel l f) = OCitLabel l f{hyperlink = "#ref-" ++ citeid} + addLink' citeid (Output xs@(OStr _ _: _) f) = + Output xs f{hyperlink = "#ref-" ++ citeid} addLink' _ x = x -- | Given the CSL 'Style' and the list of 'Reference's sort the list -- according to the 'Style' and assign the citation number to each -- 'Reference'. procRefs :: Style -> [Reference] -> [Reference] -procRefs (Style {biblio = mb, csMacros = ms , styleLocale = l, styleAbbrevs = as, csOptions = opts}) rs +procRefs Style {biblio = mb, csMacros = ms , styleLocale = l, styleAbbrevs = as, csOptions = opts} rs = maybe (setCNum rs) process mb where opts' b = mergeOptions (bibOptions b) opts @@ -156,8 +159,8 @@ -- | With a 'Style' and a sorted list of 'Reference's produce the -- evaluated output for the bibliography. procBiblio :: BibOpts -> Style -> [Reference] -> [[Output]] -procBiblio bos (Style {biblio = mb, csMacros = ms , styleLocale = l, - styleAbbrevs = as, csOptions = opts}) rs +procBiblio bos Style {biblio = mb, csMacros = ms , styleLocale = l, + styleAbbrevs = as, csOptions = opts} rs = map addSpaceAfterCitNum $ maybe [] process mb where -- handle second-field-align (sort of) @@ -196,7 +199,7 @@ getPartialEach x xs = concat . take 1 . map fst . sortBy (flip (comparing $ length . snd)) . filter ((<) 0 . length . snd) . - zip xs . map (takeWhile id . map (uncurry (==)) . zip x) $ xs + zip xs . map (takeWhile id . zipWith (==) x) $ xs chkCreator = if subAuthRule == "partial-each" then chPartialEach [] else chkCr [] @@ -264,15 +267,15 @@ | otherwise = refs where quash [] _ = True - quash q r = not . and . flip map q $ \(f,v) -> lookup_ r f v - select s r = and . flip map s $ \(f,v) -> lookup_ r f v - include i r = or . flip map i $ \(f,v) -> lookup_ r f v - exclude e r = and . flip map e $ \(f,v) -> not $ lookup_ r f v - lookup_ r f v = case f of - "type" -> look "ref-type" - "id" -> look "ref-id" - "categories" -> look "categories" - x -> look x + quash q r = not $ all (lookup_ r) q + select s r = all (lookup_ r) s + include i r = any (lookup_ r) i + exclude e r = all (not . lookup_ r) e + lookup_ r (f, v) = case f of + "type" -> look "ref-type" + "id" -> look "ref-id" + "categories" -> look "categories" + x -> look x where look s = case lookup s (mkRefMap (Just r)) of Just x | Just v' <- (fromValue x :: Maybe RefType ) -> v == uncamelize (show v') @@ -286,8 +289,8 @@ -- 'Reference's, generate a 'CitationGroup'. The citations are sorted -- according to the 'Style'. procGroup :: Style -> [(Cite, Maybe Reference)] -> CitationGroup -procGroup (Style {citation = ct, csMacros = ms , styleLocale = l, - styleAbbrevs = as, csOptions = opts}) cr +procGroup Style {citation = ct, csMacros = ms , styleLocale = l, + styleAbbrevs = as, csOptions = opts} cr = CG authIn (layFormat $ citLayout ct) (layDelim $ citLayout ct) (authIn ++ co) where (co, authIn) = case cr of @@ -318,10 +321,10 @@ combine (Formatted []) ys = ys combine xs ys = case ys of - Formatted [] -> xs + Formatted [] -> xs Formatted (Note _ : _) -> xs <> ys - Formatted (Str [c]:_) | c `elem` (", ;:" :: String) -> xs <> ys - _ -> xs <> Formatted [Space] <> ys + Formatted (Str [c]:_) | c `elem` (", ;:" :: String) -> xs <> ys + _ -> xs <> Formatted [Space] <> ys formatAuth = formatOutput . localMod formatCits = (if isNote then toNote else id) . formatOutputList . appendOutput formatting . addAffixes f . @@ -331,7 +334,7 @@ verticalAlign = if isAuthorInText cs then "" else verticalAlign f } - isAuthorInText [] = False + isAuthorInText [] = False isAuthorInText ((c,_):_) = authorInText c localMod = uncurry $ localModifiers s (not $ null co) setAsSupAu h = map $ \(c,o) -> if (citeId c, citeHash c) == h diff --git a/src/Text/CSL/Proc/Collapse.hs b/src/Text/CSL/Proc/Collapse.hs --- a/src/Text/CSL/Proc/Collapse.hs +++ b/src/Text/CSL/Proc/Collapse.hs @@ -16,16 +16,16 @@ module Text.CSL.Proc.Collapse where -import Data.Ord (comparing) -import Data.Monoid (Any(..)) -import Control.Arrow ( (&&&), (>>>), second ) -import Data.Char -import Data.List ( groupBy, sortBy ) -import Text.CSL.Util ( query, proc, proc', betterThan ) -import Text.CSL.Eval -import Text.CSL.Proc.Disamb -import Text.CSL.Style hiding (Any) -import Text.Pandoc.Definition ( Inline (Str) ) +import Control.Arrow (second, (&&&), (>>>)) +import Data.Char +import Data.List (groupBy, sortBy) +import Data.Monoid (Any (..)) +import Data.Ord (comparing) +import Text.CSL.Eval +import Text.CSL.Proc.Disamb +import Text.CSL.Style hiding (Any) +import Text.CSL.Util (betterThan, proc, proc', query) +import Text.Pandoc.Definition (Inline (Str)) -- | Collapse citations according to the style options. collapseCitGroups :: Style -> [CitationGroup] -> [CitationGroup] @@ -56,7 +56,7 @@ citNums (OCitNum i _) = [i] citNums (Output xs _) = concatMap citNums xs citNums _ = [] - numOf = foldr (\x _ -> x) 0 . citNums + numOf = foldr const 0 . citNums process xs = if hasLocator xs then xs else flip concatMap (groupConsecWith numOf xs) @@ -129,7 +129,7 @@ uncurry zip . second format . unzip $ a doCollapse [] = [] - doCollapse (x:[]) = [collapsYS x] + doCollapse [x] = [collapsYS x] doCollapse (x:xs) = let (a,b) = collapsYS x in if length x > 1 then (a, Output (b : [ODel afterColDel]) emptyFormatting) : doCollapse xs @@ -166,10 +166,10 @@ null (citeLocator $ fst b) getYS [] = [] - getYS (x:[]) = return $ uncurry addCiteAffixes x + getYS [x] = return $ uncurry addCiteAffixes x getYS (x:xs) = if ranged - then proc rmOYearSuf (snd x) : addDelim ysd (processYS $ (snd x) : query rmOYear (map snd xs)) - else addDelim ysd $ (snd x) : (processYS $ query rmOYear (map snd xs)) + then proc rmOYearSuf (snd x) : addDelim ysd (processYS $ snd x : query rmOYear (map snd xs)) + else addDelim ysd $ snd x : processYS (query rmOYear (map snd xs)) rmOYearSuf o | OYearSuf {} <- o = ONull | otherwise = o @@ -183,7 +183,7 @@ getOYS o | OYearSuf s _ _ f <- o = [(if s /= [] then ord (head s) else 0, f)] | otherwise = [] - sufOf = foldr (\x _ -> x) (0,emptyFormatting) . query getOYS + sufOf = foldr const (0,emptyFormatting) . query getOYS newSuf = map sufOf >>> (map fst >>> groupConsec) &&& map snd >>> uncurry zip process xs = flip concatMap (newSuf xs) $ \(x,f) -> if length x > 2 @@ -215,7 +215,7 @@ isNumStyle :: [Output] -> Bool isNumStyle = getAny . query ocitnum where - ocitnum (OCitNum {}) = Any True + ocitnum OCitNum {} = Any True ocitnum _ = Any False -- | Group consecutive integers: @@ -227,7 +227,7 @@ groupConsecWith :: (a -> Int) -> [a] -> [[a]] groupConsecWith f = foldr go [] . sortBy (comparing f) where go x [] = [[x]] - go x ((y:ys):gs) = if (f x + 1) == (f y) - then ((x:y:ys):gs) - else ([x]:(y:ys):gs) + go x ((y:ys):gs) = if (f x + 1) == f y + then (x:y:ys):gs + else [x]:(y:ys):gs go _ ([]:_) = error "groupConsec: head of list is empty" diff --git a/src/Text/CSL/Proc/Disamb.hs b/src/Text/CSL/Proc/Disamb.hs --- a/src/Text/CSL/Proc/Disamb.hs +++ b/src/Text/CSL/Proc/Disamb.hs @@ -21,16 +21,16 @@ module Text.CSL.Proc.Disamb where -import Control.Arrow ( (&&&), (>>>), second ) -import Data.List ( elemIndex, find, findIndex, sortBy, mapAccumL - , nub, nubBy, groupBy, isPrefixOf ) -import Data.Maybe -import Data.Ord ( comparing ) +import Control.Arrow (second, (&&&), (>>>)) +import Data.List (elemIndex, find, findIndex, groupBy, + isPrefixOf, mapAccumL, nub, nubBy, sortBy) +import Data.Maybe +import Data.Ord (comparing) -import Text.CSL.Eval -import Text.CSL.Reference -import Text.CSL.Style -import Text.CSL.Util (query, proc) +import Text.CSL.Eval +import Text.CSL.Reference +import Text.CSL.Style +import Text.CSL.Util (proc, query) -- | Given the 'Style', the list of references and the citation -- groups, disambiguate citations according to the style options. @@ -58,12 +58,12 @@ hasYSuffOpt = "disambiguate-add-year-suffix" `elem` disOpts giveNameDisamb = case getOptionVal "givenname-disambiguation-rule" (citOptions (citation s)) of - "by-cite" -> ByCite - "all-names" -> AllNames - "all-names-with-initials" -> AllNames - "primary-name" -> PrimaryName + "by-cite" -> ByCite + "all-names" -> AllNames + "all-names-with-initials" -> AllNames + "primary-name" -> PrimaryName "primary-name-with-initials" -> PrimaryName - _ -> ByCite -- default as of CSL 1.0 + _ -> ByCite -- default as of CSL 1.0 clean = if hasGNameOpt then id else proc rmHashAndGivenNames withNames = flip map duplics $ same . clean . map (if hasNamesOpt then disambData else return . disambYS) @@ -234,8 +234,8 @@ -- allow title to disambiguate xs -> xs years o = case query getYears o of - [] -> [([],[])] - r -> r + [] -> [([],[])] + r -> r zipData = uncurry . zipWith $ \c y -> if key c /= [] then c {citYear = snd y} else c {key = fst y @@ -408,11 +408,11 @@ -- | Removes all given names and name hashes from OName elements. rmHashAndGivenNames :: Output -> Output rmHashAndGivenNames (OName _ s _ f) = OName emptyAgent s [] f -rmHashAndGivenNames o = o +rmHashAndGivenNames o = o rmGivenNames :: Output -> Output rmGivenNames (OName a s _ f) = OName a s [] f -rmGivenNames o = o +rmGivenNames o = o -- | Add, with 'proc', a give name to the family name. Needed for -- disambiguation. diff --git a/src/Text/CSL/Reference.hs b/src/Text/CSL/Reference.hs --- a/src/Text/CSL/Reference.hs +++ b/src/Text/CSL/Reference.hs @@ -1,11 +1,17 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, OverloadedStrings, - DeriveDataTypeable, ExistentialQuantification, FlexibleInstances, - ScopedTypeVariables, GeneralizedNewtypeDeriving, IncoherentInstances, - DeriveGeneric, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE IncoherentInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} #if MIN_VERSION_base(4,8,0) #define OVERLAPS {-# OVERLAPPING #-} #else -{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE OverlappingInstances #-} #define OVERLAPS #endif ----------------------------------------------------------------------------- @@ -33,7 +39,6 @@ , handleLiteral , toDatePart , setCirca - , mkRefDate , RefType(..) , CNum(..) , CLabel(..) @@ -44,39 +49,44 @@ , processCites , setPageFirst , setNearNote + , parseEDTFDate ) where -import Control.Monad ( guard, mplus ) -import Data.List ( elemIndex, intercalate ) -import Data.List.Split ( splitWhen ) -import Data.Maybe ( fromMaybe, isJust, isNothing ) -import Data.Generics hiding (Generic) -import GHC.Generics (Generic) -import Data.Aeson hiding (Value) -import qualified Data.Aeson as Aeson -import Data.Aeson.Types (Parser) -import qualified Data.Yaml.Builder as Y -import Data.Yaml.Builder (ToYaml(..)) -import Data.Either (lefts, rights) -import Control.Applicative ((<|>)) -import qualified Data.Text as T -import Data.Text (Text) -import qualified Data.Vector as V -import Data.Char (toLower, isDigit) -import Text.CSL.Style hiding (Number) -import Text.CSL.Util (parseString, parseInt, parseBool, safeRead, readNum, - inlinesToString, capitalize, camelize, uncamelize, - (&=), mapping') -import Text.Pandoc (Inline(Str)) -import Data.String -import qualified Text.Parsec as P -import qualified Text.Parsec.String as P +import Control.Applicative ((<|>)) +import Control.Monad (guard, mplus) +import Data.Aeson hiding (Value) +import qualified Data.Aeson as Aeson +import Data.Aeson.Types (Parser) +import Data.Char (isDigit, toLower) +import Data.Either (lefts, rights) +import Data.Generics hiding (Generic) import qualified Data.HashMap.Strict as H +import Data.List (elemIndex, intercalate) +import Data.List.Split (splitWhen) +import Data.Maybe (fromMaybe, isNothing) +import Data.String +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Vector as V +import Data.Yaml.Builder (ToYaml (..)) +import qualified Data.Yaml.Builder as Y +import GHC.Generics (Generic) +import Text.CSL.Style hiding (Number) +import Text.CSL.Util (camelize, capitalize, inlinesToString, + mapping', parseBool, parseInt, parseMaybeInt, + parseString, readNum, safeRead, trim, + uncamelize, AddYaml(..)) +import Text.Pandoc (Inline (Str)) +import qualified Text.Parsec as P +import qualified Text.Parsec.String as P newtype Literal = Literal { unLiteral :: String } deriving ( Show, Read, Eq, Data, Typeable, Monoid, Generic ) +instance AddYaml Literal + where x &= (Literal y) = x &= (T.pack y) + instance FromJSON Literal where parseJSON v = Literal `fmap` parseString v @@ -123,41 +133,46 @@ data Empty = Empty deriving ( Typeable, Data, Generic ) data RefDate = - RefDate { year :: Literal - , month :: Literal - , season :: Literal - , day :: Literal + RefDate { year :: Maybe Int + , month :: Maybe Int + , season :: Maybe Int + , day :: Maybe Int , other :: Literal , circa :: Bool } deriving ( Show, Read, Eq, Typeable, Data, Generic ) +instance AddYaml RefDate where + _ &= (RefDate Nothing Nothing Nothing Nothing o _) | o == mempty = id + x &= y = x &= y + instance FromJSON RefDate where parseJSON (Array v) = handlePseudoMonths <$> case fromJSON (Array v) of - Success [y] -> RefDate <$> parseJSON y <*> - pure "" <*> pure "" <*> pure "" <*> pure "" <*> pure False - Success [y,m] -> RefDate <$> parseJSON y <*> parseJSON m <*> - pure "" <*> pure "" <*> pure "" <*> pure False - Success [y,m,d] -> RefDate <$> parseJSON y <*> parseJSON m <*> - pure "" <*> parseJSON d <*> pure "" <*> pure False + Success [y] -> RefDate <$> parseMaybeInt y <*> + pure Nothing <*> pure Nothing <*> pure Nothing <*> + pure "" <*> pure False + Success [y,m] -> RefDate <$> parseMaybeInt y <*> parseMaybeInt m <*> + pure Nothing <*> pure Nothing <*> pure "" <*> pure False + Success [y,m,d] -> RefDate <$> parseMaybeInt y <*> parseMaybeInt m <*> + pure Nothing <*> parseMaybeInt d <*> pure "" <*> pure False Error e -> fail $ "Could not parse RefDate: " ++ e _ -> fail "Could not parse RefDate" where handlePseudoMonths r = - case unLiteral (month r) of - "13" -> r{ month = mempty, season = Literal "1" } - "14" -> r{ month = mempty, season = Literal "2" } - "15" -> r{ month = mempty, season = Literal "3" } - "16" -> r{ month = mempty, season = Literal "4" } - "21" -> r{ month = mempty, season = Literal "1" } - "22" -> r{ month = mempty, season = Literal "2" } - "23" -> r{ month = mempty, season = Literal "3" } - "24" -> r{ month = mempty, season = Literal "4" } + case month r of + Just 13 -> r{ month = Nothing, season = Just 1 } + Just 14 -> r{ month = Nothing, season = Just 2 } + Just 15 -> r{ month = Nothing, season = Just 3 } + Just 16 -> r{ month = Nothing, season = Just 4 } + Just 21 -> r{ month = Nothing, season = Just 1 } + Just 22 -> r{ month = Nothing, season = Just 2 } + Just 23 -> r{ month = Nothing, season = Just 3 } + Just 24 -> r{ month = Nothing, season = Just 4 } _ -> r parseJSON (Object v) = RefDate <$> - v .:? "year" .!= "" <*> - v .:? "month" .!= "" <*> - v .:? "season" .!= "" <*> - v .:? "day" .!= "" <*> + (v .:? "year" >>= parseMaybeInt) <*> + (v .:? "month" >>= parseMaybeInt) <*> + (v .:? "season" >>= parseMaybeInt) <*> + (v .:? "day" >>= parseMaybeInt) <*> v .:? "literal" .!= "" <*> ((v .: "circa" >>= parseBool) <|> pure False) parseJSON _ = fail "Could not parse RefDate" @@ -174,13 +189,14 @@ -} instance ToYaml RefDate where - toYaml r = mapping' [ "year" &= year r - , "month" &= month r - , "season" &= season r - , "day" &= day r - , "literal" &= other r - , "circa" &= T.pack (if circa r then "1" else "") - ] + toYaml r = mapping' + [ "year" &= year r + , "month" &= month r + , "season" &= season r + , "day" &= day r + , "literal" &= other r + , "circa" &= circa r + ] instance OVERLAPS FromJSON [RefDate] where @@ -191,61 +207,55 @@ circa' <- (v .: "circa" >>= parseBool) <|> pure False season' <- v .:? "season" case dateParts of - Just (Array xs) | not (isJust raw') && not (V.null xs) + Just (Array xs) | isNothing raw' && not (V.null xs) -> mapM (fmap (setCirca circa' . - maybe id setSeason season') . parseJSON) + maybe id setSeason season') . parseJSON) $ V.toList xs _ -> case raw' of Nothing -> handleLiteral <$> parseJSON (Object v) Just r -> return $ parseRawDate r parseJSON x = parseRawDate <$> parseJSON x +instance OVERLAPS + ToJSON [RefDate] where + toJSON [] = Array V.empty + toJSON xs = object' $ + case filter (not . null) (map toDatePart xs) of + [] -> ["literal" .= intercalate "; " (map (unLiteral . other) xs)] + dps -> "date-parts" .= dps : + ["circa" .= (1 :: Int) | any circa xs] + + -- Zotero doesn't properly support date ranges, so a common -- workaround is 2005_2007 or 2005_; support this as date range: handleLiteral :: RefDate -> [RefDate] -handleLiteral d@(RefDate (Literal "") (Literal "") (Literal "") - (Literal "") (Literal xs) b) +handleLiteral d@(RefDate Nothing Nothing Nothing Nothing (Literal xs) b) = case splitWhen (=='_') xs of [x,y] | all isDigit x && all isDigit y && not (null x) -> - [RefDate (Literal x) mempty mempty mempty mempty b, - RefDate (Literal y) mempty mempty mempty mempty b] + [RefDate (safeRead x) Nothing Nothing Nothing mempty b, + RefDate (safeRead y) Nothing Nothing Nothing mempty b] _ -> [d] handleLiteral d = [d] toDatePart :: RefDate -> [Int] toDatePart refdate = - case (safeRead (unLiteral $ year refdate), - safeRead (unLiteral $ month refdate) + case (year refdate, month refdate `mplus` - ((+ 12) <$> safeRead (unLiteral $ season refdate)), - safeRead (unLiteral $ day refdate)) of + ((+ 12) <$> season refdate), + day refdate) of (Just (y :: Int), Just (m :: Int), Just (d :: Int)) -> [y, m, d] (Just y, Just m, Nothing) -> [y, m] (Just y, Nothing, Nothing) -> [y] _ -> [] -instance OVERLAPS - ToJSON [RefDate] where - toJSON [] = Array V.empty - toJSON xs = object' $ - case filter (not . null) (map toDatePart xs) of - [] -> ["literal" .= intercalate "; " (map (unLiteral . other) xs)] - dps -> (["date-parts" .= dps ] ++ - ["circa" .= (1 :: Int) | or (map circa xs)]) - setCirca :: Bool -> RefDate -> RefDate setCirca circa' rd = rd{ circa = circa' } -setSeason :: Literal -> RefDate -> RefDate +setSeason :: Maybe Int -> RefDate -> RefDate setSeason season' rd = rd{ season = season' } -mkRefDate :: Literal -> Parser [RefDate] -mkRefDate z@(Literal xs) - | all isDigit xs = return [RefDate z mempty mempty mempty mempty False] - | otherwise = return [RefDate mempty mempty mempty mempty z False] - data RefType = NoType | Article @@ -292,12 +302,12 @@ -- found in one of the test cases: parseJSON (String "film") = return MotionPicture parseJSON (String t) = - (safeRead (capitalize . camelize . T.unpack $ t)) <|> + safeRead (capitalize . camelize . T.unpack $ t) <|> fail ("'" ++ T.unpack t ++ "' is not a valid reference type") parseJSON v@(Array _) = fmap (capitalize . camelize . inlinesToString) (parseJSON v) >>= \t -> - (safeRead t <|> - fail ("'" ++ t ++ "' is not a valid reference type")) + safeRead t <|> + fail ("'" ++ t ++ "' is not a valid reference type") parseJSON _ = fail "Could not parse RefType" instance ToJSON RefType where @@ -308,11 +318,11 @@ -- For some reason, CSL is inconsistent about hyphens and underscores: handleSpecialCases :: String -> String -handleSpecialCases "motion-picture" = "motion_picture" -handleSpecialCases "musical-score" = "musical_score" +handleSpecialCases "motion-picture" = "motion_picture" +handleSpecialCases "musical-score" = "musical_score" handleSpecialCases "personal-communication" = "personal_communication" -handleSpecialCases "legal-case" = "legal_case" -handleSpecialCases x = x +handleSpecialCases "legal-case" = "legal_case" +handleSpecialCases x = x newtype CNum = CNum { unCNum :: Int } deriving ( Show, Read, Eq, Num, Typeable, Data, Generic ) @@ -343,81 +353,81 @@ -- | The 'Reference' record. data Reference = Reference - { refId :: Literal - , refType :: RefType + { refId :: Literal + , refType :: RefType - , author :: [Agent] - , editor :: [Agent] - , translator :: [Agent] - , recipient :: [Agent] - , interviewer :: [Agent] - , composer :: [Agent] - , director :: [Agent] - , illustrator :: [Agent] - , originalAuthor :: [Agent] - , containerAuthor :: [Agent] - , collectionEditor :: [Agent] - , editorialDirector :: [Agent] - , reviewedAuthor :: [Agent] + , author :: [Agent] + , editor :: [Agent] + , translator :: [Agent] + , recipient :: [Agent] + , interviewer :: [Agent] + , composer :: [Agent] + , director :: [Agent] + , illustrator :: [Agent] + , originalAuthor :: [Agent] + , containerAuthor :: [Agent] + , collectionEditor :: [Agent] + , editorialDirector :: [Agent] + , reviewedAuthor :: [Agent] - , issued :: [RefDate] - , eventDate :: [RefDate] - , accessed :: [RefDate] - , container :: [RefDate] - , originalDate :: [RefDate] - , submitted :: [RefDate] + , issued :: [RefDate] + , eventDate :: [RefDate] + , accessed :: [RefDate] + , container :: [RefDate] + , originalDate :: [RefDate] + , submitted :: [RefDate] - , title :: Formatted - , titleShort :: Formatted - , reviewedTitle :: Formatted - , containerTitle :: Formatted - , volumeTitle :: Formatted - , collectionTitle :: Formatted - , containerTitleShort :: Formatted - , collectionNumber :: Formatted --Int - , originalTitle :: Formatted - , publisher :: Formatted - , originalPublisher :: Formatted - , publisherPlace :: Formatted - , originalPublisherPlace :: Formatted - , authority :: Formatted - , jurisdiction :: Formatted - , archive :: Formatted - , archivePlace :: Formatted - , archiveLocation :: Formatted - , event :: Formatted - , eventPlace :: Formatted - , page :: Formatted - , pageFirst :: Formatted - , numberOfPages :: Formatted - , version :: Formatted - , volume :: Formatted - , numberOfVolumes :: Formatted --Int - , issue :: Formatted - , chapterNumber :: Formatted - , medium :: Formatted - , status :: Formatted - , edition :: Formatted - , section :: Formatted - , source :: Formatted - , genre :: Formatted - , note :: Formatted - , annote :: Formatted - , abstract :: Formatted - , keyword :: Formatted - , number :: Formatted - , references :: Formatted - , url :: Literal - , doi :: Literal - , isbn :: Literal - , issn :: Literal - , pmcid :: Literal - , pmid :: Literal - , callNumber :: Literal - , dimensions :: Literal - , scale :: Literal - , categories :: [Literal] - , language :: Literal + , title :: Formatted + , titleShort :: Formatted + , reviewedTitle :: Formatted + , containerTitle :: Formatted + , volumeTitle :: Formatted + , collectionTitle :: Formatted + , containerTitleShort :: Formatted + , collectionNumber :: Formatted --Int + , originalTitle :: Formatted + , publisher :: Formatted + , originalPublisher :: Formatted + , publisherPlace :: Formatted + , originalPublisherPlace :: Formatted + , authority :: Formatted + , jurisdiction :: Formatted + , archive :: Formatted + , archivePlace :: Formatted + , archiveLocation :: Formatted + , event :: Formatted + , eventPlace :: Formatted + , page :: Formatted + , pageFirst :: Formatted + , numberOfPages :: Formatted + , version :: Formatted + , volume :: Formatted + , numberOfVolumes :: Formatted --Int + , issue :: Formatted + , chapterNumber :: Formatted + , medium :: Formatted + , status :: Formatted + , edition :: Formatted + , section :: Formatted + , source :: Formatted + , genre :: Formatted + , note :: Formatted + , annote :: Formatted + , abstract :: Formatted + , keyword :: Formatted + , number :: Formatted + , references :: Formatted + , url :: Literal + , doi :: Literal + , isbn :: Literal + , issn :: Literal + , pmcid :: Literal + , pmid :: Literal + , callNumber :: Literal + , dimensions :: Literal + , scale :: Literal + , categories :: [Literal] + , language :: Literal , citationNumber :: CNum , firstReferenceNoteNumber :: Int @@ -505,8 +515,8 @@ v .:? "citation-label" .!= mempty) where takeFirstNum (Formatted (Str xs : _)) = case takeWhile isDigit xs of - [] -> mempty - ds -> Formatted [Str ds] + [] -> mempty + ds -> Formatted [Str ds] takeFirstNum x = x addPageFirst ref = if pageFirst ref == mempty && page ref /= mempty then ref{ pageFirst = @@ -858,7 +868,7 @@ = procGr [] cs where near_note = let nn = fromMaybe [] . lookup "near-note-distance" . citOptions . citation $ s - in if nn == [] then 5 else readNum nn + in if null nn then 5 else readNum nn procGr _ [] = [] procGr a (x:xs) = let (a',res) = procCs a x in res : procGr a' xs @@ -876,38 +886,72 @@ parseRawDate :: String -> [RefDate] parseRawDate o = case P.parse rawDate "raw date" o of - Left _ -> [RefDate mempty mempty mempty mempty (Literal o) False] + Left _ -> [RefDate Nothing Nothing Nothing Nothing (Literal o) False] Right ds -> ds rawDate :: P.Parser [RefDate] rawDate = rawDateISO <|> rawDateOld +parseEDTFDate :: String -> [RefDate] +parseEDTFDate o = + case handleRanges (trim o) of + [] -> [] + o' -> case P.parse rawDateISO "date" o' of + Left _ -> [] + Right ds -> ds + where handleRanges s = + case splitWhen (=='/') s of + -- 199u EDTF format for a range + [x] | 'u' `elem` x -> + map (\c -> if c == 'u' then '0' else c) x ++ "/" ++ + map (\c -> if c == 'u' then '9' else c) x + [x, "open"] -> x ++ "/" -- EDTF + [x, "unknown"] -> x ++ "/" -- EDTF + _ -> s + rawDateISO :: P.Parser [RefDate] rawDateISO = do d1 <- isoDate - P.option [d1] (P.char '/' >> (\x -> [d1, x]) <$> isoDate) + P.option [d1] (P.char '/' >> + (\x -> [d1, x]) <$> + ( isoDate <|> return emptydate )) <* P.eof + where emptydate = RefDate Nothing Nothing Nothing Nothing mempty False isoDate :: P.Parser RefDate isoDate = P.try $ do + extyear <- P.option False (True <$ P.char 'y') -- EDTF year > 4 digits + -- needed for bibtex y <- do sign <- P.option "" (P.string "-") rest <- P.count 4 P.digit - return $ sign ++ rest + extended <- if extyear + then P.many P.digit + else return [] + return $ case safeRead (sign ++ rest ++ extended) of + Just x | x <= 0 -> Just (x - 1) -- 0 = -1 AD + x -> x m' <- P.option Nothing $ Just <$> P.try (P.char '-' >> P.many1 P.digit) (m,s) <- case m' >>= safeRead of Just (n::Int) - | n >= 1 && n <= 12 -> return (show n, "") - | n >= 13 && n <= 16 -> return ("", show (n - 12)) - | n >= 21 && n <= 24 -> return ("", show (n - 20)) - Nothing | isNothing m' -> return ("", "") + | n >= 1 && n <= 12 -> return (Just n, Nothing) + | n >= 13 && n <= 16 -> return (Nothing, Just (n - 12)) + | n >= 21 && n <= 24 -> return (Nothing, Just (n - 20)) + Nothing | isNothing m' -> return (Nothing, Nothing) _ -> fail "Improper month" - d <- P.option Nothing $ Just <$> P.try (P.char '-' >> P.many1 P.digit) - guard $ isNothing d || case d >>= safeRead of - Just (n::Int) | n >= 1 && n <= 31 -> True - _ -> False + d <- P.option Nothing $ safeRead <$> P.try (P.char '-' >> P.many1 P.digit) + guard $ case d of + Nothing -> True + Just (n::Int) | n >= 1 && n <= 31 -> True + _ -> False + P.optional $ do + _ <- P.char 'T' + _ <- P.many (P.digit <|> P.char ':') + P.optional $ (P.oneOf "+-" >> P.many1 (P.digit <|> P.char ':')) + <|> P.string "Z" + _ <- P.optional (P.char '?') c <- P.option False (True <$ P.char '~') - return RefDate{ year = Literal y, month = Literal m, - season = Literal s, day = maybe mempty Literal d, + return RefDate{ year = y, month = m, + season = s, day = d, other = mempty, circa = c } rawDateOld :: P.Parser [RefDate] @@ -919,43 +963,43 @@ xs <- P.many1 P.letter <|> P.many1 P.digit if all isDigit xs then case safeRead xs of - Just (n::Int) | n >= 1 && n <= 12 -> return (show n) + Just (n::Int) | n >= 1 && n <= 12 -> return (Just n) _ -> fail "Improper month" else case elemIndex (map toLower $ take 3 xs) months of Nothing -> fail "Improper month" - Just n -> return (show (n+1)) + Just n -> return (Just (n+1)) let pseason = P.try $ do xs <- P.many1 P.letter case elemIndex (map toLower $ take 3 xs) seasons of Nothing -> fail "Improper season" - Just n -> return (show (n+1)) + Just n -> return (Just (n+1)) let pday = P.try $ do xs <- P.many1 P.digit case safeRead xs of - Just (n::Int) | n >= 1 && n <= 31 -> return (show n) + Just (n::Int) | n >= 1 && n <= 31 -> return (Just n) _ -> fail "Improper day" - let pyear = P.many1 P.digit + let pyear = safeRead <$> P.many1 P.digit let sep = P.oneOf [' ','/',','] >> P.spaces let rangesep = P.try $ P.spaces >> P.char '-' >> P.spaces - let refDate = RefDate mempty mempty mempty mempty mempty False + let refDate = RefDate Nothing Nothing Nothing Nothing mempty False let date = P.choice $ map P.try [ (do s <- pseason sep y <- pyear - return refDate{ year = Literal y, season = Literal s }) + return refDate{ year = y, season = s }) , (do m <- pmonth sep d <- pday sep y <- pyear - return refDate{ year = Literal y, month = Literal m, - day = Literal d }) + return refDate{ year = y, month = m, day = d }) , (do m <- pmonth sep y <- pyear - return refDate{ year = Literal y, month = Literal m }) + return refDate{ year = y, month = m }) , (do y <- pyear - return refDate{ year = Literal y }) + return refDate{ year = y }) ] d1 <- date P.option [d1] ((\x -> [d1,x]) <$> (rangesep >> date)) + diff --git a/src/Text/CSL/Style.hs b/src/Text/CSL/Style.hs --- a/src/Text/CSL/Style.hs +++ b/src/Text/CSL/Style.hs @@ -1,10 +1,16 @@ -{-# LANGUAGE OverloadedStrings, PatternGuards, DeriveDataTypeable, - ScopedTypeVariables, FlexibleInstances, DeriveGeneric, - GeneralizedNewtypeDeriving, CPP, MultiParamTypeClasses #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} + +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} #if MIN_VERSION_base(4,8,0) #define OVERLAPS {-# OVERLAPPING #-} #else -{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE OverlappingInstances #-} #define OVERLAPS #endif ----------------------------------------------------------------------------- @@ -86,41 +92,43 @@ ) where -import Data.Aeson hiding (Number) -import GHC.Generics (Generic) -import Data.String -import Control.Arrow hiding (left, right) -import Control.Monad (liftM, mplus) -import Control.Applicative ((<|>)) -import qualified Data.Aeson as Aeson -import Data.Aeson.Types (Pair) -import Data.List ( nubBy, isPrefixOf, isInfixOf, intersperse, intercalate ) -import Data.List.Split ( splitWhen, wordsBy ) -import Data.Generics ( Data, Typeable ) -import Data.Maybe ( listToMaybe ) -import qualified Data.Map as M -import Data.Char (isPunctuation, isUpper, isLetter) -import Text.CSL.Util (mb, parseBool, parseString, (.#?), (.#:), query, - betterThan, trimr, tailInline, headInline, - initInline, lastInline, splitStrWhen, mapping', - (&=)) -import Data.Yaml.Builder(ToYaml(..)) -import qualified Data.Yaml.Builder as Y -import Text.Pandoc.Definition hiding (Citation, Cite) -import Text.Pandoc (bottomUp) -import Text.CSL.Compat.Pandoc (readHtml, writeMarkdown) -import qualified Text.Pandoc.Walk as Walk -import qualified Text.Pandoc.Builder as B -import qualified Data.Text as T -import Text.Pandoc.XML (fromEntities) +import Control.Applicative ((<|>), (<$>)) +import Control.Arrow hiding (left, right) +import Control.Monad (mplus) +import Data.Aeson hiding (Number) +import qualified Data.Aeson as Aeson +import Data.Aeson.Types (Pair) +import Data.Char (isLetter, isPunctuation, isUpper) +import Data.Generics (Data, Typeable) +import Data.List (intercalate, intersperse, isInfixOf, + isPrefixOf, nubBy) +import Data.List.Split (splitWhen, wordsBy) +import qualified Data.Map as M +import Data.Maybe (listToMaybe, isNothing) +import Data.String +import qualified Data.Text as T +import Data.Yaml.Builder (ToYaml (..)) +import qualified Data.Yaml.Builder as Y +import GHC.Generics (Generic) +import Text.CSL.Compat.Pandoc (readHtml, writeMarkdown) +import Text.CSL.Util (betterThan, headInline, initInline, + lastInline, mapping', mb, parseBool, + parseString, query, splitStrWhen, + tailInline, trimr, (.#:), (.#?), + AddYaml(..)) +import Text.Pandoc (bottomUp) +import qualified Text.Pandoc.Builder as B +import Text.Pandoc.Definition hiding (Citation, Cite) +import qualified Text.Pandoc.Walk as Walk +import Text.Pandoc.XML (fromEntities) #ifdef UNICODE_COLLATION -import qualified Data.Text as T -import qualified Data.Text.ICU as T +import qualified Data.Text as T +import qualified Data.Text.ICU as T #else -import Data.RFC5051 (compareUnicode) +import Data.RFC5051 (compareUnicode) #endif -import qualified Data.Vector as V +import qualified Data.Vector as V -- Note: FromJSON reads HTML, ToJSON writes Markdown. -- This means that they aren't proper inverses of each other, which @@ -131,9 +139,9 @@ readCSLString :: String -> [Inline] readCSLString s = Walk.walk handleSmallCapsSpans $ case readHtml (adjustScTags s) of - Pandoc _ [Plain ils] -> ils - Pandoc _ [Para ils] -> ils - Pandoc _ x -> Walk.query (:[]) x + Pandoc _ [Plain ils] -> ils + Pandoc _ [Para ils] -> ils + Pandoc _ x -> Walk.query (:[]) x -- this is needed for versions of pandoc that don't turn -- a span with font-variant:small-caps into a SmallCaps element: where handleSmallCapsSpans (Span ("",[],[("style",sty)]) ils) @@ -198,7 +206,7 @@ parseJSON v@(Array _) = Formatted <$> (parseJSON v <|> ((query (:[]) :: [Block] -> [Inline]) <$> parseJSON v)) - parseJSON v = fmap (Formatted . readCSLString) $ parseString v + parseJSON v = (Formatted . readCSLString) Control.Applicative.<$> parseString v instance ToJSON Formatted where toJSON = toJSON . writeCSLString . unFormatted @@ -209,6 +217,12 @@ instance IsString Formatted where fromString = Formatted . toStr +instance AddYaml Formatted where + x &= (Formatted y) = + \acc -> if null y + then acc + else (x Y..= Formatted y) : acc + instance Monoid Formatted where mempty = Formatted [] mappend = appendWithPunct @@ -216,7 +230,7 @@ instance Walk.Walkable Inline Formatted where walk f = Formatted . Walk.walk f . unFormatted - walkM f = liftM Formatted . Walk.walkM f . unFormatted + walkM f = fmap Formatted . Walk.walkM f . unFormatted query f = Walk.query f . unFormatted instance Walk.Walkable Formatted Formatted where @@ -241,7 +255,7 @@ appendWithPunct :: Formatted -> Formatted -> Formatted appendWithPunct (Formatted left) (Formatted right) = Formatted $ - case concat [lastleft, firstright] of + case lastleft ++ firstright of [' ',d] | d `elem` (",.:;" :: String) -> initInline left ++ right [c,d] | c `elem` (" ,.:;" :: String), d == c -> left ++ tailInline right [c,'.'] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right @@ -324,7 +338,7 @@ findTerm'' :: String -> Form -> Maybe Gender -> [CslTerm] -> Maybe CslTerm findTerm'' s f mbg ts = listToMaybe [ t | t <- ts, cslTerm t == s, termForm t == f, - mbg == Nothing || mbg == Just (termGenderForm t) ] + isNothing mbg || mbg == Just (termGenderForm t) ] `mplus` -- fallback: http://citationstyles.org/downloads/specification.html#terms case f of @@ -427,7 +441,7 @@ match :: Match -> [Bool] -> Bool match All = and match Any = or -match None = and . map not +match None = all not data DatePart = DatePart @@ -704,7 +718,7 @@ instance OVERLAPS FromJSON [[Cite]] where parseJSON (Array v) = mapM parseJSON $ V.toList v - parseJSON _ = return [] + parseJSON _ = return [] emptyCite :: Cite emptyCite = Cite [] mempty mempty [] [] [] [] False False False 0 @@ -764,11 +778,11 @@ object' :: [Pair] -> Aeson.Value object' = object . filter (not . isempty) - where isempty (_, Array v) = V.null v - isempty (_, String t) = T.null t + where isempty (_, Array v) = V.null v + isempty (_, String t) = T.null t isempty ("first-reference-note-number", Aeson.Number n) = n == 0 - isempty ("citation-number", Aeson.Number n) = n == 0 - isempty (_, _) = False + isempty ("citation-number", Aeson.Number n) = n == 0 + isempty (_, _) = False data Agent = Agent { givenName :: [Formatted] @@ -788,9 +802,9 @@ -- CSL JSON uses quotes to protect capitalization removeQuoted :: Formatted -> Formatted removeQuoted (Formatted ils) = Formatted (go ils) - where go [] = [] + where go [] = [] go (Quoted DoubleQuote ils' : xs) = ils' ++ go xs - go (x:xs) = x : go xs + go (x:xs) = x : go xs instance FromJSON Agent where parseJSON (Object v) = nameTransform <$> (Agent <$> @@ -866,18 +880,18 @@ startWithCapital' :: Inline -> Bool startWithCapital' (Str (c:_)) = isUpper c && isLetter c -startWithCapital' _ = False +startWithCapital' _ = False startWithCapital :: Formatted -> Bool startWithCapital (Formatted (x:_)) = startWithCapital' x -startWithCapital _ = False +startWithCapital _ = False stripFinalComma :: Formatted -> (String, Formatted) stripFinalComma (Formatted ils) = case reverse $ splitStrWhen isPunctuation ils of - Str ",":xs -> (",", Formatted $ reverse xs) + Str ",":xs -> (",", Formatted $ reverse xs) Str "!":Str ",":xs -> (",!", Formatted $ reverse xs) - _ -> ("", Formatted ils) + _ -> ("", Formatted ils) suffixTransform :: Agent -> Agent suffixTransform ag @@ -915,7 +929,8 @@ FromJSON [Agent] where parseJSON (Array xs) = mapM parseJSON $ V.toList xs parseJSON (Object v) = (:[]) `fmap` parseJSON (Object v) - parseJSON _ = fail "Could not parse [Agent]" + parseJSON _ = fail "Could not parse [Agent]" -- instance ToJSON [Agent] where -- toJSON xs = Array (V.fromList $ map toJSON xs) + diff --git a/src/Text/CSL/Util.hs b/src/Text/CSL/Util.hs --- a/src/Text/CSL/Util.hs +++ b/src/Text/CSL/Util.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE ScopedTypeVariables, PatternGuards, FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} module Text.CSL.Util ( safeRead , readNum @@ -16,6 +20,7 @@ , parseBool , parseString , parseInt + , parseMaybeInt , mb , (.#?) , (.#:) @@ -40,34 +45,35 @@ , mapHeadInline , tr' , findFile - , (&=) + , AddYaml(..) , mapping' , parseRomanNumeral , isRange ) where -import Data.Aeson -import Data.Aeson.Types (Parser) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Char (toLower, toUpper, isLower, isUpper, isPunctuation, isAscii) +import Control.Monad.State +import Data.Aeson +import Data.Aeson.Types (Parser) +import Data.Char (isAscii, isLower, isPunctuation, isUpper, + toLower, toUpper) +import Data.Generics (Data, Typeable, everything, everywhere, + everywhere', everywhereM, mkM, mkQ, mkT) +import Data.List.Split (wordsBy) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T import qualified Data.Traversable -import Text.Pandoc.Shared (safeRead, stringify) -import Text.Pandoc.Walk (walk) -import Text.Pandoc -import Data.List.Split (wordsBy) -import Control.Monad.State -import Data.Generics ( Typeable, Data, everywhere, everywhereM, mkM, - everywhere', everything, mkT, mkQ ) -import qualified Data.Set as Set -import System.FilePath -import System.Directory (doesFileExist) -import qualified Data.Yaml.Builder as Y -import Data.Yaml.Builder (ToYaml(..), YamlBuilder) -import qualified Text.Parsec as P +import Data.Yaml.Builder (ToYaml (..), YamlBuilder) +import qualified Data.Yaml.Builder as Y +import System.Directory (doesFileExist) +import System.FilePath +import Text.Pandoc +import Text.Pandoc.Shared (safeRead, stringify) +import Text.Pandoc.Walk (walk) +import qualified Text.Parsec as P #ifdef TRACE import qualified Debug.Trace -import Text.Show.Pretty (ppShow) +import Text.Show.Pretty (ppShow) #endif #ifdef TRACE @@ -93,7 +99,7 @@ sa <^> sb = sa ++ sb capitalize :: String -> String -capitalize [] = [] +capitalize [] = [] capitalize (c:cs) = toUpper c : cs isPunct :: Char -> Bool @@ -156,14 +162,28 @@ -- | Parse JSON value as Int. parseInt :: Value -> Parser Int -parseInt (String s) = case safeRead (T.unpack s) of - Just n -> return n - Nothing -> fail "Could not read Int" parseInt (Number n) = case fromJSON (Number n) of Success (x :: Int) -> return x - Error e -> fail $ "Could not read string: " ++ e -parseInt _ = fail "Could not read string" + Error e -> fail $ "Could not read Int: " ++ e +parseInt x = parseString x >>= \s -> + case safeRead s of + Just n -> return n + Nothing -> fail "Could not read Int" +-- | Parse JSON value as Maybe Int. +parseMaybeInt :: Maybe Value -> Parser (Maybe Int) +parseMaybeInt Nothing = return Nothing +parseMaybeInt (Just (Number n)) = case fromJSON (Number n) of + Success (x :: Int) -> return (Just x) + Error e -> fail $ "Could not read Int: " ++ e +parseMaybeInt (Just x) = + parseString x >>= \s -> + if null s + then return Nothing + else case safeRead s of + Just n -> return (Just n) + Nothing -> fail $ "Could not read as Int: " ++ show s + mb :: Monad m => (b -> m a) -> (Maybe b -> m (Maybe a)) mb = Data.Traversable.mapM @@ -175,7 +195,7 @@ x .#: y = (x .: y) >>= parseString onBlocks :: ([Inline] -> [Inline]) -> [Block] -> [Block] -onBlocks f bs = walk f' bs +onBlocks f = walk f' where f' (Para ils) = Para (f ils) f' (Plain ils) = Plain (f ils) f' x = x @@ -189,7 +209,7 @@ splitUpStr ils = case reverse (combineInternalPeriods (splitStrWhen (\c -> isPunctuation c || c == '\160') ils)) of - [] -> [] + [] -> [] (x:xs) -> reverse $ Span ("",["lastword"],[]) [x] : xs -- We want to make sure that the periods in www.example.com, for @@ -259,7 +279,7 @@ | isMixedCase s -> Str s | otherwise -> Str (toUpper x:xs) SentenceBoundary -> - if isMixedCase (x:xs) || (all isUpperOrPunct (x:xs)) + if isMixedCase (x:xs) || all isUpperOrPunct (x:xs) then Str (x:xs) else Str (toUpper x : xs) _ -> Str (x:xs) @@ -304,9 +324,7 @@ | c `elem` "-/\x2013\x2014\160" = do put WordBoundary return $ Str [c] : acc - | isPunctuation c = do - -- leave state unchanged - return $ Str [c] : acc + | isPunctuation c = return $ Str [c] : acc -- leave state unchanged go acc (Str []) = return acc go acc (Str xs) = do res <- xform (Str xs) @@ -316,7 +334,7 @@ b <- get case b of WordBoundary -> put LastWordBoundary - _ -> return () + _ -> return () go acc x go acc (Span ("",classes,[]) xs) | null classes || classes == ["nocase"] = do @@ -386,7 +404,7 @@ initInline :: [Inline] -> [Inline] initInline [] = [] -initInline (i:[]) +initInline [i] | Str s <- i = return $ Str (init' s) | Emph is <- i = return $ Emph (initInline is) | Strong is <- i = return $ Strong (initInline is) @@ -411,7 +429,7 @@ toCapital :: [Inline] -> [Inline] toCapital ils@(Span (_,["nocase"],_) _:_) = ils -toCapital ils = mapHeadInline capitalize ils +toCapital ils = mapHeadInline capitalize ils mapHeadInline :: (String -> String) -> [Inline] -> [Inline] mapHeadInline _ [] = [] @@ -443,12 +461,28 @@ then return $ Just (p f) else findFile ps f -(&=) :: (ToYaml a, Monoid a, Eq a) - => Text -> a -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)] -x &= y = \acc -> if y == mempty - then acc - else (x Y..= y) : acc +class AddYaml a where + (&=) :: Text -> a -> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)] +instance ToYaml a => AddYaml [a] where + x &= y = \acc -> if null y + then acc + else (x Y..= y) : acc + +instance ToYaml a => AddYaml (Maybe a) where + x &= y = \acc -> case y of + Nothing -> acc + Just z -> (x Y..= z) : acc + +instance AddYaml Text where + x &= y = \acc -> if T.null y + then acc + else (x Y..= y) : acc + +instance AddYaml Bool where + _ &= False = id + x &= True = \acc -> (x Y..= Y.bool True) : acc + mapping' :: [[(Text, YamlBuilder)] -> [(Text, YamlBuilder)]] -> YamlBuilder mapping' = Y.mapping . foldr ($) [] @@ -472,19 +506,19 @@ else lowercaseRomanDigits let [one, five, ten, fifty, hundred, fivehundred, thousand] = map P.char romanDigits - thousands <- P.many thousand >>= (return . (1000 *) . length) + thousands <- ((1000 *) . length) <$> P.many thousand ninehundreds <- P.option 0 $ P.try $ hundred >> thousand >> return 900 - fivehundreds <- P.many fivehundred >>= (return . (500 *) . length) + fivehundreds <- ((500 *) . length) <$> P.many fivehundred fourhundreds <- P.option 0 $ P.try $ hundred >> fivehundred >> return 400 - hundreds <- P.many hundred >>= (return . (100 *) . length) + hundreds <- ((100 *) . length) <$> P.many hundred nineties <- P.option 0 $ P.try $ ten >> hundred >> return 90 - fifties <- P.many fifty >>= (return . (50 *) . length) + fifties <- ((50 *) . length) <$> P.many fifty forties <- P.option 0 $ P.try $ ten >> fifty >> return 40 - tens <- P.many ten >>= (return . (10 *) . length) + tens <- ((10 *) . length) <$> P.many ten nines <- P.option 0 $ P.try $ one >> ten >> return 9 - fives <- P.many five >>= (return . (5 *) . length) + fives <- ((5 *) . length) <$> P.many five fours <- P.option 0 $ P.try $ one >> five >> return 4 - ones <- P.many one >>= (return . length) + ones <- length <$> P.many one let total = thousands + ninehundreds + fivehundreds + fourhundreds + hundreds + nineties + fifties + forties + tens + nines + fives + fours + ones diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -10,4 +10,7 @@ - '.' extra-deps: - rfc5051-0.1.0.3 -resolver: lts-10.0 +- pandoc-2.1 +- hslua-0.9.5 +- skylighting-0.5.1 +resolver: lts-10.2 diff --git a/tests/JSON.hs b/tests/JSON.hs --- a/tests/JSON.hs +++ b/tests/JSON.hs @@ -1,12 +1,12 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- ToJSON/FromJSON instances for Style module JSON where -import Data.Aeson -import Text.CSL.Style -import Text.CSL.Parser -import qualified Data.Text.Encoding as T +import Data.Aeson import qualified Data.ByteString.Lazy as L +import qualified Data.Text.Encoding as T +import Text.CSL.Parser +import Text.CSL.Style instance FromJSON Style where parseJSON (String s) = return $ parseCSL' $ L.fromChunks [T.encodeUtf8 s] - parseJSON _ = fail "Could not parse Style" + parseJSON _ = fail "Could not parse Style" diff --git a/tests/biblio2yaml/aksin.biblatex b/tests/biblio2yaml/aksin.biblatex --- a/tests/biblio2yaml/aksin.biblatex +++ b/tests/biblio2yaml/aksin.biblatex @@ -62,7 +62,7 @@ - family: Özkal given: Erhan issued: - - year: '2006' + - year: 2006 title: Effect of immobilization on catalytic characteristics of saturated Pd-N-heterocyclic carbenes in Mizoroki-Heck reactions container-title: J. Organomet. Chem. diff --git a/tests/biblio2yaml/almendro.biblatex b/tests/biblio2yaml/almendro.biblatex --- a/tests/biblio2yaml/almendro.biblatex +++ b/tests/biblio2yaml/almendro.biblatex @@ -54,7 +54,7 @@ - family: Nozal given: Fernando issued: - - year: '1998' + - year: 1998 title: Elektromagnetisches Signalhorn jurisdiction: France; United Kingdom; Germany annote: This is a patent entry with a location field. The number is given in the diff --git a/tests/biblio2yaml/angenendt.biblatex b/tests/biblio2yaml/angenendt.biblatex --- a/tests/biblio2yaml/angenendt.biblatex +++ b/tests/biblio2yaml/angenendt.biblatex @@ -47,7 +47,7 @@ - family: Angenendt given: Arnold issued: - - year: '2002' + - year: 2002 title: In Honore Salvatoris – Vom Sinn und Unsinn der Patrozinienkunde title-short: In Honore Salvatoris container-title: Revue d’Histoire Ecclésiastique diff --git a/tests/biblio2yaml/aristotle-anima.biblatex b/tests/biblio2yaml/aristotle-anima.biblatex --- a/tests/biblio2yaml/aristotle-anima.biblatex +++ b/tests/biblio2yaml/aristotle-anima.biblatex @@ -46,7 +46,7 @@ - family: Hicks given: Robert Drew issued: - - year: '1907' + - year: 1907 title: De anima publisher: Cambridge University Press publisher-place: Cambridge diff --git a/tests/biblio2yaml/aristotle-physics.biblatex b/tests/biblio2yaml/aristotle-physics.biblatex --- a/tests/biblio2yaml/aristotle-physics.biblatex +++ b/tests/biblio2yaml/aristotle-physics.biblatex @@ -46,7 +46,7 @@ - family: Cornford given: F. M. issued: - - year: '1929' + - year: 1929 title: Physics title-short: Physics publisher: G. P. Putnam diff --git a/tests/biblio2yaml/aristotle-poetics.biblatex b/tests/biblio2yaml/aristotle-poetics.biblatex --- a/tests/biblio2yaml/aristotle-poetics.biblatex +++ b/tests/biblio2yaml/aristotle-poetics.biblatex @@ -46,7 +46,7 @@ - family: Lucas given: D. W. issued: - - year: '1968' + - year: 1968 title: Poetics title-short: Poetics collection-title: Clarendon Aristotle diff --git a/tests/biblio2yaml/aristotle-rhetoric.biblatex b/tests/biblio2yaml/aristotle-rhetoric.biblatex --- a/tests/biblio2yaml/aristotle-rhetoric.biblatex +++ b/tests/biblio2yaml/aristotle-rhetoric.biblatex @@ -60,7 +60,7 @@ - family: Cope given: Edward Meredith issued: - - year: '1877' + - year: 1877 title: The rhetoric of Aristotle with a commentary by the late Edward Meredith Cope title-short: Rhetoric publisher: Cambridge University Press diff --git a/tests/biblio2yaml/article.biblatex b/tests/biblio2yaml/article.biblatex --- a/tests/biblio2yaml/article.biblatex +++ b/tests/biblio2yaml/article.biblatex @@ -85,9 +85,9 @@ - family: Author given: Ann issued: - - year: '2013' - month: '7' - day: '29' + - year: 2013 + month: 7 + day: 29 title: An article entry with just the required fields container-title: The Journaltitle language: en-US @@ -105,13 +105,13 @@ - family: Translator given: Ted issued: - - year: '2008' - month: '12' - day: '31' + - year: 2008 + month: 12 + day: 31 accessed: - - year: '2013' - month: '7' - day: '29' + - year: 2013 + month: 7 + day: 29 title: 'An article entry with the required and all optional fields: The subtitle. The titleaddon' title-short: An article entry with the required and all optional fields diff --git a/tests/biblio2yaml/augustine.biblatex b/tests/biblio2yaml/augustine.biblatex --- a/tests/biblio2yaml/augustine.biblatex +++ b/tests/biblio2yaml/augustine.biblatex @@ -40,7 +40,7 @@ - family: Augustine given: Robert L. issued: - - year: '1995' + - year: 1995 title: Heterogeneous catalysis for the synthetic chemist title-short: Heterogeneous catalysis publisher: Marcel Dekker diff --git a/tests/biblio2yaml/averroes-bland.biblatex b/tests/biblio2yaml/averroes-bland.biblatex --- a/tests/biblio2yaml/averroes-bland.biblatex +++ b/tests/biblio2yaml/averroes-bland.biblatex @@ -62,7 +62,7 @@ - family: Bland given: Kalman P. issued: - - year: '1982' + - year: 1982 title: The epistle on the possibility of conjunction with the active intellect by Ibn Rushd with the commentary of Moses Narboni title-short: Possibility of conjunction diff --git a/tests/biblio2yaml/averroes-hannes.biblatex b/tests/biblio2yaml/averroes-hannes.biblatex --- a/tests/biblio2yaml/averroes-hannes.biblatex +++ b/tests/biblio2yaml/averroes-hannes.biblatex @@ -64,7 +64,7 @@ - family: Hannes given: Ludwig issued: - - year: '1892' + - year: 1892 title: 'Des Averroës Abhandlung: “Über die Möglichkeit der Conjunktion” oder “Über den materiellen Intellekt”' title-short: Über die Möglichkeit der Conjunktion diff --git a/tests/biblio2yaml/averroes-hercz.biblatex b/tests/biblio2yaml/averroes-hercz.biblatex --- a/tests/biblio2yaml/averroes-hercz.biblatex +++ b/tests/biblio2yaml/averroes-hercz.biblatex @@ -64,7 +64,7 @@ - family: Hercz given: J. issued: - - year: '1869' + - year: 1869 title: 'Drei Abhandlungen über die Conjunction des separaten Intellects mit dem Menschen: Von Averroes (Vater und Sohn), aus dem Arabischen übersetzt von Samuel Ibn Tibbon' diff --git a/tests/biblio2yaml/baez-article.biblatex b/tests/biblio2yaml/baez-article.biblatex --- a/tests/biblio2yaml/baez-article.biblatex +++ b/tests/biblio2yaml/baez-article.biblatex @@ -54,7 +54,7 @@ - family: Lauda given: Aaron D. issued: - - year: '2004' + - year: 2004 title: 'Higher-dimensional algebra V: 2-groups' title-short: Higher-dimensional algebra V container-title: Theory and Applications of Categories diff --git a/tests/biblio2yaml/baez-online.biblatex b/tests/biblio2yaml/baez-online.biblatex --- a/tests/biblio2yaml/baez-online.biblatex +++ b/tests/biblio2yaml/baez-online.biblatex @@ -51,9 +51,9 @@ - family: Lauda given: Aaron D. issued: - - year: '2004' - month: '10' - day: '27' + - year: 2004 + month: 10 + day: 27 title: 'Higher-dimensional algebra V: 2-groups' title-short: Higher-dimensional algebra V version: '3' diff --git a/tests/biblio2yaml/basic.bibtex b/tests/biblio2yaml/basic.bibtex --- a/tests/biblio2yaml/basic.bibtex +++ b/tests/biblio2yaml/basic.bibtex @@ -33,7 +33,7 @@ - family: Doe given: John issued: - - year: '2005' + - year: 2005 title: First book publisher: Cambridge University Press publisher-place: Cambridge @@ -44,7 +44,7 @@ - family: Doe given: John issued: - - year: '2006' + - year: 2006 title: Article container-title: Journal of Generic Studies page: '33-34' @@ -61,7 +61,7 @@ - family: Smith given: Sam issued: - - year: '2007' + - year: 2007 title: Why water is wet container-title: Third book publisher: Oxford University Press diff --git a/tests/biblio2yaml/bertram.biblatex b/tests/biblio2yaml/bertram.biblatex --- a/tests/biblio2yaml/bertram.biblatex +++ b/tests/biblio2yaml/bertram.biblatex @@ -48,7 +48,7 @@ - family: Wentworth given: Richard issued: - - year: '1996' + - year: 1996 title: Gromov invariants for holomorphic maps on Riemann surfaces title-short: Gromov invariants container-title: J. Amer. Math. Soc. diff --git a/tests/biblio2yaml/book-averroes.biblatex b/tests/biblio2yaml/book-averroes.biblatex --- a/tests/biblio2yaml/book-averroes.biblatex +++ b/tests/biblio2yaml/book-averroes.biblatex @@ -62,7 +62,7 @@ - family: Bland given: Kalman P. issued: - - year: '1982' + - year: 1982 title: The epistle on the possibility of conjunction with the active intellect by Ibn Rushd with the commentary of Moses Narboni title-short: Possibility of conjunction @@ -87,7 +87,7 @@ - family: Hannes given: Ludwig issued: - - year: '1892' + - year: 1892 title: 'Des Averroës Abhandlung: “Über die Möglichkeit der Conjunktion” oder “Über den materiellen Intellekt”' title-short: Über die Möglichkeit der Conjunktion @@ -110,7 +110,7 @@ - family: Hercz given: J. issued: - - year: '1869' + - year: 1869 title: 'Drei Abhandlungen über die Conjunction des separaten Intellects mit dem Menschen: Von Averroes (Vater und Sohn), aus dem Arabischen übersetzt von Samuel Ibn Tibbon' diff --git a/tests/biblio2yaml/book-coleridge.biblatex b/tests/biblio2yaml/book-coleridge.biblatex --- a/tests/biblio2yaml/book-coleridge.biblatex +++ b/tests/biblio2yaml/book-coleridge.biblatex @@ -36,7 +36,7 @@ - family: Bate given: W. Jackson issued: - - year: '1983' + - year: 1983 title: The collected works of Samuel Taylor Coleridge volume-title: Biographia literaria, or Biographical sketches of my literary life and opinions diff --git a/tests/biblio2yaml/book-title-maintitle-series.biblatex b/tests/biblio2yaml/book-title-maintitle-series.biblatex --- a/tests/biblio2yaml/book-title-maintitle-series.biblatex +++ b/tests/biblio2yaml/book-title-maintitle-series.biblatex @@ -22,7 +22,7 @@ - family: Author given: Al issued: - - year: '2013' + - year: 2013 title: 'Maintitle: Mainsubtitle. Maintitleaddon' volume-title: 'Title of the Book: Subtitle. Titleaddon' collection-title: Series diff --git a/tests/biblio2yaml/book-vazques-de-parga.biblatex b/tests/biblio2yaml/book-vazques-de-parga.biblatex --- a/tests/biblio2yaml/book-vazques-de-parga.biblatex +++ b/tests/biblio2yaml/book-vazques-de-parga.biblatex @@ -29,7 +29,7 @@ - family: Uría Ríu given: Juan issued: - - year: '1993' + - year: 1993 title: Las Peregrinaciones a Santiago de Compostela title-short: Peregrinaciones publisher: Iberdrola diff --git a/tests/biblio2yaml/brandt.biblatex b/tests/biblio2yaml/brandt.biblatex --- a/tests/biblio2yaml/brandt.biblatex +++ b/tests/biblio2yaml/brandt.biblatex @@ -64,7 +64,7 @@ - family: Seibt given: Ferdinand issued: - - year: '1987' + - year: 1987 title: Die nordischen Länder von der Mitte des 11. Jahrhunderts bis 1448 title-short: Die nordischen Länder container-title: Europa im Hoch- und Spätmittelalter diff --git a/tests/biblio2yaml/britannica.biblatex b/tests/biblio2yaml/britannica.biblatex --- a/tests/biblio2yaml/britannica.biblatex +++ b/tests/biblio2yaml/britannica.biblatex @@ -62,7 +62,7 @@ - family: Preece given: Warren E. issued: - - year: '2003' + - year: 2003 title: The new encyclopædia Britannica title-short: Encyclopædia Britannica publisher: Encyclopædia Britannica diff --git a/tests/biblio2yaml/chiu.biblatex b/tests/biblio2yaml/chiu.biblatex --- a/tests/biblio2yaml/chiu.biblatex +++ b/tests/biblio2yaml/chiu.biblatex @@ -57,7 +57,7 @@ - family: Chow given: We Min issued: - - year: '1978' + - year: 1978 title: A hybrid hierarchical model of a multiple virtual storage (MVS) operating system publisher: IBM diff --git a/tests/biblio2yaml/cicero.biblatex b/tests/biblio2yaml/cicero.biblatex --- a/tests/biblio2yaml/cicero.biblatex +++ b/tests/biblio2yaml/cicero.biblatex @@ -63,7 +63,7 @@ - family: Blank-Sangmeister given: Ursula issued: - - year: '1995' + - year: 1995 title: De natura deorum. Über das Wesen der Götter title-short: De natura deorum publisher: Reclam diff --git a/tests/biblio2yaml/cms.biblatex b/tests/biblio2yaml/cms.biblatex --- a/tests/biblio2yaml/cms.biblatex +++ b/tests/biblio2yaml/cms.biblatex @@ -57,7 +57,7 @@ - id: cms type: book issued: - - year: '2003' + - year: 2003 title: 'The Chicago manual of style: The essential guide for writers, editors, and publishers' title-short: Chicago manual of style diff --git a/tests/biblio2yaml/coleridge.biblatex b/tests/biblio2yaml/coleridge.biblatex --- a/tests/biblio2yaml/coleridge.biblatex +++ b/tests/biblio2yaml/coleridge.biblatex @@ -63,7 +63,7 @@ - family: Bate given: W. Jackson issued: - - year: '1983' + - year: 1983 title: The collected works of Samuel Taylor Coleridge volume-title: Biographia literaria, or Biographical sketches of my literary life and opinions diff --git a/tests/biblio2yaml/companion.biblatex b/tests/biblio2yaml/companion.biblatex --- a/tests/biblio2yaml/companion.biblatex +++ b/tests/biblio2yaml/companion.biblatex @@ -50,7 +50,7 @@ - family: Samarin given: Alexander issued: - - year: '1994' + - year: 1994 title: The LaTeX companion title-short: LaTeX companion publisher: Addison-Wesley diff --git a/tests/biblio2yaml/cotton.biblatex b/tests/biblio2yaml/cotton.biblatex --- a/tests/biblio2yaml/cotton.biblatex +++ b/tests/biblio2yaml/cotton.biblatex @@ -51,7 +51,7 @@ - family: Bochmann given: Manfred issued: - - year: '1999' + - year: 1999 title: Advanced inorganic chemistry publisher: Wiley publisher-place: Chichester diff --git a/tests/biblio2yaml/crossref-inbook-mvbook.biblatex b/tests/biblio2yaml/crossref-inbook-mvbook.biblatex --- a/tests/biblio2yaml/crossref-inbook-mvbook.biblatex +++ b/tests/biblio2yaml/crossref-inbook-mvbook.biblatex @@ -31,7 +31,7 @@ container-author: - family: Shakespeare issued: - - year: '1975' + - year: 1975 title: Macbeth \[title field of inbook-1\] container-title: Collected works \[title field of mvbook-1\] publisher: Publisher @@ -46,8 +46,8 @@ author: - family: Shakespeare issued: - - year: '1970' - - year: '1980' + - year: 1970 + - year: 1980 title: Collected works \[title field of mvbook-1\] publisher: Publisher publisher-place: Location diff --git a/tests/biblio2yaml/crossref-nested.biblatex b/tests/biblio2yaml/crossref-nested.biblatex --- a/tests/biblio2yaml/crossref-nested.biblatex +++ b/tests/biblio2yaml/crossref-nested.biblatex @@ -43,7 +43,7 @@ container-author: - family: Shakespeare issued: - - year: '1975' + - year: 1975 title: Macbeth \[title field of bookinbook-1\] container-title: Collected works \[title field of mvbook-1\] volume-title: Tragedies \[title field of book-1\] @@ -61,7 +61,7 @@ container-author: - family: Shakespeare issued: - - year: '1975' + - year: 1975 title: Macbeth \[title field of inbook-1\] container-title: Collected works \[title field of mvbook-1\] volume-title: Tragedies \[title field of book-1\] @@ -79,7 +79,7 @@ container-author: - family: Shakespeare issued: - - year: '1975' + - year: 1975 title: Collected works \[title field of mvbook-1\] volume-title: Tragedies \[title field of book-1\] publisher: Publisher @@ -92,8 +92,8 @@ author: - family: Shakespeare issued: - - year: '1970' - - year: '1980' + - year: 1970 + - year: 1980 title: Collected works \[title field of mvbook-1\] publisher: Publisher publisher-place: Location diff --git a/tests/biblio2yaml/ctan.biblatex b/tests/biblio2yaml/ctan.biblatex --- a/tests/biblio2yaml/ctan.biblatex +++ b/tests/biblio2yaml/ctan.biblatex @@ -52,11 +52,11 @@ - id: ctan type: webpage issued: - - year: '2006' + - year: 2006 accessed: - - year: '2006' - month: '10' - day: '1' + - year: 2006 + month: 10 + day: 1 title: 'CTAN: The Comprehensive TeX Archive Network' title-short: CTAN annote: This is an online entry. The url, diff --git a/tests/biblio2yaml/dates.biblatex b/tests/biblio2yaml/dates.biblatex --- a/tests/biblio2yaml/dates.biblatex +++ b/tests/biblio2yaml/dates.biblatex @@ -84,8 +84,8 @@ - family: Author given: Al issued: - - year: '1999' - month: '8' + - year: 1999 + month: 8 title: Year and month, bibtex style, supported by biblatex for backwards compatibility container-title: Journal @@ -95,8 +95,8 @@ - family: Author given: Al issued: - - year: '1999' - month: '08' + - year: 1999 + month: 8 title: Year and month, biblatex style; note that biblatex does not have a “day” field container-title: Journal @@ -107,21 +107,21 @@ - family: Author given: Al issued: - - year: '2012' - month: '12' - day: '13' + - year: 2012 + month: 12 + day: 13 event-date: - - year: '2011' - month: '10' - day: '3' + - year: 2011 + month: 10 + day: 3 accessed: - - year: '1999' - month: '5' - day: '23' + - year: 1999 + month: 5 + day: 23 original-date: - - year: '1888' - month: '10' - day: '1' + - year: 1888 + month: 10 + day: 1 title: Dates, default biblatex style; year, month to be ignored if date exists container-title: Journal @@ -131,31 +131,31 @@ - family: Author given: Al issued: - - year: '1999' - month: '10' - day: '14' - - year: '2010' - month: '1' - day: '23' + - year: 1999 + month: 10 + day: 14 + - year: 2010 + month: 1 + day: 23 event-date: - - year: '1999' - month: '12' - - year: '2000' - month: '1' + - year: 1999 + month: 12 + - year: 2000 + month: 1 accessed: - - year: '2012' - month: '10' - day: '12' - - year: '2013' - month: '1' - day: '31' + - year: 2012 + month: 10 + day: 12 + - year: 2013 + month: 1 + day: 31 original-date: - - year: '1888' - month: '1' - day: '2' - - year: '1913' - month: '12' - day: '13' + - year: 1888 + month: 1 + day: 2 + - year: 1913 + month: 12 + day: 13 title: Date ranges; different years container-title: Journal @@ -165,31 +165,31 @@ - family: Author given: Al issued: - - year: '1999' - month: '10' - day: '14' - - year: '1999' - month: '10' - day: '15' + - year: 1999 + month: 10 + day: 14 + - year: 1999 + month: 10 + day: 15 event-date: - - year: '1999' - month: '10' - - year: '1999' - month: '11' + - year: 1999 + month: 10 + - year: 1999 + month: 11 accessed: - - year: '2012' - month: '10' - day: '31' - - year: '2012' - month: '11' - day: '1' + - year: 2012 + month: 10 + day: 31 + - year: 2012 + month: 11 + day: 1 original-date: - - year: '1888' - month: '1' - day: '2' - - year: '1888' - month: '12' - day: '13' + - year: 1888 + month: 1 + day: 2 + - year: 1888 + month: 12 + day: 13 title: Date ranges; same year container-title: Journal @@ -199,23 +199,23 @@ - family: Author given: Al issued: - - year: '1999' - month: '10' - day: '14' + - year: 1999 + month: 10 + day: 14 - {} event-date: - - year: '1999' - month: '10' + - year: 1999 + month: 10 - {} accessed: - - year: '2012' - month: '10' - day: '31' + - year: 2012 + month: 10 + day: 31 - {} original-date: - - year: '1888' - month: '1' - day: '2' + - year: 1888 + month: 1 + day: 2 - {} title: Date ranges, open-ended container-title: Journal @@ -226,21 +226,21 @@ - family: Author given: Al issued: - - year: '712' - month: '12' - day: '13' + - year: 712 + month: 12 + day: 13 event-date: - - year: '311' - month: '10' - day: '3' + - year: 311 + month: 10 + day: 3 accessed: - - year: '999' - month: '12' - day: '14' + - year: 999 + month: 12 + day: 14 original-date: - - year: '88' - month: '10' - day: '1' + - year: 88 + month: 10 + day: 1 title: Dates, year less than 1000 container-title: Journal ... diff --git a/tests/biblio2yaml/doody.biblatex b/tests/biblio2yaml/doody.biblatex --- a/tests/biblio2yaml/doody.biblatex +++ b/tests/biblio2yaml/doody.biblatex @@ -69,7 +69,7 @@ - family: Doody given: Terrence issued: - - year: '1974' + - year: 1974 title: Hemingway’s style and Jake’s narration container-title: The Journal of Narrative Technique page: '212-225' @@ -85,7 +85,7 @@ - family: Matuz given: Roger issued: - - year: '1990' + - year: 1990 title: Contemporary literary criticism publisher: Gale publisher-place: Detroit diff --git a/tests/biblio2yaml/edtf-date.biblatex b/tests/biblio2yaml/edtf-date.biblatex --- a/tests/biblio2yaml/edtf-date.biblatex +++ b/tests/biblio2yaml/edtf-date.biblatex @@ -18,81 +18,81 @@ - id: item3-3 type: article-journal issued: - - year: '1998' + - year: 1998 - {} - id: item3-4 type: article-journal issued: - - year: '1999' + - year: 1999 - {} - id: item3-10 type: article-journal issued: - - year: '2004' - month: '4' - day: '5' + - year: 2004 + month: 4 + day: 5 - id: item5-1 type: article-journal issued: - - year: '-1' + - year: -1 - id: item5-2 type: article-journal issued: - - year: '-877' + - year: -877 - id: item5-3 type: article-journal issued: - - year: '-878' - - year: '-867' + - year: -878 + - year: -867 - id: item5-5 type: article-journal issued: - - year: '-344' - month: '2' + - year: -344 + month: 2 - id: item5-8 type: article-journal issued: - - year: '1723' - circa: '1' + - year: 1723 + circa: true - id: item5-9 type: article-journal issued: - - year: '1723' + - year: 1723 - id: item5-10 type: article-journal issued: - - year: '1723' - circa: '1' + - year: 1723 + circa: true - id: item5-11 type: article-journal issued: - - year: '2004' - season: '2' + - year: 2004 + season: 2 - id: item5-12 type: article-journal issued: - - year: '2004' - season: '4' + - year: 2004 + season: 4 - id: item5-13 type: article-journal issued: - - year: '2000' - - year: '2099' + - year: 2000 + - year: 2099 - id: item5-14 type: article-journal issued: - - year: '-123456790' + - year: -123456790 ... diff --git a/tests/biblio2yaml/gaonkar-in.biblatex b/tests/biblio2yaml/gaonkar-in.biblatex --- a/tests/biblio2yaml/gaonkar-in.biblatex +++ b/tests/biblio2yaml/gaonkar-in.biblatex @@ -46,7 +46,7 @@ - family: Gaonkar given: Dilip Parameshwar issued: - - year: '2001' + - year: 2001 title: On alternative modernities container-title: Alternative modernities publisher: Duke University Press diff --git a/tests/biblio2yaml/gaonkar.biblatex b/tests/biblio2yaml/gaonkar.biblatex --- a/tests/biblio2yaml/gaonkar.biblatex +++ b/tests/biblio2yaml/gaonkar.biblatex @@ -42,7 +42,7 @@ - family: Gaonkar given: Dilip Parameshwar issued: - - year: '2001' + - year: 2001 title: Alternative modernities publisher: Duke University Press publisher-place: Durham; London diff --git a/tests/biblio2yaml/geer.biblatex b/tests/biblio2yaml/geer.biblatex --- a/tests/biblio2yaml/geer.biblatex +++ b/tests/biblio2yaml/geer.biblatex @@ -49,7 +49,7 @@ given: Ingrid dropping-particle: de issued: - - year: '1985' + - year: 1985 title: 'Earl, saint, bishop, skald – and music: The Orkney earldom of the twelfth century. A musicological study' title-short: Earl, saint, bishop, skald – and music diff --git a/tests/biblio2yaml/gerhardt.biblatex b/tests/biblio2yaml/gerhardt.biblatex --- a/tests/biblio2yaml/gerhardt.biblatex +++ b/tests/biblio2yaml/gerhardt.biblatex @@ -46,7 +46,7 @@ - family: Gerhardt given: Michael J. issued: - - year: '2000' + - year: 2000 title: 'The federal appointments process: A constitutional and historical analysis' title-short: Federal appointments process publisher: Duke University Press diff --git a/tests/biblio2yaml/gillies.biblatex b/tests/biblio2yaml/gillies.biblatex --- a/tests/biblio2yaml/gillies.biblatex +++ b/tests/biblio2yaml/gillies.biblatex @@ -51,7 +51,7 @@ - family: Gillies given: Alexander issued: - - year: '1933' + - year: 1933 title: Herder and the preparation of Goethe’s idea of world literature container-title: Publications of the English Goethe Society collection-title: new series diff --git a/tests/biblio2yaml/glashow.biblatex b/tests/biblio2yaml/glashow.biblatex --- a/tests/biblio2yaml/glashow.biblatex +++ b/tests/biblio2yaml/glashow.biblatex @@ -37,7 +37,7 @@ - family: Glashow given: Sheldon issued: - - year: '1961' + - year: 1961 title: Partial symmetries of weak interactions container-title: Nucl. Phys. page: '579-588' diff --git a/tests/biblio2yaml/gonzalez.biblatex b/tests/biblio2yaml/gonzalez.biblatex --- a/tests/biblio2yaml/gonzalez.biblatex +++ b/tests/biblio2yaml/gonzalez.biblatex @@ -43,7 +43,7 @@ - family: Gonzalez given: Ray issued: - - year: '2001' + - year: 2001 title: The ghost of John Wayne and other stories title-short: Ghost of John Wayne publisher: The University of Arizona Press diff --git a/tests/biblio2yaml/hammond.biblatex b/tests/biblio2yaml/hammond.biblatex --- a/tests/biblio2yaml/hammond.biblatex +++ b/tests/biblio2yaml/hammond.biblatex @@ -45,7 +45,7 @@ - family: Hammond given: Christopher issued: - - year: '1997' + - year: 1997 title: The basics of crystallography and diffraction title-short: Crystallography and diffraction publisher: International Union of Crystallography; Oxford University Press diff --git a/tests/biblio2yaml/herrmann.biblatex b/tests/biblio2yaml/herrmann.biblatex --- a/tests/biblio2yaml/herrmann.biblatex +++ b/tests/biblio2yaml/herrmann.biblatex @@ -54,7 +54,7 @@ - family: Hoffmann given: Stephan D. issued: - - year: '2006' + - year: 2006 title: A carbocyclic carbene as an efficient catalyst ligand for C–C coupling reactions container-title: Angew. Chem. Int. Ed. page: '3859-3862' diff --git a/tests/biblio2yaml/hyman.biblatex b/tests/biblio2yaml/hyman.biblatex --- a/tests/biblio2yaml/hyman.biblatex +++ b/tests/biblio2yaml/hyman.biblatex @@ -57,7 +57,7 @@ - family: O’Meara given: Dominic J. issued: - - year: '1981' + - year: 1981 title: Aristotle’s theory of the intellect and its interpretation by Averroes title-short: Aristotle’s theory of the intellect container-title: Studies in Aristotle diff --git a/tests/biblio2yaml/iliad.biblatex b/tests/biblio2yaml/iliad.biblatex --- a/tests/biblio2yaml/iliad.biblatex +++ b/tests/biblio2yaml/iliad.biblatex @@ -49,7 +49,7 @@ - family: Schadewaldt given: Wolfgang issued: - - year: '2004' + - year: 2004 title: Die Ilias title-short: Ilias publisher: Artemis & Winkler diff --git a/tests/biblio2yaml/inbook-title-booktitle-maintitle-series-2.biblatex b/tests/biblio2yaml/inbook-title-booktitle-maintitle-series-2.biblatex --- a/tests/biblio2yaml/inbook-title-booktitle-maintitle-series-2.biblatex +++ b/tests/biblio2yaml/inbook-title-booktitle-maintitle-series-2.biblatex @@ -29,7 +29,7 @@ - family: Bookauthor given: Bob issued: - - year: '2011' + - year: 2011 title: 'Title of the “inbook” Entry: Subtitle. Titleaddon' container-title: 'Maintitle: Mainsubtitle. Maintitleaddon' volume-title: 'Booktitle: Booksubtitle. Booktitleaddon' diff --git a/tests/biblio2yaml/inbook-title-booktitle-maintitle-series.biblatex b/tests/biblio2yaml/inbook-title-booktitle-maintitle-series.biblatex --- a/tests/biblio2yaml/inbook-title-booktitle-maintitle-series.biblatex +++ b/tests/biblio2yaml/inbook-title-booktitle-maintitle-series.biblatex @@ -25,7 +25,7 @@ - family: Author given: Al issued: - - year: '2011' + - year: 2011 title: 'Title of the “inbook” Entry: Subtitle. Titleaddon' container-title: 'Maintitle: Mainsubtitle. Maintitleaddon' volume-title: 'Booktitle: Booksubtitle. Booktitleaddon' diff --git a/tests/biblio2yaml/inbook.biblatex b/tests/biblio2yaml/inbook.biblatex --- a/tests/biblio2yaml/inbook.biblatex +++ b/tests/biblio2yaml/inbook.biblatex @@ -70,7 +70,7 @@ - family: Kant given: Immanuel issued: - - year: '1968' + - year: 1968 title: Kritik der praktischen Vernunft title-short: Kritik der praktischen Vernunft container-title: Kants Werke. Akademie Textausgabe @@ -95,7 +95,7 @@ - family: Kant given: Immanuel issued: - - year: '1968' + - year: 1968 title: Kritik der Urtheilskraft container-title: Kants Werke. Akademie Textausgabe volume-title: Kritik der praktischen Vernunft. Kritik der Urtheilskraft @@ -122,7 +122,7 @@ - family: Nietzsche given: Friedrich issued: - - year: '1988' + - year: 1988 title: 'Unzeitgemässe Betrachtungen. Zweites Stück: Vom Nutzen und Nachtheil der Historie für das Leben' title-short: Vom Nutzen und Nachtheil der Historie diff --git a/tests/biblio2yaml/incollection-2.biblatex b/tests/biblio2yaml/incollection-2.biblatex --- a/tests/biblio2yaml/incollection-2.biblatex +++ b/tests/biblio2yaml/incollection-2.biblatex @@ -48,7 +48,7 @@ - family: Westfahl given: Gary issued: - - year: '2000' + - year: 2000 title: 'The true frontier: Confronting and avoiding the realities of space in American science fiction films' title-short: The true frontier @@ -69,7 +69,7 @@ - family: Gaonkar given: Dilip Parameshwar issued: - - year: '2001' + - year: 2001 title: On alternative modernities container-title: Alternative modernities publisher: Duke University Press @@ -83,7 +83,7 @@ - family: Westfahl given: Gary issued: - - year: '2000' + - year: 2000 title: 'Space and beyond: The frontier theme in science fiction' title-short: Space and beyond publisher: Greenwood diff --git a/tests/biblio2yaml/incollection.biblatex b/tests/biblio2yaml/incollection.biblatex --- a/tests/biblio2yaml/incollection.biblatex +++ b/tests/biblio2yaml/incollection.biblatex @@ -66,7 +66,7 @@ - family: Seibt given: Ferdinand issued: - - year: '1987' + - year: 1987 title: Die nordischen Länder von der Mitte des 11. Jahrhunderts bis 1448 title-short: Die nordischen Länder container-title: Europa im Hoch- und Spätmittelalter @@ -89,7 +89,7 @@ - family: O’Meara given: Dominic J. issued: - - year: '1981' + - year: 1981 title: Aristotle’s theory of the intellect and its interpretation by Averroes title-short: Aristotle’s theory of the intellect container-title: Studies in Aristotle @@ -111,7 +111,7 @@ - family: Twersky given: Isadore issued: - - year: '1979' + - year: 1979 title: The limitations of human knowledge according to Al-Farabi, ibn Bajja, and Maimonides title-short: Limitations of human knowledge diff --git a/tests/biblio2yaml/inproceedings.biblatex b/tests/biblio2yaml/inproceedings.biblatex --- a/tests/biblio2yaml/inproceedings.biblatex +++ b/tests/biblio2yaml/inproceedings.biblatex @@ -47,9 +47,9 @@ - family: Owen given: G. E. L. issued: - - year: '1979' + - year: 1979 event-date: - - year: '1975' + - year: 1975 title: 'Le *De Anima* dans la tradition grècque: Quelques aspects de l’interpretation du traité, de Theophraste à Themistius' title-short: '*De Anima* dans la tradition grècque' @@ -72,14 +72,14 @@ - family: Svartholm given: Nils issued: - - year: '1968' + - year: 1968 event-date: - - year: '1968' - month: '5' - day: '19' - - year: '1968' - month: '5' - day: '25' + - year: 1968 + month: 5 + day: 19 + - year: 1968 + month: 5 + day: 25 title: Weak and electromagnetic interactions container-title: 'Elementary particle theory: Relativistic groups and analyticity. Proceedings of the eighth Nobel symposium' diff --git a/tests/biblio2yaml/issue288.biblatex b/tests/biblio2yaml/issue288.biblatex --- a/tests/biblio2yaml/issue288.biblatex +++ b/tests/biblio2yaml/issue288.biblatex @@ -18,8 +18,8 @@ - family: Leavitt given: Alex issued: - - year: '2016' - month: '8' + - year: 2016 + month: 8 title: 'Upvoting the news: Breaking news aggregation, crowd collaboration, and algorithm-driven attention on reddit.com' title-short: Upvoting the news diff --git a/tests/biblio2yaml/itzhaki.biblatex b/tests/biblio2yaml/itzhaki.biblatex --- a/tests/biblio2yaml/itzhaki.biblatex +++ b/tests/biblio2yaml/itzhaki.biblatex @@ -59,9 +59,9 @@ - family: Itzhaki given: Nissan issued: - - year: '1996' - month: '3' - day: '11' + - year: 1996 + month: 3 + day: 11 title: Some remarks on ’t Hooft’s S-matrix for black holes version: '1' diff --git a/tests/biblio2yaml/jaffe.biblatex b/tests/biblio2yaml/jaffe.biblatex --- a/tests/biblio2yaml/jaffe.biblatex +++ b/tests/biblio2yaml/jaffe.biblatex @@ -63,8 +63,8 @@ - family: Jaffé given: Philipp issued: - - year: '1885' - - year: '1888' + - year: 1885 + - year: 1888 title: Regesta Pontificum Romanorum ab condita ecclesia ad annum post Christum natum mcxcviii title-short: Regesta Pontificum Romanorum diff --git a/tests/biblio2yaml/jcg.biblatex b/tests/biblio2yaml/jcg.biblatex --- a/tests/biblio2yaml/jcg.biblatex +++ b/tests/biblio2yaml/jcg.biblatex @@ -38,7 +38,7 @@ - id: jcg type: article-journal issued: - - year: '2011' + - year: 2011 title: Semantic 3D media and content container-title: Computers and Graphics volume: '35' diff --git a/tests/biblio2yaml/kant-kpv.biblatex b/tests/biblio2yaml/kant-kpv.biblatex --- a/tests/biblio2yaml/kant-kpv.biblatex +++ b/tests/biblio2yaml/kant-kpv.biblatex @@ -64,7 +64,7 @@ - family: Kant given: Immanuel issued: - - year: '1968' + - year: 1968 title: Kritik der praktischen Vernunft title-short: Kritik der praktischen Vernunft container-title: Kants Werke. Akademie Textausgabe diff --git a/tests/biblio2yaml/kant-ku.biblatex b/tests/biblio2yaml/kant-ku.biblatex --- a/tests/biblio2yaml/kant-ku.biblatex +++ b/tests/biblio2yaml/kant-ku.biblatex @@ -60,7 +60,7 @@ - family: Kant given: Immanuel issued: - - year: '1968' + - year: 1968 title: Kritik der Urtheilskraft container-title: Kants Werke. Akademie Textausgabe volume-title: Kritik der praktischen Vernunft. Kritik der Urtheilskraft diff --git a/tests/biblio2yaml/kastenholz.biblatex b/tests/biblio2yaml/kastenholz.biblatex --- a/tests/biblio2yaml/kastenholz.biblatex +++ b/tests/biblio2yaml/kastenholz.biblatex @@ -85,7 +85,7 @@ - family: Hünenberger given: Philippe H. issued: - - year: '2006' + - year: 2006 title: 'Computation of methodology-independent ionic solvation free energies from molecular simulations: I. The electrostatic potential in molecular liquids' title-short: Computation of methodology-independent ionic solvation free energies diff --git a/tests/biblio2yaml/knuth-ct-a.biblatex b/tests/biblio2yaml/knuth-ct-a.biblatex --- a/tests/biblio2yaml/knuth-ct-a.biblatex +++ b/tests/biblio2yaml/knuth-ct-a.biblatex @@ -56,7 +56,7 @@ - family: Knuth given: Donald E. issued: - - year: '1984' + - year: 1984 title: Computers & typesetting volume-title: The TeX book publisher: Addison-Wesley diff --git a/tests/biblio2yaml/knuth-ct-b.biblatex b/tests/biblio2yaml/knuth-ct-b.biblatex --- a/tests/biblio2yaml/knuth-ct-b.biblatex +++ b/tests/biblio2yaml/knuth-ct-b.biblatex @@ -51,7 +51,7 @@ - family: Knuth given: Donald E. issued: - - year: '1986' + - year: 1986 title: Computers & typesetting title-short: TeX volume-title: 'TeX: The program' diff --git a/tests/biblio2yaml/knuth-ct-c.biblatex b/tests/biblio2yaml/knuth-ct-c.biblatex --- a/tests/biblio2yaml/knuth-ct-c.biblatex +++ b/tests/biblio2yaml/knuth-ct-c.biblatex @@ -51,7 +51,7 @@ - family: Knuth given: Donald E. issued: - - year: '1986' + - year: 1986 title: Computers & typesetting volume-title: The METAFONTbook publisher: Addison-Wesley diff --git a/tests/biblio2yaml/knuth-ct-d.biblatex b/tests/biblio2yaml/knuth-ct-d.biblatex --- a/tests/biblio2yaml/knuth-ct-d.biblatex +++ b/tests/biblio2yaml/knuth-ct-d.biblatex @@ -52,7 +52,7 @@ - family: Knuth given: Donald E. issued: - - year: '1986' + - year: 1986 title: Computers & typesetting title-short: METAFONT volume-title: 'METAFONT: The program' diff --git a/tests/biblio2yaml/knuth-ct-e.biblatex b/tests/biblio2yaml/knuth-ct-e.biblatex --- a/tests/biblio2yaml/knuth-ct-e.biblatex +++ b/tests/biblio2yaml/knuth-ct-e.biblatex @@ -48,7 +48,7 @@ - family: Knuth given: Donald E. issued: - - year: '1986' + - year: 1986 title: Computers & typesetting volume-title: Computer modern typefaces publisher: Addison-Wesley diff --git a/tests/biblio2yaml/knuth-ct-related.biblatex b/tests/biblio2yaml/knuth-ct-related.biblatex --- a/tests/biblio2yaml/knuth-ct-related.biblatex +++ b/tests/biblio2yaml/knuth-ct-related.biblatex @@ -55,8 +55,8 @@ - family: Knuth given: Donald E. issued: - - year: '1984' - - year: '1986' + - year: 1984 + - year: 1986 title: Computers & typesetting publisher: Addison-Wesley publisher-place: Reading, Mass. diff --git a/tests/biblio2yaml/knuth-ct.biblatex b/tests/biblio2yaml/knuth-ct.biblatex --- a/tests/biblio2yaml/knuth-ct.biblatex +++ b/tests/biblio2yaml/knuth-ct.biblatex @@ -49,8 +49,8 @@ - family: Knuth given: Donald E. issued: - - year: '1984' - - year: '1986' + - year: 1984 + - year: 1986 title: Computers & typesetting publisher: Addison-Wesley publisher-place: Reading, Mass. diff --git a/tests/biblio2yaml/kowalik.biblatex b/tests/biblio2yaml/kowalik.biblatex --- a/tests/biblio2yaml/kowalik.biblatex +++ b/tests/biblio2yaml/kowalik.biblatex @@ -49,9 +49,9 @@ - family: Isard given: M. issued: - - year: '1995' - month: '1' - day: '11' + - year: 1995 + month: 1 + day: 11 title: Estimateur d’un défaut de fonctionnement d’un modulateur en quadrature et étage de modulation l’utilisant genre: French patent request diff --git a/tests/biblio2yaml/kullback-related.biblatex b/tests/biblio2yaml/kullback-related.biblatex --- a/tests/biblio2yaml/kullback-related.biblatex +++ b/tests/biblio2yaml/kullback-related.biblatex @@ -46,7 +46,7 @@ - family: Kullback given: Solomon issued: - - year: '1997' + - year: 1997 title: Information theory and statistics publisher: Dover Publications publisher-place: New York diff --git a/tests/biblio2yaml/kullback-reprint.biblatex b/tests/biblio2yaml/kullback-reprint.biblatex --- a/tests/biblio2yaml/kullback-reprint.biblatex +++ b/tests/biblio2yaml/kullback-reprint.biblatex @@ -52,9 +52,9 @@ - family: Kullback given: Solomon issued: - - year: '1997' + - year: 1997 original-date: - - year: '1959' + - year: 1959 title: Information theory and statistics publisher: Dover Publications original-publisher: John Wiley & Sons diff --git a/tests/biblio2yaml/kullback.biblatex b/tests/biblio2yaml/kullback.biblatex --- a/tests/biblio2yaml/kullback.biblatex +++ b/tests/biblio2yaml/kullback.biblatex @@ -38,7 +38,7 @@ - family: Kullback given: Solomon issued: - - year: '1959' + - year: 1959 title: Information theory and statistics publisher: John Wiley & Sons publisher-place: New York diff --git a/tests/biblio2yaml/laufenberg.biblatex b/tests/biblio2yaml/laufenberg.biblatex --- a/tests/biblio2yaml/laufenberg.biblatex +++ b/tests/biblio2yaml/laufenberg.biblatex @@ -85,9 +85,9 @@ - family: Ebner given: Norbert issued: - - year: '2006' - month: '9' - day: '13' + - year: 2006 + month: 9 + day: 13 title: Elektrische Einrichtung und Betriebsverfahren genre: European patent annote: This is a patent entry with a holder field. Note the format of the type diff --git a/tests/biblio2yaml/loh.biblatex b/tests/biblio2yaml/loh.biblatex --- a/tests/biblio2yaml/loh.biblatex +++ b/tests/biblio2yaml/loh.biblatex @@ -48,7 +48,7 @@ - family: Loh given: Nin C. issued: - - year: '1992' + - year: 1992 title: High-resolution micromachined interferometric accelerometer publisher: Massachusetts Institute of Technology publisher-place: Cambridge, Mass. diff --git a/tests/biblio2yaml/malinowski.biblatex b/tests/biblio2yaml/malinowski.biblatex --- a/tests/biblio2yaml/malinowski.biblatex +++ b/tests/biblio2yaml/malinowski.biblatex @@ -47,7 +47,7 @@ - family: Malinowski given: Bronisław issued: - - year: '1972' + - year: 1972 title: 'Argonauts of the Western Pacific: An account of native enterprise and adventure in the Archipelagoes of Melanesian New Guinea' title-short: Argonauts diff --git a/tests/biblio2yaml/manual.biblatex b/tests/biblio2yaml/manual.biblatex --- a/tests/biblio2yaml/manual.biblatex +++ b/tests/biblio2yaml/manual.biblatex @@ -27,7 +27,7 @@ - id: cms type: book issued: - - year: '2003' + - year: 2003 title: 'The Chicago manual of style: The essential guide for writers, editors, and publishers' title-short: Chicago manual of style diff --git a/tests/biblio2yaml/markey.biblatex b/tests/biblio2yaml/markey.biblatex --- a/tests/biblio2yaml/markey.biblatex +++ b/tests/biblio2yaml/markey.biblatex @@ -47,13 +47,13 @@ - family: Markey given: Nicolas issued: - - year: '2005' - month: '10' - day: '16' + - year: 2005 + month: 10 + day: 16 accessed: - - year: '2006' - month: '10' - day: '1' + - year: 2006 + month: 10 + day: 1 title: 'Tame the BeaST: The B to X of BibTeX' title-short: Tame the BeaST version: '1.3' diff --git a/tests/biblio2yaml/maron.biblatex b/tests/biblio2yaml/maron.biblatex --- a/tests/biblio2yaml/maron.biblatex +++ b/tests/biblio2yaml/maron.biblatex @@ -52,7 +52,7 @@ - family: Goldstein given: Brigitte issued: - - year: '2000' + - year: 2000 title: Animal triste title-short: Animal triste publisher: University of Nebraska Press diff --git a/tests/biblio2yaml/massa.biblatex b/tests/biblio2yaml/massa.biblatex --- a/tests/biblio2yaml/massa.biblatex +++ b/tests/biblio2yaml/massa.biblatex @@ -40,7 +40,7 @@ - family: Massa given: Werner issued: - - year: '2004' + - year: 2004 title: Crystal structure determination publisher: Spinger publisher-place: Berlin diff --git a/tests/biblio2yaml/moore-related.biblatex b/tests/biblio2yaml/moore-related.biblatex --- a/tests/biblio2yaml/moore-related.biblatex +++ b/tests/biblio2yaml/moore-related.biblatex @@ -48,7 +48,7 @@ - family: Moore given: Gordon E. issued: - - year: '1998' + - year: 1998 title: Cramming more components onto integrated circuits container-title: Proceedings of the IEEE page: '82-85' diff --git a/tests/biblio2yaml/moore.biblatex b/tests/biblio2yaml/moore.biblatex --- a/tests/biblio2yaml/moore.biblatex +++ b/tests/biblio2yaml/moore.biblatex @@ -40,7 +40,7 @@ - family: Moore given: Gordon E. issued: - - year: '1965' + - year: 1965 title: Cramming more components onto integrated circuits container-title: Electronics page: '114-117' diff --git a/tests/biblio2yaml/moraux.biblatex b/tests/biblio2yaml/moraux.biblatex --- a/tests/biblio2yaml/moraux.biblatex +++ b/tests/biblio2yaml/moraux.biblatex @@ -70,9 +70,9 @@ - family: Owen given: G. E. L. issued: - - year: '1979' + - year: 1979 event-date: - - year: '1975' + - year: 1975 title: 'Le *De Anima* dans la tradition grècque: Quelques aspects de l’interpretation du traité, de Theophraste à Themistius' title-short: '*De Anima* dans la tradition grècque' diff --git a/tests/biblio2yaml/murray.biblatex b/tests/biblio2yaml/murray.biblatex --- a/tests/biblio2yaml/murray.biblatex +++ b/tests/biblio2yaml/murray.biblatex @@ -83,7 +83,7 @@ - family: Murray given: Royce W. issued: - - year: '1998' + - year: 1998 title: 'Alkanethiolate gold cluster molecules with core diameters from 1.5 to 5.2 nm: Core and monolayer properties as a function of core size' diff --git a/tests/biblio2yaml/nietzsche-historie.biblatex b/tests/biblio2yaml/nietzsche-historie.biblatex --- a/tests/biblio2yaml/nietzsche-historie.biblatex +++ b/tests/biblio2yaml/nietzsche-historie.biblatex @@ -74,7 +74,7 @@ - family: Nietzsche given: Friedrich issued: - - year: '1988' + - year: 1988 title: 'Unzeitgemässe Betrachtungen. Zweites Stück: Vom Nutzen und Nachtheil der Historie für das Leben' title-short: Vom Nutzen und Nachtheil der Historie diff --git a/tests/biblio2yaml/nietzsche-ksa.biblatex b/tests/biblio2yaml/nietzsche-ksa.biblatex --- a/tests/biblio2yaml/nietzsche-ksa.biblatex +++ b/tests/biblio2yaml/nietzsche-ksa.biblatex @@ -66,7 +66,7 @@ - family: Montinari given: Mazzino issued: - - year: '1988' + - year: 1988 title: 'Sämtliche Werke: Kritische Studienausgabe' title-short: Sämtliche Werke publisher: Deutscher Taschenbuch-Verlag; Walter de Gruyter diff --git a/tests/biblio2yaml/nietzsche-ksa1.biblatex b/tests/biblio2yaml/nietzsche-ksa1.biblatex --- a/tests/biblio2yaml/nietzsche-ksa1.biblatex +++ b/tests/biblio2yaml/nietzsche-ksa1.biblatex @@ -72,7 +72,7 @@ - family: Nietzsche given: Friedrich issued: - - year: '1988' + - year: 1988 title: 'Sämtliche Werke: Kritische Studienausgabe' volume-title: Die Geburt der Tragödie. Unzeitgemäße Betrachtungen I–IV. Nachgelassene Schriften 1870–1973 diff --git a/tests/biblio2yaml/nussbaum.biblatex b/tests/biblio2yaml/nussbaum.biblatex --- a/tests/biblio2yaml/nussbaum.biblatex +++ b/tests/biblio2yaml/nussbaum.biblatex @@ -46,7 +46,7 @@ - family: Nussbaum given: Martha issued: - - year: '1978' + - year: 1978 title: Aristotle’s “De Motu Animalium” publisher: Princeton University Press publisher-place: Princeton diff --git a/tests/biblio2yaml/online.biblatex b/tests/biblio2yaml/online.biblatex --- a/tests/biblio2yaml/online.biblatex +++ b/tests/biblio2yaml/online.biblatex @@ -32,13 +32,13 @@ - family: Markey given: Nicolas issued: - - year: '2005' - month: '10' - day: '16' + - year: 2005 + month: 10 + day: 16 accessed: - - year: '2006' - month: '10' - day: '1' + - year: 2006 + month: 10 + day: 1 title: 'Tame the BeaST: The B to X of BibTeX' title-short: Tame the BeaST version: '1.3' @@ -50,11 +50,11 @@ - id: CTAN type: webpage issued: - - year: '2006' + - year: 2006 accessed: - - year: '2006' - month: '10' - day: '1' + - year: 2006 + month: 10 + day: 1 title: 'CTAN: The Comprehensive TeX Archive Network' title-short: CTAN annote: This is an online entry. The url, diff --git a/tests/biblio2yaml/options-url-false-doi-false.biblatex b/tests/biblio2yaml/options-url-false-doi-false.biblatex --- a/tests/biblio2yaml/options-url-false-doi-false.biblatex +++ b/tests/biblio2yaml/options-url-false-doi-false.biblatex @@ -36,7 +36,7 @@ - family: Author given: Andy issued: - - year: '2012' + - year: 2012 title: Title, any entry type except online container-title: Journal @@ -46,7 +46,7 @@ - family: Author given: Andy issued: - - year: '2012' + - year: 2012 title: Title, entry type online container-title: Journal URL: http://foo.bar diff --git a/tests/biblio2yaml/padhye.biblatex b/tests/biblio2yaml/padhye.biblatex --- a/tests/biblio2yaml/padhye.biblatex +++ b/tests/biblio2yaml/padhye.biblatex @@ -77,7 +77,7 @@ - family: Towsley given: Don issued: - - year: '1999' + - year: 1999 title: A stochastic model of TCP Reno congestion avoidance and control publisher: University of Massachusetts publisher-place: Amherst, Mass. diff --git a/tests/biblio2yaml/pandoc-2/ctan.biblatex b/tests/biblio2yaml/pandoc-2/ctan.biblatex --- a/tests/biblio2yaml/pandoc-2/ctan.biblatex +++ b/tests/biblio2yaml/pandoc-2/ctan.biblatex @@ -52,11 +52,11 @@ - id: ctan type: webpage issued: - - year: '2006' + - year: 2006 accessed: - - year: '2006' - month: '10' - day: '1' + - year: 2006 + month: 10 + day: 1 title: 'CTAN: The Comprehensive TeX Archive Network' title-short: CTAN annote: This is an online entry. The url, which is diff --git a/tests/biblio2yaml/pandoc-2/jaffe.biblatex b/tests/biblio2yaml/pandoc-2/jaffe.biblatex --- a/tests/biblio2yaml/pandoc-2/jaffe.biblatex +++ b/tests/biblio2yaml/pandoc-2/jaffe.biblatex @@ -63,8 +63,8 @@ - family: Jaffé given: Philipp issued: - - year: '1885' - - year: '1888' + - year: 1885 + - year: 1888 title: Regesta Pontificum Romanorum ab condita ecclesia ad annum post Christum natum mcxcviii title-short: Regesta Pontificum Romanorum diff --git a/tests/biblio2yaml/pandoc-2/kastenholz.biblatex b/tests/biblio2yaml/pandoc-2/kastenholz.biblatex --- a/tests/biblio2yaml/pandoc-2/kastenholz.biblatex +++ b/tests/biblio2yaml/pandoc-2/kastenholz.biblatex @@ -85,7 +85,7 @@ - family: Hünenberger given: Philippe H. issued: - - year: '2006' + - year: 2006 title: 'Computation of methodology-independent ionic solvation free energies from molecular simulations: I. The electrostatic potential in molecular liquids' title-short: Computation of methodology-independent ionic solvation free energies diff --git a/tests/biblio2yaml/pandoc-2/online.biblatex b/tests/biblio2yaml/pandoc-2/online.biblatex --- a/tests/biblio2yaml/pandoc-2/online.biblatex +++ b/tests/biblio2yaml/pandoc-2/online.biblatex @@ -32,13 +32,13 @@ - family: Markey given: Nicolas issued: - - year: '2005' - month: '10' - day: '16' + - year: 2005 + month: 10 + day: 16 accessed: - - year: '2006' - month: '10' - day: '1' + - year: 2006 + month: 10 + day: 1 title: 'Tame the BeaST: The B to X of BibTeX' title-short: Tame the BeaST version: '1.3' @@ -50,11 +50,11 @@ - id: CTAN type: webpage issued: - - year: '2006' + - year: 2006 accessed: - - year: '2006' - month: '10' - day: '1' + - year: 2006 + month: 10 + day: 1 title: 'CTAN: The Comprehensive TeX Archive Network' title-short: CTAN annote: This is an online entry. The url, which is diff --git a/tests/biblio2yaml/pandoc-2/sigfridsson.biblatex b/tests/biblio2yaml/pandoc-2/sigfridsson.biblatex --- a/tests/biblio2yaml/pandoc-2/sigfridsson.biblatex +++ b/tests/biblio2yaml/pandoc-2/sigfridsson.biblatex @@ -72,7 +72,7 @@ - family: Ryde given: Ulf issued: - - year: '1998' + - year: 1998 title: Comparison of methods for deriving atomic charges from the electrostatic potential and moments container-title: Journal of Computational Chemistry diff --git a/tests/biblio2yaml/patent.biblatex b/tests/biblio2yaml/patent.biblatex --- a/tests/biblio2yaml/patent.biblatex +++ b/tests/biblio2yaml/patent.biblatex @@ -65,7 +65,7 @@ - family: Nozal given: Fernando issued: - - year: '1998' + - year: 1998 title: Elektromagnetisches Signalhorn jurisdiction: France; United Kingdom; Germany annote: This is a patent entry with a location field. The number is given in the @@ -82,9 +82,9 @@ - family: Isard given: M. issued: - - year: '1995' - month: '1' - day: '11' + - year: 1995 + month: 1 + day: 11 title: Estimateur d’un défaut de fonctionnement d’un modulateur en quadrature et étage de modulation l’utilisant genre: French patent request @@ -122,9 +122,9 @@ - family: Ebner given: Norbert issued: - - year: '2006' - month: '9' - day: '13' + - year: 2006 + month: 9 + day: 13 title: Elektrische Einrichtung und Betriebsverfahren genre: European patent annote: This is a patent entry with a holder field. Note the format of the type @@ -147,9 +147,9 @@ - family: Vaughn given: Steven A. issued: - - year: '1997' - month: '9' - day: '16' + - year: 1997 + month: 9 + day: 16 title: High-speed digital-to-RF converter genre: U.S. patent annote: This is a patent entry with a holder field. Note the format of the type diff --git a/tests/biblio2yaml/periodical.biblatex b/tests/biblio2yaml/periodical.biblatex --- a/tests/biblio2yaml/periodical.biblatex +++ b/tests/biblio2yaml/periodical.biblatex @@ -14,7 +14,7 @@ - id: jcg type: article-journal issued: - - year: '2011' + - year: 2011 title: Semantic 3D media and content container-title: Computers and Graphics volume: '35' diff --git a/tests/biblio2yaml/piccato.biblatex b/tests/biblio2yaml/piccato.biblatex --- a/tests/biblio2yaml/piccato.biblatex +++ b/tests/biblio2yaml/piccato.biblatex @@ -42,7 +42,7 @@ - family: Piccato given: Pablo issued: - - year: '2001' + - year: 2001 title: 'City of suspects: Crime in Mexico City, 1900–1931' title-short: City of suspects publisher: Duke University Press diff --git a/tests/biblio2yaml/pines.biblatex b/tests/biblio2yaml/pines.biblatex --- a/tests/biblio2yaml/pines.biblatex +++ b/tests/biblio2yaml/pines.biblatex @@ -57,7 +57,7 @@ - family: Twersky given: Isadore issued: - - year: '1979' + - year: 1979 title: The limitations of human knowledge according to Al-Farabi, ibn Bajja, and Maimonides title-short: Limitations of human knowledge diff --git a/tests/biblio2yaml/quotes.biblatex b/tests/biblio2yaml/quotes.biblatex --- a/tests/biblio2yaml/quotes.biblatex +++ b/tests/biblio2yaml/quotes.biblatex @@ -27,7 +27,7 @@ - family: Nussbaum given: Martha issued: - - year: '1978' + - year: 1978 title: Aristotle’s “De Motu Animalium” publisher: Princeton University Press publisher-place: Princeton diff --git a/tests/biblio2yaml/reese.biblatex b/tests/biblio2yaml/reese.biblatex --- a/tests/biblio2yaml/reese.biblatex +++ b/tests/biblio2yaml/reese.biblatex @@ -51,7 +51,7 @@ - family: Reese given: Trevor R. issued: - - year: '1958' + - year: 1958 title: Georgia in Anglo-Spanish diplomacy, 1736-1739 container-title: William and Mary Quarterly collection-title: 3rd ser. diff --git a/tests/biblio2yaml/report.biblatex b/tests/biblio2yaml/report.biblatex --- a/tests/biblio2yaml/report.biblatex +++ b/tests/biblio2yaml/report.biblatex @@ -59,7 +59,7 @@ - family: Chow given: We Min issued: - - year: '1978' + - year: 1978 title: A hybrid hierarchical model of a Multiple Virtual Storage (MVS) operating system publisher: IBM @@ -80,7 +80,7 @@ - family: Towsley given: Don issued: - - year: '1999' + - year: 1999 title: A stochastic model of TCP Reno congestion avoidance and control publisher: University of Massachusetts publisher-place: Amherst, Mass. diff --git a/tests/biblio2yaml/salam.biblatex b/tests/biblio2yaml/salam.biblatex --- a/tests/biblio2yaml/salam.biblatex +++ b/tests/biblio2yaml/salam.biblatex @@ -51,14 +51,14 @@ - family: Svartholm given: Nils issued: - - year: '1968' + - year: 1968 event-date: - - year: '1968' - month: '5' - day: '19' - - year: '1968' - month: '5' - day: '25' + - year: 1968 + month: 5 + day: 19 + - year: 1968 + month: 5 + day: 25 title: Weak and electromagnetic interactions container-title: 'Elementary particle theory: Relativistic groups and analyticity. Proceedings of the eighth Nobel symposium' diff --git a/tests/biblio2yaml/sarfraz.biblatex b/tests/biblio2yaml/sarfraz.biblatex --- a/tests/biblio2yaml/sarfraz.biblatex +++ b/tests/biblio2yaml/sarfraz.biblatex @@ -46,7 +46,7 @@ - family: Razzak given: M. F. A. issued: - - year: '2002' + - year: 2002 title: 'Technical section: An algorithm for automatic capturing of the font outlines' title-short: Technical section container-title: Computers and Graphics diff --git a/tests/biblio2yaml/shore.biblatex b/tests/biblio2yaml/shore.biblatex --- a/tests/biblio2yaml/shore.biblatex +++ b/tests/biblio2yaml/shore.biblatex @@ -46,8 +46,8 @@ - family: Shore given: Bradd issued: - - year: '1991' - month: '3' + - year: 1991 + month: 3 title: 'Twice-born, once conceived: Meaning construction and cultural cognition' title-short: Twice-born, once conceived container-title: American Anthropologist diff --git a/tests/biblio2yaml/sigfridsson.biblatex b/tests/biblio2yaml/sigfridsson.biblatex --- a/tests/biblio2yaml/sigfridsson.biblatex +++ b/tests/biblio2yaml/sigfridsson.biblatex @@ -72,7 +72,7 @@ - family: Ryde given: Ulf issued: - - year: '1998' + - year: 1998 title: Comparison of methods for deriving atomic charges from the electrostatic potential and moments container-title: Journal of Computational Chemistry diff --git a/tests/biblio2yaml/sorace.biblatex b/tests/biblio2yaml/sorace.biblatex --- a/tests/biblio2yaml/sorace.biblatex +++ b/tests/biblio2yaml/sorace.biblatex @@ -48,9 +48,9 @@ - family: Vaughn given: Steven A. issued: - - year: '1997' - month: '9' - day: '16' + - year: 1997 + month: 9 + day: 16 title: High-speed digital-to-RF converter genre: U.S. patent annote: This is a patent entry with a holder field. Note the format of the type diff --git a/tests/biblio2yaml/spiegelberg.biblatex b/tests/biblio2yaml/spiegelberg.biblatex --- a/tests/biblio2yaml/spiegelberg.biblatex +++ b/tests/biblio2yaml/spiegelberg.biblatex @@ -55,7 +55,7 @@ - family: Spiegelberg given: Herbert issued: - - year: '1969' + - year: 1969 title: “Intention” und “Intentionalität” in der Scholastik, bei Brentano und Husserl title-short: Intention und Intentionalität container-title: Studia Philosophica diff --git a/tests/biblio2yaml/springer.biblatex b/tests/biblio2yaml/springer.biblatex --- a/tests/biblio2yaml/springer.biblatex +++ b/tests/biblio2yaml/springer.biblatex @@ -41,7 +41,7 @@ - family: Springer given: Otto issued: - - year: '1950' + - year: 1950 title: Mediaeval pilgrim routes from Scandinavia to Rome title-short: Mediaeval pilgrim routes container-title: Mediaeval Studies diff --git a/tests/biblio2yaml/strings.biblatex b/tests/biblio2yaml/strings.biblatex --- a/tests/biblio2yaml/strings.biblatex +++ b/tests/biblio2yaml/strings.biblatex @@ -29,7 +29,7 @@ - family: Hoffmann given: Stephan D. issued: - - year: '2006' + - year: 2006 title: A carbocyclic carbene as an efficient catalyst ligand for C–C coupling reactions container-title: Angew. Chem. Int. Ed. page: '3859-3862' diff --git a/tests/biblio2yaml/test-case-conversion.biblatex b/tests/biblio2yaml/test-case-conversion.biblatex --- a/tests/biblio2yaml/test-case-conversion.biblatex +++ b/tests/biblio2yaml/test-case-conversion.biblatex @@ -58,7 +58,7 @@ - family: Author given: Ann issued: - - year: '2013' + - year: 2013 title: A title, in English, with a Proper Name and an ACRONYM and a camelCase word and some units, 400 nm, 3 cm, and a quote, *Alea iacta est* diff --git a/tests/biblio2yaml/thesis.biblatex b/tests/biblio2yaml/thesis.biblatex --- a/tests/biblio2yaml/thesis.biblatex +++ b/tests/biblio2yaml/thesis.biblatex @@ -34,7 +34,7 @@ given: Ingrid dropping-particle: de issued: - - year: '1985' + - year: 1985 title: 'Earl, saint, bishop, skald – and music: The Orkney earldom of the twelfth century. A musicological study' title-short: Earl, saint, bishop, skald – and music @@ -52,7 +52,7 @@ - family: Loh given: Nin C. issued: - - year: '1992' + - year: 1992 title: High-resolution micromachined interferometric accelerometer publisher: Massachusetts Institute of Technology publisher-place: Cambridge, Mass. diff --git a/tests/biblio2yaml/vangennep-related.biblatex b/tests/biblio2yaml/vangennep-related.biblatex --- a/tests/biblio2yaml/vangennep-related.biblatex +++ b/tests/biblio2yaml/vangennep-related.biblatex @@ -52,7 +52,7 @@ given: Arnold non-dropping-particle: van issued: - - year: '1909' + - year: 1909 title: Les rites de passage title-short: Rites de passage publisher: Nourry diff --git a/tests/biblio2yaml/vangennep-trans.biblatex b/tests/biblio2yaml/vangennep-trans.biblatex --- a/tests/biblio2yaml/vangennep-trans.biblatex +++ b/tests/biblio2yaml/vangennep-trans.biblatex @@ -53,7 +53,7 @@ - family: Caffee given: Gabrielle L. issued: - - year: '1960' + - year: 1960 title: The rites of passage title-short: Rites of passage publisher: University of Chicago Press diff --git a/tests/biblio2yaml/vangennep.biblatex b/tests/biblio2yaml/vangennep.biblatex --- a/tests/biblio2yaml/vangennep.biblatex +++ b/tests/biblio2yaml/vangennep.biblatex @@ -44,7 +44,7 @@ given: Arnold non-dropping-particle: van issued: - - year: '1909' + - year: 1909 title: Les rites de passage title-short: Rites de passage publisher: Nourry diff --git a/tests/biblio2yaml/vazques-de-parga-mvbook.biblatex b/tests/biblio2yaml/vazques-de-parga-mvbook.biblatex --- a/tests/biblio2yaml/vazques-de-parga-mvbook.biblatex +++ b/tests/biblio2yaml/vazques-de-parga-mvbook.biblatex @@ -56,7 +56,7 @@ - family: Uría Ríu given: Juan issued: - - year: '1993' + - year: 1993 title: Las Peregrinaciones a Santiago de Compostela title-short: Peregrinaciones publisher: Iberdrola diff --git a/tests/biblio2yaml/vazques-de-parga.biblatex b/tests/biblio2yaml/vazques-de-parga.biblatex --- a/tests/biblio2yaml/vazques-de-parga.biblatex +++ b/tests/biblio2yaml/vazques-de-parga.biblatex @@ -55,7 +55,7 @@ - family: Uría Ríu given: Juan issued: - - year: '1993' + - year: 1993 title: Las Peregrinaciones a Santiago de Compostela title-short: Peregrinaciones publisher: Iberdrola diff --git a/tests/biblio2yaml/vizedom-related.biblatex b/tests/biblio2yaml/vizedom-related.biblatex --- a/tests/biblio2yaml/vizedom-related.biblatex +++ b/tests/biblio2yaml/vizedom-related.biblatex @@ -52,7 +52,7 @@ - family: Caffee given: Gabrielle L. issued: - - year: '1960' + - year: 1960 title: The rites of passage title-short: Rites of passage publisher: University of Chicago Press diff --git a/tests/biblio2yaml/wassenberg.biblatex b/tests/biblio2yaml/wassenberg.biblatex --- a/tests/biblio2yaml/wassenberg.biblatex +++ b/tests/biblio2yaml/wassenberg.biblatex @@ -58,9 +58,9 @@ - family: Sanders given: Peter issued: - - year: '2010' - month: '8' - day: '17' + - year: 2010 + month: 8 + day: 17 title: Faster radix sort via virtual memory and write-combining version: '1' annote: A recent online reference from arXiv using the new (April 2007 onward) identifier diff --git a/tests/biblio2yaml/weinberg.biblatex b/tests/biblio2yaml/weinberg.biblatex --- a/tests/biblio2yaml/weinberg.biblatex +++ b/tests/biblio2yaml/weinberg.biblatex @@ -38,7 +38,7 @@ - family: Weinberg given: Steven issued: - - year: '1967' + - year: 1967 title: A model of leptons container-title: Phys. Rev. Lett. page: '1264-1266' diff --git a/tests/biblio2yaml/westfahl-frontier.biblatex b/tests/biblio2yaml/westfahl-frontier.biblatex --- a/tests/biblio2yaml/westfahl-frontier.biblatex +++ b/tests/biblio2yaml/westfahl-frontier.biblatex @@ -43,7 +43,7 @@ - family: Westfahl given: Gary issued: - - year: '2000' + - year: 2000 title: 'Space and beyond: The frontier theme in science fiction' title-short: Space and beyond publisher: Greenwood diff --git a/tests/biblio2yaml/westfahl-space.biblatex b/tests/biblio2yaml/westfahl-space.biblatex --- a/tests/biblio2yaml/westfahl-space.biblatex +++ b/tests/biblio2yaml/westfahl-space.biblatex @@ -71,7 +71,7 @@ - family: Westfahl given: Gary issued: - - year: '2000' + - year: 2000 title: 'The true frontier: Confronting and avoiding the realities of space in American science fiction films' title-short: The true frontier @@ -89,7 +89,7 @@ - family: Westfahl given: Gary issued: - - year: '2000' + - year: 2000 title: 'Space and beyond: The frontier theme in science fiction' title-short: Space and beyond publisher: Greenwood diff --git a/tests/biblio2yaml/wilde.biblatex b/tests/biblio2yaml/wilde.biblatex --- a/tests/biblio2yaml/wilde.biblatex +++ b/tests/biblio2yaml/wilde.biblatex @@ -48,7 +48,7 @@ - family: Wilde given: Oscar issued: - - year: '1899' + - year: 1899 title: 'The importance of being earnest: A trivial comedy for serious people' title-short: The importance of being earnest collection-title: English and american drama of the nineteenth century diff --git a/tests/biblio2yaml/worman.biblatex b/tests/biblio2yaml/worman.biblatex --- a/tests/biblio2yaml/worman.biblatex +++ b/tests/biblio2yaml/worman.biblatex @@ -44,7 +44,7 @@ - family: Worman given: Nancy issued: - - year: '2002' + - year: 2002 title: 'The cast of character: Style in Greek literature' title-short: Cast of character publisher: University of Texas Press diff --git a/tests/biblio2yaml/yoon.biblatex b/tests/biblio2yaml/yoon.biblatex --- a/tests/biblio2yaml/yoon.biblatex +++ b/tests/biblio2yaml/yoon.biblatex @@ -50,7 +50,7 @@ - family: Ahn given: Kyo Han issued: - - year: '2006' + - year: 2006 title: 'Palladium pincer complexes with reduced bond angle strain: Efficient catalysts for the Heck reaction' title-short: Palladium pincer complexes with reduced bond angle strain diff --git a/tests/issue250.expected.native b/tests/issue250.expected.native new file mode 100644 --- /dev/null +++ b/tests/issue250.expected.native @@ -0,0 +1,5 @@ +Pandoc (Meta {unMeta = fromList [("link-citations",MetaBool True),("references",MetaList [MetaMap (fromList [("author",MetaMap (fromList [("family",MetaInlines [Str "Doe"])])),("id",MetaInlines [Str "doe"]),("title",MetaInlines [Str "Title"])])])]}) +[Para [Cite [Citation {citationId = "doe", citationPrefix = [], citationSuffix = [], citationMode = NormalCitation, citationNoteNum = 0, citationHash = 1}] [Str "(Doe,",Space,Link ("",[],[]) [Str "n.d."] ("#ref-doe",""),Str ")"]] +,Div ("refs",["references"],[]) + [Div ("ref-doe",[],[]) + [Para [Str "Doe.",Space,Str "n.d.",Space,Str "\8220Title.\8221"]]]] diff --git a/tests/issue250.in.native b/tests/issue250.in.native new file mode 100644 --- /dev/null +++ b/tests/issue250.in.native @@ -0,0 +1,2 @@ +Pandoc (Meta {unMeta = fromList [("link-citations",MetaBool True),("references",MetaList [MetaMap (fromList [("author",MetaMap (fromList [("family",MetaInlines [Str "Doe"])])),("id",MetaInlines [Str "doe"]),("title",MetaInlines [Str "Title"])])])]}) +[Para [Cite [Citation {citationId = "doe", citationPrefix = [], citationSuffix = [], citationMode = NormalCitation, citationNoteNum = 0, citationHash = 0}] [Str "[@doe]"]]] diff --git a/tests/jats.csl b/tests/jats.csl deleted file mode 100644 --- a/tests/jats.csl +++ /dev/null @@ -1,208 +0,0 @@ - - - diff --git a/tests/modern-language-association-7th-edition.csl b/tests/modern-language-association-7th-edition.csl new file mode 100644 --- /dev/null +++ b/tests/modern-language-association-7th-edition.csl @@ -0,0 +1,460 @@ + + diff --git a/tests/test-citeproc.hs b/tests/test-citeproc.hs --- a/tests/test-citeproc.hs +++ b/tests/test-citeproc.hs @@ -1,28 +1,31 @@ -{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, - ScopedTypeVariables, CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeSynonymInstances #-} -import Text.Printf -import System.Exit -import qualified Control.Exception as E -import Text.Pandoc (Block(..), Inline(..), Format(..), bottomUp, - nullMeta, Pandoc(..)) -import Text.CSL.Compat.Pandoc (writeHtmlString) -import Data.Char (isSpace, toLower) -import System.Environment (getArgs) -import System.Process -import System.IO.Temp (withSystemTempDirectory) -import qualified Text.Pandoc.UTF8 as UTF8 -import Data.Aeson -import Data.Aeson.Types (Parser) -import System.FilePath -import System.Directory -import Data.List (sort, isInfixOf) -import qualified Data.Map as M -import Text.CSL.Style hiding (Number) -import Text.CSL.Reference -import Text.CSL -import Control.Monad -import qualified Data.ByteString.Lazy as BL +import qualified Control.Exception as E +import Control.Monad +import Data.Aeson +import Data.Aeson.Types (Parser) +import qualified Data.ByteString.Lazy as BL +import Data.Char (isSpace, toLower) +import Data.List (isInfixOf, sort) +import qualified Data.Map as M +import System.Directory +import System.Environment (getArgs) +import System.Exit +import System.FilePath +import System.IO.Temp (withSystemTempDirectory) +import System.Process +import Text.CSL +import Text.CSL.Compat.Pandoc (writeHtmlString) +import Text.CSL.Reference +import Text.CSL.Style hiding (Number) +import Text.Pandoc (Block (..), Format (..), Inline (..), + Pandoc (..), bottomUp, nullMeta) +import qualified Text.Pandoc.UTF8 as UTF8 +import Text.Printf data TestCase = TestCase{ testMode :: Mode -- mode @@ -43,12 +46,12 @@ deriving Show instance FromJSON Mode where - parseJSON (String "citation") = return CitationMode - parseJSON (String "citation-rtf") = return CitationRTFMode - parseJSON (String "bibliography") = return BibliographyMode + parseJSON (String "citation") = return CitationMode + parseJSON (String "citation-rtf") = return CitationRTFMode + parseJSON (String "bibliography") = return BibliographyMode parseJSON (String "bibliography-header") = return BibliographyHeaderMode parseJSON (String "bibliography-nosort") = return BibliographyNoSortMode - parseJSON _ = fail "Unknown mode" + parseJSON _ = fail "Unknown mode" instance FromJSON TestCase where parseJSON (Object v) = TestCase <$> @@ -61,8 +64,8 @@ v .: "input" <*> v .: "result" where parseCitations :: Data.Aeson.Value -> Parser [CiteObject] - parseCitations x@(Array{}) = parseJSON x - parseCitations _ = return [] + parseCitations x@Array{} = parseJSON x + parseCitations _ = return [] parseJSON _ = fail "Could not parse test case" newtype CiteObject = @@ -81,7 +84,7 @@ #else instance FromJSON [CiteObject] where parseJSON (Array v) = mapM parseJSON $ V.toList v - parseJSON _ = return [] + parseJSON _ = return [] #endif data TestResult = @@ -153,8 +156,8 @@ -- We want & instead of & etc. adjustEntities :: String -> String adjustEntities ('&':'#':'3':'8':';':xs) = "&" ++ adjustEntities xs -adjustEntities (x:xs) = x : adjustEntities xs -adjustEntities [] = [] +adjustEntities (x:xs) = x : adjustEntities xs +adjustEntities [] = [] -- citeproc-js test suite expects "citations" to be formatted like -- .. [0] Smith (2007) diff --git a/tests/test-pandoc-citeproc.hs b/tests/test-pandoc-citeproc.hs --- a/tests/test-pandoc-citeproc.hs +++ b/tests/test-pandoc-citeproc.hs @@ -1,30 +1,30 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where -import System.Exit -import System.Directory -import System.FilePath -import Data.Maybe (fromMaybe) -import System.IO -import System.IO.Temp (withSystemTempDirectory) -import System.Process (rawSystem) -import qualified Data.Aeson as Aeson -import Text.Pandoc.Definition -import qualified Text.Pandoc.UTF8 as UTF8 -import Text.CSL.Compat.Pandoc (writeNative, pipeProcess) -import Data.List (isSuffixOf) -import System.Environment -import Control.Monad (when) +import Control.Monad (when) +import qualified Data.Aeson as Aeson +import Data.List (isSuffixOf) +import Data.Maybe (fromMaybe) +import System.Directory +import System.Environment +import System.Exit +import System.FilePath +import System.IO +import System.IO.Temp (withSystemTempDirectory) +import System.Process (rawSystem) +import Text.CSL.Compat.Pandoc (pipeProcess, writeNative) +import Text.Pandoc.Definition +import qualified Text.Pandoc.UTF8 as UTF8 #if MIN_VERSION_pandoc(2,0,0) -import qualified Control.Exception as E +import qualified Control.Exception as E #endif main :: IO () main = do args <- getArgs let regenerate = "--accept" `elem` args - testnames <- fmap (map (dropExtension . takeBaseName) . - filter (".in.native" `isSuffixOf`)) $ + testnames <- (map (dropExtension . takeBaseName) . + filter (".in.native" `isSuffixOf`)) <$> getDirectoryContents "tests" citeprocTests <- mapM (testCase regenerate) testnames fs <- filter (\f -> takeExtension f `elem` [".bibtex",".biblatex"]) @@ -57,7 +57,7 @@ hPutStr stderr $ "[" ++ csl ++ ".in.native] " indataNative <- UTF8.readFile $ "tests/" ++ csl ++ ".in.native" expectedNative <- UTF8.readFile $ "tests/" ++ csl ++ ".expected.native" - let jsonIn = Aeson.encode $ (read indataNative :: Pandoc) + let jsonIn = Aeson.encode (read indataNative :: Pandoc) let expectedDoc = read expectedNative testProgPath <- getExecutablePath let pandocCiteprocPath = takeDirectory testProgPath ".." @@ -68,11 +68,11 @@ [] jsonIn if ec == ExitSuccess then do - let outDoc = fromMaybe mempty $ Aeson.decode $ jsonOut + let outDoc = fromMaybe mempty $Aeson.decode jsonOut if outDoc == expectedDoc then err "PASSED" >> return Passed else do - err $ "FAILED" + err "FAILED" showDiff (writeNative expectedDoc) (writeNative outDoc) when regenerate $ UTF8.writeFile ("tests/" ++ csl ++ ".expected.native") $