Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-citeproc for openSUSE:Factory checked in at 2025-10-28 14:47:47 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-citeproc (Old) and /work/SRC/openSUSE:Factory/.ghc-citeproc.new.1980 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-citeproc" Tue Oct 28 14:47:47 2025 rev:28 rq:1314002 version:0.11 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-citeproc/ghc-citeproc.changes 2025-09-12 21:10:08.012753975 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-citeproc.new.1980/ghc-citeproc.changes 2025-10-28 14:48:25.031609004 +0100 @@ -1,0 +2,37 @@ +Sun Oct 19 21:11:29 UTC 2025 - Peter Simons <[email protected]> + +- Update citeproc to version 0.11. + ## 0.11 + + * Expand macros in evaluation rather than style parsing (#172). + This fixes a serious performance issue in styles with heavy + use of macros, such as the new chicago styles. With this change, + memory use goes down by more than a factor of ten with these styles. + + * All fields in NameFormat are now Maybe values, so we can tell what + has been explicitly set [API change]. + + * A new function `combineNameFormat` allows filling Nothing values + in the first argument with Just values in the second [API change]. + The old defaults that were used for the non-Maybe values are + now set at the appropriate place in Citeproc.Eval. + + * Add `styleNameFormat` field to Style [API change]. + + * Add `layoutNameFormat` to Layout [API change]. + + * Add parameter for a NameFormat to SortKeyMacro constructor on SortKey + [API change]. + + * CSL JSON: allow formatting in numeric fields (#170). + There's a catch, though. Currently the number splitting code + (`splitNums`) has to convert everything to text, so the + formatting will be lost. Still, this is better than treating + the formatting code as plain text which will then be escaped + in the output. So, for example, we get + `1er` instead of `1<sup>er</sup>` for + CSL JSON `1<sup>er</sup>`. + + * Improve test suite so that expected failures are tracked. + +------------------------------------------------------------------- Old: ---- citeproc-0.10.tar.gz New: ---- citeproc-0.11.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-citeproc.spec ++++++ --- /var/tmp/diff_new_pack.CxYlsq/_old 2025-10-28 14:48:25.607633229 +0100 +++ /var/tmp/diff_new_pack.CxYlsq/_new 2025-10-28 14:48:25.607633229 +0100 @@ -20,7 +20,7 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.10 +Version: 0.11 Release: 0 Summary: Generates citations and bibliography from CSL styles License: BSD-2-Clause ++++++ citeproc-0.10.tar.gz -> citeproc-0.11.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/citeproc-0.10/CHANGELOG.md new/citeproc-0.11/CHANGELOG.md --- old/citeproc-0.10/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/citeproc-0.11/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,38 @@ # citeproc changelog +## 0.11 + + * Expand macros in evaluation rather than style parsing (#172). + This fixes a serious performance issue in styles with heavy + use of macros, such as the new chicago styles. With this change, + memory use goes down by more than a factor of ten with these styles. + + * All fields in NameFormat are now Maybe values, so we can tell what + has been explicitly set [API change]. + + * A new function `combineNameFormat` allows filling Nothing values + in the first argument with Just values in the second [API change]. + The old defaults that were used for the non-Maybe values are + now set at the appropriate place in Citeproc.Eval. + + * Add `styleNameFormat` field to Style [API change]. + + * Add `layoutNameFormat` to Layout [API change]. + + * Add parameter for a NameFormat to SortKeyMacro constructor on SortKey + [API change]. + + * CSL JSON: allow formatting in numeric fields (#170). + There's a catch, though. Currently the number splitting code + (`splitNums`) has to convert everything to text, so the + formatting will be lost. Still, this is better than treating + the formatting code as plain text which will then be escaped + in the output. So, for example, we get + `1er` instead of `1<sup>er</sup>` for + CSL JSON `1<sup>er</sup>`. + + * Improve test suite so that expected failures are tracked. + ## 0.10 * Update locales from upstream (#161). A number of new locales, as well diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/citeproc-0.10/citeproc.cabal new/citeproc-0.11/citeproc.cabal --- old/citeproc-0.10/citeproc.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/citeproc-0.11/citeproc.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ cabal-version: 2.2 name: citeproc -version: 0.10 +version: 0.11 synopsis: Generates citations and bibliography from CSL styles. description: citeproc parses CSL style files and uses them to generate a list of formatted citations and bibliography diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/citeproc-0.10/src/Citeproc/Element.hs new/citeproc-0.11/src/Citeproc/Element.hs --- old/citeproc-0.10/src/Citeproc/Element.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/citeproc-0.11/src/Citeproc/Element.hs 2001-09-09 03:46:40.000000000 +0200 @@ -11,7 +11,6 @@ , getChildren , allChildren , getAttributes - , getNameAttributes , getFormatting , getTextContent ) @@ -23,9 +22,7 @@ import qualified Text.XML as X import Data.Text (Text) import qualified Data.Text as T -import Control.Monad.Trans.Reader import Control.Monad.Trans.Except -import Control.Monad.Trans.Class (lift) newtype Attributes = Attributes (M.Map Text Text) deriving (Show, Semigroup, Monoid, Eq) @@ -33,13 +30,13 @@ lookupAttribute :: Text -> Attributes -> Maybe Text lookupAttribute key (Attributes kvs) = M.lookup key kvs -type ElementParser = ReaderT (M.Map X.Name Text) (Except CiteprocError) +type ElementParser = Except CiteprocError runElementParser :: ElementParser a -> Either CiteprocError a -runElementParser p = runExcept (runReaderT p mempty) +runElementParser = runExcept parseFailure :: String -> ElementParser a -parseFailure s = lift $ throwE (CiteprocParseError $ T.pack s) +parseFailure s = throwE (CiteprocParseError $ T.pack s) getChildren :: Text -> X.Element -> [X.Element] getChildren name el = [e | X.NodeElement e <- X.elementNodes el @@ -52,13 +49,6 @@ getAttributes = Attributes . M.mapKeys X.nameLocalName . X.elementAttributes --- Like getAttributes but incorporates inheritable attributes. -getNameAttributes :: X.Element -> ElementParser Attributes -getNameAttributes node = do - nameattr <- ask - let xattr = X.elementAttributes node <> nameattr - return $ Attributes $ M.mapKeys X.nameLocalName xattr - getFormatting :: Attributes -> Formatting getFormatting attr = Formatting diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/citeproc-0.10/src/Citeproc/Eval.hs new/citeproc-0.11/src/Citeproc/Eval.hs --- old/citeproc-0.10/src/Citeproc/Eval.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/citeproc-0.11/src/Citeproc/Eval.hs 2001-09-09 03:46:40.000000000 +0200 @@ -42,6 +42,7 @@ , contextCollate :: [SortKeyValue] -> [SortKeyValue] -> Ordering , contextAbbreviations :: Maybe Abbreviations , contextStyleOptions :: StyleOptions + , contextMacros :: M.Map Text [Element a] , contextLocator :: Maybe Text , contextLabel :: Maybe Text , contextPosition :: [Position] @@ -49,6 +50,7 @@ , contextInSortKey :: Bool , contextInBibliography :: Bool , contextSubstituteNamesForm :: Maybe NamesFormat + , contextNameFormat :: NameFormat } -- used internally for group elements, which @@ -108,6 +110,7 @@ , contextCollate = compSortKeyValues (Unicode.comp mblang) , contextAbbreviations = styleAbbreviations style , contextStyleOptions = styleOptions style + , contextMacros = styleMacros style , contextLocator = Nothing , contextLabel = Nothing , contextPosition = [] @@ -115,6 +118,7 @@ , contextInSortKey = False , contextInBibliography = False , contextSubstituteNamesForm = Nothing + , contextNameFormat = styleNameFormat (styleOptions style) } EvalState { stateVarCount = VarCount 0 0 @@ -193,11 +197,7 @@ case layoutSortKeys biblayout of (SortKeyVariable Descending "citation-number":_) -> reverse sortedIds - (SortKeyMacro Descending - (Element (ENumber "citation-number" _) _:_) : _) - -> reverse sortedIds - (SortKeyMacro Descending - (Element (EText (TextVariable _ "citation-number")) _:_): _) + (SortKeyMacro Descending _ _:_) -> reverse sortedIds _ -> sortedIds let bibCitations = map (\ident -> @@ -1005,25 +1005,34 @@ -> ItemId -> Eval a [SortKeyValue] evalSortKeys layout citeId = - withRWST (\ctx st -> (ctx{ contextInSortKey = True }, st)) $ + withRWST (\ctx st -> (ctx{ contextInSortKey = True + , contextNameFormat = + layoutNameFormat (layoutOptions layout) + }, st)) $ mapM (evalSortKey citeId) (layoutSortKeys layout) evalSortKey :: CiteprocOutput a => ItemId -> SortKey a -> Eval a SortKeyValue -evalSortKey citeId (SortKeyMacro sortdir elts) = do +evalSortKey citeId (SortKeyMacro sortdir nameformat macroname) = do + macros <- asks contextMacros + elts <- case M.lookup macroname macros of + Nothing -> [] <$ warn ("undefined macro " <> macroname) + Just els -> pure els refmap <- gets stateRefMap case lookupReference citeId refmap of Nothing -> return $ SortKeyValue sortdir Nothing Just ref -> do k <- normalizeSortKey . toText . renderOutput defaultCiteprocOptions . grouped - <$> withRWS newContext (mconcat <$> mapM eElement elts) + <$> withRWS newContext (eElements elts) return $ SortKeyValue sortdir (Just k) where newContext oldContext s = - (oldContext, s{ stateReference = ref }) + (oldContext{ contextNameFormat = combineNameFormat + nameformat (contextNameFormat oldContext)}, + s{ stateReference = ref }) evalSortKey citeId (SortKeyVariable sortdir var) = do refmap <- gets stateRefMap SortKeyValue sortdir <$> @@ -1107,7 +1116,11 @@ => Layout a -> (Int, Citation a) -> Eval a (Output a) -evalLayout layout (citationGroupNumber, citation) = do +evalLayout layout (citationGroupNumber, citation) = local + (\ctx -> ctx{ contextNameFormat = + combineNameFormat + (layoutNameFormat (layoutOptions layout)) + (contextNameFormat ctx) } ) $ do -- this is a hack to ensure that "ibid" detection will work -- correctly in a citation starting with an author-only: -- the combination AuthorOnly [SuppressAuthor] should not @@ -1230,7 +1243,7 @@ , stateUsedIdentifier = False , stateUsedTitle = False })) - $ do xs <- mconcat <$> mapM eElement (layoutElements layout) + $ do xs <- eElements (layoutElements layout) -- find identifiers that can be used to hyperlink the title let mbident = @@ -1397,9 +1410,17 @@ else id) $ [Subsequent] +eElements :: CiteprocOutput a => [Element a] -> Eval a [Output a] +eElements els = mconcat <$> mapM eElement els + eElement :: CiteprocOutput a => Element a -> Eval a [Output a] eElement (Element etype formatting) = case etype of + EText (TextMacro name) -> do + macros <- asks contextMacros + case M.lookup name macros of + Nothing -> [] <$ warn ("undefined macro " <> name) + Just els -> eElement (Element (EGroup True els) formatting) EText textType -> (:[]) <$> withFormatting formatting (eText textType) ENumber var nform -> @@ -1598,7 +1619,7 @@ "year-suffix" -> do disamb <- gets (referenceDisambiguation . stateReference) case disamb >>= disambYearSuffix of - Just x -> + Just x -> do -- we don't update var count here; this doesn't -- count as a variable return $ Tagged (TagYearSuffix x) @@ -1682,7 +1703,7 @@ let url = identifierToURL (identConstr t) return $ Linked url [Literal $ fromText t] eText (TextMacro name) = do - warn $ "encountered unexpanded macro " <> name + warn ("unexpanded macro " <> name) return NullOutput eText (TextValue t) = return $ Literal $ fromText t eText (TextTerm term) = do @@ -1758,6 +1779,7 @@ ContextualPluralize -> case x of TextVal t -> determinePlural t + NumVal n -> determinePlural (T.pack (show n)) FancyVal w -> determinePlural (toText w) NamesVal ns -> if length ns > 1 then Plural @@ -2031,8 +2053,12 @@ -> [Element a] -> Formatting -> Eval a (Output a) -eNames vars namesFormat' subst formatting = do +eNames vars namesFormat' subst formatting' = do substituteNamesForm <- asks contextSubstituteNamesForm + cNameFormat <- asks contextNameFormat + let formatting = formatting'{ formatDelimiter = + formatDelimiter formatting' <|> + nameDelimiter cNameFormat } inSortKey <- asks contextInSortKey let namesFormat = case substituteNamesForm of @@ -2075,7 +2101,9 @@ else return vars inSubstitute <- asks contextInSubstitute let (nameFormat, nameFormatting') = - fromMaybe (defaultNameFormat, mempty) (namesName namesFormat) + case namesName namesFormat of + Nothing -> (cNameFormat, mempty) + Just (nf,f) -> (combineNameFormat nf cNameFormat, f) let nameFormatting = nameFormatting' <> formatting{ formatPrefix = Nothing , formatSuffix = Nothing @@ -2110,7 +2138,7 @@ return $ case nameForm nameFormat of - CountName -> Literal $ fromText $ T.pack $ show $ length + Just CountName -> Literal $ fromText $ T.pack $ show $ length [name | Tagged (TagName name) _ <- concatMap universe xs] _ -> formatted mempty{ formatPrefix = formatPrefix formatting @@ -2149,8 +2177,8 @@ inSortKey <- asks contextInSortKey disamb <- gets (referenceDisambiguation . stateReference) names' <- zipWithM (formatName nameFormat formatting) [1..] names - let delim' = fromMaybe (nameDelimiter nameFormat) $ - formatDelimiter formatting + let delim' = fromMaybe ", " $ + (formatDelimiter formatting <|> nameDelimiter nameFormat) let delim = case (beginsWithSpace <$> formatSuffix formatting, endsWithSpace <$> formatPrefix formatting) of (Just True, Just True) -> T.strip delim' @@ -2175,7 +2203,7 @@ Nothing -> return Nothing let finalNameIsOthers = (lastMay names >>= nameLiteral) == Just "others" -- bibtex conversions often have this, and we want to render it "et al" - let etAlUseLast = nameEtAlUseLast nameFormat + let etAlUseLast = fromMaybe False $ nameEtAlUseLast nameFormat let etAlThreshold = case etAlMin of Just x | numnames >= x -> case (disamb >>= disambEtAlNames, etAlUseFirst) of @@ -2188,7 +2216,8 @@ case mbAndTerm of Nothing -> delim Just _ -> - case nameDelimiterPrecedesLast nameFormat of + case fromMaybe PrecedesContextual + (nameDelimiterPrecedesLast nameFormat) of PrecedesContextual | numnames > 2 -> delim | otherwise -> "" @@ -2216,7 +2245,8 @@ Just t | endsWithSpace t -> "" _ -> " " let beforeEtAl = - case nameDelimiterPrecedesEtAl nameFormat of + case fromMaybe PrecedesContextual + (nameDelimiterPrecedesEtAl nameFormat) of PrecedesContextual | numnames > 2 , etAlThreshold > Just 1 -> delim @@ -2283,18 +2313,18 @@ case M.lookup name . disambNameMap =<< disamb of Nothing -> nameFormat Just AddInitials - -> nameFormat{ nameForm = LongName } + -> nameFormat{ nameForm = Just LongName } Just AddInitialsIfPrimary - | order == 1 -> nameFormat{ nameForm = LongName } + | order == 1 -> nameFormat{ nameForm = Just LongName } | otherwise -> nameFormat Just AddGivenName -> - nameFormat{ nameForm = LongName - , nameInitialize = False + nameFormat{ nameForm = Just LongName + , nameInitialize = Just False } Just AddGivenNameIfPrimary | order == 1 -> - nameFormat{ nameForm = LongName - , nameInitialize = False + nameFormat{ nameForm = Just LongName + , nameInitialize = Just False } | otherwise -> nameFormat Tagged (TagName name) <$> @@ -2421,11 +2451,11 @@ Just initializeWith -> initialize mblang - (nameInitialize nameFormat) + (fromMaybe True (nameInitialize nameFormat)) initializeWithHyphen initializeWith Nothing -> id - let separator = nameSortSeparator nameFormat + let separator = fromMaybe ", " $ nameSortSeparator nameFormat let x <+> NullOutput = x NullOutput <+> x = x Literal x <+> y = @@ -2496,7 +2526,7 @@ return $ formatted formatting . (:[]) $ if isByzantineName name then - case nameForm nameFormat of + case fromMaybe LongName (nameForm nameFormat) of LongName | demoteNonDroppingParticle == DemoteNever , inSortKey || nameAsSort -> @@ -2556,7 +2586,7 @@ family ] CountName -> NullOutput else - case nameForm nameFormat of + case fromMaybe LongName (nameForm nameFormat) of LongName -> grouped [ familyAffixes [ family ] @@ -2574,7 +2604,7 @@ -- calls at least one variable but all of the variables -- it calls are empty. VarCount oldVars oldNonempty <- gets stateVarCount - xs <- mconcat <$> mapM eElement els + xs <- eElements els VarCount newVars newNonempty <- gets stateVarCount let isempty = newVars /= oldVars && newNonempty == oldNonempty @@ -2638,7 +2668,7 @@ MatchAny -> any testCondition MatchNone -> not . any testCondition) conditions if matched - then mconcat <$> mapM eElement els + then eElements els else eChoose rest diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/citeproc-0.10/src/Citeproc/Style.hs new/citeproc-0.11/src/Citeproc/Style.hs --- old/citeproc-0.10/src/Citeproc/Style.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/citeproc-0.11/src/Citeproc/Style.hs 2001-09-09 03:46:40.000000000 +0200 @@ -18,7 +18,6 @@ import Data.Maybe (fromMaybe, isNothing) import Data.Default (def) import qualified Data.Text.Lazy as TL -import Control.Monad.Trans.Reader (local) -- | Merge the locale specified by the first parameter, if any, -- with the default locale of the style and locale definitions @@ -96,136 +95,135 @@ pStyle :: Maybe Lang -> X.Element -> ElementParser (Style a) pStyle defaultLocale node = do - let attrmap = getInheritableNameAttributes node - local (<> attrmap) $ do - let attr = getAttributes node - macroMap <- M.fromList <$> mapM pMacro (getChildren "macro" node) - (cattr, citations) - <- case getChildren "citation" node of - [n] -> (getAttributes n,) <$> pLayout macroMap n - [] -> parseFailure "No citation element present" - _ -> parseFailure "More than one citation element present" - (battr, bibliography) <- case getChildren "bibliography" node of - [n] -> (\z -> (getAttributes n, Just z)) - <$> pLayout macroMap n - [] -> return (mempty, Nothing) - _ -> parseFailure - "More than one bibliography element present" - - let disambiguateGivenNameRule = - case lookupAttribute "givenname-disambiguation-rule" cattr of - Just "all-names" -> AllNames - Just "all-names-with-initials" -> AllNamesWithInitials - Just "primary-name" -> PrimaryName - Just "primary-name-with-initials" -> PrimaryNameWithInitials - _ -> ByCite - - let disambigStrategy = - DisambiguationStrategy - { disambiguateAddNames = - lookupAttribute "disambiguate-add-names" cattr == Just "true" - , disambiguateAddGivenNames = - case lookupAttribute "disambiguate-add-givenname" cattr of - Just "true" -> Just disambiguateGivenNameRule - _ -> Nothing - , disambiguateAddYearSuffix = - lookupAttribute "disambiguate-add-year-suffix" cattr == - Just "true" - } - - let hasYearSuffixVariable - (Element (EText (TextVariable _ "year-suffix")) _) = True - hasYearSuffixVariable - (Element (EGroup _ es) _) = any hasYearSuffixVariable es - hasYearSuffixVariable - (Element (EChoose []) _) = False - hasYearSuffixVariable - (Element (EChoose ((_,_,es):conds)) f) = - any hasYearSuffixVariable es || + let attr = getAttributes node + let nameformat = getInheritableNameFormat attr + macros <- M.fromList <$> mapM pMacro (getChildren "macro" node) + (cattr, citations) + <- case getChildren "citation" node of + [n] -> (getAttributes n,) <$> pLayout n + [] -> parseFailure "No citation element present" + _ -> parseFailure "More than one citation element present" + (battr, bibliography) <- case getChildren "bibliography" node of + [n] -> (\z -> (getAttributes n, Just z)) + <$> pLayout n + [] -> return (mempty, Nothing) + _ -> parseFailure + "More than one bibliography element present" + + let disambiguateGivenNameRule = + case lookupAttribute "givenname-disambiguation-rule" cattr of + Just "all-names" -> AllNames + Just "all-names-with-initials" -> AllNamesWithInitials + Just "primary-name" -> PrimaryName + Just "primary-name-with-initials" -> PrimaryNameWithInitials + _ -> ByCite + + let disambigStrategy = + DisambiguationStrategy + { disambiguateAddNames = + lookupAttribute "disambiguate-add-names" cattr == Just "true" + , disambiguateAddGivenNames = + case lookupAttribute "disambiguate-add-givenname" cattr of + Just "true" -> Just disambiguateGivenNameRule + _ -> Nothing + , disambiguateAddYearSuffix = + lookupAttribute "disambiguate-add-year-suffix" cattr == + Just "true" + } + + let hasYearSuffixVariable (Element e f) = + case e of + EText (TextVariable _ "year-suffix") -> True + EText (TextMacro macroname) + | Just es' <- M.lookup macroname macros -> + any hasYearSuffixVariable es' + EGroup _ es -> any hasYearSuffixVariable es + EChoose [] -> False + EChoose ((_,_,es):conds) -> any hasYearSuffixVariable es || hasYearSuffixVariable (Element (EChoose conds) f) - hasYearSuffixVariable _ = False - let usesYearSuffixVariable = - any hasYearSuffixVariable $ - layoutElements citations ++ maybe [] layoutElements bibliography - - let sOpts = StyleOptions - { styleIsNoteStyle = - case lookupAttribute "class" attr of - Just "note" -> True - Nothing -> True - _ -> False - , styleDefaultLocale = defaultLocale - , styleDemoteNonDroppingParticle = - case lookupAttribute "demote-non-dropping-particle" attr of - Just "never" -> DemoteNever - Just "sort-only" -> DemoteSortOnly - _ -> DemoteDisplayAndSort - , styleInitializeWithHyphen = - maybe True (== "true") $ - lookupAttribute "initialize-with-hyphen" attr - , stylePageRangeFormat = - case lookupAttribute "page-range-format" attr of - Just "chicago" -> Just PageRangeChicago15 - -- chicago is an alias for chicago-15, but this - -- will change to chicago-16 in v1.1 - Just "chicago-15" -> Just PageRangeChicago15 - Just "chicago-16" -> Just PageRangeChicago16 - Just "expanded" -> Just PageRangeExpanded - Just "minimal" -> Just PageRangeMinimal - Just "minimal-two" -> Just PageRangeMinimalTwo - _ -> Nothing - , stylePageRangeDelimiter = - lookupAttribute "page-range-delimiter" attr - , styleDisambiguation = disambigStrategy - , styleNearNoteDistance = - lookupAttribute "near-note-distance" attr >>= readAsInt - , styleCiteGroupDelimiter = - lookupAttribute "cite-group-delimiter" cattr <|> - (", " <$ lookupAttribute "collapse" cattr) - , styleLineSpacing = - lookupAttribute "line-spacing" battr >>= readAsInt - , styleEntrySpacing = - lookupAttribute "entry-spacing" battr >>= readAsInt - , styleHangingIndent = - lookupAttribute "hanging-indent" battr == Just "true" - , styleSecondFieldAlign = - case lookupAttribute "second-field-align" battr of - Just "flush" -> Just SecondFieldAlignFlush - Just "margin" -> Just SecondFieldAlignMargin - _ -> Nothing - , styleSubsequentAuthorSubstitute = - case lookupAttribute "subsequent-author-substitute" - battr of - Nothing -> Nothing - Just t -> Just $ - SubsequentAuthorSubstitute t - $ case lookupAttribute - "subsequent-author-substitute-rule" battr of - Just "complete-each" -> CompleteEach - Just "partial-each" -> PartialEach - Just "partial-first" -> PartialFirst - _ -> CompleteAll - , styleUsesYearSuffixVariable = usesYearSuffixVariable - } - locales <- mapM pLocale (getChildren "locale" node) - let cslVersion = case lookupAttribute "version" attr of - Nothing -> (0,0,0) - Just t -> - case map readAsInt (T.splitOn "." t) of - (Just x : Just y : Just z :_) -> (x,y,z) - (Just x : Just y : _) -> (x,y,0) - (Just x : _) -> (x,0,0) - _ -> (0,0,0) - return $ Style - { styleCslVersion = cslVersion - , styleOptions = sOpts - , styleCitation = citations - , styleBibliography = bibliography - , styleLocales = locales - , styleAbbreviations = Nothing - } - - + _ -> False + let usesYearSuffixVariable = + any hasYearSuffixVariable $ + layoutElements citations ++ maybe [] layoutElements bibliography + + let sOpts = StyleOptions + { styleIsNoteStyle = + case lookupAttribute "class" attr of + Just "note" -> True + Nothing -> True + _ -> False + , styleDefaultLocale = defaultLocale + , styleDemoteNonDroppingParticle = + case lookupAttribute "demote-non-dropping-particle" attr of + Just "never" -> DemoteNever + Just "sort-only" -> DemoteSortOnly + _ -> DemoteDisplayAndSort + , styleInitializeWithHyphen = + maybe True (== "true") $ + lookupAttribute "initialize-with-hyphen" attr + , stylePageRangeFormat = + case lookupAttribute "page-range-format" attr of + Just "chicago" -> Just PageRangeChicago15 + -- chicago is an alias for chicago-15, but this + -- will change to chicago-16 in v1.1 + Just "chicago-15" -> Just PageRangeChicago15 + Just "chicago-16" -> Just PageRangeChicago16 + Just "expanded" -> Just PageRangeExpanded + Just "minimal" -> Just PageRangeMinimal + Just "minimal-two" -> Just PageRangeMinimalTwo + _ -> Nothing + , stylePageRangeDelimiter = + lookupAttribute "page-range-delimiter" attr + , styleDisambiguation = disambigStrategy + , styleNearNoteDistance = + lookupAttribute "near-note-distance" attr >>= readAsInt + , styleCiteGroupDelimiter = + lookupAttribute "cite-group-delimiter" cattr <|> + (", " <$ lookupAttribute "collapse" cattr) + , styleLineSpacing = + lookupAttribute "line-spacing" battr >>= readAsInt + , styleEntrySpacing = + lookupAttribute "entry-spacing" battr >>= readAsInt + , styleHangingIndent = + lookupAttribute "hanging-indent" battr == Just "true" + , styleSecondFieldAlign = + case lookupAttribute "second-field-align" battr of + Just "flush" -> Just SecondFieldAlignFlush + Just "margin" -> Just SecondFieldAlignMargin + _ -> Nothing + , styleSubsequentAuthorSubstitute = + case lookupAttribute "subsequent-author-substitute" + battr of + Nothing -> Nothing + Just t -> Just $ + SubsequentAuthorSubstitute t + $ case lookupAttribute + "subsequent-author-substitute-rule" battr of + Just "complete-each" -> CompleteEach + Just "partial-each" -> PartialEach + Just "partial-first" -> PartialFirst + _ -> CompleteAll + , styleUsesYearSuffixVariable = usesYearSuffixVariable + , styleNameFormat = nameformat -- TODO + } + locales <- mapM pLocale (getChildren "locale" node) + let cslVersion = case lookupAttribute "version" attr of + Nothing -> (0,0,0) + Just t -> + case map readAsInt (T.splitOn "." t) of + (Just x : Just y : Just z :_) -> (x,y,z) + (Just x : Just y : _) -> (x,y,0) + (Just x : _) -> (x,0,0) + _ -> (0,0,0) + return $ Style + { styleCslVersion = cslVersion + , styleOptions = sOpts + , styleCitation = citations + , styleBibliography = bibliography + , styleLocales = locales + , styleAbbreviations = Nothing + , styleMacros = macros + } pElement :: X.Element -> ElementParser (Element a) pElement node = @@ -322,7 +320,7 @@ pNames :: X.Element -> ElementParser (Element a) pNames node = do - attr <- getNameAttributes node + let attr = getAttributes node let formatting = getFormatting attr let variables = maybe [] splitVars $ lookupAttribute "variable" attr let pChild (nf,subst) n = @@ -362,7 +360,7 @@ pName :: X.Element -> ElementParser (NameFormat, Formatting) pName node = do - attr <- getNameAttributes node + let attr = getAttributes node let formatting = getFormatting attr let nameParts = map getAttributes $ getChildren "name-part" node let nameformat = NameFormat @@ -384,43 +382,45 @@ Just "symbol" -> Just Symbol _ -> Nothing , nameDelimiter = - fromMaybe ", " $ lookupAttribute "delimiter" attr + lookupAttribute "delimiter" attr , nameDelimiterPrecedesEtAl = case lookupAttribute "delimiter-precedes-et-al" attr of - Just "after-inverted-name" -> PrecedesAfterInvertedName - Just "always" -> PrecedesAlways - Just "never" -> PrecedesNever - _ -> PrecedesContextual + Just "after-inverted-name" -> Just PrecedesAfterInvertedName + Just "always" -> Just PrecedesAlways + Just "never" -> Just PrecedesNever + Just "contextual" -> Just PrecedesContextual + _ -> Nothing , nameDelimiterPrecedesLast = case lookupAttribute "delimiter-precedes-last" attr of - Just "after-inverted-name" -> PrecedesAfterInvertedName - Just "always" -> PrecedesAlways - Just "never" -> PrecedesNever - _ -> PrecedesContextual + Just "after-inverted-name" -> Just PrecedesAfterInvertedName + Just "always" -> Just PrecedesAlways + Just "never" -> Just PrecedesNever + Just "contextual" -> Just PrecedesContextual + _ -> Nothing , nameEtAlMin = - (lookupAttribute "names-min" attr <|> - lookupAttribute "et-al-min" attr) >>= readAsInt + lookupAttribute "et-al-min" attr >>= readAsInt , nameEtAlUseFirst = - (lookupAttribute "names-use-first" attr <|> - lookupAttribute "et-al-use-first" attr) >>= readAsInt + lookupAttribute "et-al-use-first" attr >>= readAsInt , nameEtAlSubsequentUseFirst = lookupAttribute "et-al-subsequent-use-first" attr >>= readAsInt , nameEtAlSubsequentMin = lookupAttribute "et-al-subsequent-min" attr >>= readAsInt , nameEtAlUseLast = - case lookupAttribute "names-use-last" attr <|> - lookupAttribute "et-al-use-last" attr of - Just "true" -> True - _ -> False + case lookupAttribute "et-al-use-last" attr of + Just "true" -> Just True + Just "false" -> Just False + _ -> Nothing , nameForm = case lookupAttribute "form" attr of - Just "short" -> ShortName - Just "count" -> CountName - _ -> LongName + Just "short" -> Just ShortName + Just "count" -> Just CountName + Just "long" -> Just LongName + _ -> Nothing , nameInitialize = case lookupAttribute "initialize" attr of - Just "false" -> False - _ -> True + Just "false" -> Just False + Just "true" -> Just True + _ -> Nothing , nameInitializeWith = lookupAttribute "initialize-with" attr , nameAsSortOrder = @@ -429,7 +429,7 @@ Just "first" -> Just NameAsSortOrderFirst _ -> Nothing , nameSortSeparator = - fromMaybe ", " $ lookupAttribute "sort-separator" attr + lookupAttribute "sort-separator" attr } return (nameformat, formatting) @@ -461,9 +461,7 @@ Just var -> return $ EText (TextVariable varform (toVariable var)) Nothing -> case lookupAttribute "macro" attr of - Just _ -> do - elements <- mapM pElement (allChildren node) - return $ EGroup True elements + Just macroname -> return $ EText (TextMacro macroname) Nothing -> case lookupAttribute "term" attr of Just termname -> @@ -483,132 +481,143 @@ parseFailure "text element lacks needed attribute" return $ Element elt formatting -pMacro :: X.Element -> ElementParser (Text, [X.Element]) +pMacro :: X.Element -> ElementParser (Text, [Element a]) pMacro node = do name <- case lookupAttribute "name" (getAttributes node) of Just t -> return t Nothing -> parseFailure "macro element missing name attribute" - return (name, allChildren node) + elts <- mapM pElement (allChildren node) + return (name, elts) + +getInheritableNameFormat :: Attributes -> NameFormat +getInheritableNameFormat attr = + NameFormat + { nameGivenFormatting = Nothing + , nameFamilyFormatting = Nothing + , nameAndStyle = + case lookupAttribute "and" attr of + Just "text" -> Just Long + Just "symbol" -> Just Symbol + _ -> Nothing + , nameDelimiter = + lookupAttribute "name-delimiter" attr <|> + lookupAttribute "names-delimiter" attr + , nameDelimiterPrecedesEtAl = + case lookupAttribute "delimiter-precedes-et-al" attr of + Just "after-inverted-name" -> Just PrecedesAfterInvertedName + Just "always" -> Just PrecedesAlways + Just "never" -> Just PrecedesNever + Just "contextual" -> Just PrecedesContextual + _ -> Nothing + , nameDelimiterPrecedesLast = + case lookupAttribute "delimiter-precedes-last" attr of + Just "after-inverted-name" -> Just PrecedesAfterInvertedName + Just "always" -> Just PrecedesAlways + Just "never" -> Just PrecedesNever + Just "contextual" -> Just PrecedesContextual + _ -> Nothing + , nameEtAlMin = + lookupAttribute "et-al-min" attr >>= readAsInt + , nameEtAlUseFirst = + lookupAttribute "et-al-use-first" attr >>= readAsInt + , nameEtAlSubsequentUseFirst = + lookupAttribute "et-al-subsequent-use-first" attr >>= readAsInt + , nameEtAlSubsequentMin = + lookupAttribute "et-al-subsequent-min" attr >>= readAsInt + , nameEtAlUseLast = + case lookupAttribute "et-al-use-last" attr of + Just "true" -> Just True + Just "false" -> Just False + _ -> Nothing + , nameForm = + case lookupAttribute "name-form" attr of + Just "short" -> Just ShortName + Just "count" -> Just CountName + Just "long" -> Just LongName + _ -> Nothing + , nameInitialize = + case lookupAttribute "initialize" attr of + Just "false" -> Just False + Just "true" -> Just True + _ -> Nothing + , nameInitializeWith = + lookupAttribute "initialize-with" attr + , nameAsSortOrder = + case lookupAttribute "name-as-sort-order" attr of + Just "all" -> Just NameAsSortOrderAll + Just "first" -> Just NameAsSortOrderFirst + _ -> Nothing + , nameSortSeparator = + lookupAttribute "sort-separator" attr + } --- these name and names attributes are inheritable from a parent style --- citation or bibliography element. We use a map because --- sometimes the name is different (e.g. name-form and form). -inheritableNameAttributes :: M.Map X.Name X.Name -inheritableNameAttributes = M.fromList $ - map (\(x,y) -> (attname x, attname y)) - [ ("and", "and") - , ("delimiter-precedes-et-al", "delimiter-precedes-et-al") - , ("delimiter-precedes-last", "delimiter-precedes-last") - , ("et-al-min", "et-al-min") - , ("et-al-use-first", "et-al-use-first") - , ("et-al-use-last", "et-al-use-last") - , ("et-al-subsequent-min", "et-al-subsequent-min") - , ("et-al-subsequent-use-first", "et-al-subsequent-use-first") - , ("initialize", "initialize") - , ("initialize-with", "initialize-with") - , ("name-as-sort-order", "name-as-sort-order") - , ("sort-separator", "sort-separator") - , ("name-form", "form") - , ("name-delimiter", "delimiter") - , ("names-delimiter", "delimiter") - , ("names-min", "names-min") - , ("names-use-first", "names-use-first") - , ("names-use-last", "names-use-last") - ] - -getInheritableNameAttributes :: X.Element -> M.Map X.Name Text -getInheritableNameAttributes elt = - M.foldrWithKey - (\k v m -> case M.lookup k inheritableNameAttributes of - Just k' -> M.insert k' v m - Nothing -> m) M.empty (X.elementAttributes elt) - -pLayout :: M.Map Text [X.Element] -> X.Element -> ElementParser (Layout a) -pLayout macroMap node = do - let attrmap = getInheritableNameAttributes node +pLayout :: X.Element -> ElementParser (Layout a) +pLayout node = do let attr = getAttributes node - local (<> attrmap) $ do - node' <- expandMacros macroMap node - let layouts = getChildren "layout" node' - -- In case there are multiple layouts (as CSL-M allows), we raise an error - let elname = T.unpack $ X.nameLocalName $ X.elementName node - layout <- case layouts of - [] -> parseFailure $ "No layout element present in " <> elname - [l] -> return l - (_:_) -> parseFailure $ "Multiple layout elements present in " <> elname - let formatting = getFormatting . getAttributes $ layout - let sorts = getChildren "sort" node' - elements <- mapM pElement $ allChildren layout - let opts = LayoutOptions - { layoutCollapse = - case lookupAttribute "collapse" attr of - Just "citation-number" -> Just CollapseCitationNumber - Just "year" -> Just CollapseYear - Just "year-suffix" -> Just CollapseYearSuffix - Just "year-suffix-ranged" - -> Just CollapseYearSuffixRanged - _ -> Nothing - , layoutYearSuffixDelimiter = - lookupAttribute "year-suffix-delimiter" attr <|> - -- technically the spec doesn't say this, but - -- this seems to be what the test suites want?: - lookupAttribute "cite-group-delimiter" attr <|> - formatDelimiter formatting - , layoutAfterCollapseDelimiter = - lookupAttribute "after-collapse-delimiter" attr <|> - formatDelimiter formatting - } - sortKeys <- mapM pSortKey (concatMap (getChildren "key") sorts) - return $ Layout { layoutOptions = opts - , layoutFormatting = formatting{ - formatAffixesInside = True } - , layoutElements = elements - , layoutSortKeys = sortKeys - } + let nameformat = getInheritableNameFormat attr + let layouts = getChildren "layout" node + -- In case there are multiple layouts (as CSL-M allows), we raise an error + let elname = T.unpack $ X.nameLocalName $ X.elementName node + layout <- case layouts of + [] -> parseFailure $ "No layout element present in " <> elname + [l] -> return l + (_:_) -> parseFailure $ "Multiple layout elements present in " <> elname + let formatting = getFormatting . getAttributes $ layout + let sorts = getChildren "sort" node + elements <- mapM pElement $ allChildren layout + let opts = LayoutOptions + { layoutCollapse = + case lookupAttribute "collapse" attr of + Just "citation-number" -> Just CollapseCitationNumber + Just "year" -> Just CollapseYear + Just "year-suffix" -> Just CollapseYearSuffix + Just "year-suffix-ranged" + -> Just CollapseYearSuffixRanged + _ -> Nothing + , layoutYearSuffixDelimiter = + lookupAttribute "year-suffix-delimiter" attr <|> + -- technically the spec doesn't say this, but + -- this seems to be what the test suites want?: + lookupAttribute "cite-group-delimiter" attr <|> + formatDelimiter formatting + , layoutAfterCollapseDelimiter = + lookupAttribute "after-collapse-delimiter" attr <|> + formatDelimiter formatting + , layoutNameFormat = nameformat + } + sortKeys <- mapM pSortKey (concatMap (getChildren "key") sorts) + return $ Layout { layoutOptions = opts + , layoutFormatting = formatting{ + formatAffixesInside = True } + , layoutElements = elements + , layoutSortKeys = sortKeys + } pSortKey :: X.Element -> ElementParser (SortKey a) pSortKey node = do - let attrmap = getInheritableNameAttributes node - local (<> attrmap) $ do - let attr = getAttributes node - let direction = case lookupAttribute "sort" attr of - Just "descending" -> Descending - _ -> Ascending - case lookupAttribute "macro" attr of - Just _ -> -- should already be expanded - SortKeyMacro direction <$> mapM pElement (allChildren node) - Nothing -> return $ SortKeyVariable direction - (toVariable $ fromMaybe mempty $ - lookupAttribute "variable" attr) - -attname :: Text -> X.Name -attname t = X.Name t Nothing Nothing - -expandMacros :: M.Map Text [X.Element] - -> X.Element - -> ElementParser X.Element -expandMacros macroMap el = - case X.nameLocalName (X.elementName el) of - n | n == "text" || - n == "key" -> - case M.lookup (attname "macro") (X.elementAttributes el) of - Nothing -> do - els' <- mapM expandNode (X.elementNodes el) - return $ el{ X.elementNodes = els' } - Just macroName -> - case M.lookup macroName macroMap of - Nothing -> - parseFailure $ "macro " <> T.unpack macroName <> " not found" - Just els -> do - -- the expansion may contain further macros: - els' <- mapM (fmap X.NodeElement . expandMacros macroMap) els - return $ el{ X.elementNodes = els' } - _ -> do - els' <- mapM expandNode (X.elementNodes el) - return $ el{ X.elementNodes = els' } - where - expandNode (X.NodeElement el') = X.NodeElement <$> expandMacros macroMap el' - expandNode x = return x + let attr@(Attributes attr') = getAttributes node + let direction = case lookupAttribute "sort" attr of + Just "descending" -> Descending + _ -> Ascending + -- The attributes names-min, names-use-first, and names-use-last may + -- be used to override the values of the corresponding + -- et-al-min/et-al-subsequent-min, + -- et-al-use-first/et-al-subsequent-use-first and et-al-use-last + -- attributes, and affect all names generated via macros called by + -- cs:key. + let keyChange "names-min" = "et-al-min" + keyChange "names-use-first" = "et-al-use-first" + keyChange "names-use-last" = "et-al-use-last" + keyChange "names-subsequent-min" = "et-al-subsequent-min" + keyChange "names-subsequent-use-first" = "et-al-subsequent-use-first" + keyChange x = x + let nameformat = getInheritableNameFormat + (Attributes (M.mapKeys keyChange attr')) + case lookupAttribute "macro" attr of + Just macroname -> return $ SortKeyMacro direction nameformat macroname + Nothing -> return $ SortKeyVariable direction + (toVariable $ fromMaybe mempty $ + lookupAttribute "variable" attr) splitVars :: Text -> [Variable] splitVars = map toVariable . T.words . T.strip diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/citeproc-0.10/src/Citeproc/Types.hs new/citeproc-0.11/src/Citeproc/Types.hs --- old/citeproc-0.10/src/Citeproc/Types.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/citeproc-0.11/src/Citeproc/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,7 @@ {-# LANGUAGE StrictData #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -33,6 +35,7 @@ , TextType(..) , NameFormat(..) , defaultNameFormat + , combineNameFormat , NameAsSortOrder(..) , NamesFormat(..) , NameForm(..) @@ -115,6 +118,7 @@ import Control.Applicative ((<|>), optional) import Data.Char (isLower, isDigit, isLetter, isSpace) import Data.Text (Text) +import GHC.Generics (Generic) import qualified Data.Text as T import Data.List (elemIndex) import Data.Maybe @@ -461,40 +465,70 @@ { nameGivenFormatting :: Maybe Formatting , nameFamilyFormatting :: Maybe Formatting , nameAndStyle :: Maybe TermForm - , nameDelimiter :: Text - , nameDelimiterPrecedesEtAl :: DelimiterPrecedes - , nameDelimiterPrecedesLast :: DelimiterPrecedes + , nameDelimiter :: Maybe Text + , nameDelimiterPrecedesEtAl :: Maybe DelimiterPrecedes + , nameDelimiterPrecedesLast :: Maybe DelimiterPrecedes , nameEtAlMin :: Maybe Int , nameEtAlUseFirst :: Maybe Int , nameEtAlSubsequentUseFirst :: Maybe Int , nameEtAlSubsequentMin :: Maybe Int - , nameEtAlUseLast :: Bool - , nameForm :: NameForm - , nameInitialize :: Bool + , nameEtAlUseLast :: Maybe Bool + , nameForm :: Maybe NameForm + , nameInitialize :: Maybe Bool , nameInitializeWith :: Maybe Text , nameAsSortOrder :: Maybe NameAsSortOrder - , nameSortSeparator :: Text - } deriving (Show, Eq) + , nameSortSeparator :: Maybe Text + } deriving (Show, Eq, Generic) + +-- | Combine two NameFormats, with the second argument used to +-- fill Nothing values in the first. +combineNameFormat :: NameFormat -> NameFormat -> NameFormat +combineNameFormat a b = + NameFormat + { nameGivenFormatting = nameGivenFormatting a + <|> nameGivenFormatting b + , nameFamilyFormatting = nameFamilyFormatting a + <|> nameFamilyFormatting b + , nameAndStyle = nameAndStyle a <|> nameAndStyle b + , nameDelimiter = nameDelimiter a <|> nameDelimiter b + , nameDelimiterPrecedesEtAl = nameDelimiterPrecedesEtAl a + <|> nameDelimiterPrecedesEtAl b + , nameDelimiterPrecedesLast = nameDelimiterPrecedesLast a + <|> nameDelimiterPrecedesLast b + , nameEtAlMin = nameEtAlMin a <|> nameEtAlMin b + , nameEtAlUseFirst = nameEtAlUseFirst a <|> nameEtAlUseFirst b + , nameEtAlSubsequentUseFirst = nameEtAlSubsequentUseFirst a + <|> nameEtAlSubsequentUseFirst b + , nameEtAlSubsequentMin = nameEtAlSubsequentMin a + <|> nameEtAlSubsequentMin b + , nameEtAlUseLast = nameEtAlUseLast a <|> nameEtAlUseLast b + , nameForm = nameForm a <|> nameForm b + , nameInitialize = nameInitialize a <|> nameInitialize b + , nameInitializeWith = nameInitializeWith a + <|> nameInitializeWith b + , nameAsSortOrder = nameAsSortOrder a <|> nameAsSortOrder b + , nameSortSeparator = nameSortSeparator a <|> nameSortSeparator b + } defaultNameFormat :: NameFormat defaultNameFormat = NameFormat { nameGivenFormatting = Nothing - , nameFamilyFormatting = Nothing + , nameFamilyFormatting = Nothing , nameAndStyle = Nothing - , nameDelimiter = ", " - , nameDelimiterPrecedesEtAl = PrecedesContextual - , nameDelimiterPrecedesLast = PrecedesContextual + , nameDelimiter = Nothing + , nameDelimiterPrecedesEtAl = Nothing + , nameDelimiterPrecedesLast = Nothing , nameEtAlMin = Nothing , nameEtAlUseFirst = Nothing , nameEtAlSubsequentUseFirst = Nothing , nameEtAlSubsequentMin = Nothing - , nameEtAlUseLast = False - , nameForm = LongName - , nameInitialize = True + , nameEtAlUseLast = Nothing + , nameForm = Nothing + , nameInitialize = Nothing , nameInitializeWith = Nothing , nameAsSortOrder = Nothing - , nameSortSeparator = ", " + , nameSortSeparator = Nothing } data NameAsSortOrder = @@ -606,7 +640,7 @@ data SortKey a = SortKeyVariable SortDirection Variable - | SortKeyMacro SortDirection [Element a] + | SortKeyMacro SortDirection NameFormat Text deriving (Show, Eq) data SortKeyValue = @@ -626,6 +660,7 @@ { layoutCollapse :: Maybe Collapsing , layoutYearSuffixDelimiter :: Maybe Text , layoutAfterCollapseDelimiter :: Maybe Text + , layoutNameFormat :: NameFormat } deriving (Show, Eq) data Collapsing = @@ -673,6 +708,7 @@ , styleSecondFieldAlign :: Maybe SecondFieldAlign , styleSubsequentAuthorSubstitute :: Maybe SubsequentAuthorSubstitute , styleUsesYearSuffixVariable :: Bool + , styleNameFormat :: NameFormat } deriving (Show, Eq) data SubsequentAuthorSubstitute = @@ -707,6 +743,7 @@ , styleBibliography :: Maybe (Layout a) , styleLocales :: [Locale] , styleAbbreviations :: Maybe Abbreviations + , styleMacros :: M.Map Text [Element a] } deriving (Show, Eq) -- Note: no macros section, because we -- expand these after parsing the CSL. @@ -898,10 +935,11 @@ return $ M.insert k v' m NumberVariable -> do v' <- case v of - String{} -> parseJSON v - Number{} -> T.pack . show <$> (parseJSON v :: Parser Int) + String{} -> FancyVal <$> parseJSON v + Number{} -> (NumVal <$> parseJSON v) <|> + (FancyVal <$> parseJSON v) _ -> typeMismatch "String or Number" v - return $ M.insert k (TextVal v') m + return $ M.insert k v' m DateVariable -> do v' <- parseJSON v return $ M.insert k (DateVal v') m diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/citeproc-0.10/test/Spec.hs new/citeproc-0.11/test/Spec.hs --- old/citeproc-0.10/test/Spec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/citeproc-0.11/test/Spec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -91,14 +91,14 @@ (nubOrdOn referenceId (input test)) Just cs -> cs let doError err = do - modify $ \st -> st{ errored = category test : errored st } + modify $ \st -> st{ errored = (category test, path test) : errored st } liftIO $ do TIO.putStrLn $ "[ERRORED] " <> T.pack (path test) TIO.putStrLn $ T.pack $ show err TIO.putStrLn "" return $ Errored err let doSkip reason = do - modify $ \st -> st{ skipped = category test : skipped st } + modify $ \st -> st{ skipped = (category test, path test) : skipped st } liftIO $ do TIO.putStrLn $ "[SKIPPED] " <> T.pack (path test) -- TIO.putStrLn $ T.strip reason @@ -184,12 +184,12 @@ else result test if actual == expected then do - modify $ \st -> st{ passed = category test : passed st } + modify $ \st -> st{ passed = (category test, path test) : passed st } -- suppress PASSED messages -- liftIO $ TIO.putStrLn $ "[PASSED] " <> path test return Passed else do - modify $ \st -> st{ failed = category test : failed st } + modify $ \st -> st{ failed = (category test, path test) : failed st } liftIO $ do TIO.putStrLn $ "[FAILED] " <> T.pack (path test) showDiff expected actual @@ -319,10 +319,10 @@ ("ERROR" :: String) ("SKIP" :: String) let resultsFor cat = do - let p = length . filter (== cat) . passed $ counts - let f = length . filter (== cat) . failed $ counts - let e = length . filter (== cat) . errored $ counts - let s = length . filter (== cat) . skipped $ counts + let p = length . filter ((== cat) . fst) . passed $ counts + let f = length . filter ((== cat) . fst) . failed $ counts + let e = length . filter ((== cat) . fst) . errored $ counts + let s = length . filter ((== cat) . fst) . skipped $ counts let percent = (fromIntegral p / fromIntegral (p + f + e) :: Double) putStrLn $ printf "%-15s %6d %6d %6d %6d |%-20s|" (T.unpack cat) p f e s @@ -340,19 +340,34 @@ (length (failed counts)) (length (errored counts)) (length (skipped counts)) - case length (failed counts) + length (errored counts) of - 0 -> exitSuccess - n | n <= 68 -> do - putStrLn "We have passed all the CSL tests we expect to..." - exitSuccess - | otherwise -> exitWith $ ExitFailure n + let unexpectedFailures = + filter ((`notElem` expectedFailures) . snd) (failed counts) + let unexpectedPasses = + filter ((`elem` expectedFailures) . snd) (passed counts) + unless (null unexpectedFailures) $ do + putStrLn "" + putStrLn "Unexpected failures" + putStrLn "-------------------" + mapM_ (putStrLn . snd) unexpectedFailures + putStrLn "" + unless (null unexpectedPasses) $ do + putStrLn "" + putStrLn "Unexpected passes" + putStrLn "-----------------" + mapM_ (putStrLn . snd) unexpectedPasses + putStrLn "" + case length unexpectedFailures + length (errored counts) of + 0 -> do + putStrLn "(All failures were expected failures.)" + exitSuccess + n -> exitWith $ ExitFailure n data Counts = Counts - { failed :: [Text] - , errored :: [Text] - , passed :: [Text] - , skipped :: [Text] + { failed :: [(Text,FilePath)] -- category, filepath + , errored :: [(Text,FilePath)] + , passed :: [(Text,FilePath)] + , skipped :: [(Text,FilePath)] } deriving (Show) showDiff :: Text -> Text -> IO () @@ -368,3 +383,75 @@ (Pretty.text . T.unpack . unnumber) $ getContextDiff Nothing (T.lines expected) (T.lines actual) +expectedFailures :: [FilePath] +expectedFailures = [ + "test/csl/bugreports_OverwriteCitationItems.txt", + "test/csl/bugreports_SingleQuoteXml.txt", + "test/csl/bugreports_SmallCapsEscape.txt", + "test/csl/bugreports_SortedIeeeItalicsFail.txt", + "test/csl/bugreports_ikeyOne.txt", + "test/csl/collapse_AuthorCollapseNoDateSorted.txt", + "test/csl/date_NegativeDateSort.txt", + "test/csl/date_NegativeDateSortViaMacro.txt", + "test/csl/date_NegativeDateSortViaMacroOnYearMonthOnly.txt", + "test/csl/date_YearSuffixImplicitWithNoDate.txt", + "test/csl/date_YearSuffixWithNoDate.txt", + "test/csl/disambiguate_DifferentSpacingInInitials.txt", + "test/csl/disambiguate_DisambiguationHang.txt", + "test/csl/disambiguate_IncrementalExtraText.txt", + "test/csl/disambiguate_InitializeWithButNoDisambiguation.txt", + "test/csl/disambiguate_PrimaryNameWithNonDroppingParticle.txt", + "test/csl/disambiguate_PrimaryNameWithParticle.txt", + "test/csl/disambiguate_YearCollapseWithInstitution.txt", + "test/csl/disambiguate_YearSuffixAtTwoLevels.txt", + "test/csl/disambiguate_YearSuffixWithEtAlSubequent.txt", + "test/csl/disambiguate_YearSuffixWithEtAlSubsequent.txt", + "test/csl/flipflop_LeadingMarkupWithApostrophe.txt", + "test/csl/flipflop_OrphanQuote.txt", + "test/overrides/fullstyles_ABdNT.txt", + "test/csl/fullstyles_ChicagoAuthorDateSimple.txt", + "test/csl/integration_FirstReferenceNoteNumberPositionChange.txt", + "test/csl/integration_IbidOnInsert.txt", + "test/csl/label_EditorTranslator1.txt", + "test/csl/magic_CapitalizeFirstOccurringTerm.txt", + "test/csl/magic_PunctuationInQuoteNested.txt", + "test/csl/magic_SubsequentAuthorSubstituteNotFooled.txt", + "test/csl/magic_TermCapitalizationWithPrefix.txt", + "test/csl/name_CiteGroupDelimiterWithYearSuffixCollapse2.txt", + "test/csl/name_DelimiterAfterInverted.txt", + "test/csl/name_EtAlWithCombined.txt", + "test/csl/name_HebrewAnd.txt", + "test/csl/name_InTextMarkupInitialize.txt", + "test/csl/name_InTextMarkupNormalizeInitials.txt", + "test/csl/number_OrdinalSpacing.txt", + "test/csl/number_PlainHyphenOrEnDashAlwaysPlural.txt", + "test/csl/position_FirstTrueOnlyOnce.txt", + "test/csl/position_IbidInText.txt", + "test/csl/position_IbidSeparateCiteSameNote.txt", + "test/csl/position_IbidWithLocator.txt", + "test/csl/position_IbidWithMultipleSoloCitesInBackref.txt", + "test/csl/position_IfIbidWithLocatorIsTrueThenIbidIsTrue.txt", + "test/csl/position_NearNoteSameNote.txt", + "test/csl/position_ResetNoteNumbers.txt", + "test/csl/punctuation_FullMontyQuotesIn.txt", + "test/csl/quotes_QuotesUnderQuotesFalse.txt", + "test/csl/sort_BibliographyCitationNumberDescending.txt", + "test/csl/sort_BibliographyCitationNumberDescendingViaCompositeMacro.txt", + "test/csl/sort_BibliographyCitationNumberDescendingViaMacro.txt", + "test/csl/sort_ChicagoYearSuffix1.txt", + "test/csl/sort_ChicagoYearSuffix2.txt", + "test/csl/sort_LeadingApostropheOnNameParticle.txt", + "test/csl/sort_OmittedBibRefMixedNumericStyle.txt", + "test/csl/sort_OmittedBibRefNonNumericStyle.txt", + "test/csl/sort_RangeUnaffected.txt", + "test/csl/substitute_SubstituteOnlyOnceTermEmpty.txt", + "test/csl/bugreports_NoCaseEscape.txt", + "test/csl/bugreports_LegislationCrash.txt", + "test/csl/bugreports_EnvAndUrb.txt", + "test/csl/bugreports_DemoPageFullCiteCruftOnSubsequent.txt", + "test/csl/bugreports_ChicagoAuthorDateLooping.txt", + "test/csl/bugreports_AutomaticallyDeleteItemsFails.txt", + "test/csl/affix_WithCommas.txt", + "test/csl/affix_CommaAfterQuote.txt", + "test/overrides/flipflop_NumericField.txt" + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/citeproc-0.10/test/overrides/flipflop_NumericField.txt new/citeproc-0.11/test/overrides/flipflop_NumericField.txt --- old/citeproc-0.10/test/overrides/flipflop_NumericField.txt 2001-09-09 03:46:40.000000000 +0200 +++ new/citeproc-0.11/test/overrides/flipflop_NumericField.txt 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,3 @@ -Note: since the spec doesn't demand the strange output -expected by citeproc-js, and the output our library gives -seems clearly better, we treat this as passing. - >>===== MODE =====>> citation <<===== MODE =====<< @@ -20,7 +16,7 @@ >>===== RESULT =====>> -1<sup>er</sup> +1<sup>er</sup> <<===== RESULT =====<< >>===== CSL =====>>
