content: {-# LANGUAGE StrictData #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TupleSections #-}
  module Citeproc.Eval
    ( evalStyle )
  where
  import Citeproc.Types
  import Citeproc.Style (mergeLocales)
  import qualified Citeproc.Unicode as Unicode
  import Control.Monad.Trans.RWS.CPS
  import Data.Containers.ListUtils (nubOrdOn, nubOrd)
  import Safe (headMay, headDef, lastMay, initSafe, tailSafe, maximumMay)
  import Data.Maybe
  import Control.Monad (foldM, foldM_, zipWithM, when, unless)
  import qualified Data.Map as M
  import qualified Data.Set as Set
  import Data.Coerce (coerce)
  import Data.List (find, intersperse, sortBy, sortOn, groupBy, foldl', transpose,
                    sort, (\\))
  import Data.Text (Text)
  import qualified Data.Text as T
  import Data.Char (isSpace, isDigit, isUpper, isLower, isLetter,
                    ord, chr)
  import Text.Printf (printf)
  import Control.Applicative
  import Data.Generics.Uniplate.Operations (universe, transform)
  
  -- import Debug.Trace (trace)
  -- traceShowIdLabeled :: Show a => String -> a -> a
  -- traceShowIdLabeled label x =
  --   trace (label ++ ": " ++ show x) x
  -- import Text.Show.Pretty (ppShow)
  -- ppTrace :: Show a => a -> a
  -- ppTrace x = trace (ppShow x) x
  
  data Context a =
    Context
    { contextLocale              :: Locale
    , contextCollate             :: [SortKeyValue] -> [SortKeyValue] -> Ordering
    , contextAbbreviations       :: Maybe Abbreviations
    , contextStyleOptions        :: StyleOptions
    , contextLocator             :: Maybe Text
    , contextLabel               :: Maybe Text
    , contextPosition            :: [Position]
    , contextInSubstitute        :: Bool
    , contextInSortKey           :: Bool
    , contextInBibliography      :: Bool
    , contextSubstituteNamesForm :: Maybe NamesFormat
    }
  
  -- used internally for group elements, which
  -- are skipped if (a) the group calls a variable
  -- but (b) all of the variables called are empty.
  data VarCount =
    VarCount
    { variablesAccessed :: Int
    , variablesNonempty :: Int
    } deriving (Show)
  
  data EvalState a =
    EvalState
    { stateVarCount       :: VarCount
    , stateLastCitedMap   :: M.Map ItemId (Int, Maybe Int, Int,
                                            Bool, Maybe Text, Maybe Text)
                          -- (citegroup, noteNum, posInGroup,
                          --      aloneInCitation, label, locator)
    , stateNoteMap        :: M.Map Int (Set.Set ItemId) -- ids cited in note
    , stateRefMap         :: ReferenceMap a
    , stateReference      :: Reference a
    , stateUsedYearSuffix :: Bool
    , stateUsedIdentifier :: Bool
    -- ^ tracks whether an identifier (DOI,PMCID,PMID,URL) has yet been used
    , stateUsedTitle      :: Bool
    -- ^ tracks whether the item title has yet been used
    } deriving (Show)
  
  
  type Eval a = RWS (Context a) (Set.Set Text) (EvalState a)
  
  updateVarCount :: Int -> Int -> Eval a ()
  updateVarCount total' nonempty' =
    modify $ \st ->
      let VarCount{ variablesAccessed = total
                  , variablesNonempty = nonempty } = stateVarCount st
       in st{ stateVarCount =
                VarCount { variablesAccessed = total + total',
                           variablesNonempty = nonempty + nonempty' } }
  
  evalStyle  :: CiteprocOutput a
             => Style a          -- ^ Parsed CSL style.
             -> Maybe Lang       -- ^ Override style default locale.
             -> [Reference a]    -- ^ List of references (bibliographic data).
             -> [Citation a]     -- ^ List of citations.
             -> ([Output a], [(Text, Output a)], [Text])
                         -- ^ (citations, (id, bibentry) pairs, warnings)
  evalStyle style mblang refs' citations =
    (citationOs, bibliographyOs, Set.toList warnings)
   where
    refs'' = refs' ++ extractItemData citations
    (refs, refmap) = makeReferenceMap refs''
  
    ((citationOs, bibliographyOs), warnings) = evalRWS go
       Context
        { contextLocale              = mergeLocales mblang style
        , contextCollate             = compSortKeyValues (Unicode.comp mblang)
        , contextAbbreviations       = styleAbbreviations style
        , contextStyleOptions        = styleOptions style
        , contextLocator             = Nothing
        , contextLabel               = Nothing
        , contextPosition            = []
        , contextInSubstitute        = False
        , contextInSortKey           = False
        , contextInBibliography      = False
        , contextSubstituteNamesForm = Nothing
        }
        EvalState
        { stateVarCount = VarCount 0 0
        , stateLastCitedMap = mempty
        , stateNoteMap = mempty
        , stateRefMap = refmap
        , stateReference = Reference mempty mempty Nothing mempty
        , stateUsedYearSuffix = False
        , stateUsedIdentifier = False
        , stateUsedTitle = False
        }
  
    assignCitationNumbers sortedIds =
      modify $ \st ->
                st{ stateRefMap = ReferenceMap $ foldl'
                       (\m (citeId, num) ->
                           M.adjust (\ref ->
                             ref{ referenceVariables =
                                   M.insert "citation-number"
                                      (NumVal num) .
                                   M.insert "citation-key"
                                       (TextVal (unItemId citeId)) .
                                   M.alter (addIfMissing (citationLabel ref))
                                      "citation-label"
                                   $ referenceVariables ref
                                }) citeId m)
                       (unReferenceMap (stateRefMap st))
                       (zip sortedIds [1..]) }
  
    addIfMissing x Nothing  = Just x
    addIfMissing _ (Just x) = Just x
  
    go = do
        -- list of citationItemIds that are actually cited
        let citationOrder = M.fromList $ reverse $ zip
              (concatMap (map citationItemId . citationItems) citations)
              [(1 :: Int)..]
        let citeIds = M.keysSet citationOrder
        let sortedCiteIds = sortOn
                (fromMaybe maxBound . (`M.lookup` citationOrder))
                (map referenceId refs)
        let layoutOpts = layoutOptions $ styleCitation style
        let mbcgDelim =
              case styleCiteGroupDelimiter (styleOptions style) of
                Just x -> Just x
                Nothing
                  -- grouping is activated whenever there is
                  -- collapsing; this is the default
                  -- cite-group-delimiter
                  | isJust (layoutCollapse layoutOpts) -> Just ", "
                  | otherwise -> Nothing
  
        assignCitationNumbers sortedCiteIds
        -- sorting of bibliography, insertion of citation-number
        collate <- asks contextCollate
  
        (bibCitations, bibSortKeyMap) <-
          case styleBibliography style of
            Nothing -> return ([], mempty)
            Just biblayout -> do
              bibSortKeyMap <- M.fromList
                        <$> mapM
                            ((\citeId ->
                               (citeId,) <$> evalSortKeys biblayout citeId)
                               . referenceId)
                            refs
              let sortedIds =
                    if null (layoutSortKeys biblayout)
                       then sortedCiteIds
                       else sortBy
                         (\x y -> collate
                                    (fromMaybe [] $ M.lookup x bibSortKeyMap)
                                    (fromMaybe [] $ M.lookup y bibSortKeyMap))
                              (map referenceId refs)
              assignCitationNumbers $
                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")) _:_): _)
                    -> reverse sortedIds
                  _ -> sortedIds
              let bibCitations = map (\ident ->
                    Citation (Just $ unItemId ident) Nothing Nothing Nothing
                     [CitationItem ident Nothing Nothing
                        NormalCite Nothing Nothing Nothing]) sortedIds
              return (bibCitations, bibSortKeyMap)
        -- styling of citations
        sortKeyMap <-
          foldM (\m citeId -> do
                    sk <- evalSortKeys (styleCitation style) citeId
                    return $ M.insert citeId sk m)
                 M.empty
                 citeIds
        -- We can't just sort all the citations, because
        -- this can make a hash out of prefixes and suffixes.
        -- See e.g. pandoc-citeproc issue #292.
        -- We need to first break into groups so that any item
        -- with a prefix or suffix is insulated from sorting.
        -- We sort the groups, then combine again:
        let canGroup i1 i2
             =   isNothing (citationItemSuffix i1) &&
                 isNothing (citationItemPrefix i2) &&
                 isNothing (citationItemSuffix i2) &&
                 isNothing (citationItemPrefix i1)
        let sortCitationItems citation' =
              citation'{ citationItems =
                            concatMap
                             (sortBy
                               (\item1 item2 ->
                                 collate
                                  (fromMaybe [] $ M.lookup
                                     (citationItemId item1) sortKeyMap)
                                  (fromMaybe [] $ M.lookup
                                     (citationItemId item2) sortKeyMap)))
                          $ groupBy canGroup
                          $ citationItems citation' }
        let citCitations = map sortCitationItems citations
        cs <- disambiguateCitations style bibSortKeyMap citCitations
        let cs' = case mbcgDelim of
                     Nothing -> cs
                     Just citeGroupDelim -> map
                        (groupAndCollapseCitations citeGroupDelim
                         (layoutYearSuffixDelimiter layoutOpts)
                         (layoutAfterCollapseDelimiter layoutOpts)
                         (layoutCollapse layoutOpts))
                        cs
  
        let removeIfEqual x y
             | x == y    = NullOutput
             | otherwise = y
        let removeNamesIfSuppressAuthor
             (Tagged (TagItem SuppressAuthor cid') x)
               = let y = getAuthors x
                  in Tagged (TagItem SuppressAuthor cid')
                       (transform (removeIfEqual y) x)
            removeNamesIfSuppressAuthor x = x
  
        -- we need to do this after disambiguation and collapsing
        let handleSuppressAuthors = transform removeNamesIfSuppressAuthor
  
        let isNoteCitation = styleIsNoteStyle (styleOptions style)
  
        -- if we have an author-only citation at the beginning
        -- separate it out:
        let handleAuthorOnly formattedCit =
              case formattedCit of
                Formatted f
                  (x@(Tagged (TagItem AuthorOnly _) _):xs)
                    | isNoteCitation
                      -> formatted mempty
                          (x : [InNote (formatted f xs) | not (null xs)])
                    | otherwise
                      -> formatted mempty
                          (x :
                           if null xs
                              then []
                              else [Literal (fromText " "),
                                    formatted f xs])
                Formatted f
                  (Formatted f'
                    (x@(Tagged (TagItem AuthorOnly _) _):xs) : ys)
                    | isNoteCitation
                      -> formatted mempty
                          (x :
                           if null xs && null ys
                              then []
                              else [InNote (formatted f
                                             (formatted f' xs : ys))])
                    | otherwise
                      -> Formatted mempty
                          (x :
                           if null xs && null ys
                              then []
                              else [Literal (fromText " "),
                                    formatted f (formatted f' xs : ys)])
                _ | isNoteCitation -> InNote formattedCit
                  | otherwise      -> formattedCit
  
        let cs'' = map (handleSuppressAuthors . handleAuthorOnly) cs'
  
        -- styling of bibliography (this needs to go here to take account
        -- of year suffixes added in disambiguation)
        bs <- case styleBibliography style of
                 Just biblayout
                   -> local (\context ->
                               context{ contextInBibliography = True }) $
                      mapM (evalLayout biblayout) (zip [1..] bibCitations)
                      >>= \bs ->
                        case styleSubsequentAuthorSubstitute
                              (styleOptions style) of
                          Nothing -> return bs
                          Just subs -> subsequentAuthorSubstitutes subs bs
                 Nothing -> return []
        return (cs'', case styleBibliography style of
                       Nothing -> []
                       Just _  ->
                         zip (map (fromMaybe "" . citationId) bibCitations) bs)
  
  extractItemData :: [Citation a] -> [Reference a]
  extractItemData = concatMap (mapMaybe citationItemData . citationItems)
  
  subsequentAuthorSubstitutes :: CiteprocOutput a
                              => SubsequentAuthorSubstitute
                              -> [Output a]
                              -> Eval a [Output a]
  subsequentAuthorSubstitutes (SubsequentAuthorSubstitute t rule) =
    return . groupCitesByNames
   where
    groupCitesByNames [] = []
    groupCitesByNames (x:xs) =
      let xnames = fromMaybe ([],NullOutput) $ getNames x
          samenames = replaceMatch rule (fromText t) xnames xs
          rest = drop (length samenames) xs
      in  (x : samenames) ++ groupCitesByNames rest
    getNames (Formatted _ (x:_)) =
      case [(ns,r) | (Tagged (TagNames _ _ ns) r) <- universe x] of
        ((ns,r) : _) -> Just (ns,r)
        []           -> Nothing
    getNames _ = Nothing
  
  replaceMatch :: CiteprocOutput a
               => SubsequentAuthorSubstituteRule
               -> a
               -> ([Name], Output a)
               -> [Output a]
               -> [Output a]
  replaceMatch _ _ _ [] = []
  replaceMatch rule replacement (names, raw) (z:zs) =
    case go z of
      Nothing -> []
      Just z' -> z' : replaceMatch rule replacement (names, raw) zs
   where
    go (Tagged t@TagItem{} y) =
      Tagged t <$> go y
    go (Formatted f (y:ys)) =
      Formatted f . (: ys) <$> go y
    go y@(Tagged (TagNames _ _ ns) r) =
      case (if null names then CompleteAll else rule) of
          CompleteAll ->
            if ns == names && (not (null names) || r == raw)
               then Just $ replaceAll y
               else Nothing
          CompleteEach ->
            if ns == names
               then Just $ transform replaceEach y
               else Nothing
          PartialEach ->
            case numberOfMatches ns names of
              num | num >= 1 -> Just $ transform (replaceFirst num) y
              _ -> Nothing
          PartialFirst ->
            case numberOfMatches ns names of
              num | num >= (1 :: Int) -> Just $ transform (replaceFirst 1) y
              _ -> Nothing
    go _ = Nothing
    replaceAll (Tagged (TagNames t' nf ns') x)
       = Tagged (TagNames t' nf ns') $
         -- removeName will leave label "ed."
         -- which we want, but it will also leave the substituted
         -- title when there is no name, which we do not want.
         -- So, if ns' is null, then we just remove everything.
         if null ns'
            then Literal replacement
            else
              case transform removeName x of
                Formatted f' xs -> Formatted f' (Literal replacement : xs)
                _               -> Literal replacement
    replaceAll x = x
    removeName (Tagged (TagName _) _) = NullOutput
    removeName x = x
    replaceEach (Tagged (TagName n) _)
      | n `elem` names
       = Tagged (TagName n) (Literal replacement)
    replaceEach x = x
    replaceFirst num x@(Tagged (TagNames _ _ ns') _)
      = foldr (transform . replaceName) x $ take num ns'
    replaceFirst _num x = x
    replaceName name (Tagged (TagName n) _)
      | n == name = Tagged (TagName n) (Literal replacement)
    replaceName _ x = x
    numberOfMatches (a:as) (b:bs)
      | a == b    = 1 + numberOfMatches as bs
      | otherwise = 0
    numberOfMatches _ _ = 0
  
  --
  -- Disambiguation
  --
  
  data DisambData =
    DisambData
    { ddItem       :: ItemId
    , ddNames      :: [Name]
    , ddDates      :: [Date]
    , ddRendered   :: Text
    } deriving (Eq, Ord, Show)
  
  disambiguateCitations :: forall a . CiteprocOutput a
                        => Style a
                        -> M.Map ItemId [SortKeyValue]
                        -> [Citation a]
                        -> Eval a [Output a]
  disambiguateCitations style bibSortKeyMap citations = do
    refs <- unReferenceMap <$> gets stateRefMap
    let refIds = M.keys refs
    let ghostItems = [ ident
                     | ident <- refIds
                     ]
                     -- we add additional references for EVERY citation,
                     -- even those we have already, to handle cases like #116
  
    -- for purposes of disambiguation, we remove prefixes and
    -- suffixes and locators, and we convert author-in-text to normal citation.
    let removeAffix item = item{ citationItemLabel = Nothing
                               , citationItemLocator = Nothing
                               , citationItemPrefix = Nothing
                               , citationItemSuffix = Nothing }
    let cleanCitation (Citation a b c d (i1:i2:is))
         | citationItemType i1 == AuthorOnly
         , citationItemType i2 == SuppressAuthor
          = Citation a b c d
              (map removeAffix (i2{ citationItemType = NormalCite }:is))
        cleanCitation (Citation a b c d is)
          = Citation a b c d (map removeAffix is)
  
    -- note that citations must go first, and order must be preserved:
    -- we use a "basic item" that strips off prefixes, suffixes, locators
    let citations' = map cleanCitation citations ++
                     [Citation Nothing Nothing Nothing Nothing (map basicItem ghostItems)]
    allCites <- renderCitations citations'
  
    mblang <- asks (localeLanguage . contextLocale)
    styleOpts <- asks contextStyleOptions
    let strategy = styleDisambiguation styleOpts
    let allNameGroups = [ns | Tagged (TagNames _ _ ns) _ <-
                                concatMap universe allCites]
    let allNames = nubOrd $ concat allNameGroups
    let primaryNames = nubOrd $ concatMap (take 1) allNameGroups
    allCites' <-
      case disambiguateAddGivenNames strategy of
           Nothing     -> return allCites
           Just ByCite -> return allCites -- do this later
           Just rule   -> do -- disambiguate names, not just citations
             let relevantNames =
                   case rule of
                     PrimaryNameWithInitials -> primaryNames
                     PrimaryName -> primaryNames
                     _ -> allNames
             let familyNames = nubOrd $ mapMaybe nameFamily relevantNames
             let grps = map (\name ->
                               [v | v <- relevantNames
                                  , nameFamily v == Just name])
                            familyNames
             let toHint names name =
                    if any (initialsMatch mblang name) (filter (/= name) names)
                       then
                         case rule of
                           AllNamesWithInitials    -> Nothing
                           PrimaryNameWithInitials -> Nothing
                           PrimaryName             -> Just AddGivenNameIfPrimary
                           _                       -> Just AddGivenName
                       else
                         case rule of
                           PrimaryNameWithInitials -> Just AddInitialsIfPrimary
                           PrimaryName             -> Just AddInitialsIfPrimary
                           _                       -> Just AddInitials
             let namesMap = mconcat $ map
                    (\names -> if length names > 1
                                   then foldr
                                      (\name ->
                                          case toHint names name of
                                            Just x -> M.insert name x
                                            Nothing -> id)
                                      mempty
                                      names
                                   else mempty) grps
             -- use this same names map for every citation
             modify $ \st ->
                st{ stateRefMap = ReferenceMap $
                     foldr
                       (M.adjust (alterReferenceDisambiguation
                         (\d -> d{ disambNameMap = namesMap })))
                       (unReferenceMap $ stateRefMap st)
                       refIds }
             -- redo citations
             renderCitations citations'
  
    case getAmbiguities allCites' of
      []          -> return ()
      ambiguities -> analyzeAmbiguities mblang strategy citations' ambiguities
    renderCitations citations
  
   where
  
    renderCitations :: [Citation a] -> Eval a [Output a]
    renderCitations cs =
      withRWST (\ctx st -> (ctx,
                            st { stateLastCitedMap = mempty
                               , stateNoteMap = mempty })) $
       mapM (evalLayout (styleCitation style)) (zip [1..] cs)
  
    refreshAmbiguities :: [Citation a] -> Eval a [[DisambData]]
    refreshAmbiguities = fmap getAmbiguities . renderCitations
  
    analyzeAmbiguities :: Maybe Lang
                       -> DisambiguationStrategy
                       -> [Citation a]
                       -> [[DisambData]]
                       -> Eval a ()
    analyzeAmbiguities mblang strategy cs ambiguities = do
      -- add names to et al.
      return ambiguities
        >>= (\as ->
             (if not (null as) && disambiguateAddNames strategy
                 then do
                   mapM_ (tryAddNames mblang (disambiguateAddGivenNames strategy)) as
                   refreshAmbiguities cs
                 else
                   return as))
        >>= (\as ->
             (case disambiguateAddGivenNames strategy of
                    Just ByCite | not (null as) -> do
                       mapM_ (tryAddGivenNames mblang) as
                       refreshAmbiguities cs
                    _           -> return as))
        >>= (\as ->
             (if not (null as) && disambiguateAddYearSuffix strategy
                 then do
                   addYearSuffixes bibSortKeyMap as
                   refreshAmbiguities cs
                 else return as))
        >>= mapM_ tryDisambiguateCondition
  
  basicItem :: ItemId -> CitationItem a
  basicItem iid = CitationItem
    { citationItemId      = iid
    , citationItemLabel   = Nothing
    , citationItemLocator = Nothing
    , citationItemType    = NormalCite
    , citationItemPrefix  = Nothing
    , citationItemSuffix  = Nothing
    , citationItemData    = Nothing
    }
  
  isDisambiguated :: Maybe Lang
                  -> Maybe GivenNameDisambiguationRule
                  -> Int -- et al min
                  -> [DisambData]
                  -> DisambData
                  -> Bool
  isDisambiguated mblang mbrule etAlMin xs x =
    all (\y -> x == y || disambiguatedName y /= disambiguatedName x) xs
   where
    disambiguatedName = nameParts . take etAlMin . ddNames
    nameParts =
      case mbrule of
        Just AllNames -> id
        Just AllNamesWithInitials ->
             map (\name -> name{ nameGiven = initialize mblang True False ""
                                              <$> nameGiven name })
        Just PrimaryName ->
          \case
            [] -> []
            (z:zs) -> z : map (\name -> name{ nameGiven = Nothing }) zs
        Just PrimaryNameWithInitials ->
          \case
            [] -> []
            (z:zs) -> z{ nameGiven =
                       initialize mblang True False "" <$> nameGiven z } :
                       map (\name -> name{ nameGiven = Nothing }) zs
        Just ByCite -> id -- hints will be added later
        _ -> map (\name -> name{ nameGiven = Nothing })
  
  tryAddNames :: Maybe Lang
              -> Maybe GivenNameDisambiguationRule
              -> [DisambData]
              -> Eval a ()
  tryAddNames mblang mbrule bs =
                       (case mbrule of
                            Just ByCite -> bs <$ tryAddGivenNames mblang bs
                            _ -> return bs) >>= go 1
                          -- if ByCite, we want to make sure that
                          -- tryAddGivenNames is still applied, as
                          -- calculation of "add names" assumes this.
   where
     maxnames = fromMaybe 0 . maximumMay . map (length . ddNames)
     go n as
       | n > maxnames as = return ()
       | otherwise = do
           let ds = filter (isDisambiguated mblang mbrule n as) as
           if null ds
              then go (n + 1) as
              else do
                modify $ \st ->
                  st{ stateRefMap = ReferenceMap
                        $ foldr (setEtAlNames (Just n) . ddItem)
                          (unReferenceMap $ stateRefMap st) as }
                go (n + 1) (as \\ ds)
  
  tryAddGivenNames :: Maybe Lang
                   -> [DisambData]
                   -> Eval a ()
  tryAddGivenNames mblang as = do
    let correspondingNames =
           map (zip (map ddItem as)) $ transpose $ map ddNames as
        go [] _ = return []
        go (as' :: [DisambData]) (ns :: [(ItemId, Name)]) = do
          hintedIds <- Set.fromList . catMaybes <$>
                          mapM (addNameHint mblang (map snd ns)) ns
          return $ filter (\x -> ddItem x `Set.notMember` hintedIds) as'
    foldM_ go as correspondingNames
  
  addYearSuffixes :: M.Map ItemId [SortKeyValue]
                  -> [[DisambData]]
                  -> Eval a ()
  addYearSuffixes bibSortKeyMap' as = do
    let allitems = concat as
    collate <- asks contextCollate
    let companions a =
          sortBy
          (\item1 item2 ->
            collate
              (fromMaybe [] $ M.lookup (ddItem item1) bibSortKeyMap')
              (fromMaybe [] $ M.lookup (ddItem item2) bibSortKeyMap'))
          (concat [ x | x <- as, a `elem` x ])
    let groups = Set.map companions $ Set.fromList allitems
    let addYearSuffix item suff =
          modify $ \st ->
            st{ stateRefMap = ReferenceMap
                 $ setYearSuffix suff item
                 $ unReferenceMap
                 $ stateRefMap st }
    mapM_ (\xs -> zipWithM addYearSuffix (map ddItem xs) [1..]) groups
  
  tryDisambiguateCondition :: [DisambData] -> Eval a ()
  tryDisambiguateCondition as =
    case as of
      [] -> return ()
      xs -> modify $ \st ->
              st{ stateRefMap = ReferenceMap
                  $ foldr (setDisambCondition True . ddItem)
                    (unReferenceMap (stateRefMap st))
                    xs }
  
  alterReferenceDisambiguation :: (DisambiguationData -> DisambiguationData)
                               -> Reference a
                               -> Reference a
  alterReferenceDisambiguation f r =
        r{ referenceDisambiguation = f <$>
             case referenceDisambiguation r of
               Nothing -> Just
                 DisambiguationData
                   { disambYearSuffix  = Nothing
                   , disambNameMap     = mempty
                   , disambEtAlNames   = Nothing
                   , disambCondition   = False
                 }
               Just x  -> Just x }
  
  initialsMatch :: Maybe Lang -> Name -> Name -> Bool
  initialsMatch mblang x y =
    case (nameGiven x, nameGiven y) of
      (Just x', Just y') ->
        initialize mblang True False "" x' ==
          initialize mblang True False "" y'
      _ -> False
  
  addNameHint :: Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
  addNameHint mblang names (item, name) = do
    let familyMatches = [n | n <- names
                           , n /= name
                           , nameFamily n == nameFamily name]
    case familyMatches of
      [] -> return Nothing
      _  -> do
        let hint = if any (initialsMatch mblang name) familyMatches
                      then AddGivenName
                      else AddInitials
        modify $ \st ->
          st{ stateRefMap = ReferenceMap
              $ setNameHint hint name item
              $ unReferenceMap (stateRefMap st) }
        return $ Just item
  
  setNameHint :: NameHints -> Name -> ItemId
              -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
  setNameHint hint name = M.adjust
         (alterReferenceDisambiguation
           (\d -> d{ disambNameMap =
                       M.insert name hint
                       (disambNameMap d) }))
  
  setEtAlNames :: Maybe Int -> ItemId
               -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
  setEtAlNames x = M.adjust
         (alterReferenceDisambiguation
           (\d -> d{ disambEtAlNames = x }))
  
  setYearSuffix :: Int -> ItemId
                -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
  setYearSuffix x = M.adjust
         (alterReferenceDisambiguation
           (\d -> d{ disambYearSuffix = Just x }))
  
  setDisambCondition :: Bool -> ItemId
                     -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
  setDisambCondition x = M.adjust
         (alterReferenceDisambiguation
           (\d -> d{ disambCondition = x }))
  
  getAmbiguities :: CiteprocOutput a => [Output a] -> [[DisambData]]
  getAmbiguities =
          mapMaybe
             (\zs ->
                 case zs of
                   []     -> Nothing
                   [_]    -> Nothing
                   (z:_) ->
                     case ddRendered z of
                       "" -> Nothing
                       _  -> case nubOrdOn ddItem zs of
                               ys@(_:_:_) -> Just ys -- > 1 ambiguous entry
                               _          -> Nothing)
        . groupBy (\x y -> ddRendered x == ddRendered y)
        . sortOn ddRendered
        . map toDisambData
        . extractTagItems
  
  extractTagItems :: [Output a] -> [(ItemId, Output a)]
  extractTagItems xs =
    [(iid, x) | Tagged (TagItem NormalCite iid) x <- concatMap universe xs
              , not (hasIbid x)]
   where -- we don't want two "ibid" entries to be treated as ambiguous.
    hasIbid x = not $ null [ trm | Tagged (TagTerm trm) _ <- universe x
                                 , termName trm == "ibid" ]
  
  
  toDisambData :: CiteprocOutput a => (ItemId, Output a) -> DisambData
  toDisambData (iid, x) =
    let xs = universe x
        ns' = getNames xs
        ds' = getDates xs
        t   = outputToText x
     in DisambData { ddItem = iid
                   , ddNames = ns'
                   , ddDates = ds'
                   , ddRendered = t }
   where
    getNames :: [Output a] -> [Name]
    getNames (Tagged (TagNames _ _ ns) _ : xs)
                    = ns ++ getNames xs
    getNames (_ : xs)   = getNames xs
    getNames []         = []
  
    getDates :: [Output a] -> [Date]
    getDates (Tagged (TagDate d) _ : xs)
                    = d : getDates xs
    getDates (_ : xs)   = getDates xs
    getDates []         = []
  
  
  --
  -- Grouping and collapsing
  --
  
  groupAndCollapseCitations :: forall a . CiteprocOutput a
                            => Text
                            -> Maybe Text
                            -> Maybe Text
                            -> Maybe Collapsing
                            -> Output a
                            -> Output a
  groupAndCollapseCitations citeGroupDelim yearSuffixDelim afterCollapseDelim
    collapsing (Formatted f xs) =
     case collapsing of
        Just CollapseCitationNumber ->
          Formatted f{ formatDelimiter = Nothing } $
              foldr collapseRange []
                    (groupSuccessive isAdjacentCitationNumber xs)
        Just collapseType ->
            Formatted f{ formatDelimiter = Nothing } $
              foldr (collapseGroup collapseType) [] (groupWith sameNames xs)
        Nothing ->
            Formatted f $
               map (Formatted mempty{ formatDelimiter = Just citeGroupDelim })
                   (groupWith sameNames xs)
   where
    --   Note that we cannot assume we've sorted by name,
    --   so we can't just use Data.ListgroupBy.  We also
    --   take care not to move anything past a prefix or suffix.
    groupWith :: (Output a -> Output a -> Bool)
              -> [Output a]
              -> [[Output a]]
    groupWith _ [] = []
    groupWith isMatched (z:zs)
     | hasSuffix z = [z] : groupWith isMatched zs
     | otherwise =  -- we allow a prefix on first item in collapsed group
      case span hasNoPrefixOrSuffix zs of
        ([],ys) -> [z] : groupWith isMatched ys
        (ws,ys) ->
          (z : filter (isMatched z) ws) :
            groupWith isMatched (filter (not . isMatched z) ws ++ ys)
  
    hasNoPrefixOrSuffix :: Output a -> Bool
    hasNoPrefixOrSuffix x = not (hasPrefix x) && not (hasSuffix x)
  
    hasPrefix :: Output a -> Bool
    hasPrefix x = not $ null [y | y@(Tagged TagPrefix _) <- universe x]
  
    hasSuffix :: Output a -> Bool
    hasSuffix x = not $ null [y | y@(Tagged TagSuffix _) <- universe x]
  
    collapseRange :: [Output a] -> [Output a] -> [Output a]
    collapseRange ys zs
      | length ys >= 3
      , Just yhead <- headMay ys
      , Just ylast <- lastMay ys
        = Formatted mempty{ formatDelimiter = Just $ T.singleton enDash }
                    [yhead, ylast] :
                    if null zs
                       then []
                       else maybe NullOutput literal afterCollapseDelim : zs
    collapseRange ys zs =
      Formatted mempty{ formatDelimiter = formatDelimiter f } ys :
        if null zs
           then []
           else maybe NullOutput literal (formatDelimiter f) : zs
  
    collapseGroup :: Collapsing -> [Output a] -> [Output a] -> [Output a]
    collapseGroup _ [] zs = zs
    collapseGroup collapseType (y:ys) zs =
      let ys' = y : map (transform removeNames) ys
          ws = collapseYearSuffix collapseType ys'
          noCollapse = ws == y:ys
          noYearSuffixCollapse = ws == ys'
          hasLocator u = not $ null [x | x@(Tagged TagLocator _) <- universe u]
          anyHasLocator = any hasLocator ws
          -- https://github.com/citation-style-language/test-suite/issues/36 :
          flippedAfterCollapseDelim = collapseType == CollapseYear
          addCGDelim u [] = [u]
          addCGDelim u us =
            Formatted mempty{ formatSuffix =
                                if noCollapse || noYearSuffixCollapse &&
                                   not (flippedAfterCollapseDelim &&
                                        anyHasLocator)
                                   then Just citeGroupDelim
                                   else afterCollapseDelim <|>
                                        formatDelimiter f } [u] : us
       in Formatted mempty{ formatDelimiter = Nothing
                          , formatSuffix =
                              if null zs
                                 then Nothing
                                 else if noCollapse &&
                                            not flippedAfterCollapseDelim
                                         then formatDelimiter f
                                         else afterCollapseDelim <|>
                                              formatDelimiter f }
                                 (foldr addCGDelim [] ws) : zs
    collapseRanges = map rangifyGroup . groupSuccessive isSuccessive
    isSuccessive x y
      = case ([c | Tagged (TagYearSuffix c) _ <- universe x],
              [d | Tagged (TagYearSuffix d) _ <- universe y]) of
          ([c],[d]) -> d == c + 1
          _   -> False
  
    rangifyGroup :: [Output a] -> Output a
    rangifyGroup zs
      | length zs >= 3
      , Just zhead <- headMay zs
      , Just zlast <- lastMay zs
      = Formatted mempty{ formatDelimiter = Just (T.singleton enDash) }
                  [zhead, zlast]
    rangifyGroup [z] = z
    rangifyGroup zs = Formatted mempty{ formatDelimiter = yearSuffixDelim
                                      } zs
  
    yearSuffixGroup :: Bool -> [Output a] -> Output a
    yearSuffixGroup _ [x] = x
    yearSuffixGroup useRanges zs  =
      Formatted mempty{ formatDelimiter = yearSuffixDelim }
        $ if useRanges then collapseRanges zs else zs
  
    collapseYearSuffix :: Collapsing -> [Output a] -> [Output a]
    collapseYearSuffix CollapseYearSuffix zs =
      reverse $ yearSuffixGroup False cur : items
     where
       (cur, items) = foldl' (goYearSuffix False) ([], []) zs
    collapseYearSuffix CollapseYearSuffixRanged zs =
      reverse $ yearSuffixGroup True cur : items
     where
       (cur, items) = foldl' (goYearSuffix True) ([], []) zs
    collapseYearSuffix _ zs = zs
  
    getDates :: Output a -> [Date]
    getDates x = [d | Tagged (TagDate d) _ <- universe x]
  
    getYears :: Output a -> [[Maybe Int]]
    getYears x = [map (\case
                          DateParts (y:_) -> Just y
                          _               -> Nothing) (dateParts d)
                  | d <- getDates x
                  , isNothing (dateLiteral d)]
  
    goYearSuffix :: Bool -> ([Output a], [Output a]) -> Output a
                 -> ([Output a], [Output a])
    goYearSuffix useRanges (cur, items) item =
      case cur of
        []     -> ([item], items)
        (z:zs)
          | getYears z == getYears item
            -> (z:zs ++ [transform removeYear item], items)
          | otherwise -> ([item], yearSuffixGroup useRanges (z:zs) : items)
  
    removeYear :: Output a -> Output a
    removeYear (Tagged (TagDate d) x) =
      Tagged (TagDate d) (extractYearSuffix x)
    removeYear x = x
  
    extractYearSuffix :: Output a -> Output a
    extractYearSuffix x =
      case [z | z@(Tagged (TagYearSuffix _) _) <- universe x] of
        (y:_) -> y
        _     -> NullOutput
  
    isAdjacentCitationNumber :: Output a -> Output a -> Bool
    isAdjacentCitationNumber
       (Tagged (TagItem _ _)
         (Formatted _f1 [Tagged (TagCitationNumber n1) _xs1]))
       (Tagged (TagItem _ _)
         (Formatted _f2 [Tagged (TagCitationNumber n2) _xs2]))
      = n2 == n1 + 1
    isAdjacentCitationNumber
       (Tagged (TagItem _ _) (Tagged (TagCitationNumber n1) _xs1))
       (Tagged (TagItem _ _) (Tagged (TagCitationNumber n2) _xs2))
      = n2 == n1 + 1
    isAdjacentCitationNumber _ _ = False
  
    sameNames :: Output a -> Output a -> Bool
    sameNames x y =
      case (extractTagged x, extractTagged y) of
        (Just (Tagged (TagNames t1 _nf1 ns1) ws1),
         Just (Tagged (TagNames t2 _nf2 ns2) ws2))
          -> t1 == t2 && (if ns1 == ns2
                             then not (null ns1) || ws1 == ws2
                             else ws1 == ws2)
        -- case where it's just a date with no name or anything;
        -- we treat this as same name e.g. (1955a,b)
        (Just (Tagged TagDate{} _), Just (Tagged TagDate{} _))
          -> True
            -- case where title is substituted
        _ -> False
  
    extractTagged :: Output a -> Maybe (Output a)
    extractTagged x =
      let items = [y | y@(Tagged (TagItem ty _) _) <- universe x
                     , ty /= AuthorOnly]
          names = [y | y@(Tagged TagNames{} _) <- concatMap universe items]
          dates = [y | y@(Tagged TagDate{} _) <- concatMap universe items]
      in  if null items
             then Nothing
             else listToMaybe names <|> listToMaybe dates
  
  groupAndCollapseCitations _ _ _ _ x = x
  
  takeSeq :: Show a => (a -> a -> Bool) -> [a] -> ([a], [a])
  takeSeq isAdjacent (x1 : x2 : rest)
    | isAdjacent x1 x2 = (x1:ys, zs)
    where (ys, zs) = takeSeq isAdjacent (x2:rest)
  takeSeq _ (y:ys) = ([y], ys)
  takeSeq _ []     = ([], [])
  
  groupSuccessive :: Show a => (a -> a -> Bool) -> [a] -> [[a]]
  groupSuccessive isAdjacent zs =
    case takeSeq isAdjacent zs of
      ([],_)  -> []
      (xs,ys) -> xs : groupSuccessive isAdjacent ys
  
  --
  -- Sorting
  --
  
  evalSortKeys :: CiteprocOutput a
               => Layout a
               -> ItemId
               -> Eval a [SortKeyValue]
  evalSortKeys layout citeId =
    withRWST (\ctx st -> (ctx{ contextInSortKey = True }, st)) $
      mapM (evalSortKey citeId) (layoutSortKeys layout)
  
  evalSortKey :: CiteprocOutput a
              => ItemId
              -> SortKey a
              -> Eval a SortKeyValue
  evalSortKey citeId (SortKeyMacro sortdir elts) = do
    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)
          return $ SortKeyValue sortdir (Just k)
       where
        newContext oldContext s =
          (oldContext, s{ stateReference = ref })
  evalSortKey citeId (SortKeyVariable sortdir var) = do
    refmap <- gets stateRefMap
    SortKeyValue sortdir <$>
      case lookupReference citeId refmap >>= lookupVariable var of
        Nothing           -> return Nothing
        Just (TextVal t)  -> return $ Just $ normalizeSortKey t
        Just (NumVal  i)  -> return $ Just [T.pack $ printf "%09d" i]
        Just (FancyVal x) -> return $ Just $ normalizeSortKey $ toText x
        Just (NamesVal ns) ->
          Just . normalizeSortKey . mconcat . intersperse "," . map T.unwords
               <$> mapM getNamePartSortOrder ns
        Just (DateVal d)  -> return $ Just [T.toLower $ dateToText d]
        Just SubstitutedVal -> return Nothing
  
  -- Note: we do a case-insensitive sort (using toCaseFold):
  normalizeSortKey :: Text -> [Text]
  normalizeSortKey = filter (not . T.null) . T.split isWordSep . T.toCaseFold
   where
    isWordSep c = isSpace c || c == '\'' || c == '’' || c == ',' ||
                  c == 'ʾ' || c == 'ʿ' -- ayn/hamza in transliterated arabic
  
  -- absence should sort AFTER all values
  -- see sort_StatusFieldAscending.txt, sort_StatusFieldDescending.txt
  compSortKeyValue :: (Text -> Text -> Ordering)
                   -> SortKeyValue
                   -> SortKeyValue
                   -> Ordering
  compSortKeyValue collate sk1 sk2 =
    case (sk1, sk2) of
      (SortKeyValue _ Nothing, SortKeyValue _ Nothing) -> EQ
      (SortKeyValue _ Nothing, SortKeyValue _ (Just _)) -> GT
      (SortKeyValue _ (Just _), SortKeyValue _ Nothing) -> LT
      (SortKeyValue Ascending (Just t1), SortKeyValue Ascending (Just t2)) ->
        collateKey t1 t2
      (SortKeyValue Descending (Just t1), SortKeyValue Descending (Just t2))->
        collateKey t2 t1
      _ -> EQ
   where
    collateKey :: [Text] -> [Text] -> Ordering
    collateKey [] [] = EQ
    collateKey [] (_:_) = LT
    collateKey (_:_) [] = GT
    collateKey (x:xs) (y:ys) =
      case collate x y of
        EQ -> collateKey xs ys
        GT -> GT
        LT -> LT
  
  compSortKeyValues :: (Text -> Text -> Ordering)
                    -> [SortKeyValue]
                    -> [SortKeyValue]
                    -> Ordering
  compSortKeyValues _ [] [] = EQ
  compSortKeyValues _ [] (_:_) = LT
  compSortKeyValues _ (_:_) [] = GT
  compSortKeyValues collate (x:xs) (y:ys) =
    case compSortKeyValue collate x y of
      EQ -> compSortKeyValues collate xs ys
      GT -> GT
      LT -> LT
  
  -- Note!  This prints negative (BC) dates as N(999,999,999 + y)
  -- and positive (AD) dates as Py so they sort properly.  (Note that
  -- our unicode sorting ignores punctuation, so we use a letter
  -- rather than -.) Do not use out of context of sort keys.
  dateToText :: Date -> Text
  dateToText = mconcat . map (T.pack . go . coerce) . dateParts
   where
    go :: [Int] -> String
    go [] = ""
    go [y] = toYear y <> "0000"
    go [y,m] = toYear y <> printf "%02d" m <> "00"
    go (y:m:d:_) = toYear y <> printf "%02d" m <> printf "%02d" d
    toYear :: Int -> String
    toYear y
      | y < 0     = printf "N%09d" (999999999 + y)
      | otherwise = printf "P%09d" y
  
  
  evalLayout :: CiteprocOutput a
              => Layout a
              -> (Int, Citation a)
              -> Eval a (Output a)
  evalLayout layout (citationGroupNumber, citation) = 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
    -- count against a later Ibid citation.
    let positionsInCitation =
          case citationItems citation of
            (c:_) | citationItemType c == AuthorOnly -> [0..]
            _ -> [1..]
  
    let addCitationAffixes =
            maybe id (\pref xs ->
                        case xs of
                          [] -> []
                          (x:rest) -> x{ citationItemPrefix = Just $ pref <>
                                           fromMaybe mempty (citationItemPrefix x) }
                                            : rest)
                  (citationPrefix citation) .
            maybe id (\suff xs ->
                        case reverse xs of
                          [] -> []
                          (x:rest) -> reverse rest ++ [x{ citationItemSuffix = Just $
                                                          fromMaybe mempty (citationItemSuffix x)
                                                          <> suff }])
                  (citationSuffix citation)
  
    items <- mapM evalItem' (zip positionsInCitation
                              (addCitationAffixes (citationItems citation)))
  
    -- see display_SecondFieldAlignMigratePunctuation.txt
    let moveSuffixInsideDisplay zs =
          case (lastMay zs, formatSuffix formatting) of
            (Just (Tagged (TagItem ct id') (Formatted f ys)), Just _) ->
              (\ys' -> initSafe zs ++
                        [Tagged (TagItem ct id') (Formatted f ys')]) <$>
                          moveSuffixInsideDisplay ys
            (Just (Formatted f ys), Just suff)
              | isJust (formatDisplay f) ->
                  Just $ initSafe zs ++
                       [Formatted f{ formatSuffix = Just
                            (fromMaybe "" (formatSuffix f) <> suff) } ys]
              | otherwise -> (\ys' -> initSafe zs ++ [Formatted f ys']) <$>
                               moveSuffixInsideDisplay ys
            _ -> Nothing
  
    return $
      case moveSuffixInsideDisplay items of
        Nothing     -> formatted formatting items
        Just items' -> formatted formatting{ formatSuffix = Nothing } items'
   where
    formatting = layoutFormatting layout
  
    secondFieldAlign [Linked t (x:xs)] =
      secondFieldAlign [x, Linked t xs]
    secondFieldAlign (x:xs) =
      formatted mempty{ formatDisplay = Just DisplayLeftMargin } [x]
      : [formatted mempty{ formatDisplay = Just DisplayRightInline } xs]
    secondFieldAlign [] = []
  
    evalItem' (positionInCitation :: Int, item) = do
      isBibliography  <- asks contextInBibliography
  
      styleOpts <- asks contextStyleOptions
      let isNote = styleIsNoteStyle styleOpts
      position <- getPosition citationGroupNumber (citationNoteNumber citation)
                       item positionInCitation
  
      xs <- evalItem layout (position, item)
      -- we only update the map in the citations section
      unless isBibliography $ do
        updateRefMap citationGroupNumber citation item
        updateLastCitedMap citationGroupNumber positionInCitation citation item
  
      return $
            maybe id (\pref x -> grouped [Tagged TagPrefix (Literal pref), x])
                  (citationItemPrefix item)
          . maybe id (\suff x -> grouped [x, Tagged TagSuffix (Literal suff)])
                     (citationItemSuffix item)
          . (\x -> case x of
                     NullOutput -> x
                     _          -> Tagged (TagItem (citationItemType item)
                                                    (citationItemId item)) x)
          . formatted mempty
          . (if citationItemType item == AuthorOnly
                then (:[]) . getAuthors . formatted mempty
                else id)
          . (case citationItemPrefix item of
               -- this handles the case where the prefix is a whole sentence:
               Just t | isNote
                      , ". " `T.isSuffixOf` toText t
                      , T.count " " (toText t) > 1 -- exclude single word
                                   -> capitalizeInitialTerm
               _                   -> id)
          . (if isBibliography
                then
                  case styleSecondFieldAlign styleOpts of
                    Just SecondFieldAlignFlush  -> secondFieldAlign
                    Just SecondFieldAlignMargin -> secondFieldAlign -- TODO?
                    Nothing -> id
                else id)
          $ xs
  
  evalItem :: CiteprocOutput a
           => Layout a -> ([Position], CitationItem a) -> Eval a [Output a]
  evalItem layout (position, item) = do
    refmap <- gets stateRefMap
  
    let addLangToFormatting lang (Formatted f xs) =
          Formatted f{ formatLang = Just lang } xs
        addLangToFormatting _ x = x
  
    case lookupReference (citationItemId item) refmap of
      Just ref -> withRWST
        (\ctx st ->
         (ctx{ contextLocator = citationItemLocator item
             , contextLabel = citationItemLabel item
             , contextPosition = position
             },
          st{ stateReference = ref
            , stateUsedYearSuffix = False
            , stateUsedIdentifier = False
            , stateUsedTitle = False
            }))
          $ do xs <- mconcat <$> mapM eElement (layoutElements layout)
  
               -- find identifiers that can be used to hyperlink the title
               let mbident =
                      foldl (<|>) Nothing
                        [ IdentDOI   <$> (valToText =<< lookupVariable "DOI" ref)
                        , IdentPMCID <$> (valToText =<< lookupVariable "PMCID" ref)
                        , IdentPMID  <$> (valToText =<< lookupVariable "PMID" ref)
                        , IdentURL   <$> (valToText =<< lookupVariable "URL" ref)
                        ]
               let mburl = identifierToURL <$> mbident
  
               -- hyperlink any titles in the output
               let linkTitle url (Tagged TagTitle x) = Linked url [Tagged TagTitle x]
                   linkTitle _ x = x
  
               usedLink  <- gets stateUsedIdentifier
               usedTitle <- gets stateUsedTitle
               inBiblio  <- asks contextInBibliography
  
               -- when no links were rendered for a bibliography item, hyperlink
               -- the title, if it exists, otherwise hyperlink the whole item
               let xs' =
                     if usedLink || not inBiblio
                       then xs
                     else case mburl of
                           Nothing  -> xs
                           Just url -> if usedTitle
                                          -- hyperlink the title
                                          then fmap (transform (linkTitle url)) xs
                                          -- hyperlink the entire bib item
                                          else [Linked url xs]
  
               let mblang = lookupVariable "language" ref
                            >>= valToText
                            >>= either (const Nothing) Just . parseLang
               return $
                 case mblang of
                   Nothing   -> xs'
                   Just lang -> map
                       (transform (addLangToFormatting lang)) xs'
      Nothing -> do
        warn $ "citation " <> unItemId (citationItemId item) <>
               " not found"
        return [Literal $ addFontWeight BoldWeight
           $ fromText $ unItemId (citationItemId item) <> "?"]
  
  
  
  updateRefMap :: Int -> Citation a -> CitationItem a -> Eval a ()
  updateRefMap citationGroupNumber citation item = do
    isNote <- asks (styleIsNoteStyle . contextStyleOptions)
    lastCitedMap <- gets stateLastCitedMap
    let notenum = NumVal $ fromMaybe citationGroupNumber (citationNoteNumber citation)
    -- keep track of how many citations in each note.
    -- two citations from the same note don't count as "alone"
    -- for ibid purposes. See citation-style-language/documentation#121
    case citationNoteNumber citation of
      Nothing -> return ()
      Just n  -> modify $ \st ->
                     st{ stateNoteMap = M.alter
                          (maybe
                            (Just (Set.singleton (citationItemId item)))
                            (Just . Set.insert (citationItemId item)))
                          n
                          (stateNoteMap st) }
    case M.lookup (citationItemId item) lastCitedMap of
      Nothing | isNote -> -- first citation
        modify $ \st ->
          st{ stateRefMap = ReferenceMap $
                  M.adjust (\ref -> ref{ referenceVariables =
                    M.insert "first-reference-note-number" notenum
                               (referenceVariables ref)})
                    (citationItemId item)
                 (unReferenceMap $ stateRefMap st) }
      _  -> return ()
  
  updateLastCitedMap :: Int -> Int -> Citation a -> CitationItem a -> Eval a ()
  updateLastCitedMap citationGroupNumber positionInCitation citation item = do
    unless (citationItemType item == AuthorOnly) $
      modify $ \st ->
        st{ stateLastCitedMap =
          M.insert (citationItemId item)
            (citationGroupNumber, citationNoteNumber citation,
             positionInCitation,
             (case citationItems citation of
                [_]   -> True
                [x,y] -> citationItemId x == citationItemId y
                        && citationItemType x == AuthorOnly
                        && citationItemType y == SuppressAuthor
                _     -> False),
             citationItemLabel item,
             citationItemLocator item)
          $ stateLastCitedMap st }
  
  
  -- | The first-occurring element tagged as Names will be
  -- treated as the "author"; generally that is the author
  -- but it might be the editor if it's an edited volume.
  getAuthors :: Output a -> Output a
  getAuthors x =
    headDef NullOutput [y | y@(Tagged TagNames{} _) <- universe x]
  
  removeNames :: Output a -> Output a
  removeNames (Tagged TagNames{} _) = NullOutput
  removeNames x = x
  
  capitalizeInitialTerm :: [Output a] -> [Output a]
  capitalizeInitialTerm [] = []
  capitalizeInitialTerm (z:zs) = go z : zs
   where
    go (Tagged (TagTerm t) x) =
      Tagged (TagTerm t)
        (formatted mempty{ formatTextCase = Just CapitalizeFirst } [x])
    go (Formatted f xs) = Formatted f (capitalizeInitialTerm xs)
    go (Tagged tg x) = Tagged tg (go x)
    go x = x
  
  getPosition :: Int -> Maybe Int -> CitationItem a -> Int -> Eval a [Position]
  getPosition groupNum mbNoteNum item posInGroup = do
    inBibliography <- asks contextInBibliography
    if inBibliography
       then return []
       else getPosition'
   where
    getPosition' = do
      lastCitedMap <- gets stateLastCitedMap
      noteMap <- gets stateNoteMap
      case M.lookup (citationItemId item) lastCitedMap of
        Nothing -> return [FirstPosition]
        Just (prevGroupNum, mbPrevNoteNum,
               prevPosInGroup, prevAloneInGroup,
               prevLabel, prevLoc) -> do
          isNote <- asks (styleIsNoteStyle . contextStyleOptions)
          nearNoteDistance <- fromMaybe 5 <$>
                  asks (styleNearNoteDistance . contextStyleOptions)
          let noteNum = fromMaybe groupNum mbNoteNum
          let prevNoteNum = fromMaybe prevGroupNum mbPrevNoteNum
          let prevAloneInNote =
                case M.lookup prevNoteNum noteMap of
                  Nothing -> True
                  Just s  -> Set.size s <= 1
          let prevAlone = prevAloneInGroup && prevAloneInNote
          return $
            (if isNote && noteNum - prevNoteNum < nearNoteDistance
                then (NearNote :)
                else id) .
            (if (groupNum == prevGroupNum &&
                 posInGroup == prevPosInGroup + 1) ||
                (groupNum == prevGroupNum + 1 &&
                  (((-) <$> mbNoteNum <*> mbPrevNoteNum) <= Just 1) &&
                 posInGroup == 1 &&
                 prevAlone)
                 then case (prevLoc, citationItemLocator item) of
                        (Nothing, Just _)
                          -> (IbidWithLocator :) . (Ibid :)
                        (Nothing, Nothing) -> (Ibid :)
                        (Just _, Nothing)   -> id
                        (Just l1, Just l2)
                          | l1 == l2
                          , citationItemLabel item == prevLabel
                            -> (Ibid :)
                          | otherwise
                            -> (IbidWithLocator :) . (Ibid :)
                 else id)
            $ [Subsequent]
  
  eElement :: CiteprocOutput a => Element a -> Eval a [Output a]
  eElement (Element etype formatting) =
    case etype of
      EText textType ->
        (:[]) <$> withFormatting formatting (eText textType)
      ENumber var nform ->
        (:[]) <$> withFormatting formatting (eNumber var nform)
      EGroup isMacro els ->
        (:[]) <$> eGroup isMacro formatting els
      EChoose chooseParts -> eChoose chooseParts
      ELabel var termform pluralize ->
        (:[]) <$> eLabel var termform pluralize formatting
      EDate var dateType mbShowDateParts dps ->
        (:[]) <$> eDate var dateType mbShowDateParts dps formatting
      ENames vars namesFormat subst ->
        (:[]) <$> eNames vars namesFormat subst formatting
  
  withFormatting :: CiteprocOutput a
                 => Formatting -> Eval a (Output a) -> Eval a (Output a)
  withFormatting (Formatting Nothing Nothing Nothing Nothing Nothing Nothing
                             Nothing Nothing Nothing Nothing Nothing
                             False False False) p
                            = p
  withFormatting formatting p = do
    -- Title case conversion only affects English-language items.
    lang <- asks (localeLanguage . contextLocale)
    ref <- gets stateReference
    let reflang = case M.lookup "language" (referenceVariables ref) of
                    Just (TextVal t)  ->
                      either (const Nothing) Just $ parseLang t
                    Just (FancyVal x) ->
                      either (const Nothing) Just $ parseLang $ toText x
                    _                 -> Nothing
    let mainLangIsEn Nothing = False
        mainLangIsEn (Just l) = langLanguage l == "en"
    let isEnglish = case reflang of
                      Just l  -> mainLangIsEn (Just l)
                      Nothing -> mainLangIsEn lang
    let formatting' = if formatTextCase formatting == Just TitleCase &&
                         not isEnglish
                         then formatting{ formatTextCase = Nothing }
                         else formatting
    res <- p
    return $ formatted formatting' [res]
  
  lookupTerm :: Term -> Eval a [(Term, Text)]
  lookupTerm term = do
    terms <- asks (localeTerms . contextLocale)
    let term' = if termName term == "sub verbo"
                   then term{ termName = "sub-verbo" }
                   else term
    case M.lookup (termName term') terms of
       Just ts -> return $ [ (term'',t)
                           | (term'',t) <- ts
                           , term' <= term''
                           ]
       Nothing -> return []
  
  lookupTerm' :: CiteprocOutput a => Term -> Eval a (Output a)
  lookupTerm' term = lookupTerm term >>= f
   where
     f []  =
       --  “verb-short” first falls back to “verb”, “symbol”
       --  first falls back to “short”, and “verb” and “short”
       --  both fall back to “long”.
       case termForm term of
         VerbShort -> lookupTerm' term{ termForm = Verb }
         Symbol    -> lookupTerm' term{ termForm = Short }
         Verb      -> lookupTerm' term{ termForm = Long }
         Short     -> lookupTerm' term{ termForm = Long }
         _         -> return NullOutput
     f ((_,t):_) = return $ if T.null t
                               then NullOutput
                               else Literal $ fromText t
  
  pageRange :: CiteprocOutput a => Text -> Eval a (Output a)
  pageRange x = do
    pageDelim <- lookupTerm'
                    emptyTerm{ termName = "page-range-delimiter" }
    mbPageRangeFormat <- asks (stylePageRangeFormat . contextStyleOptions)
    let ranges = map T.strip $ T.groupBy
                 (\c d -> not (c == ',' || c == '&' || d == ',' || d == '&'))
                 x
    return $ formatted mempty{ formatDelimiter = Just " " }
           $ map (formatPageRange mbPageRangeFormat
              (case pageDelim of
                 NullOutput -> literal $ T.singleton enDash
                 delim      -> delim)) ranges
  
  enDash :: Char
  enDash = '\x2013'
  
  formatPageRange :: CiteprocOutput a
                  => Maybe PageRangeFormat
                  -> Output a
                  -> Text
                  -> Output a
  formatPageRange _ _ "&" = literal "&"
  formatPageRange _ _ "," = literal ","
  formatPageRange mbPageRangeFormat delim t =
    let isDash '-' = True
        isDash '\x2013' = True
        isDash _ = False
        rangeParts = if "\\-" `T.isInfixOf` t
                        then [T.replace "\\-" "-" t]
                        else map T.strip $ T.split isDash t
        inRange pref xs
          | T.null pref = grouped (intersperse delim (map literal xs))
          | otherwise = grouped
              (literal pref : intersperse delim (map literal xs))
        changedDigits xs ys =
          length $ filter not $ zipWith (==) (xs ++ repeat ' ') ys
        minimal threshold pref x y =
          case T.commonPrefixes x y of
               Just (_comm, restx, resty) | T.length restx == T.length resty ->
                   if T.length resty < threshold && T.length y >= threshold
                      then inRange pref [x, T.takeEnd threshold y]
                      else inRange pref [x, resty]
               _ -> inRange pref [x, y]
     in case rangeParts of
          []     -> NullOutput
          [w]    -> literal w
          [w,v]
            | Nothing <- mbPageRangeFormat -> inRange mempty [w,v]
            | Just fmt <- mbPageRangeFormat -> do
              let wPrefix = T.dropWhileEnd isDigit w
              let vPrefix = T.dropWhileEnd isDigit v
              if wPrefix == vPrefix
                 then do
                   let pref = wPrefix
                   let x = T.drop (T.length wPrefix) w
                   let y = T.drop (T.length vPrefix) v
                   let xlen = T.length x
                   let ylen = T.length y
                   let y'   = if ylen < xlen
                                 then T.take (xlen - ylen) x <> y
                                 else y
                   case fmt of
                     PageRangeChicago15
                         | xlen < 3  -> inRange pref [x, y']
                         | "00" `T.isSuffixOf` x -> inRange pref [x, y']
                         | T.take 1 (T.takeEnd 2 x) == "0"
                         , T.take 1 (T.takeEnd 2 y') == "0"
                           -> minimal 1 pref x y'
                         | xlen == 4
                         , changedDigits (T.unpack x) (T.unpack y') >= 3
                           -> inRange pref [x, y']
                         | otherwise -> minimal 2 pref x y'
                     PageRangeChicago16
                         | xlen < 3  -> inRange pref [x, y']
                         | "00" `T.isSuffixOf` x -> inRange pref [x, y']
                         | T.take 1 (T.takeEnd 2 x) == "0"
                         , T.take 1 (T.takeEnd 2 y') == "0"
                           -> minimal 1 pref x y'
                         | otherwise -> minimal 2 pref x y'
                     PageRangeExpanded ->
                         inRange mempty [pref <> x, pref <> y']
                     PageRangeMinimal -> minimal 1 pref x y'
                     PageRangeMinimalTwo -> minimal 2 pref x y'
                 else inRange mempty [w,v]
          _ -> literal t
  
  eText :: CiteprocOutput a => TextType -> Eval a (Output a)
  eText (TextVariable varForm v) = do
    ref <- gets stateReference
    -- Note: we do book keeping on how many variables
    -- have been accessed and how many are nonempty,
    -- in order to properly handle the group element,
    -- which is implicitly conditional.
    case v of
      "id"   -> do
        updateVarCount 1 1
        return $ Literal $ fromText $ coerce $ referenceId ref
      "type" -> do
        updateVarCount 1 1
        return $ Literal $ fromText  $ referenceType ref
      "locator" -> do
          let handleAmpersands (Just t) | T.any (=='&') t = do
                ts <- lookupTerm emptyTerm { termName = "and"
                                           , termForm = Symbol }
                case ts of
                  (_,x):_ -> return (Just $ T.replace "&" x t)
                  []      -> return (Just t)
              handleAmpersands x = return x
  
          mbv <- asks contextLocator >>= handleAmpersands
          mbl <- asks contextLabel
          case mbv of
            Just x | isNothing mbl || mbl == Just "page" -> do
                        updateVarCount 1 1
                        Tagged TagLocator <$> pageRange x
                   | otherwise -> do
                        updateVarCount 1 1
                        return $ Tagged TagLocator $
                                  formatPageRange Nothing
                                  (literal $ T.singleton enDash) x
            Nothing -> NullOutput <$ updateVarCount 1 0
  
      "year-suffix" -> do
          disamb <- gets (referenceDisambiguation . stateReference)
          case disamb >>= disambYearSuffix of
            Just x ->
              -- we don't update var count here; this doesn't
              -- count as a variable
              return $ Tagged (TagYearSuffix x)
                              (Literal (fromText (showYearSuffix x)))
            Nothing -> return NullOutput
  
      "citation-number" -> do
          mbv <- askVariable v
          case mbv of
            Just (NumVal x)  -> return $
                                Tagged (TagCitationNumber x) $
                                Literal $ fromText (T.pack (show x))
            _ -> do
              warn $ "citation-number not defined for " <>
                        coerce (referenceId ref)
              return NullOutput
  
      "citation-label" -> do  -- these need year suffix too
          mbv <- askVariable v
          mbsuff <- getYearSuffix
          case mbv of
            Just (TextVal t)  -> return $
                                  Tagged TagCitationLabel $
                                    grouped $
                                    Literal (fromText t)
                                    : maybeToList mbsuff
            Just (FancyVal x) -> return $
                                   Tagged TagCitationLabel $
                                    grouped $
                                    Literal x
                                    : maybeToList mbsuff
            _ -> do
              warn $ "citation-label of unknown type for " <>
                        coerce (referenceId ref)
              return NullOutput
  
      "DOI"   -> handleIdent id IdentDOI
      "PMCID" -> handleIdent id IdentPMCID
      "PMID"  -> handleIdent id IdentPMID
      "URL"   -> handleIdent id IdentURL
  
      _ -> do
          mbv <- if varForm == ShortForm
                    then do
                      mbval <- (<|>) <$> askVariable (v <> "-short")
                                     <*> askVariable v
                      case mbval of
                        Nothing -> return Nothing
                        Just val -> do
                          mbAbbrevs <- asks contextAbbreviations
                          return $ Just $ fromMaybe val
                                 $ mbAbbrevs >>= lookupAbbreviation v val
                    else askVariable v
          res <- case mbv of
                   Just (TextVal x)
                     | v == "page" -> pageRange x
                     | otherwise   -> return $ Literal $ fromText x
                   Just (FancyVal x)
                     | v == "page" -> pageRange (toText x)
                     | otherwise   -> return $ Literal x
                   Just (NumVal x) -> return $ Literal
                                             $ fromText (T.pack (show x))
                   _ -> return NullOutput
          unless (isNothing mbv) $ deleteSubstitutedVariables [v]
          if v == "title" && res /= NullOutput
              then do
                modify (\st -> st { stateUsedTitle = True })
                -- tag title so we can hyperlink it later
                return $ Tagged TagTitle res
              else return res
      where
        handleIdent :: CiteprocOutput b => (Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
        handleIdent f identConstr = do
          mbv <- askVariable v
          deleteSubstitutedVariables [v]
          case f <$> (valToText =<< mbv) of
            Nothing -> return NullOutput
            Just t  -> do
              -- create link and remember that we've done so far
              modify (\st -> st { stateUsedIdentifier = True })
              let url = identifierToURL (identConstr t)
              return $ Linked url [Literal $ fromText t]
  eText (TextMacro name) = do
    warn $ "encountered unexpanded macro " <> name
    return NullOutput
  eText (TextValue t) = return $ Literal $ fromText t
  eText (TextTerm term) = do
    t' <- lookupTerm' term
    t'' <- if termName term == "no date"
              then do
                mbsuff <- getYearSuffix
                case mbsuff of
                  Nothing  -> return t'
                  Just suff
                    | termForm term == Long
                      -> return $ grouped [t', Literal (fromText " "), suff]
                    | otherwise -> return $ grouped [t', suff]
              else return t'
    return $ Tagged (TagTerm term) t''
  
  
  -- | Delete substituted variables so they aren't used again.
  deleteSubstitutedVariables :: [Variable] -> Eval a ()
  deleteSubstitutedVariables vars = do
    inSubst <- asks contextInSubstitute
    when inSubst $
      modify $ \st -> -- delete variables so they aren't used again...
        st{ stateReference =
                    let Reference id' type' d' m' = stateReference st
                     in Reference id' type' d' (foldr (\v -> M.insert v SubstitutedVal) m' vars) }
  
  -- Numbers with prefixes or suffixes are never ordinalized
  -- or rendered in roman numerals (e.g. “2E” remains “2E).
  -- Numbers without affixes are individually transformed
  -- (“2, 3” can become “2nd, 3rd”, “second, third” or “ii, iii”).
  -- So, first we split on punctuation and spaces:
  splitNums :: Text -> [Val a]
  splitNums = map go . T.groupBy sameClass
   where
    go t = case readAsInt t of
             Just i  -> NumVal i
             Nothing -> TextVal $ if t == "-"
                                     then T.singleton enDash
                                     else t
    sameClass c d = (isSepPunct c || isSpace c) ==
                    (isSepPunct d || isSpace d)
  
  --- punctuation that separates pages in a range
  isSepPunct :: Char -> Bool
  isSepPunct ',' = True
  isSepPunct ';' = True
  isSepPunct '-' = True
  isSepPunct '\x2013' = True
  isSepPunct _   = False
  
  eLabel :: CiteprocOutput a
         => Variable
         -> TermForm
         -> Pluralize
         -> Formatting
         -> Eval a (Output a)
  eLabel var termform pluralize formatting = do
    ref <- gets stateReference
    let getTerm :: CiteprocOutput a
                => Text -> Val a -> Eval a (Output a)
        getTerm termname x = do
          let determinePlural t
               | var == "number-of-volumes"
               , t /= "1" && t /= "0"      = Plural
               | "\\-" `T.isInfixOf` t     = Singular
               | length (splitNums t) > 1  = Plural
                 -- see label_CollapsedPageNumberPluralDetection.txt
               | otherwise                 = Singular
          let number = case pluralize of
                           AlwaysPluralize     -> Plural
                           NeverPluralize      -> Singular
                           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
                                                else Singular
                              _ -> Singular
          let term = emptyTerm{ termName = termname
                              , termForm = termform
                              , termNumber = Just number }
          lookupTerm' term
    locator <- asks contextLocator
    label <- asks contextLabel
    let var' = if var == "editortranslator" then "editor" else var
    term' <- case (var, locator, label) of
               ("locator", Just loc, Just lab) -> getTerm lab (TextVal loc)
               ("locator", Just loc, Nothing)
                  | beginsWithSpace loc -> return NullOutput
                  | ". " `T.isPrefixOf` T.dropWhile isLetter loc
                                           -> return NullOutput
                  | otherwise              -> getTerm "page" (TextVal loc)
               _ -> case lookupVariable var' ref of
                           Nothing -> return NullOutput
                           Just x  -> getTerm (fromVariable var) x
  
    return $
      case formatSuffix formatting of
        Just suff
          | "." `T.isPrefixOf` suff
            -> case term' of
                 Literal x
                   | "." `T.isSuffixOf` toText x
                   , not (formatStripPeriods formatting)
                   -> formatted
                       formatting{ formatSuffix =
                          if T.length suff <= 1
                             then Nothing
                             else Just (T.drop 1 suff) }
                       [term']
                 _ -> formatted formatting [term']
        _ -> formatted formatting [term']
  
  eDate :: CiteprocOutput a
         => Variable
         -> DateType
         -> Maybe ShowDateParts
         -> [DP]
         -> Formatting
         -> Eval a (Output a)
  eDate var dateType mbShowDateParts dps formatting
    | var == mempty = do
      warn "skipping date element with no variable attribute set"
      return NullOutput
    | otherwise = do
      datevar <- askVariable var
      localeDateElt <- M.lookup dateType <$> asks (localeDate . contextLocale)
      let addOverride newdps olddp accum =
            case find ((== dpName olddp) . dpName) newdps of
              Just x  -> x{ dpFormatting =
                              dpFormatting olddp <> dpFormatting x } : accum
              Nothing -> olddp : accum
      let useDatePart dp =
            case mbShowDateParts of
              Just Year      -> dpName dp == DPYear
              Just YearMonth -> dpName dp == DPYear || dpName dp == DPMonth
              _              -> True
      let (dps', formatting') =
            case localeDateElt of
              Just (Element (EDate _ _ _ edps) f)
                -> (filter useDatePart $ foldr (addOverride dps) [] edps,
                     formatting <> f)
              _ -> (filter useDatePart dps, formatting)
      case datevar of
        Nothing ->
          -- warn $ "date element for empty variable " <> var
          return NullOutput
        Just (DateVal date) ->
          case dateLiteral date of
            Just t -> return $ formatted formatting' [Literal $ fromText t]
            Nothing -> do
              let dateparts = case dateSeason date of
                                Just i  ->
                                  case dateParts date of
                                    [DateParts [y]] ->
                                      [DateParts [y, 12 + i]] -- pseudo-mo
                                    xs    -> xs
                                Nothing -> dateParts date
              xs <- formatDateParts dps'
                      $ case dateparts of
                          [] -> (DateParts [], Nothing)
                          [d] -> (d, Nothing)
                          (d:e:_) -> (d, Just e)
              when (all (== NullOutput) xs) $
                -- back off on the claim to nonemptiness
                -- when the only match are in date parts that
                -- we aren't printing; see
                -- group_SuppressTermWhenNoOutputFromPartialDate.txt
                updateVarCount 0 (-1)
  
              yearSuffix <- getYearSuffix
              return $ Tagged (TagDate date) $ formatted formatting'
                        (xs ++ maybeToList yearSuffix)
        Just _ -> do
          warn $ "date element for variable with non-date value " <>
                  fromVariable var
          return NullOutput
  
  
  getYearSuffix :: CiteprocOutput a => Eval a (Maybe (Output a))
  getYearSuffix = do
    disamb <- gets (referenceDisambiguation . stateReference)
    sopts <- asks contextStyleOptions
    -- we only want year suffix on first occurence of year
    -- in a reference:
    usedYearSuffix <- gets stateUsedYearSuffix
    case disamb >>= disambYearSuffix of
      Just c
        | not (styleUsesYearSuffixVariable sopts)
        , not usedYearSuffix
        -> do
          modify $ \st -> st{ stateUsedYearSuffix = True }
          return $ Just $ Tagged (TagYearSuffix c)
                           (Literal (fromText (showYearSuffix c)))
        | otherwise -> return Nothing
      Nothing  -> return Nothing
  
  formatSortDate :: CiteprocOutput a
                 => [DP] -> (Maybe Int, Maybe Int, Maybe Int) -> Output a
  formatSortDate dpSpecs (mbyr, mbmo, mbda) =
    Literal $ fromText $ T.pack $  sortyr <> sortmo <> sortda
   where
    sortyr = case mbyr of
               Just yr | any ((== DPYear) . dpName) dpSpecs
                  -> printf "%04d" (yr + 5000) -- to work with BC and AD
               _  -> ""
    sortmo = case mbmo of
               Just mo | any ((== DPMonth) . dpName) dpSpecs
                  -> printf "%02d" mo
               _  -> ""
    sortda = case mbda of
               Just da | any ((== DPDay) . dpName) dpSpecs
                  -> printf "%02d" da
               _  -> ""
  
  formatDateParts :: CiteprocOutput a
            => [DP] -> (DateParts, Maybe DateParts) -> Eval a [Output a]
  formatDateParts dpSpecs (date, mbNextDate) = do
    inSortKey <- asks contextInSortKey
    let (yr,mo,da) = bindDateParts date
    case bindDateParts <$> mbNextDate of
      Nothing
        | inSortKey -> return [formatSortDate dpSpecs (yr, mo, da)]
        | otherwise -> mapM (eDP (yr,mo,da)) dpSpecs
      Just (nextyr, nextmo, nextda)
        | inSortKey -> return [formatSortDate dpSpecs (yr, mo, da),
                               Literal (fromText "-"),
                               formatSortDate dpSpecs (nextyr, nextmo, nextda)]
        | otherwise -> do
          let isOpenRange = nextyr == Just 0 &&
                            isNothing nextmo &&
                            isNothing nextda
          -- figure out where the range goes:
          -- first to differ out of the items selected by dpSpecs, in order y->m->d
          let dpToNs DPYear  = (yr, nextyr)
              dpToNs DPMonth = (mo, nextmo)
              dpToNs DPDay   = (da, nextda)
          let areSame = takeWhile (uncurry (==) . dpToNs) $
                          sort $ map dpName dpSpecs
          let (sames1, rest) = span (\dp -> dpName dp `elem` areSame) dpSpecs
          let (diffs, sames2) = span (\dp -> dpName dp `notElem` areSame) rest
          let cleanup = filter (/= NullOutput)
          sames1' <- cleanup <$> mapM (eDP (yr,mo,da)) sames1
          diffsLeft' <- cleanup <$> mapM (eDP (yr,mo,da)) diffs
          diffsRight' <- cleanup <$> mapM (eDP (nextyr,nextmo,nextda)) diffs
          sames2' <- cleanup <$> mapM (eDP (yr,mo,da)) sames2
          let rangeDelim = case sortOn dpName diffs of
                                  []     -> Nothing
                                  (dp:_) -> Just $ dpRangeDelimiter dp
          let toRange xs ys =
                case lastMay xs of
                  Just xlast ->
                       initSafe xs ++
                         [Formatted mempty{ formatDelimiter = rangeDelim }
                         [xlast, headDef (Literal mempty) ys]] ++
                       tailSafe ys
                  _ -> xs ++ ys
  
          return $
            if isOpenRange
               then [Formatted mempty{ formatSuffix = rangeDelim }
                        (removeLastSuffix $ sames1' ++ diffsLeft')]
               else removeLastSuffix $
                     sames1' ++
                     toRange (removeLastSuffix diffsLeft')
                             (removeFirstPrefix diffsRight') ++
                     sames2'
  
  removeFirstPrefix :: [Output a] -> [Output a]
  removeFirstPrefix (Formatted f xs : rest) =
    Formatted f{ formatPrefix = Nothing } xs : rest
  removeFirstPrefix xs = xs
  
  removeLastSuffix :: [Output a] -> [Output a]
  removeLastSuffix [] = []
  removeLastSuffix [Formatted f xs] =
    [Formatted f{ formatSuffix = Nothing } xs ]
  removeLastSuffix (x:xs) = x : removeLastSuffix xs
  
  eDP :: CiteprocOutput a
      => (Maybe Int, Maybe Int, Maybe Int) ->  DP -> Eval a (Output a)
  eDP (yr,mo,da) dp = do
    let mbn = case dpName dp of
                 DPDay   -> da
                 DPMonth -> mo
                 DPYear  -> yr
    case mbn of
      Nothing -> return NullOutput
      Just 0 | dpName dp == DPYear
              -> return $ Literal mempty -- open date range
      Just n  -> do
        let litStr = return . Literal . fromText . T.pack
        suffix <- case dpName dp of
                    DPYear
                      | n < 0
                        -> (:[]) <$> lookupTerm' emptyTerm{ termName = "bc" }
                      | n > 0
                      , n < 1000
                        -> (:[]) <$> lookupTerm' emptyTerm{ termName = "ad" }
                      | otherwise -> return []
                    _ -> return []
        let n' = case dpName dp of
                   DPYear -> abs n
                   _      -> n
        formatted (dpFormatting dp) . (:suffix) <$>
            case dpForm dp of
              DPNumeric             -> litStr (show n')
              DPNumericLeadingZeros -> litStr (printf "%02d" n')
              DPOrdinal             -> do
                locale <- asks contextLocale
                if localeLimitDayOrdinalsToDay1 locale == Just True && n' /= 1
                   then litStr (show n')
                   else evalNumber NumberOrdinal Nothing (NumVal n')
              form -> do
                let termForMonth s = emptyTerm{ termName = T.pack s
                                              , termForm = if form == DPShort
                                                              then Short
                                                              else Long }
  
                case dpName dp of
                  DPMonth | n <= 0 -> return NullOutput
                          | n <= 12 ->
                    lookupTerm' $ termForMonth (printf "month-%02d" n)
                          | n <= 16 -> -- season pseudo-month
                    lookupTerm' $ termForMonth (printf "season-%02d" (n - 12))
                          | n <= 20 -> -- season pseudo-month
                    lookupTerm' $ termForMonth (printf "season-%02d" (n - 16))
                          | otherwise -> -- season pseudo-month
                    lookupTerm' $ termForMonth (printf "season-%02d" (n - 20))
                  _                 -> litStr (show n')
  
  
  bindDateParts :: DateParts -> (Maybe Int, Maybe Int, Maybe Int)
  bindDateParts date =
        case date of
          DateParts (y:m:d:_) -> (Just y,Just m,Just d)
          DateParts [y,m]     -> (Just y,Just m,Nothing)
          DateParts [y]       -> (Just y,Nothing,Nothing)
          _                   -> (Nothing,Nothing,Nothing)
  
  eNames :: CiteprocOutput a
          => [Variable]
          -> NamesFormat
          -> [Element a]
          -> Formatting
          -> Eval a (Output a)
  eNames vars namesFormat' subst formatting = do
    substituteNamesForm <- asks contextSubstituteNamesForm
    inSortKey <- asks contextInSortKey
    let namesFormat =
          case substituteNamesForm of
            Nothing -> namesFormat'
            Just subs ->
              NamesFormat
              { namesLabel           =
                  if inSortKey -- see test/csl/sort_DropNameLabelInSort.txt
                     -- though this doesn't seem to be in the spec
                     then Nothing
                     else namesLabel namesFormat' <|> namesLabel subs
              , namesEtAl            = namesEtAl namesFormat' <|>
                                         namesEtAl subs
              , namesName            = namesName namesFormat' <|>
                                         namesName subs
              , namesLabelBeforeName =
                  if isJust (namesName namesFormat') &&
                     isJust (namesLabel namesFormat')
                     then namesLabelBeforeName namesFormat'
                     else namesLabelBeforeName subs
              }
  
    vars' <- if "editor" `elem` vars && "translator" `elem` vars
                then do
                  ed <- askVariable "editor"
                  tr <- askVariable "translator"
                  let termform =
                        case namesLabel namesFormat of
                          Just (termform', _, _) -> termform'
                          _ -> Long
                  mbterm <- lookupTerm'
                              emptyTerm{ termName = "editortranslator"
                                       , termForm = termform }
                  if ed == tr && mbterm /= NullOutput
                     then return $ "editortranslator" :
                          [v | v <- vars
                             , v /= "editor"
                             , v /= "translator"]
                     else return vars
                else return vars
    inSubstitute <- asks contextInSubstitute
    let (nameFormat, nameFormatting') =
          fromMaybe (defaultNameFormat, mempty) (namesName namesFormat)
    let nameFormatting = nameFormatting' <>
                         formatting{ formatPrefix = Nothing
                                   , formatSuffix = Nothing
                                   , formatDelimiter = Nothing }
    rawContribs <- mapM (\var -> (var,) <$>
                         askVariable
                         (if var == "editortranslator"
                             then "editor"
                             else var)) vars'
    if all (isNothing . snd) rawContribs
       then
         case subst of
           els@(_:_) | not inSubstitute -> do
             res <- withRWST
                    (\ctx st -> (ctx{ contextInSubstitute = True
                                    , contextSubstituteNamesForm =
                                        Just namesFormat },
                                 st)) $ eSubstitute els
             return $
               case res of
                 (Tagged TagNames{} _:_) -> formatted formatting res
                 -- important to have title (or whatever) tagged as
                 -- substituting for Names, for purposes of
                 -- disambiguation:
                 _ -> formatted formatting
                      [Tagged (TagNames "" namesFormat []) $ grouped res]
           _ -> return NullOutput
       else do
          xs <- mapM (formatNames namesFormat nameFormat nameFormatting)
                 rawContribs
          deleteSubstitutedVariables [v | (v, Just _) <- rawContribs ]
  
          return $
            case nameForm nameFormat of
               CountName -> Literal $ fromText $ T.pack $ show $ length
                 [name
                   | Tagged (TagName name) _ <- concatMap universe xs]
               _ -> formatted mempty{ formatPrefix = formatPrefix formatting
                                    , formatSuffix = formatSuffix formatting
                                    , formatDelimiter =
                                      formatDelimiter formatting } xs
  
  eSubstitute :: CiteprocOutput a
              => [Element a]
              -> Eval a [Output a]
  eSubstitute els =
    case els of
      [] -> return []
      (e:es) -> do
        res <- eElement e
        case dropWhile (== NullOutput) res of
          [] -> eSubstitute es
          (x:_) -> return [x]
  
  formatNames :: CiteprocOutput a
              => NamesFormat
              -> NameFormat
              -> Formatting
              -> (Variable, Maybe (Val a))
              -> Eval a (Output a)
  formatNames namesFormat nameFormat formatting (var, Just (NamesVal names)) =
    do
    isSubsequent <- (Subsequent `elem`) <$> asks contextPosition
    isInBibliography <- asks contextInBibliography
    let (etAlMin, etAlUseFirst) =
          if not isInBibliography && isSubsequent
             then (nameEtAlSubsequentMin nameFormat <|> nameEtAlMin nameFormat,
                   nameEtAlSubsequentUseFirst nameFormat <|>
                      nameEtAlUseFirst nameFormat)
             else (nameEtAlMin nameFormat, nameEtAlUseFirst nameFormat)
    inSortKey <- asks contextInSortKey
    disamb <- gets (referenceDisambiguation . stateReference)
    names' <- zipWithM (formatName nameFormat formatting) [1..] names
    let delim' = fromMaybe (nameDelimiter nameFormat) $
                   formatDelimiter formatting
    let delim = case (beginsWithSpace <$> formatSuffix formatting,
                      endsWithSpace <$> formatPrefix formatting) of
                      (Just True, Just True) -> T.strip delim'
                      (Just True, _)         -> T.stripStart delim'
                      (_, Just True)         -> T.stripEnd delim'
                      _                      -> delim'
    let numnames = length names'
    label <- case namesLabel namesFormat of
               Just (termform, pluralize, lf) | not inSortKey ->
                 (:[]) <$> eLabel var termform pluralize lf
               _ -> return []
    mbAndTerm <- case nameAndStyle nameFormat of
                    Just Symbol -> do
                      ts <- lookupTerm emptyTerm { termName = "and"
                                                 , termForm = Symbol }
                      case ts of
                        (_,x):_ -> return $ Just x
                        []      -> return $ Just "&"
                    Just _ -> fmap snd . listToMaybe <$>
                                lookupTerm emptyTerm { termName = "and"
                                                     , termForm = Long }
                    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 etAlThreshold = case etAlMin of
                          Just x | numnames >= x
                            -> case (disamb >>= disambEtAlNames, etAlUseFirst) of
                                 (Just n, Just m) -> Just (max m n)
                                 (_, y) -> y
                                 | numnames < x
                                 , finalNameIsOthers -> Just (numnames - 1)
                          _ -> Nothing
    let beforeLastDelim =
          case mbAndTerm of
            Nothing -> delim
            Just _ ->
               case nameDelimiterPrecedesLast nameFormat of
                  PrecedesContextual
                    | numnames > 2          -> delim
                    | otherwise             -> ""
                  PrecedesAfterInvertedName
                    -> case nameAsSortOrder nameFormat of
                         Just NameAsSortOrderAll -> delim
                         Just NameAsSortOrderFirst
                           | numnames < 3        -> delim
                         _                       -> ""
                  PrecedesAlways            -> delim
                  PrecedesNever             -> ""
    let andPreSpace = case beforeLastDelim of
          "" -> case formatSuffix formatting of
                  Just t | endsWithSpace t -> ""
                  _ -> " "
          t | endsWithSpace t -> ""
          _  -> " "
    let andPostSpace = case formatPrefix formatting of
                         Just t | beginsWithSpace t -> ""
                         _ -> " "
    let mbAndDelim = case mbAndTerm of
                           Nothing -> Nothing
                           Just t  -> Just (andPreSpace <> t <> andPostSpace)
    let etAlPreSpace = case formatSuffix formatting of
                         Just t | endsWithSpace t -> ""
                         _ -> " "
    let beforeEtAl =
          case nameDelimiterPrecedesEtAl nameFormat of
              PrecedesContextual
                | numnames > 2
                , etAlThreshold > Just 1 -> delim
                | otherwise              -> etAlPreSpace
              PrecedesAfterInvertedName
                    -> case nameAsSortOrder nameFormat of
                         Just NameAsSortOrderAll  -> delim
                         Just NameAsSortOrderFirst
                           | etAlThreshold < Just 2 -> delim
                         _                          -> etAlPreSpace
              PrecedesAlways            -> delim
              PrecedesNever             -> etAlPreSpace
    etAl <- case namesEtAl namesFormat of
                  Just (term, f) -> withFormatting f{
                      formatPrefix = removeDoubleSpaces <$>
                        Just beforeEtAl <> formatPrefix f } $
                   lookupTerm' emptyTerm{ termName = term }
                  Nothing
                    | etAlUseLast && not finalNameIsOthers ->
                      return $
                        Formatted mempty{ formatPrefix = Just beforeEtAl }
                          [literal "\x2026 "] -- ellipses
                    | otherwise   ->
                        Formatted mempty{ formatPrefix = Just beforeEtAl }
                        . (:[]) <$> lookupTerm' emptyTerm{ termName = "et-al" }
    let addNameAndDelim name idx
         | etAlThreshold == Just 0 = NullOutput
         | idx == 1    = name
         | maybe False (idx - 1 ==) etAlThreshold =
           if inSortKey
              then NullOutput
              else etAl
         | idx == numnames
         , etAlUseLast
         , maybe False (idx - 1 >=) etAlThreshold
           = name
         | maybe False (idx - 1 >) etAlThreshold = NullOutput
         | inSortKey = name
         | idx == numnames
           = formatted mempty{ formatPrefix =
                         Just (beforeLastDelim <> fromMaybe "" mbAndDelim) }
              [name]
         | otherwise = formatted mempty{ formatPrefix = Just delim } [name]
    let names'' = zipWith addNameAndDelim names' [1..]
    -- we set delimiter to Nothing because we're handling delim
    -- manually, to allow for things like "and" and no final comma
    return $ Tagged (TagNames var namesFormat names)
           $ grouped $
             if namesLabelBeforeName namesFormat
                then label ++ names''
                else names'' ++ label
  
  formatNames _ _ _ (var, Just x) = do
    when (x /= SubstitutedVal) $
      warn $ "ignoring non-name value for variable " <> fromVariable var
    return NullOutput
  formatNames _ _ _ (_, Nothing) = return NullOutput
  
  formatName :: CiteprocOutput a
             => NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
  formatName nameFormat formatting order name = do
    disamb <- gets (referenceDisambiguation . stateReference)
    let nameFormat' =
          case M.lookup name . disambNameMap =<< disamb of
            Nothing -> nameFormat
            Just AddInitials
              -> nameFormat{ nameForm = LongName }
            Just AddInitialsIfPrimary
              | order == 1  -> nameFormat{ nameForm = LongName }
              | otherwise -> nameFormat
            Just AddGivenName ->
              nameFormat{ nameForm = LongName
                        , nameInitialize = False
                        }
            Just AddGivenNameIfPrimary
              | order == 1 ->
                 nameFormat{ nameForm = LongName
                           , nameInitialize = False
                           }
              | otherwise -> nameFormat
    Tagged (TagName name) <$>
      case nameLiteral name of
        Just t  -> return $ formatted formatting
                          $ maybe [literal t]
                            (\f -> [Formatted f [literal t]])
                            (nameFamilyFormatting nameFormat)
        Nothing -> getDisplayName nameFormat' formatting order name
  
  
  getNamePartSortOrder :: Name -> Eval a [Text]
  getNamePartSortOrder name = do
    demoteNonDroppingParticle <-
      asks (styleDemoteNonDroppingParticle . contextStyleOptions)
    map (fromMaybe mempty) <$>
      case nameLiteral name of
        Nothing
          | isByzantineName name
             -> return $
                     case demoteNonDroppingParticle of
                       DemoteNever ->
                             [nameNonDroppingParticle name <> nameFamily name,
                              nameDroppingParticle name,
                              nameGiven name,
                              nameSuffix name]
                       _ ->  [nameFamily name,
                              nameDroppingParticle name <>
                                nameNonDroppingParticle name,
                              nameGiven name,
                              nameSuffix name]
          | otherwise
             -> return [nameFamily name,
                        nameGiven name]
        Just n -> return [Just n]
  
  literal :: CiteprocOutput a => Text -> Output a
  literal = Literal . fromText
  
  showYearSuffix :: Int -> Text
  showYearSuffix x
    | x < 27    = T.singleton $ chr $ ord 'a' + (x - 1)
    | otherwise =
        let x' = x - 1
         in T.pack [chr (ord 'a' - 1 + (x' `div` 26)),
                    chr (ord 'a' + (x' `mod` 26))]
  
  initialize :: Maybe Lang
             -> Bool       -- ^ initialize
             -> Bool       -- ^ with hyphen
             -> Text       -- ^ initialize with (suffix)
             -> Text
             -> Text
  initialize mblang makeInitials useHyphen initializeWith =
     stripSpaces . T.replace " -" "-" . mconcat . map initializeWord . splitWords
    where
     stripSpaces = T.dropWhile (==' ') . T.dropWhileEnd (==' ') -- preserve nbsp
     -- Left values are already initials
     -- Right values are not
     splitWords =
       reverse . (\(ws,cs) ->
                    case cs of
                      [] -> ws
                      [d] -> Left (T.singleton d) : ws
                      _   -> Right (T.pack (reverse cs)) : ws) .
       T.foldl'
       (\(ws, cs) c ->
         case c of
           '.' | null cs   -> (ws, [])
               | otherwise -> (Left (T.pack (reverse cs)) : ws, [])
           '-' | null cs   -> (ws, ['-'])
               | otherwise -> (Right (T.pack (reverse cs)) : ws, ['-'])
           ' ' -> case cs of
                    []  -> (ws, cs)
                    [d] -> (Left (T.singleton d) : ws, [])
                    _   -> (Right (T.pack (reverse cs)) : ws, [])
           _   -> (ws, c:cs))
       ([], mempty)
     addSuffix t
       | T.null t  = mempty
       | otherwise = t <> initializeWith
     toInitial t =
         case T.uncons t of
           Just ('-', t') ->
             case T.uncons t' of
               Just (c, _)
                 | isUpper c
                 , useHyphen -> "-" <> Unicode.toUpper mblang (T.singleton c)
                 | isUpper c -> Unicode.toUpper mblang (T.singleton c)
               _ -> mempty  -- e.g. Ji-ping -> J. not J.-p.
           Just (c, t')
             | isUpper c ->
               case T.uncons t' of
                 Just (d, t'')
                   | isUpper d  -- see test/csl/name_LongAbbreviation.txt
                   , not (T.null t'')
                   , T.all isLower t''
                   -> T.singleton c <> T.toLower (T.singleton d)
                 _ -> T.singleton c
           _ -> t
     initializeWord (Left t) -- Left values already initialized
       = addSuffix t
     initializeWord (Right t) -- Right values not already initialized
       | T.all isLower t = if endsWithSpace initializeWith
                              then t <> " "
                              else " " <> t <> " "
       | makeInitials    = (addSuffix . toInitial) t
       | otherwise       = t <> " "
  
  getDisplayName :: CiteprocOutput a
                 => NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
  getDisplayName nameFormat formatting order name = do
    inSortKey <- asks contextInSortKey
    demoteNonDroppingParticle <-
      asks (styleDemoteNonDroppingParticle . contextStyleOptions)
    initializeWithHyphen <-
      asks (styleInitializeWithHyphen . contextStyleOptions)
    mblang <- asks (localeLanguage . contextLocale)
    let initialize' =
          case nameFamily name of
            Nothing -> id
            Just _ ->
              case nameInitializeWith nameFormat of
                Just initializeWith ->
                  initialize
                  mblang
                  (nameInitialize nameFormat)
                  initializeWithHyphen
                  initializeWith
                Nothing -> id
    let separator = nameSortSeparator nameFormat
    let x <+> NullOutput = x
        NullOutput <+> x = x
        Literal x <+> y =
          case T.unsnoc (toText x) of
            Just (_, c) | c == '’' || c == '\'' || c == '-' || c == '\x2013' ||
                          c == '\xa0' ->
                 formatted mempty [Literal x, y]
            _ | isByzantineName name ->
                 formatted mempty{ formatDelimiter = Just " " } [Literal x, y]
              | otherwise -> formatted mempty [Literal x, y]
        Formatted f x <+> y =
          formatted mempty{ formatDelimiter =
                              case formatSuffix f of
                                Just t | endsWithSpace t -> Nothing
                                _ -> Just " " } [formatted f x, y]
        Linked i x <+> y =
          formatted mempty{ formatDelimiter = Just " " } [Linked i x, y]
        Tagged _ x <+> y = x <+> y
        InNote x <+> y = x <+> y
    let x <:> NullOutput = x
        NullOutput <:> x = x
        Literal x <:> y =
          formatted mempty{ formatDelimiter = Just separator } [Literal x, y]
        Formatted f x <:> y = formatted
          (mempty{ formatDelimiter = Just separator }) [Formatted f x, y]
        Linked i x <:> y = formatted
          (mempty{ formatDelimiter = Just separator }) [Linked i x, y]
        Tagged _ x <:> y = x <:> y
        InNote x <:> y = x <:> y
  
    let familyAffixes = formatted
            (case nameFamilyFormatting nameFormat of
               Nothing -> mempty
               Just f  -> mempty{ formatSuffix = formatSuffix f
                                , formatPrefix = formatPrefix f })
    let givenAffixes = formatted
            (case nameGivenFormatting nameFormat of
               Nothing -> mempty
               Just f  -> mempty{ formatSuffix = formatSuffix f
                                , formatPrefix = formatPrefix f })
    let familyFormatting = formatted
            (case nameFamilyFormatting nameFormat of
               Nothing -> mempty
               Just f  -> f{ formatSuffix = Nothing
                           , formatPrefix = Nothing })
    let givenFormatting = formatted
            (case nameGivenFormatting nameFormat of
               Nothing -> mempty
               Just f  -> f{ formatSuffix = Nothing
                           , formatPrefix = Nothing })
    let nonDroppingParticle =
          maybe NullOutput (familyFormatting . (:[]) . literal) $
            nameNonDroppingParticle name
    let droppingParticle =
          maybe NullOutput (givenFormatting . (:[]) . literal) $
            nameDroppingParticle name
    let given =
          maybe NullOutput (givenFormatting . (:[]) . literal . initialize') $
            nameGiven name
    let family =
          maybe NullOutput (familyFormatting . (:[]) . literal) $
            nameFamily name
    let suffix = maybe NullOutput literal $ nameSuffix name
    let nameAsSort = case nameAsSortOrder nameFormat of
                            Just NameAsSortOrderAll -> True
                            Just NameAsSortOrderFirst -> order == 1
                            _ -> False
    return $ formatted formatting . (:[]) $
      if isByzantineName name
         then
           case nameForm nameFormat of
                LongName
                  | demoteNonDroppingParticle == DemoteNever
                  , inSortKey || nameAsSort ->
                        familyAffixes
                        [ nonDroppingParticle <+>
                          family ] <:>
                        givenAffixes
                        [ given <+>
                          droppingParticle ] <:>
                        suffix
                  | demoteNonDroppingParticle == DemoteSortOnly
                  , inSortKey ->
                        familyAffixes
                        [ family ] <:>
                        givenAffixes
                        [ given <+>
                          droppingParticle <+>
                          nonDroppingParticle ] <:>
                        suffix
                  | demoteNonDroppingParticle == DemoteSortOnly
                  , nameAsSort ->
                        familyAffixes
                        [ nonDroppingParticle <+>
                          family ] <:>
                        givenAffixes
                        [ given <+>
                          droppingParticle ] <:>
                        suffix
                  | demoteNonDroppingParticle == DemoteDisplayAndSort
                  , inSortKey || nameAsSort ->
                        familyAffixes
                        [ family ] <:>
                        givenAffixes
                        [ given <+>
                          droppingParticle <+>
                          nonDroppingParticle ] <:>
                        suffix
                  | nameCommaSuffix name ->
                        givenAffixes
                        [ given ] <+>
                        familyAffixes
                        [ droppingParticle <+>
                          nonDroppingParticle <+>
                          family <:>
                          suffix ]
                  | otherwise ->
                        givenAffixes
                        [ given ] <+>
                        familyAffixes
                        [ droppingParticle <+>
                          nonDroppingParticle <+>
                          family <+>
                          suffix ]
                ShortName ->
                        familyAffixes
                        [ nonDroppingParticle <+>
                          family ]
                CountName -> NullOutput
         else
           case nameForm nameFormat of
                LongName  -> grouped
                  [ familyAffixes
                    [ family ]
                  , givenAffixes
                    [ given ] ]
                ShortName -> familyAffixes
                               [ family ]
                CountName -> NullOutput
  
  
  eGroup :: CiteprocOutput a
            => Bool -> Formatting -> [Element a] -> Eval a (Output a)
  eGroup isMacro formatting els = do
    -- A group is suppressed if it directly or indirectly
    -- calls at least one variable but all of the variables
    -- it calls are empty.
    VarCount oldVars oldNonempty <- gets stateVarCount
    xs <- mconcat <$> mapM eElement els
    VarCount newVars newNonempty <- gets stateVarCount
    let isempty = newVars /= oldVars && newNonempty == oldNonempty
  
    -- see
    -- https://github.com/citation-style-language/documentation/blob/master/specification.rst#group
    -- "When a cs:group contains a child cs:macro, if the cs:macro is
    -- non-empty, it is treated as a non-empty variable for the purposes of
    -- determining suppression of the outer cs:group."
    when (isMacro && not isempty) $ updateVarCount 1 1
    return $ if not isempty
                then formatted formatting xs
                else NullOutput
  
  eChoose :: CiteprocOutput a
          => [(Match, [Condition], [Element a])] -> Eval a [Output a]
  eChoose [] = return []
  eChoose ((match, conditions, els):rest) = do
    ref <- gets stateReference
    label <- asks contextLabel
    let disambiguate = maybe False
                        disambCondition (referenceDisambiguation ref)
    positions <- asks contextPosition
    locator <- asks contextLocator
    let hasLocator = isJust locator
    let isNumericChunk t =
          case T.dropWhile isLetter (T.dropWhileEnd isLetter (T.strip t)) of
            t' | T.null t' -> False
               | T.all isDigit t' -> True
               | otherwise -> False
    let isNumeric t = all isNumericChunk
          (T.split (\c -> c == ',' || c == '-' || c == '&') t)
    let testCondition cond =
          case cond of
             HasVariable "locator" -> hasLocator
             HasVariable t ->
               case lookupVariable t ref of
                 Just x  -> isNonEmpty x
                 Nothing -> False
             HasType ts ->
               case lookupVariable "type" ref of
                 Just (TextVal ty) -> ty `elem` ts
                 _ -> False
             IsUncertainDate t -> case lookupVariable t ref of
                                    Just (DateVal d) -> dateCirca d
                                    _                -> False
             IsNumeric t
               | t == "locator" -> maybe False isNumeric locator
               | otherwise -> case lookupVariable t ref of
                                Just (NumVal _)   -> True
                                Just (TextVal x)  -> isNumeric x
                                Just (FancyVal x) -> isNumeric (toText x)
                                _                 -> False
             HasLocatorType t -> case label of
                                   Just "sub verbo" -> t == "sub-verbo"
                                   Just x -> toVariable x == t
                                   Nothing -> t == "page" && hasLocator
             HasPosition pos -> pos `elem` positions
             WouldDisambiguate -> disambiguate
    let matched = (case match of
                     MatchAll  -> all testCondition
                     MatchAny  -> any testCondition
                     MatchNone -> not . any testCondition) conditions
    if matched
       then mconcat <$> mapM eElement els
       else eChoose rest
  
  
  eNumber :: CiteprocOutput a => Variable -> NumberForm -> Eval a (Output a)
  eNumber var nform = do
    mbv <- askVariable var
    varTerms <- lookupTerm emptyTerm { termName = fromVariable var }
    let mbGender = case varTerms of
                     [] -> Nothing
                     ((t,_):_) -> termGender t
    let nparts = case mbv of
                   Just x@NumVal{}   -> [x]
                   Just (FancyVal x) -> splitNums (toText x)
                   Just (TextVal t)  -> splitNums t
                   _                 -> []
    grouped <$> mapM (evalNumber nform mbGender) nparts
  
  evalNumber :: CiteprocOutput a
             => NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
  evalNumber form mbGender (NumVal i) = do
    let numterm s x = emptyTerm { termName = T.pack $ printf s x
                                , termGenderForm = mbGender }
    let dectext = T.pack (show i)
    let twomatch = numterm "ordinal-%02d" (i `mod` 100)
    let onematch = numterm "ordinal-%02d" (i `mod` 10)
    let fallback = emptyTerm { termName = "ordinal" }
    case form of
      NumberNumeric -> return $ Literal $ fromText dectext
      NumberOrdinal -> do
        res <- (if i > 99
                   then filter (\(t,_) -> termMatch t /= Just WholeNumber)
                   else id) <$> lookupTerm twomatch
        case res of
          ((_,suff):_) ->
            return $ Literal $ fromText (dectext <> suff)
          [] -> do -- not an exact match
            res' <- (if i > 10
                        then filter (\(t,_) ->
                               isNothing (termMatch t) ||
                               termMatch t == Just LastDigit)
                        else id) <$> lookupTerm onematch
            case res' of
              ((_,suff):_) ->
                return $ Literal $ fromText (dectext <> suff)
              [] -> do
                res'' <- lookupTerm fallback
                case res'' of
                  ((_,suff):_) ->
                    return $ Literal $ fromText (dectext <> suff)
                  [] -> do
                    warn $ "no ordinal suffix found for " <> dectext
                    return $ Literal $ fromText (T.pack (show i))
      NumberLongOrdinal
        | i >= 1
        , i <= 10 -> do
          res <- lookupTerm (numterm "long-ordinal-%02d" i)
          case res of
            ((_,t):_) -> return $ Literal $ fromText t
            []        -> evalNumber NumberOrdinal mbGender (NumVal i)
        | otherwise -> evalNumber NumberOrdinal mbGender (NumVal i)
      NumberRoman -> return $ Literal $ fromText $ toRomanNumeral i
  evalNumber _ _ (TextVal t) = return $ Literal $ fromText t
  evalNumber _ _ (FancyVal t) = return $ Literal t
  evalNumber _ _ _ = return NullOutput
  
  
  warn :: Text -> Eval a ()
  warn t = tell $ Set.singleton t
  
  -- | Convert number < 4000 to lowercase roman numeral.
  toRomanNumeral :: Int -> Text
  toRomanNumeral x
    | x >= 4000 || x < 0 = T.pack (show x)
    | x >= 1000 = "m" <> toRomanNumeral (x - 1000)
    | x >= 900  = "cm" <> toRomanNumeral (x - 900)
    | x >= 500  = "d" <> toRomanNumeral (x - 500)
    | x >= 400  = "cd" <> toRomanNumeral (x - 400)
    | x >= 100  = "c" <> toRomanNumeral (x - 100)
    | x >= 90   = "xc" <> toRomanNumeral (x - 90)
    | x >= 50   = "l"  <> toRomanNumeral (x - 50)
    | x >= 40   = "xl" <> toRomanNumeral (x - 40)
    | x >= 10   = "x" <> toRomanNumeral (x - 10)
    | x == 9    = "ix"
    | x >= 5    = "v" <> toRomanNumeral (x - 5)
    | x == 4    = "iv"
    | x >= 1    = "i" <> toRomanNumeral (x - 1)
    | x == 0    = ""
    | otherwise = T.pack (show x)
  
  -- Gets variable while updating var count.
  askVariable :: CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
  askVariable "page-first" = do
    res <- askVariable "page"
    case res of
      Just (TextVal t)  ->
        return $ Just $ TextVal $ T.takeWhile (not . isSepPunct) t
      Just (FancyVal x) ->
        return $ Just $ TextVal $ T.takeWhile (not . isSepPunct) $ toText x
      Just (NumVal n)   -> return $ Just $ NumVal n
      _                 -> return Nothing
  askVariable v = do
    ref <- gets stateReference
    case lookupVariable v ref of
      Just x | isNonEmpty x && x /= SubstitutedVal -> do
        updateVarCount 1 1
        return $ Just x
      _ -> do
        updateVarCount 1 0
        return Nothing
  
  isNonEmpty :: CiteprocOutput a => Val a -> Bool
  isNonEmpty (TextVal t) = not (T.null t)
  isNonEmpty (FancyVal x) = x /= mempty
  isNonEmpty (NamesVal []) = False
  isNonEmpty (DateVal (Date [] _ Nothing Nothing)) = False
  isNonEmpty _       = True
  
  citationLabel :: Reference a -> Val a
  citationLabel ref = TextVal trigraph
   where
    trigraph = namepart <> datepart
    datepart = case M.lookup "issued" varmap of
                 Just (DateVal d) -> getYear d
                 _ -> ""
    namepart = if "author" `elem` namevars
                  then getNames "author"
                  else case namevars of
                         (n:_) -> getNames n
                         _     -> "Xyz"
    varmap = referenceVariables ref
    vars = M.keys varmap
    namevars = [v | v <- vars, variableType v == NameVariable]
    getNames var = case M.lookup var varmap of
                     Just (NamesVal ns) ->
                       let x = case length ns of
                                 1  -> 4
                                 n | n >= 4 -> 1
                                   | otherwise -> 2
                       in mconcat $
                          map (T.take x . fromMaybe "" .  nameFamily)
                          (take 4 ns)
                     _ -> ""
    getYear d = case dateParts d of
                  (DateParts (x:_):_) ->
                    T.pack (printf "%02d" $ x `mod` 100)
                  _ -> ""
  
  removeDoubleSpaces :: Text -> Text
  removeDoubleSpaces = T.replace "  " " "
  
  endsWithSpace :: Text -> Bool
  endsWithSpace t = not (T.null t) && isSpace (T.last t)
  
  beginsWithSpace :: Text -> Bool
  beginsWithSpace t = not (T.null t) && isSpace (T.head t)
  
  