citeproc 0.10 → 0.11

raw patch · 8 files changed

+543/−360 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +33/−0
• citeproc.cabal +1/−1
• src/Citeproc/Element.hs +3/−13
• src/Citeproc/Eval.hs +63/−33
• src/Citeproc/Style.hs +279/−270
• src/Citeproc/Types.hs +58/−20
• test/Spec.hs +105/−18
• test/overrides/flipflop_NumericField.txt +1/−5

@@ -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&#60;sup&#62;er&#60;/sup&#62;` 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

@@ -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

@@ -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@@ -51,13 +48,6 @@ getAttributes :: X.Element -> Attributes 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 =

@@ -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  

@@ -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 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 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 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 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)---- 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")-  ]+  elts <- mapM pElement (allChildren node)+  return (name, elts) -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)+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+         } -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

@@ -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

@@ -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"+  ]

@@ -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&#60;sup&#62;er&#60;/sup&#62; <<===== RESULT =====<<  >>===== CSL =====>>