{-# 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
  { forall a. Context a -> Locale
contextLocale              :: Locale
  , forall a. Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate             :: [SortKeyValue] -> [SortKeyValue] -> Ordering
  , forall a. Context a -> Maybe Abbreviations
contextAbbreviations       :: Maybe Abbreviations
  , forall a. Context a -> StyleOptions
contextStyleOptions        :: StyleOptions
  , forall a. Context a -> Maybe Text
contextLocator             :: Maybe Text
  , forall a. Context a -> Maybe Text
contextLabel               :: Maybe Text
  , forall a. Context a -> [Position]
contextPosition            :: [Position]
  , forall a. Context a -> Bool
contextInSubstitute        :: Bool
  , forall a. Context a -> Bool
contextInSortKey           :: Bool
  , forall a. Context a -> Bool
contextInBibliography      :: Bool
  , forall a. Context a -> Maybe NamesFormat
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
  { VarCount -> Int
variablesAccessed :: Int
  , VarCount -> Int
variablesNonempty :: Int
  } deriving (Int -> VarCount -> ShowS
[VarCount] -> ShowS
VarCount -> String
(Int -> VarCount -> ShowS)
-> (VarCount -> String) -> ([VarCount] -> ShowS) -> Show VarCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VarCount -> ShowS
showsPrec :: Int -> VarCount -> ShowS
$cshow :: VarCount -> String
show :: VarCount -> String
$cshowList :: [VarCount] -> ShowS
showList :: [VarCount] -> ShowS
Show)

data EvalState a =
  EvalState
  { forall a. EvalState a -> VarCount
stateVarCount       :: VarCount
  , forall a.
EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap   :: M.Map ItemId (Int, Maybe Int, Int,
                                          Bool, Maybe Text, Maybe Text)
                        -- (citegroup, noteNum, posInGroup,
                        --      aloneInCitation, label, locator)
  , forall a. EvalState a -> Map Int (Set ItemId)
stateNoteMap        :: M.Map Int (Set.Set ItemId) -- ids cited in note
  , forall a. EvalState a -> ReferenceMap a
stateRefMap         :: ReferenceMap a
  , forall a. EvalState a -> Reference a
stateReference      :: Reference a
  , forall a. EvalState a -> Bool
stateUsedYearSuffix :: Bool
  , forall a. EvalState a -> Bool
stateUsedIdentifier :: Bool
  -- ^ tracks whether an identifier (DOI,PMCID,PMID,URL) has yet been used
  , forall a. EvalState a -> Bool
stateUsedTitle      :: Bool
  -- ^ tracks whether the item title has yet been used
  } deriving (Int -> EvalState a -> ShowS
[EvalState a] -> ShowS
EvalState a -> String
(Int -> EvalState a -> ShowS)
-> (EvalState a -> String)
-> ([EvalState a] -> ShowS)
-> Show (EvalState a)
forall a. Show a => Int -> EvalState a -> ShowS
forall a. Show a => [EvalState a] -> ShowS
forall a. Show a => EvalState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> EvalState a -> ShowS
showsPrec :: Int -> EvalState a -> ShowS
$cshow :: forall a. Show a => EvalState a -> String
show :: EvalState a -> String
$cshowList :: forall a. Show a => [EvalState a] -> ShowS
showList :: [EvalState a] -> ShowS
Show)


type Eval a = RWS (Context a) (Set.Set Text) (EvalState a)

updateVarCount :: Int -> Int -> Eval a ()
updateVarCount :: forall a. Int -> Int -> Eval a ()
updateVarCount Int
total' Int
nonempty' =
  (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
    let VarCount{ variablesAccessed :: VarCount -> Int
variablesAccessed = Int
total
                , variablesNonempty :: VarCount -> Int
variablesNonempty = Int
nonempty } = EvalState a -> VarCount
forall a. EvalState a -> VarCount
stateVarCount EvalState a
st
     in EvalState a
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 :: forall a.
CiteprocOutput a =>
Style a
-> Maybe Lang
-> [Reference a]
-> [Citation a]
-> ([Output a], [(Text, Output a)], [Text])
evalStyle Style a
style Maybe Lang
mblang [Reference a]
refs' [Citation a]
citations =
  ([Output a]
citationOs, [(Text, Output a)]
bibliographyOs, Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
warnings)
 where
  refs'' :: [Reference a]
refs'' = [Reference a]
refs' [Reference a] -> [Reference a] -> [Reference a]
forall a. [a] -> [a] -> [a]
++ [Citation a] -> [Reference a]
forall a. [Citation a] -> [Reference a]
extractItemData [Citation a]
citations
  ([Reference a]
refs, ReferenceMap a
refmap) = [Reference a] -> ([Reference a], ReferenceMap a)
forall a. [Reference a] -> ([Reference a], ReferenceMap a)
makeReferenceMap [Reference a]
refs''

  (([Output a]
citationOs, [(Text, Output a)]
bibliographyOs), Set Text
warnings) = RWS
  (Context a)
  (Set Text)
  (EvalState a)
  ([Output a], [(Text, Output a)])
-> Context a
-> EvalState a
-> (([Output a], [(Text, Output a)]), Set Text)
forall w r s a. Monoid w => RWS r w s a -> r -> s -> (a, w)
evalRWS RWS
  (Context a)
  (Set Text)
  (EvalState a)
  ([Output a], [(Text, Output a)])
go
     Context
      { contextLocale :: Locale
contextLocale              = Maybe Lang -> Style a -> Locale
forall a. Maybe Lang -> Style a -> Locale
mergeLocales Maybe Lang
mblang Style a
style
      , contextCollate :: [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate             = \[SortKeyValue]
xs [SortKeyValue]
ys ->
                                       (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues (Maybe Lang -> Text -> Text -> Ordering
Unicode.comp Maybe Lang
mblang)
                                       [SortKeyValue]
xs [SortKeyValue]
ys
      , contextAbbreviations :: Maybe Abbreviations
contextAbbreviations       = Style a -> Maybe Abbreviations
forall a. Style a -> Maybe Abbreviations
styleAbbreviations Style a
style
      , contextStyleOptions :: StyleOptions
contextStyleOptions        = Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style
      , contextLocator :: Maybe Text
contextLocator             = Maybe Text
forall a. Maybe a
Nothing
      , contextLabel :: Maybe Text
contextLabel               = Maybe Text
forall a. Maybe a
Nothing
      , contextPosition :: [Position]
contextPosition            = []
      , contextInSubstitute :: Bool
contextInSubstitute        = Bool
False
      , contextInSortKey :: Bool
contextInSortKey           = Bool
False
      , contextInBibliography :: Bool
contextInBibliography      = Bool
False
      , contextSubstituteNamesForm :: Maybe NamesFormat
contextSubstituteNamesForm = Maybe NamesFormat
forall a. Maybe a
Nothing
      }
      EvalState
      { stateVarCount :: VarCount
stateVarCount = Int -> Int -> VarCount
VarCount Int
0 Int
0
      , stateLastCitedMap :: Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap = Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall a. Monoid a => a
mempty
      , stateNoteMap :: Map Int (Set ItemId)
stateNoteMap = Map Int (Set ItemId)
forall a. Monoid a => a
mempty
      , stateRefMap :: ReferenceMap a
stateRefMap = ReferenceMap a
refmap
      , stateReference :: Reference a
stateReference = ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
forall a.
ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
Reference ItemId
forall a. Monoid a => a
mempty Text
forall a. Monoid a => a
mempty Maybe DisambiguationData
forall a. Maybe a
Nothing Map Variable (Val a)
forall a. Monoid a => a
mempty
      , stateUsedYearSuffix :: Bool
stateUsedYearSuffix = Bool
False
      , stateUsedIdentifier :: Bool
stateUsedIdentifier = Bool
False
      , stateUsedTitle :: Bool
stateUsedTitle = Bool
False
      }

  assignCitationNumbers :: [ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers [ItemId]
sortedIds =
    (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> RWST r w (EvalState a) m ())
-> (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
              EvalState a
st{ stateRefMap = ReferenceMap $ foldl'
                     (\Map ItemId (Reference a)
m (ItemId
citeId, Int
num) ->
                         (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\Reference a
ref ->
                           Reference a
ref{ referenceVariables =
                                 M.insert "citation-number"
                                    (NumVal num) .
                                 M.insert "citation-key"
                                     (TextVal (unItemId citeId)) .
                                 M.alter (addIfMissing (citationLabel ref))
                                    "citation-label"
                                 $ referenceVariables ref
                              }) ItemId
citeId Map ItemId (Reference a)
m)
                     (unReferenceMap (stateRefMap st))
                     (zip sortedIds [1..]) }

  addIfMissing :: a -> Maybe a -> Maybe a
addIfMissing a
x Maybe a
Nothing  = a -> Maybe a
forall a. a -> Maybe a
Just a
x
  addIfMissing a
_ (Just a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

  go :: RWS
  (Context a)
  (Set Text)
  (EvalState a)
  ([Output a], [(Text, Output a)])
go = do
      -- list of citationItemIds that are actually cited
      let citationOrder :: Map ItemId Int
citationOrder = [(ItemId, Int)] -> Map ItemId Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ItemId, Int)] -> Map ItemId Int)
-> [(ItemId, Int)] -> Map ItemId Int
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int)] -> [(ItemId, Int)]
forall a. [a] -> [a]
reverse ([(ItemId, Int)] -> [(ItemId, Int)])
-> [(ItemId, Int)] -> [(ItemId, Int)]
forall a b. (a -> b) -> a -> b
$ [ItemId] -> [Int] -> [(ItemId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip
            ((Citation a -> [ItemId]) -> [Citation a] -> [ItemId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((CitationItem a -> ItemId) -> [CitationItem a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId ([CitationItem a] -> [ItemId])
-> (Citation a -> [CitationItem a]) -> Citation a -> [ItemId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems) [Citation a]
citations)
            [(Int
1 :: Int)..]
      let citeIds :: Set ItemId
citeIds = Map ItemId Int -> Set ItemId
forall k a. Map k a -> Set k
M.keysSet Map ItemId Int
citationOrder
      let sortedCiteIds :: [ItemId]
sortedCiteIds = (ItemId -> Int) -> [ItemId] -> [ItemId]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn
              (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. Bounded a => a
maxBound (Maybe Int -> Int) -> (ItemId -> Maybe Int) -> ItemId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId -> Map ItemId Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map ItemId Int
citationOrder))
              ((Reference a -> ItemId) -> [Reference a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId [Reference a]
refs)
      let layoutOpts :: LayoutOptions
layoutOpts = Layout a -> LayoutOptions
forall a. Layout a -> LayoutOptions
layoutOptions (Layout a -> LayoutOptions) -> Layout a -> LayoutOptions
forall a b. (a -> b) -> a -> b
$ Style a -> Layout a
forall a. Style a -> Layout a
styleCitation Style a
style
      let mbcgDelim :: Maybe Text
mbcgDelim =
            case StyleOptions -> Maybe Text
styleCiteGroupDelimiter (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style) of
              Just Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
              Maybe Text
Nothing
                -- grouping is activated whenever there is
                -- collapsing; this is the default
                -- cite-group-delimiter
                | Maybe Collapsing -> Bool
forall a. Maybe a -> Bool
isJust (LayoutOptions -> Maybe Collapsing
layoutCollapse LayoutOptions
layoutOpts) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
", "
                | Bool
otherwise -> Maybe Text
forall a. Maybe a
Nothing

      [ItemId] -> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall {m :: * -> *} {r} {w} {a}.
Monad m =>
[ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers [ItemId]
sortedCiteIds
      -- sorting of bibliography, insertion of citation-number
      [SortKeyValue] -> [SortKeyValue] -> Ordering
collate <- (Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     ([SortKeyValue] -> [SortKeyValue] -> Ordering)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
forall a. Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate

      ([Citation a]
bibCitations, Map ItemId [SortKeyValue]
bibSortKeyMap) <-
        case Style a -> Maybe (Layout a)
forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
          Maybe (Layout a)
Nothing -> ([Citation a], Map ItemId [SortKeyValue])
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     ([Citation a], Map ItemId [SortKeyValue])
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Map ItemId [SortKeyValue]
forall a. Monoid a => a
mempty)
          Just Layout a
biblayout -> do
            Map ItemId [SortKeyValue]
bibSortKeyMap <- [(ItemId, [SortKeyValue])] -> Map ItemId [SortKeyValue]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                      ([(ItemId, [SortKeyValue])] -> Map ItemId [SortKeyValue])
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     [(ItemId, [SortKeyValue])]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId [SortKeyValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference a
 -> RWST
      (Context a)
      (Set Text)
      (EvalState a)
      Identity
      (ItemId, [SortKeyValue]))
-> [Reference a]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     [(ItemId, [SortKeyValue])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
                          ((\ItemId
citeId ->
                             (ItemId
citeId,) ([SortKeyValue] -> (ItemId, [SortKeyValue]))
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [SortKeyValue]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (ItemId, [SortKeyValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Layout a
-> ItemId
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [SortKeyValue]
forall a.
CiteprocOutput a =>
Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys Layout a
biblayout ItemId
citeId)
                             (ItemId
 -> RWST
      (Context a)
      (Set Text)
      (EvalState a)
      Identity
      (ItemId, [SortKeyValue]))
-> (Reference a -> ItemId)
-> Reference a
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (ItemId, [SortKeyValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId)
                          [Reference a]
refs
            let sortedIds :: [ItemId]
sortedIds =
                  if [SortKey a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Layout a -> [SortKey a]
forall a. Layout a -> [SortKey a]
layoutSortKeys Layout a
biblayout)
                     then [ItemId]
sortedCiteIds
                     else (ItemId -> ItemId -> Ordering) -> [ItemId] -> [ItemId]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
                       (\ItemId
x ItemId
y -> [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
                                  ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ItemId
x Map ItemId [SortKeyValue]
bibSortKeyMap)
                                  ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ItemId
y Map ItemId [SortKeyValue]
bibSortKeyMap))
                            ((Reference a -> ItemId) -> [Reference a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId [Reference a]
refs)
            [ItemId] -> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall {m :: * -> *} {r} {w} {a}.
Monad m =>
[ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers ([ItemId] -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> [ItemId]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$
              case Layout a -> [SortKey a]
forall a. Layout a -> [SortKey a]
layoutSortKeys Layout a
biblayout of
                (SortKeyVariable SortDirection
Descending Variable
"citation-number":[SortKey a]
_)
                  -> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
                (SortKeyMacro SortDirection
Descending
                  (Element (ENumber Variable
"citation-number" NumberForm
_) Formatting
_:[Element a]
_) : [SortKey a]
_)
                  -> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
                (SortKeyMacro SortDirection
Descending
                  (Element (EText (TextVariable VariableForm
_ Variable
"citation-number")) Formatting
_:[Element a]
_): [SortKey a]
_)
                  -> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
                [SortKey a]
_ -> [ItemId]
sortedIds
            let bibCitations :: [Citation a]
bibCitations = (ItemId -> Citation a) -> [ItemId] -> [Citation a]
forall a b. (a -> b) -> [a] -> [b]
map (\ItemId
ident ->
                  Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ItemId -> Text
unItemId ItemId
ident) Maybe Int
forall a. Maybe a
Nothing
                   [ItemId
-> Maybe Text
-> Maybe Text
-> CitationItemType
-> Maybe a
-> Maybe a
-> Maybe (Reference a)
-> CitationItem a
forall a.
ItemId
-> Maybe Text
-> Maybe Text
-> CitationItemType
-> Maybe a
-> Maybe a
-> Maybe (Reference a)
-> CitationItem a
CitationItem ItemId
ident Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
                      CitationItemType
NormalCite Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing Maybe (Reference a)
forall a. Maybe a
Nothing]) [ItemId]
sortedIds
            ([Citation a], Map ItemId [SortKeyValue])
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     ([Citation a], Map ItemId [SortKeyValue])
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Citation a]
forall {a}. [Citation a]
bibCitations, Map ItemId [SortKeyValue]
bibSortKeyMap)
      -- styling of citations
      Map ItemId [SortKeyValue]
sortKeyMap <-
        (Map ItemId [SortKeyValue]
 -> ItemId
 -> RWST
      (Context a)
      (Set Text)
      (EvalState a)
      Identity
      (Map ItemId [SortKeyValue]))
-> Map ItemId [SortKeyValue]
-> Set ItemId
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId [SortKeyValue])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Map ItemId [SortKeyValue]
m ItemId
citeId -> do
                  [SortKeyValue]
sk <- Layout a
-> ItemId
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [SortKeyValue]
forall a.
CiteprocOutput a =>
Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys (Style a -> Layout a
forall a. Style a -> Layout a
styleCitation Style a
style) ItemId
citeId
                  Map ItemId [SortKeyValue]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId [SortKeyValue])
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ItemId [SortKeyValue]
 -> RWST
      (Context a)
      (Set Text)
      (EvalState a)
      Identity
      (Map ItemId [SortKeyValue]))
-> Map ItemId [SortKeyValue]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId [SortKeyValue])
forall a b. (a -> b) -> a -> b
$ ItemId
-> [SortKeyValue]
-> Map ItemId [SortKeyValue]
-> Map ItemId [SortKeyValue]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ItemId
citeId [SortKeyValue]
sk Map ItemId [SortKeyValue]
m)
               Map ItemId [SortKeyValue]
forall k a. Map k a
M.empty
               Set ItemId
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
      -- suffix ends a group and any prefix begins a group;
      -- then sort the groups; then combine again:
      let canGroup :: CitationItem a -> CitationItem a -> Bool
canGroup CitationItem a
i1 CitationItem a
i2
           =   Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemSuffix CitationItem a
i1) Bool -> Bool -> Bool
&&
               Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemPrefix CitationItem a
i2)
      let sortCitationItems :: Citation a -> Citation a
sortCitationItems Citation a
citation' =
            Citation a
citation'{ citationItems =
                          concatMap
                           (sortBy
                             (\CitationItem a
item1 CitationItem a
item2 ->
                               [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
                                ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
                                   (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item1) Map ItemId [SortKeyValue]
sortKeyMap)
                                ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
                                   (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item2) Map ItemId [SortKeyValue]
sortKeyMap)))
                        $ groupBy canGroup
                        $ citationItems citation' }
      let citCitations :: [Citation a]
citCitations = (Citation a -> Citation a) -> [Citation a] -> [Citation a]
forall a b. (a -> b) -> [a] -> [b]
map Citation a -> Citation a
forall {a}. Citation a -> Citation a
sortCitationItems [Citation a]
citations
      [Output a]
cs <- Style a
-> Map ItemId [SortKeyValue] -> [Citation a] -> Eval a [Output a]
forall a.
CiteprocOutput a =>
Style a
-> Map ItemId [SortKeyValue] -> [Citation a] -> Eval a [Output a]
disambiguateCitations Style a
style Map ItemId [SortKeyValue]
bibSortKeyMap [Citation a]
citCitations
      let cs' :: [Output a]
cs' = case Maybe Text
mbcgDelim of
                   Maybe Text
Nothing -> [Output a]
cs
                   Just Text
citeGroupDelim -> (Output a -> Output a) -> [Output a] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map
                      (Text
-> Maybe Text
-> Maybe Text
-> Maybe Collapsing
-> Output a
-> Output a
forall a.
CiteprocOutput a =>
Text
-> Maybe Text
-> Maybe Text
-> Maybe Collapsing
-> Output a
-> Output a
groupAndCollapseCitations Text
citeGroupDelim
                       (LayoutOptions -> Maybe Text
layoutYearSuffixDelimiter LayoutOptions
layoutOpts)
                       (LayoutOptions -> Maybe Text
layoutAfterCollapseDelimiter LayoutOptions
layoutOpts)
                       (LayoutOptions -> Maybe Collapsing
layoutCollapse LayoutOptions
layoutOpts))
                      [Output a]
cs

      let removeIfEqual :: Output a -> Output a -> Output a
removeIfEqual Output a
x Output a
y
           | Output a
x Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
y    = Output a
forall a. Output a
NullOutput
           | Bool
otherwise = Output a
y
      let removeNamesIfSuppressAuthor :: Output a -> Output a
removeNamesIfSuppressAuthor
           (Tagged (TagItem CitationItemType
SuppressAuthor ItemId
cid') Output a
x)
             = let y :: Output a
y = Output a -> Output a
forall a. Output a -> Output a
getAuthors Output a
x
                in Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (CitationItemType -> ItemId -> Tag
TagItem CitationItemType
SuppressAuthor ItemId
cid')
                     ((Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Output a -> Output a -> Output a
forall {a}. Eq a => Output a -> Output a -> Output a
removeIfEqual Output a
y) Output a
x)
          removeNamesIfSuppressAuthor Output a
x = Output a
x

      -- we need to do this after disambiguation and collapsing
      let handleSuppressAuthors :: Output a -> Output a
handleSuppressAuthors = (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
forall {a}. Eq a => Output a -> Output a
removeNamesIfSuppressAuthor

      let isNoteCitation :: Bool
isNoteCitation = StyleOptions -> Bool
styleIsNoteStyle (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style)

      -- if we have an author-only citation at the beginning
      -- separate it out:
      let handleAuthorOnly :: Output a -> Output a
handleAuthorOnly Output a
formattedCit =
            case Output a
formattedCit of
              Formatted Formatting
f
                (x :: Output a
x@(Tagged (TagItem CitationItemType
AuthorOnly ItemId
_) Output a
_):[Output a]
xs)
                  | Bool
isNoteCitation
                    -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
                        (Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a -> Output a
forall a. Output a -> Output a
InNote (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
xs) | Bool -> Bool
not ([Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs)])
                  | Bool
otherwise
                    -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
                        (Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
                         if [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs
                            then []
                            else [a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
" "),
                                  Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
xs])
              Formatted Formatting
f
                (Formatted Formatting
f'
                  (x :: Output a
x@(Tagged (TagItem CitationItemType
AuthorOnly ItemId
_) Output a
_):[Output a]
xs) : [Output a]
ys)
                  | Bool
isNoteCitation
                    -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
                        (Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
                         if [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs Bool -> Bool -> Bool
&& [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
ys
                            then []
                            else [Output a -> Output a
forall a. Output a -> Output a
InNote (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f
                                           (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f' [Output a]
xs Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
ys))])
                  | Bool
otherwise
                    -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty
                        (Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
                         if [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs Bool -> Bool -> Bool
&& [Output a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
ys
                            then []
                            else [a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
" "),
                                  Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f' [Output a]
xs Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
ys)])
              Output a
_ | Bool
isNoteCitation -> Output a -> Output a
forall a. Output a -> Output a
InNote Output a
formattedCit
                | Bool
otherwise      -> Output a
formattedCit

      let cs'' :: [Output a]
cs'' = (Output a -> Output a) -> [Output a] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map (Output a -> Output a
handleSuppressAuthors (Output a -> Output a)
-> (Output a -> Output a) -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output a -> Output a
forall {a}. CiteprocOutput a => Output a -> Output a
handleAuthorOnly) [Output a]
cs'

      -- styling of bibliography (this needs to go here to take account
      -- of year suffixes added in disambiguation)
      [Output a]
bs <- case Style a -> Maybe (Layout a)
forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
               Just Layout a
biblayout
                 -> (Context a -> Context a) -> Eval a [Output a] -> Eval a [Output a]
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
local (\Context a
context ->
                             Context a
context{ contextInBibliography = True }) (Eval a [Output a] -> Eval a [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall a b. (a -> b) -> a -> b
$
                    ((Int, Citation a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [(Int, Citation a)] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Layout a
-> (Int, Citation a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Layout a -> (Int, Citation a) -> Eval a (Output a)
evalLayout Layout a
biblayout) ([Int] -> [Citation a] -> [(Int, Citation a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Citation a]
bibCitations)
                    Eval a [Output a]
-> ([Output a] -> Eval a [Output a]) -> Eval a [Output a]
forall a b.
RWST (Context a) (Set Text) (EvalState a) Identity a
-> (a -> RWST (Context a) (Set Text) (EvalState a) Identity b)
-> RWST (Context a) (Set Text) (EvalState a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Output a]
bs ->
                      case StyleOptions -> Maybe SubsequentAuthorSubstitute
styleSubsequentAuthorSubstitute
                            (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style) of
                        Maybe SubsequentAuthorSubstitute
Nothing -> [Output a] -> Eval a [Output a]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
bs
                        Just SubsequentAuthorSubstitute
subs -> SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
forall a.
CiteprocOutput a =>
SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
subsequentAuthorSubstitutes SubsequentAuthorSubstitute
subs [Output a]
bs
               Maybe (Layout a)
Nothing -> [Output a] -> Eval a [Output a]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      ([Output a], [(Text, Output a)])
-> RWS
     (Context a)
     (Set Text)
     (EvalState a)
     ([Output a], [(Text, Output a)])
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output a]
cs'', case Style a -> Maybe (Layout a)
forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
                     Maybe (Layout a)
Nothing -> []
                     Just Layout a
_  ->
                       [Text] -> [Output a] -> [(Text, Output a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Citation a -> Text) -> [Citation a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> (Citation a -> Maybe Text) -> Citation a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation a -> Maybe Text
forall a. Citation a -> Maybe Text
citationId) [Citation a]
bibCitations) [Output a]
bs)

extractItemData :: [Citation a] -> [Reference a]
extractItemData :: forall a. [Citation a] -> [Reference a]
extractItemData = (Citation a -> [Reference a]) -> [Citation a] -> [Reference a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((CitationItem a -> Maybe (Reference a))
-> [CitationItem a] -> [Reference a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CitationItem a -> Maybe (Reference a)
forall a. CitationItem a -> Maybe (Reference a)
citationItemData ([CitationItem a] -> [Reference a])
-> (Citation a -> [CitationItem a]) -> Citation a -> [Reference a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems)

subsequentAuthorSubstitutes :: CiteprocOutput a
                            => SubsequentAuthorSubstitute
                            -> [Output a]
                            -> Eval a [Output a]
subsequentAuthorSubstitutes :: forall a.
CiteprocOutput a =>
SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
subsequentAuthorSubstitutes (SubsequentAuthorSubstitute Text
t SubsequentAuthorSubstituteRule
rule) =
  [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output a]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [Output a])
-> ([Output a] -> [Output a])
-> [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output a] -> [Output a]
forall {a}. CiteprocOutput a => [Output a] -> [Output a]
groupCitesByNames
 where
  groupCitesByNames :: [Output a] -> [Output a]
groupCitesByNames [] = []
  groupCitesByNames (Output a
x:[Output a]
xs) =
    let xnames :: ([Name], Output a)
xnames = ([Name], Output a)
-> Maybe ([Name], Output a) -> ([Name], Output a)
forall a. a -> Maybe a -> a
fromMaybe ([],Output a
forall a. Output a
NullOutput) (Maybe ([Name], Output a) -> ([Name], Output a))
-> Maybe ([Name], Output a) -> ([Name], Output a)
forall a b. (a -> b) -> a -> b
$ Output a -> Maybe ([Name], Output a)
forall {a}. Output a -> Maybe ([Name], Output a)
getNames Output a
x
        samenames :: [Output a]
samenames = SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
forall a.
CiteprocOutput a =>
SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
rule (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
t) ([Name], Output a)
xnames [Output a]
xs
        rest :: [Output a]
rest = Int -> [Output a] -> [Output a]
forall a. Int -> [a] -> [a]
drop ([Output a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
samenames) [Output a]
xs
    in  (Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
samenames) [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ [Output a] -> [Output a]
groupCitesByNames [Output a]
rest
  getNames :: Output a -> Maybe ([Name], Output a)
getNames (Formatted Formatting
_ (Output a
x:[Output a]
_)) =
    case [([Name]
ns,Output a
r) | (Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
r) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x] of
      (([Name]
ns,Output a
r) : [([Name], Output a)]
_) -> ([Name], Output a) -> Maybe ([Name], Output a)
forall a. a -> Maybe a
Just ([Name]
ns,Output a
r)
      []           -> Maybe ([Name], Output a)
forall a. Maybe a
Nothing
  getNames Output a
_ = Maybe ([Name], Output a)
forall a. Maybe a
Nothing

replaceMatch :: CiteprocOutput a
             => SubsequentAuthorSubstituteRule
             -> a
             -> ([Name], Output a)
             -> [Output a]
             -> [Output a]
replaceMatch :: forall a.
CiteprocOutput a =>
SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
_ a
_ ([Name], Output a)
_ [] = []
replaceMatch SubsequentAuthorSubstituteRule
rule a
replacement ([Name]
names, Output a
raw) (Output a
z:[Output a]
zs) =
  case Output a -> Maybe (Output a)
go Output a
z of
    Maybe (Output a)
Nothing -> []
    Just Output a
z' -> Output a
z' Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
forall a.
CiteprocOutput a =>
SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
rule a
replacement ([Name]
names, Output a
raw) [Output a]
zs
 where
  go :: Output a -> Maybe (Output a)
go (Tagged t :: Tag
t@TagItem{} Output a
y) =
    Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
t (Output a -> Output a) -> Maybe (Output a) -> Maybe (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output a -> Maybe (Output a)
go Output a
y
  go (Formatted Formatting
f (Output a
y:[Output a]
ys)) =
    Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f ([Output a] -> Output a)
-> (Output a -> [Output a]) -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
ys) (Output a -> Output a) -> Maybe (Output a) -> Maybe (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output a -> Maybe (Output a)
go Output a
y
  go y :: Output a
y@(Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
r) =
    case (if [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names then SubsequentAuthorSubstituteRule
CompleteAll else SubsequentAuthorSubstituteRule
rule) of
        SubsequentAuthorSubstituteRule
CompleteAll ->
          if [Name]
ns [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name]
names Bool -> Bool -> Bool
&& (Bool -> Bool
not ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) Bool -> Bool -> Bool
|| Output a
r Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
raw)
             then Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ Output a -> Output a
replaceAll Output a
y
             else Maybe (Output a)
forall a. Maybe a
Nothing
        SubsequentAuthorSubstituteRule
CompleteEach ->
          if [Name]
ns [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name]
names
             then Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
replaceEach Output a
y
             else Maybe (Output a)
forall a. Maybe a
Nothing
        SubsequentAuthorSubstituteRule
PartialEach ->
          case [Name] -> [Name] -> Int
forall {a} {a}. (Eq a, Num a) => [a] -> [a] -> a
numberOfMatches [Name]
ns [Name]
names of
            Int
num | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 -> Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Int -> Output a -> Output a
replaceFirst Int
num) Output a
y
            Int
_ -> Maybe (Output a)
forall a. Maybe a
Nothing
        SubsequentAuthorSubstituteRule
PartialFirst ->
          case [Name] -> [Name] -> Int
forall {a} {a}. (Eq a, Num a) => [a] -> [a] -> a
numberOfMatches [Name]
ns [Name]
names of
            Int
num | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
1 :: Int) -> Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Int -> Output a -> Output a
replaceFirst Int
1) Output a
y
            Int
_ -> Maybe (Output a)
forall a. Maybe a
Nothing
  go Output a
_ = Maybe (Output a)
forall a. Maybe a
Nothing
  replaceAll :: Output a -> Output a
replaceAll (Tagged (TagNames Variable
t' NamesFormat
nf [Name]
ns') Output a
x)
     = Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Variable -> NamesFormat -> [Name] -> Tag
TagNames Variable
t' NamesFormat
nf [Name]
ns') (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$
       -- 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 [Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ns'
          then a -> Output a
forall a. a -> Output a
Literal a
replacement
          else
            case (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
forall a. Output a -> Output a
removeName Output a
x of
              Formatted Formatting
f' [Output a]
xs -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f' (a -> Output a
forall a. a -> Output a
Literal a
replacement Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
xs)
              Output a
_               -> a -> Output a
forall a. a -> Output a
Literal a
replacement
  replaceAll Output a
x = Output a
x
  removeName :: Output a -> Output a
removeName (Tagged (TagName Name
_) Output a
_) = Output a
forall a. Output a
NullOutput
  removeName Output a
x = Output a
x
  replaceEach :: Output a -> Output a
replaceEach (Tagged (TagName Name
n) Output a
_)
    | Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
names
     = Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Name -> Tag
TagName Name
n) (a -> Output a
forall a. a -> Output a
Literal a
replacement)
  replaceEach Output a
x = Output a
x
  replaceFirst :: Int -> Output a -> Output a
replaceFirst Int
num x :: Output a
x@(Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns') Output a
_)
    = (Name -> Output a -> Output a) -> Output a -> [Name] -> Output a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform ((Output a -> Output a) -> Output a -> Output a)
-> (Name -> Output a -> Output a) -> Name -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Output a -> Output a
replaceName) Output a
x ([Name] -> Output a) -> [Name] -> Output a
forall a b. (a -> b) -> a -> b
$ Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
num [Name]
ns'
  replaceFirst Int
_num Output a
x = Output a
x
  replaceName :: Name -> Output a -> Output a
replaceName Name
name (Tagged (TagName Name
n) Output a
_)
    | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name = Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Name -> Tag
TagName Name
n) (a -> Output a
forall a. a -> Output a
Literal a
replacement)
  replaceName Name
_ Output a
x = Output a
x
  numberOfMatches :: [a] -> [a] -> a
numberOfMatches (a
a:[a]
as) (a
b:[a]
bs)
    | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b    = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ [a] -> [a] -> a
numberOfMatches [a]
as [a]
bs
    | Bool
otherwise = a
0
  numberOfMatches [a]
_ [a]
_ = a
0

--
-- Disambiguation
--

data DisambData =
  DisambData
  { DisambData -> ItemId
ddItem       :: ItemId
  , DisambData -> [Name]
ddNames      :: [Name]
  , DisambData -> [Date]
ddDates      :: [Date]
  , DisambData -> Text
ddRendered   :: Text
  } deriving (DisambData -> DisambData -> Bool
(DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> Bool) -> Eq DisambData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisambData -> DisambData -> Bool
== :: DisambData -> DisambData -> Bool
$c/= :: DisambData -> DisambData -> Bool
/= :: DisambData -> DisambData -> Bool
Eq, Eq DisambData
Eq DisambData =>
(DisambData -> DisambData -> Ordering)
-> (DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> DisambData)
-> (DisambData -> DisambData -> DisambData)
-> Ord DisambData
DisambData -> DisambData -> Bool
DisambData -> DisambData -> Ordering
DisambData -> DisambData -> DisambData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DisambData -> DisambData -> Ordering
compare :: DisambData -> DisambData -> Ordering
$c< :: DisambData -> DisambData -> Bool
< :: DisambData -> DisambData -> Bool
$c<= :: DisambData -> DisambData -> Bool
<= :: DisambData -> DisambData -> Bool
$c> :: DisambData -> DisambData -> Bool
> :: DisambData -> DisambData -> Bool
$c>= :: DisambData -> DisambData -> Bool
>= :: DisambData -> DisambData -> Bool
$cmax :: DisambData -> DisambData -> DisambData
max :: DisambData -> DisambData -> DisambData
$cmin :: DisambData -> DisambData -> DisambData
min :: DisambData -> DisambData -> DisambData
Ord, Int -> DisambData -> ShowS
[DisambData] -> ShowS
DisambData -> String
(Int -> DisambData -> ShowS)
-> (DisambData -> String)
-> ([DisambData] -> ShowS)
-> Show DisambData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisambData -> ShowS
showsPrec :: Int -> DisambData -> ShowS
$cshow :: DisambData -> String
show :: DisambData -> String
$cshowList :: [DisambData] -> ShowS
showList :: [DisambData] -> ShowS
Show)

disambiguateCitations :: forall a . CiteprocOutput a
                      => Style a
                      -> M.Map ItemId [SortKeyValue]
                      -> [Citation a]
                      -> Eval a [Output a]
disambiguateCitations :: forall a.
CiteprocOutput a =>
Style a
-> Map ItemId [SortKeyValue] -> [Citation a] -> Eval a [Output a]
disambiguateCitations Style a
style Map ItemId [SortKeyValue]
bibSortKeyMap [Citation a]
citations = do
  Map ItemId (Reference a)
refs <- ReferenceMap a -> Map ItemId (Reference a)
forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (ReferenceMap a -> Map ItemId (Reference a))
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (ReferenceMap a)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId (Reference a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState a -> ReferenceMap a)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (ReferenceMap a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap
  let refIds :: [ItemId]
refIds = Map ItemId (Reference a) -> [ItemId]
forall k a. Map k a -> [k]
M.keys Map ItemId (Reference a)
refs
  let ghostItems :: [ItemId]
ghostItems = [ ItemId
ident
                   | ItemId
ident <- [ItemId]
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 :: CitationItem a -> CitationItem a
removeAffix CitationItem a
item = CitationItem a
item{ citationItemLabel = Nothing
                             , citationItemLocator = Nothing
                             , citationItemPrefix = Nothing
                             , citationItemSuffix = Nothing }
  let cleanCitation :: Citation a -> Citation a
cleanCitation (Citation Maybe Text
a Maybe Int
b (CitationItem a
i1:CitationItem a
i2:[CitationItem a]
is))
       | CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
i1 CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly
       , CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
i2 CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
SuppressAuthor
        = Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation Maybe Text
a Maybe Int
b
            ((CitationItem a -> CitationItem a)
-> [CitationItem a] -> [CitationItem a]
forall a b. (a -> b) -> [a] -> [b]
map CitationItem a -> CitationItem a
forall {a}. CitationItem a -> CitationItem a
removeAffix (CitationItem a
i2{ citationItemType = NormalCite }CitationItem a -> [CitationItem a] -> [CitationItem a]
forall a. a -> [a] -> [a]
:[CitationItem a]
is))
      cleanCitation (Citation Maybe Text
a Maybe Int
b [CitationItem a]
is)
        = Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation Maybe Text
a Maybe Int
b ((CitationItem a -> CitationItem a)
-> [CitationItem a] -> [CitationItem a]
forall a b. (a -> b) -> [a] -> [b]
map CitationItem a -> CitationItem a
forall {a}. CitationItem a -> CitationItem a
removeAffix [CitationItem a]
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' :: [Citation a]
citations' = (Citation a -> Citation a) -> [Citation a] -> [Citation a]
forall a b. (a -> b) -> [a] -> [b]
map Citation a -> Citation a
forall {a}. Citation a -> Citation a
cleanCitation [Citation a]
citations [Citation a] -> [Citation a] -> [Citation a]
forall a. [a] -> [a] -> [a]
++
                   [Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation Maybe Text
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing ((ItemId -> CitationItem a) -> [ItemId] -> [CitationItem a]
forall a b. (a -> b) -> [a] -> [b]
map ItemId -> CitationItem a
forall a. ItemId -> CitationItem a
basicItem [ItemId]
ghostItems)]
  [Output a]
allCites <- [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
citations'

  Maybe Lang
mblang <- (Context a -> Maybe Lang)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Lang)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Maybe Lang
localeLanguage (Locale -> Maybe Lang)
-> (Context a -> Locale) -> Context a -> Maybe Lang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> Locale
forall a. Context a -> Locale
contextLocale)
  StyleOptions
styleOpts <- (Context a -> StyleOptions)
-> RWST (Context a) (Set Text) (EvalState a) Identity StyleOptions
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions
  let strategy :: DisambiguationStrategy
strategy = StyleOptions -> DisambiguationStrategy
styleDisambiguation StyleOptions
styleOpts
  let allNameGroups :: [[Name]]
allNameGroups = [[Name]
ns | Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
_ <-
                              (Output a -> [Output a]) -> [Output a] -> [Output a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe [Output a]
allCites]
  let allNames :: [Name]
allNames = [Name] -> [Name]
forall a. Ord a => [a] -> [a]
nubOrd ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
allNameGroups
  let primaryNames :: [Name]
primaryNames = [Name] -> [Name]
forall a. Ord a => [a] -> [a]
nubOrd ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ([Name] -> [Name]) -> [[Name]] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
1) [[Name]]
allNameGroups
  [Output a]
allCites' <-
    case DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy of
         Maybe GivenNameDisambiguationRule
Nothing     -> [Output a] -> Eval a [Output a]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
allCites
         Just GivenNameDisambiguationRule
ByCite -> [Output a] -> Eval a [Output a]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
allCites -- do this later
         Just GivenNameDisambiguationRule
rule   -> do -- disambiguate names, not just citations
           let relevantNames :: [Name]
relevantNames =
                 case GivenNameDisambiguationRule
rule of
                   GivenNameDisambiguationRule
PrimaryNameWithInitials -> [Name]
primaryNames
                   GivenNameDisambiguationRule
PrimaryName -> [Name]
primaryNames
                   GivenNameDisambiguationRule
_ -> [Name]
allNames
           let familyNames :: [Text]
familyNames = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Name -> Maybe Text) -> [Name] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Name -> Maybe Text
nameFamily [Name]
relevantNames
           let grps :: [[Name]]
grps = (Text -> [Name]) -> [Text] -> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
name ->
                             [Name
v | Name
v <- [Name]
relevantNames
                                , Name -> Maybe Text
nameFamily Name
v Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name])
                          [Text]
familyNames
           let toHint :: [Name] -> Name -> Maybe NameHints
toHint [Name]
names Name
name =
                  if (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Lang -> Name -> Name -> Bool
initialsMatch Maybe Lang
mblang Name
name) ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name) [Name]
names)
                     then
                       case GivenNameDisambiguationRule
rule of
                         GivenNameDisambiguationRule
AllNamesWithInitials    -> Maybe NameHints
forall a. Maybe a
Nothing
                         GivenNameDisambiguationRule
PrimaryNameWithInitials -> Maybe NameHints
forall a. Maybe a
Nothing
                         GivenNameDisambiguationRule
PrimaryName             -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddGivenNameIfPrimary
                         GivenNameDisambiguationRule
_                       -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddGivenName
                     else
                       case GivenNameDisambiguationRule
rule of
                         GivenNameDisambiguationRule
PrimaryNameWithInitials -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddInitialsIfPrimary
                         GivenNameDisambiguationRule
PrimaryName             -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddInitialsIfPrimary
                         GivenNameDisambiguationRule
_                       -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddInitials
           let namesMap :: Map Name NameHints
namesMap = [Map Name NameHints] -> Map Name NameHints
forall a. Monoid a => [a] -> a
mconcat ([Map Name NameHints] -> Map Name NameHints)
-> [Map Name NameHints] -> Map Name NameHints
forall a b. (a -> b) -> a -> b
$ ([Name] -> Map Name NameHints) -> [[Name]] -> [Map Name NameHints]
forall a b. (a -> b) -> [a] -> [b]
map
                  (\[Name]
names -> if [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
names Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                                 then (Name -> Map Name NameHints -> Map Name NameHints)
-> Map Name NameHints -> [Name] -> Map Name NameHints
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                                    (\Name
name ->
                                        case [Name] -> Name -> Maybe NameHints
toHint [Name]
names Name
name of
                                          Just NameHints
x -> Name -> NameHints -> Map Name NameHints -> Map Name NameHints
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name NameHints
x
                                          Maybe NameHints
Nothing -> Map Name NameHints -> Map Name NameHints
forall a. a -> a
id)
                                    Map Name NameHints
forall a. Monoid a => a
mempty
                                    [Name]
names
                                 else Map Name NameHints
forall a. Monoid a => a
mempty) [[Name]]
grps
           -- use this same names map for every citation
           (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
              EvalState a
st{ stateRefMap = ReferenceMap $
                   foldr
                     (M.adjust (alterReferenceDisambiguation
                       (\DisambiguationData
d -> DisambiguationData
d{ disambNameMap = namesMap })))
                     (unReferenceMap $ stateRefMap st)
                     refIds }
           -- redo citations
           [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
citations'

  case [Output a] -> [[DisambData]]
forall a. CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities [Output a]
allCites' of
    []          -> () -> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [[DisambData]]
ambiguities -> Maybe Lang
-> DisambiguationStrategy
-> [Citation a]
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
analyzeAmbiguities Maybe Lang
mblang DisambiguationStrategy
strategy [Citation a]
citations' [[DisambData]]
ambiguities
  [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
citations

 where

  renderCitations :: [Citation a] -> Eval a [Output a]
  renderCitations :: [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
cs =
    (Context a -> EvalState a -> (Context a, EvalState a))
-> Eval a [Output a] -> Eval a [Output a]
forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST (\Context a
ctx EvalState a
st -> (Context a
ctx,
                          EvalState a
st { stateLastCitedMap = mempty
                             , stateNoteMap = mempty })) (Eval a [Output a] -> Eval a [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall a b. (a -> b) -> a -> b
$
     ((Int, Citation a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [(Int, Citation a)] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Layout a
-> (Int, Citation a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Layout a -> (Int, Citation a) -> Eval a (Output a)
evalLayout (Style a -> Layout a
forall a. Style a -> Layout a
styleCitation Style a
style)) ([Int] -> [Citation a] -> [(Int, Citation a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Citation a]
cs)

  refreshAmbiguities :: [Citation a] -> Eval a [[DisambData]]
  refreshAmbiguities :: [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities = ([Output a] -> [[DisambData]])
-> Eval a [Output a] -> Eval a [[DisambData]]
forall a b.
(a -> b)
-> RWST (Context a) (Set Text) (EvalState a) Identity a
-> RWST (Context a) (Set Text) (EvalState a) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Output a] -> [[DisambData]]
forall a. CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities (Eval a [Output a] -> Eval a [[DisambData]])
-> ([Citation a] -> Eval a [Output a])
-> [Citation a]
-> Eval a [[DisambData]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Citation a] -> Eval a [Output a]
renderCitations

  analyzeAmbiguities :: Maybe Lang
                     -> DisambiguationStrategy
                     -> [Citation a]
                     -> [[DisambData]]
                     -> Eval a ()
  analyzeAmbiguities :: Maybe Lang
-> DisambiguationStrategy
-> [Citation a]
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
analyzeAmbiguities Maybe Lang
mblang DisambiguationStrategy
strategy [Citation a]
cs [[DisambData]]
ambiguities = do
    -- add names to et al.
    [[DisambData]] -> Eval a [[DisambData]]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
ambiguities
      Eval a [[DisambData]]
-> ([[DisambData]] -> Eval a [[DisambData]])
-> Eval a [[DisambData]]
forall a b.
RWST (Context a) (Set Text) (EvalState a) Identity a
-> (a -> RWST (Context a) (Set Text) (EvalState a) Identity b)
-> RWST (Context a) (Set Text) (EvalState a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[[DisambData]]
as ->
           (if Bool -> Bool
not ([[DisambData]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DisambData]]
as) Bool -> Bool -> Bool
&& DisambiguationStrategy -> Bool
disambiguateAddNames DisambiguationStrategy
strategy
               then do
                 ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe Lang
-> Maybe GivenNameDisambiguationRule
-> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a.
Maybe Lang
-> Maybe GivenNameDisambiguationRule -> [DisambData] -> Eval a ()
tryAddNames Maybe Lang
mblang (DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy)) [[DisambData]]
as
                 [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities [Citation a]
cs
               else
                 [[DisambData]] -> Eval a [[DisambData]]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
as))
      Eval a [[DisambData]]
-> ([[DisambData]] -> Eval a [[DisambData]])
-> Eval a [[DisambData]]
forall a b.
RWST (Context a) (Set Text) (EvalState a) Identity a
-> (a -> RWST (Context a) (Set Text) (EvalState a) Identity b)
-> RWST (Context a) (Set Text) (EvalState a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[[DisambData]]
as ->
           (case DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy of
                  Just GivenNameDisambiguationRule
ByCite | Bool -> Bool
not ([[DisambData]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DisambData]]
as) -> do
                     ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe Lang
-> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. Maybe Lang -> [DisambData] -> Eval a ()
tryAddGivenNames Maybe Lang
mblang) [[DisambData]]
as
                     [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities [Citation a]
cs
                  Maybe GivenNameDisambiguationRule
_           -> [[DisambData]] -> Eval a [[DisambData]]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
as))
      Eval a [[DisambData]]
-> ([[DisambData]] -> Eval a [[DisambData]])
-> Eval a [[DisambData]]
forall a b.
RWST (Context a) (Set Text) (EvalState a) Identity a
-> (a -> RWST (Context a) (Set Text) (EvalState a) Identity b)
-> RWST (Context a) (Set Text) (EvalState a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[[DisambData]]
as ->
           (if Bool -> Bool
not ([[DisambData]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DisambData]]
as) Bool -> Bool -> Bool
&& DisambiguationStrategy -> Bool
disambiguateAddYearSuffix DisambiguationStrategy
strategy
               then do
                 Map ItemId [SortKeyValue]
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. Map ItemId [SortKeyValue] -> [[DisambData]] -> Eval a ()
addYearSuffixes Map ItemId [SortKeyValue]
bibSortKeyMap [[DisambData]]
as
                 [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities [Citation a]
cs
               else [[DisambData]] -> Eval a [[DisambData]]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
as))
      Eval a [[DisambData]]
-> ([[DisambData]]
    -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b.
RWST (Context a) (Set Text) (EvalState a) Identity a
-> (a -> RWST (Context a) (Set Text) (EvalState a) Identity b)
-> RWST (Context a) (Set Text) (EvalState a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. [DisambData] -> Eval a ()
tryDisambiguateCondition

basicItem :: ItemId -> CitationItem a
basicItem :: forall a. ItemId -> CitationItem a
basicItem ItemId
iid = CitationItem
  { citationItemId :: ItemId
citationItemId      = ItemId
iid
  , citationItemLabel :: Maybe Text
citationItemLabel   = Maybe Text
forall a. Maybe a
Nothing
  , citationItemLocator :: Maybe Text
citationItemLocator = Maybe Text
forall a. Maybe a
Nothing
  , citationItemType :: CitationItemType
citationItemType    = CitationItemType
NormalCite
  , citationItemPrefix :: Maybe a
citationItemPrefix  = Maybe a
forall a. Maybe a
Nothing
  , citationItemSuffix :: Maybe a
citationItemSuffix  = Maybe a
forall a. Maybe a
Nothing
  , citationItemData :: Maybe (Reference a)
citationItemData    = Maybe (Reference a)
forall a. Maybe a
Nothing
  }

isDisambiguated :: Maybe Lang
                -> Maybe GivenNameDisambiguationRule
                -> Int -- et al min
                -> [DisambData]
                -> DisambData
                -> Bool
isDisambiguated :: Maybe Lang
-> Maybe GivenNameDisambiguationRule
-> Int
-> [DisambData]
-> DisambData
-> Bool
isDisambiguated Maybe Lang
mblang Maybe GivenNameDisambiguationRule
mbrule Int
etAlMin [DisambData]
xs DisambData
x =
  (DisambData -> Bool) -> [DisambData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\DisambData
y -> DisambData
x DisambData -> DisambData -> Bool
forall a. Eq a => a -> a -> Bool
== DisambData
y Bool -> Bool -> Bool
|| DisambData -> [Name]
disambiguatedName DisambData
y [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
/= DisambData -> [Name]
disambiguatedName DisambData
x) [DisambData]
xs
 where
  disambiguatedName :: DisambData -> [Name]
disambiguatedName = [Name] -> [Name]
nameParts ([Name] -> [Name])
-> (DisambData -> [Name]) -> DisambData -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
etAlMin ([Name] -> [Name])
-> (DisambData -> [Name]) -> DisambData -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> [Name]
ddNames
  nameParts :: [Name] -> [Name]
nameParts =
    case Maybe GivenNameDisambiguationRule
mbrule of
      Just GivenNameDisambiguationRule
AllNames -> [Name] -> [Name]
forall a. a -> a
id
      Just GivenNameDisambiguationRule
AllNamesWithInitials ->
           (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven = initialize mblang True False ""
                                            <$> nameGiven name })
      Just GivenNameDisambiguationRule
PrimaryName ->
        \case
          [] -> []
          (Name
z:[Name]
zs) -> Name
z Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven = Nothing }) [Name]
zs
      Just GivenNameDisambiguationRule
PrimaryNameWithInitials ->
        \case
          [] -> []
          (Name
z:[Name]
zs) -> Name
z{ nameGiven =
                     initialize mblang True False "" <$> nameGiven z } Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:
                     (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven = Nothing }) [Name]
zs
      Just GivenNameDisambiguationRule
ByCite -> [Name] -> [Name]
forall a. a -> a
id -- hints will be added later
      Maybe GivenNameDisambiguationRule
_ -> (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven = Nothing })

tryAddNames :: Maybe Lang
            -> Maybe GivenNameDisambiguationRule
            -> [DisambData]
            -> Eval a ()
tryAddNames :: forall a.
Maybe Lang
-> Maybe GivenNameDisambiguationRule -> [DisambData] -> Eval a ()
tryAddNames Maybe Lang
mblang Maybe GivenNameDisambiguationRule
mbrule [DisambData]
bs =
                     (case Maybe GivenNameDisambiguationRule
mbrule of
                          Just GivenNameDisambiguationRule
ByCite -> [DisambData]
bs [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall a b.
a
-> RWST (Context a) (Set Text) (EvalState a) Identity b
-> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe Lang
-> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. Maybe Lang -> [DisambData] -> Eval a ()
tryAddGivenNames Maybe Lang
mblang [DisambData]
bs
                          Maybe GivenNameDisambiguationRule
_ -> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [DisambData]
bs) RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
-> ([DisambData]
    -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b.
RWST (Context a) (Set Text) (EvalState a) Identity a
-> (a -> RWST (Context a) (Set Text) (EvalState a) Identity b)
-> RWST (Context a) (Set Text) (EvalState a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int
-> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall {m :: * -> *} {r} {w} {a}.
Monad m =>
Int -> [DisambData] -> RWST r w (EvalState a) m ()
go Int
1
                        -- if ByCite, we want to make sure that
                        -- tryAddGivenNames is still applied, as
                        -- calculation of "add names" assumes this.
 where
   maxnames :: [DisambData] -> Int
maxnames = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int)
-> ([DisambData] -> Maybe Int) -> [DisambData] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
maximumMay ([Int] -> Maybe Int)
-> ([DisambData] -> [Int]) -> [DisambData] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DisambData -> Int) -> [DisambData] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Name] -> Int) -> (DisambData -> [Name]) -> DisambData -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> [Name]
ddNames)
   go :: Int -> [DisambData] -> RWST r w (EvalState a) m ()
go Int
n [DisambData]
as
     | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [DisambData] -> Int
maxnames [DisambData]
as = () -> RWST r w (EvalState a) m ()
forall a. a -> RWST r w (EvalState a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     | Bool
otherwise = do
         let ds :: [DisambData]
ds = (DisambData -> Bool) -> [DisambData] -> [DisambData]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Lang
-> Maybe GivenNameDisambiguationRule
-> Int
-> [DisambData]
-> DisambData
-> Bool
isDisambiguated Maybe Lang
mblang Maybe GivenNameDisambiguationRule
mbrule Int
n [DisambData]
as) [DisambData]
as
         if [DisambData] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DisambData]
ds
            then Int -> [DisambData] -> RWST r w (EvalState a) m ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [DisambData]
as
            else do
              (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> RWST r w (EvalState a) m ())
-> (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
                EvalState a
st{ stateRefMap = ReferenceMap
                      $ foldr (setEtAlNames (Just n) . ddItem)
                        (unReferenceMap $ stateRefMap st) as }
              Int -> [DisambData] -> RWST r w (EvalState a) m ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([DisambData]
as [DisambData] -> [DisambData] -> [DisambData]
forall a. Eq a => [a] -> [a] -> [a]
\\ [DisambData]
ds)

tryAddGivenNames :: Maybe Lang
                 -> [DisambData]
                 -> Eval a ()
tryAddGivenNames :: forall a. Maybe Lang -> [DisambData] -> Eval a ()
tryAddGivenNames Maybe Lang
mblang [DisambData]
as = do
  let correspondingNames :: [[(ItemId, Name)]]
correspondingNames =
         ([Name] -> [(ItemId, Name)]) -> [[Name]] -> [[(ItemId, Name)]]
forall a b. (a -> b) -> [a] -> [b]
map ([ItemId] -> [Name] -> [(ItemId, Name)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((DisambData -> ItemId) -> [DisambData] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map DisambData -> ItemId
ddItem [DisambData]
as)) ([[Name]] -> [[(ItemId, Name)]]) -> [[Name]] -> [[(ItemId, Name)]]
forall a b. (a -> b) -> a -> b
$ [[Name]] -> [[Name]]
forall a. [[a]] -> [[a]]
transpose ([[Name]] -> [[Name]]) -> [[Name]] -> [[Name]]
forall a b. (a -> b) -> a -> b
$ (DisambData -> [Name]) -> [DisambData] -> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map DisambData -> [Name]
ddNames [DisambData]
as
      go :: [DisambData]
-> [(ItemId, Name)]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
go [] [(ItemId, Name)]
_ = [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      go ([DisambData]
as' :: [DisambData]) ([(ItemId, Name)]
ns :: [(ItemId, Name)]) = do
        Set ItemId
hintedIds <- [ItemId] -> Set ItemId
forall a. Ord a => [a] -> Set a
Set.fromList ([ItemId] -> Set ItemId)
-> ([Maybe ItemId] -> [ItemId]) -> [Maybe ItemId] -> Set ItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe ItemId] -> [ItemId]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ItemId] -> Set ItemId)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [Maybe ItemId]
-> RWST (Context a) (Set Text) (EvalState a) Identity (Set ItemId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        ((ItemId, Name)
 -> RWST
      (Context a) (Set Text) (EvalState a) Identity (Maybe ItemId))
-> [(ItemId, Name)]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [Maybe ItemId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe Lang
-> [Name]
-> (ItemId, Name)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe ItemId)
forall a.
Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint Maybe Lang
mblang (((ItemId, Name) -> Name) -> [(ItemId, Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, Name) -> Name
forall a b. (a, b) -> b
snd [(ItemId, Name)]
ns)) [(ItemId, Name)]
ns
        [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData])
-> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall a b. (a -> b) -> a -> b
$ (DisambData -> Bool) -> [DisambData] -> [DisambData]
forall a. (a -> Bool) -> [a] -> [a]
filter (\DisambData
x -> DisambData -> ItemId
ddItem DisambData
x ItemId -> Set ItemId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set ItemId
hintedIds) [DisambData]
as'
  ([DisambData]
 -> [(ItemId, Name)]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData])
-> [DisambData] -> [[(ItemId, Name)]] -> Eval a ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ [DisambData]
-> [(ItemId, Name)]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall {a}.
[DisambData]
-> [(ItemId, Name)]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
go [DisambData]
as [[(ItemId, Name)]]
correspondingNames

addYearSuffixes :: M.Map ItemId [SortKeyValue]
                -> [[DisambData]]
                -> Eval a ()
addYearSuffixes :: forall a. Map ItemId [SortKeyValue] -> [[DisambData]] -> Eval a ()
addYearSuffixes Map ItemId [SortKeyValue]
bibSortKeyMap' [[DisambData]]
as = do
  let allitems :: [DisambData]
allitems = [[DisambData]] -> [DisambData]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[DisambData]]
as
  [SortKeyValue] -> [SortKeyValue] -> Ordering
collate <- (Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     ([SortKeyValue] -> [SortKeyValue] -> Ordering)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
forall a. Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate
  let companions :: DisambData -> [DisambData]
companions DisambData
a =
        (DisambData -> DisambData -> Ordering)
-> [DisambData] -> [DisambData]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
        (\DisambData
item1 DisambData
item2 ->
          [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
            ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (DisambData -> ItemId
ddItem DisambData
item1) Map ItemId [SortKeyValue]
bibSortKeyMap')
            ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (DisambData -> ItemId
ddItem DisambData
item2) Map ItemId [SortKeyValue]
bibSortKeyMap'))
        ([[DisambData]] -> [DisambData]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [DisambData]
x | [DisambData]
x <- [[DisambData]]
as, DisambData
a DisambData -> [DisambData] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DisambData]
x ])
  let groups :: Set [DisambData]
groups = (DisambData -> [DisambData]) -> Set DisambData -> Set [DisambData]
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map DisambData -> [DisambData]
companions (Set DisambData -> Set [DisambData])
-> Set DisambData -> Set [DisambData]
forall a b. (a -> b) -> a -> b
$ [DisambData] -> Set DisambData
forall a. Ord a => [a] -> Set a
Set.fromList [DisambData]
allitems
  let addYearSuffix :: ItemId -> Int -> RWST r w (EvalState a) m ()
addYearSuffix ItemId
item Int
suff =
        (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> RWST r w (EvalState a) m ())
-> (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
          EvalState a
st{ stateRefMap = ReferenceMap
               $ setYearSuffix suff item
               $ unReferenceMap
               $ stateRefMap st }
  ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [()])
-> Set [DisambData] -> Eval a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[DisambData]
xs -> (ItemId -> Int -> Eval a ())
-> [ItemId]
-> [Int]
-> RWST (Context a) (Set Text) (EvalState a) Identity [()]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ItemId -> Int -> Eval a ()
forall {m :: * -> *} {r} {w} {a}.
Monad m =>
ItemId -> Int -> RWST r w (EvalState a) m ()
addYearSuffix ((DisambData -> ItemId) -> [DisambData] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map DisambData -> ItemId
ddItem [DisambData]
xs) [Int
1..]) Set [DisambData]
groups

tryDisambiguateCondition :: [DisambData] -> Eval a ()
tryDisambiguateCondition :: forall a. [DisambData] -> Eval a ()
tryDisambiguateCondition [DisambData]
as =
  case [DisambData]
as of
    [] -> () -> Eval a ()
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [DisambData]
xs -> (EvalState a -> EvalState a) -> Eval a ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> Eval a ())
-> (EvalState a -> EvalState a) -> Eval a ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
            EvalState a
st{ stateRefMap = ReferenceMap
                $ foldr (setDisambCondition True . ddItem)
                  (unReferenceMap (stateRefMap st))
                  xs }

alterReferenceDisambiguation :: (DisambiguationData -> DisambiguationData)
                             -> Reference a
                             -> Reference a
alterReferenceDisambiguation :: forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation DisambiguationData -> DisambiguationData
f Reference a
r =
      Reference a
r{ referenceDisambiguation = f <$>
           case referenceDisambiguation r of
             Maybe DisambiguationData
Nothing -> DisambiguationData -> Maybe DisambiguationData
forall a. a -> Maybe a
Just
               DisambiguationData
                 { disambYearSuffix :: Maybe Int
disambYearSuffix  = Maybe Int
forall a. Maybe a
Nothing
                 , disambNameMap :: Map Name NameHints
disambNameMap     = Map Name NameHints
forall a. Monoid a => a
mempty
                 , disambEtAlNames :: Maybe Int
disambEtAlNames   = Maybe Int
forall a. Maybe a
Nothing
                 , disambCondition :: Bool
disambCondition   = Bool
False
               }
             Just DisambiguationData
x  -> DisambiguationData -> Maybe DisambiguationData
forall a. a -> Maybe a
Just DisambiguationData
x }

initialsMatch :: Maybe Lang -> Name -> Name -> Bool
initialsMatch :: Maybe Lang -> Name -> Name -> Bool
initialsMatch Maybe Lang
mblang Name
x Name
y =
  case (Name -> Maybe Text
nameGiven Name
x, Name -> Maybe Text
nameGiven Name
y) of
    (Just Text
x', Just Text
y') ->
      Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
"" Text
x' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==
        Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
"" Text
y'
    (Maybe Text, Maybe Text)
_ -> Bool
False

addNameHint :: Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint :: forall a.
Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint Maybe Lang
mblang [Name]
names (ItemId
item, Name
name) = do
  let familyMatches :: [Name]
familyMatches = [Name
n | Name
n <- [Name]
names
                         , Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name
                         , Name -> Maybe Text
nameFamily Name
n Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Text
nameFamily Name
name]
  case [Name]
familyMatches of
    [] -> Maybe ItemId -> Eval a (Maybe ItemId)
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ItemId
forall a. Maybe a
Nothing
    [Name]
_  -> do
      let hint :: NameHints
hint = if (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Lang -> Name -> Name -> Bool
initialsMatch Maybe Lang
mblang Name
name) [Name]
familyMatches
                    then NameHints
AddGivenName
                    else NameHints
AddInitials
      (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
        EvalState a
st{ stateRefMap = ReferenceMap
            $ setNameHint hint name item
            $ unReferenceMap (stateRefMap st) }
      Maybe ItemId -> Eval a (Maybe ItemId)
forall a. a -> RWST (Context a) (Set Text) (EvalState a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ItemId -> Eval a (Maybe ItemId))
-> Maybe ItemId -> Eval a (Maybe ItemId)
forall a b. (a -> b) -> a -> b
$ ItemId -> Maybe ItemId
forall a. a -> Maybe a
Just ItemId
item

setNameHint :: NameHints -> Name -> ItemId
            -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setNameHint :: forall a.
NameHints
-> Name
-> ItemId
-> Map ItemId (Reference a)
-> Map ItemId (Reference a)
setNameHint NameHints
hint Name
name = (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       ((DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambNameMap =
                     M.insert name hint
                     (disambNameMap d) }))

setEtAlNames :: Maybe Int -> ItemId
             -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setEtAlNames :: forall a.
Maybe Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setEtAlNames Maybe Int
x = (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       ((DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambEtAlNames = x }))

setYearSuffix :: Int -> ItemId
              -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setYearSuffix :: forall a.
Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setYearSuffix Int
x = (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       ((DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambYearSuffix = Just x }))

setDisambCondition :: Bool -> ItemId
                   -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setDisambCondition :: forall a.
Bool
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setDisambCondition Bool