{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
#if MIN_VERSION_base(4,9,0)
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Proc.Disamb
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module provides functions for processing the evaluated
-- 'Output' for citation disambiguation.
--
-- Describe the disambiguation process.
--
-----------------------------------------------------------------------------

module Text.CSL.Proc.Disamb where

import Prelude
import           Control.Arrow      (second, (&&&), (>>>))
import           Data.List          (elemIndex, find, findIndex, groupBy,
                                     mapAccumL, nub, nubBy, sortOn)
import           Data.Text          (Text)
import qualified Data.Text          as T
import           Data.Maybe
import           Text.CSL.Eval
import           Text.CSL.Reference
import           Text.CSL.Style
import           Text.CSL.Util      (proc, query)
import           Text.Pandoc.Shared (ordNub)

-- | Given the 'Style', the list of references and the citation
-- groups, disambiguate citations according to the style options.
disambCitations :: Style -> [Reference] -> Citations -> [CitationGroup]
                -> ([(Text, Text)], [CitationGroup])
disambCitations :: Style
-> [Reference]
-> Citations
-> [CitationGroup]
-> ([(Text, Text)], [CitationGroup])
disambCitations s :: Style
s bibs :: [Reference]
bibs cs :: Citations
cs groups :: [CitationGroup]
groups
   = (,) [(Text, Text)]
yearSuffs [CitationGroup]
citOutput
    where
      -- utils
      when_ :: Bool -> [a] -> [a]
when_ b :: Bool
b f :: [a]
f = if Bool
b then [a]
f else []
      filter_ :: ((b, b) -> Bool) -> t ([b], [b]) -> [b]
filter_ f :: (b, b) -> Bool
f = (([b], [b]) -> [b]) -> t ([b], [b]) -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((b, b) -> b) -> [(b, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, b) -> b
forall a b. (a, b) -> a
fst ([(b, b)] -> [b]) -> (([b], [b]) -> [(b, b)]) -> ([b], [b]) -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, b) -> Bool) -> [(b, b)] -> [(b, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (b, b) -> Bool
f ([(b, b)] -> [(b, b)])
-> (([b], [b]) -> [(b, b)]) -> ([b], [b]) -> [(b, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b] -> [b] -> [(b, b)]) -> ([b], [b]) -> [(b, b)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip)

      -- the list of the position and the reference of each citation
      -- for each citation group.
      refs :: [[(Cite, Maybe Reference)]]
refs   = [Reference] -> Citations -> [[(Cite, Maybe Reference)]]
processCites [Reference]
bibs Citations
cs
      -- name data of name duplicates
      nameDupls :: [[NameData]]
nameDupls = [CitationGroup] -> [[NameData]]
getDuplNameData [CitationGroup]
groups
      -- citation data of ambiguous cites
      duplics :: [[CiteData]]
duplics   = GiveNameDisambiguation
-> Bool -> Bool -> [CitationGroup] -> [[CiteData]]
getDuplCiteData GiveNameDisambiguation
giveNameDisamb Bool
hasNamesOpt Bool
hasYSuffOpt [CitationGroup]
groups

      -- check the options set in the style
      disOpts :: [Text]
disOpts     = Style -> [Text]
getCitDisambOptions Style
s
      hasNamesOpt :: Bool
hasNamesOpt = "disambiguate-add-names"       Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
disOpts
      hasGNameOpt :: Bool
hasGNameOpt = "disambiguate-add-givenname"   Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
disOpts
      hasYSuffOpt :: Bool
hasYSuffOpt = "disambiguate-add-year-suffix" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
disOpts
      giveNameDisamb :: GiveNameDisambiguation
giveNameDisamb = case Text -> [(Text, Text)] -> Text
getOptionVal "givenname-disambiguation-rule"
                             (Citation -> [(Text, Text)]
citOptions (Style -> Citation
citation Style
s)) of
                        "by-cite"                    -> GiveNameDisambiguation
ByCite
                        "all-names"                  -> GiveNameDisambiguation
AllNames
                        "all-names-with-initials"    -> GiveNameDisambiguation
AllNames
                        "primary-name"               -> GiveNameDisambiguation
PrimaryName
                        "primary-name-with-initials" -> GiveNameDisambiguation
PrimaryName
                        _                            -> GiveNameDisambiguation
ByCite -- default as of CSL 1.0
      clean :: [[[Output]]] -> [[[Output]]]
clean     = if Bool
hasGNameOpt then [[[Output]]] -> [[[Output]]]
forall a. a -> a
id else (Output -> Output) -> [[[Output]]] -> [[[Output]]]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
rmHashAndGivenNames
      withNames :: [[Bool]]
withNames = (([CiteData] -> [Bool]) -> [[CiteData]] -> [[Bool]])
-> [[CiteData]] -> ([CiteData] -> [Bool]) -> [[Bool]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([CiteData] -> [Bool]) -> [[CiteData]] -> [[Bool]]
forall a b. (a -> b) -> [a] -> [b]
map [[CiteData]]
duplics (([CiteData] -> [Bool]) -> [[Bool]])
-> ([CiteData] -> [Bool]) -> [[Bool]]
forall a b. (a -> b) -> a -> b
$ [[[Output]]] -> [Bool]
forall a. Eq a => [a] -> [Bool]
same ([[[Output]]] -> [Bool])
-> ([CiteData] -> [[[Output]]]) -> [CiteData] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Output]]] -> [[[Output]]]
clean ([[[Output]]] -> [[[Output]]])
-> ([CiteData] -> [[[Output]]]) -> [CiteData] -> [[[Output]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (CiteData -> [[Output]]) -> [CiteData] -> [[[Output]]]
forall a b. (a -> b) -> [a] -> [b]
map (if Bool
hasNamesOpt then CiteData -> [[Output]]
disambData else [Output] -> [[Output]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> [[Output]])
-> (CiteData -> [Output]) -> CiteData -> [[Output]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CiteData -> [Output]
disambYS)

      needNames :: [CiteData]
needNames = ((CiteData, Bool) -> Bool) -> [([CiteData], [Bool])] -> [CiteData]
forall (t :: * -> *) b b.
Foldable t =>
((b, b) -> Bool) -> t ([b], [b]) -> [b]
filter_ (Bool -> Bool
not (Bool -> Bool)
-> ((CiteData, Bool) -> Bool) -> (CiteData, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CiteData, Bool) -> Bool
forall a b. (a, b) -> b
snd) ([([CiteData], [Bool])] -> [CiteData])
-> [([CiteData], [Bool])] -> [CiteData]
forall a b. (a -> b) -> a -> b
$ [[CiteData]] -> [[Bool]] -> [([CiteData], [Bool])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[CiteData]]
duplics [[Bool]]
withNames
      needYSuff :: [CiteData]
needYSuff = ((CiteData, Bool) -> Bool) -> [([CiteData], [Bool])] -> [CiteData]
forall (t :: * -> *) b b.
Foldable t =>
((b, b) -> Bool) -> t ([b], [b]) -> [b]
filter_        (CiteData, Bool) -> Bool
forall a b. (a, b) -> b
snd  ([([CiteData], [Bool])] -> [CiteData])
-> [([CiteData], [Bool])] -> [CiteData]
forall a b. (a -> b) -> a -> b
$ [[CiteData]] -> [[Bool]] -> [([CiteData], [Bool])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[CiteData]]
duplics [[Bool]]
withNames

      newNames :: [CiteData]
      newNames :: [CiteData]
newNames  = Bool -> [CiteData] -> [CiteData]
forall a. Bool -> [a] -> [a]
when_ (Bool
hasNamesOpt Bool -> Bool -> Bool
|| Bool
hasGNameOpt) ([CiteData] -> [CiteData]) -> [CiteData] -> [CiteData]
forall a b. (a -> b) -> a -> b
$ GiveNameDisambiguation -> [CiteData] -> [CiteData]
disambAddNames GiveNameDisambiguation
giveNameDisamb ([CiteData] -> [CiteData]) -> [CiteData] -> [CiteData]
forall a b. (a -> b) -> a -> b
$ [CiteData]
needNames [CiteData] -> [CiteData] -> [CiteData]
forall a. [a] -> [a] -> [a]
++
                  if Bool
hasYSuffOpt Bool -> Bool -> Bool
&& GiveNameDisambiguation
giveNameDisamb GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
forall a. Eq a => a -> a -> Bool
== GiveNameDisambiguation
NoGiven then [] else [CiteData]
needYSuff

      newGName :: [NameData]
      newGName :: [NameData]
newGName  = Bool -> [NameData] -> [NameData]
forall a. Bool -> [a] -> [a]
when_ Bool
hasGNameOpt ([NameData] -> [NameData]) -> [NameData] -> [NameData]
forall a b. (a -> b) -> a -> b
$ ([NameData] -> [NameData]) -> [[NameData]] -> [NameData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [NameData] -> [NameData]
disambAddGivenNames [[NameData]]
nameDupls

      -- the list of citations that need re-evaluation with the
      -- \"disambiguate\" condition set to 'True'
      reEval :: [CiteData]
reEval      = let chk :: [CiteData] -> [CiteData]
chk = if Bool
hasYSuffOpt then (CiteData -> Bool) -> [CiteData] -> [CiteData]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
T.null (Text -> Bool) -> (CiteData -> Text) -> CiteData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CiteData -> Text
citYear) else [CiteData] -> [CiteData]
forall a. a -> a
id
                    in  [CiteData] -> [CiteData]
chk [CiteData]
needYSuff
      reEvaluated :: [CitationGroup]
reEvaluated = if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((IfThen -> [Bool]) -> Style -> [Bool]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query IfThen -> [Bool]
hasIfDis Style
s) Bool -> Bool -> Bool
&& Bool -> Bool
not ([CiteData] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CiteData]
reEval)
                    then ([(Cite, Maybe Reference)] -> CitationGroup -> CitationGroup)
-> [[(Cite, Maybe Reference)]]
-> [CitationGroup]
-> [CitationGroup]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Style
-> [CiteData]
-> [(Cite, Maybe Reference)]
-> CitationGroup
-> CitationGroup
reEvaluate Style
s [CiteData]
reEval) [[(Cite, Maybe Reference)]]
refs [CitationGroup]
groups
                    else [CitationGroup]
groups

      withYearS :: [CitationGroup]
withYearS = [CitationGroup] -> [CitationGroup]
addNames ([CitationGroup] -> [CitationGroup])
-> [CitationGroup] -> [CitationGroup]
forall a b. (a -> b) -> a -> b
$
                  if Bool
hasYSuffOpt
                     then (CitationGroup -> CitationGroup)
-> [CitationGroup] -> [CitationGroup]
forall a b. (a -> b) -> [a] -> [b]
map (([Output] -> [Output]) -> CitationGroup -> CitationGroup
mapCitationGroup
                               (Bool -> [CiteData] -> [Output] -> [Output]
setYearSuffCollision Bool
hasNamesOpt [CiteData]
needYSuff))
                              [CitationGroup]
reEvaluated
                     else [CitationGroup] -> [CitationGroup]
rmYearSuff [CitationGroup]
reEvaluated

      yearSuffs :: [(Text, Text)]
yearSuffs = Bool -> [(Text, Text)] -> [(Text, Text)]
forall a. Bool -> [a] -> [a]
when_ Bool
hasYSuffOpt ([(Text, Text)] -> [(Text, Text)])
-> ([CitationGroup] -> [(Text, Text)])
-> [CitationGroup]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Reference] -> [(Text, [Output])] -> [(Text, Text)]
generateYearSuffix [Reference]
bibs ([(Text, [Output])] -> [(Text, Text)])
-> ([CitationGroup] -> [(Text, [Output])])
-> [CitationGroup]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CitationGroup -> [(Text, [Output])])
-> [CitationGroup] -> [(Text, [Output])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CitationGroup -> [(Text, [Output])]
getYearSuffixes ([CitationGroup] -> [(Text, Text)])
-> [CitationGroup] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ [CitationGroup]
withYearS

      addNames :: [CitationGroup] -> [CitationGroup]
addNames  = (Output -> Output) -> [CitationGroup] -> [CitationGroup]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc (GiveNameDisambiguation
-> [CiteData] -> [NameData] -> Output -> Output
updateContrib GiveNameDisambiguation
giveNameDisamb [CiteData]
newNames [NameData]
newGName)
      processed :: [CitationGroup]
processed = if Bool
hasYSuffOpt
                  then (Output -> Output) -> [CitationGroup] -> [CitationGroup]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc ([(Text, Text)] -> Output -> Output
updateYearSuffixes [(Text, Text)]
yearSuffs) [CitationGroup]
withYearS
                  else [CitationGroup]
withYearS

      citOutput :: [CitationGroup]
citOutput = if [Text]
disOpts [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then [CitationGroup]
processed else [CitationGroup]
reEvaluated

mapDisambData :: (Output -> Output) -> CiteData -> CiteData
mapDisambData :: (Output -> Output) -> CiteData -> CiteData
mapDisambData f :: Output -> Output
f (CD k :: Text
k c :: [Output]
c ys :: [Output]
ys d :: [[Output]]
d r :: [Output]
r s :: [Text]
s y :: Text
y) = Text
-> [Output]
-> [Output]
-> [[Output]]
-> [Output]
-> [Text]
-> Text
-> CiteData
CD Text
k [Output]
c [Output]
ys ((Output -> Output) -> [[Output]] -> [[Output]]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
f [[Output]]
d) [Output]
r [Text]
s Text
y

mapCitationGroup :: ([Output] -> [Output]) -> CitationGroup ->  CitationGroup
mapCitationGroup :: ([Output] -> [Output]) -> CitationGroup -> CitationGroup
mapCitationGroup f :: [Output] -> [Output]
f (CG cs :: [(Cite, Output)]
cs fm :: Formatting
fm d :: Text
d os :: [(Cite, Output)]
os) = [(Cite, Output)]
-> Formatting -> Text -> [(Cite, Output)] -> CitationGroup
CG [(Cite, Output)]
cs Formatting
fm Text
d ([Cite] -> [Output] -> [(Cite, Output)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Cite, Output) -> Cite) -> [(Cite, Output)] -> [Cite]
forall a b. (a -> b) -> [a] -> [b]
map (Cite, Output) -> Cite
forall a b. (a, b) -> a
fst [(Cite, Output)]
os) ([Output] -> [(Cite, Output)])
-> ([Output] -> [Output]) -> [Output] -> [(Cite, Output)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> [Output]
f ([Output] -> [(Cite, Output)]) -> [Output] -> [(Cite, Output)]
forall a b. (a -> b) -> a -> b
$ ((Cite, Output) -> Output) -> [(Cite, Output)] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map (Cite, Output) -> Output
forall a b. (a, b) -> b
snd [(Cite, Output)]
os)

data GiveNameDisambiguation
    = NoGiven  -- TODO this is no longer used?
    | ByCite
    | AllNames
    | PrimaryName
    deriving (Int -> GiveNameDisambiguation -> ShowS
[GiveNameDisambiguation] -> ShowS
GiveNameDisambiguation -> String
(Int -> GiveNameDisambiguation -> ShowS)
-> (GiveNameDisambiguation -> String)
-> ([GiveNameDisambiguation] -> ShowS)
-> Show GiveNameDisambiguation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GiveNameDisambiguation] -> ShowS
$cshowList :: [GiveNameDisambiguation] -> ShowS
show :: GiveNameDisambiguation -> String
$cshow :: GiveNameDisambiguation -> String
showsPrec :: Int -> GiveNameDisambiguation -> ShowS
$cshowsPrec :: Int -> GiveNameDisambiguation -> ShowS
Show, GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
(GiveNameDisambiguation -> GiveNameDisambiguation -> Bool)
-> (GiveNameDisambiguation -> GiveNameDisambiguation -> Bool)
-> Eq GiveNameDisambiguation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
$c/= :: GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
== :: GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
$c== :: GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
Eq)

disambAddNames :: GiveNameDisambiguation -> [CiteData] -> [CiteData]
disambAddNames :: GiveNameDisambiguation -> [CiteData] -> [CiteData]
disambAddNames b :: GiveNameDisambiguation
b needName :: [CiteData]
needName = [CiteData]
addLNames
    where
      clean :: CiteData -> CiteData
clean     = if GiveNameDisambiguation
b GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
forall a. Eq a => a -> a -> Bool
== GiveNameDisambiguation
NoGiven then (Output -> Output) -> CiteData -> CiteData
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
rmHashAndGivenNames else CiteData -> CiteData
forall a. a -> a
id
      disSolved :: [(CiteData, [[Output]])]
disSolved = [CiteData] -> [[[Output]]] -> [(CiteData, [[Output]])]
forall a b. [a] -> [b] -> [(a, b)]
zip [CiteData]
needName' ([[[Output]]] -> [(CiteData, [[Output]])])
-> ([CiteData] -> [[[Output]]])
-> [CiteData]
-> [(CiteData, [[Output]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Output]]] -> [[[Output]]]
forall a. Eq a => [[a]] -> [[a]]
disambiguate ([[[Output]]] -> [[[Output]]])
-> ([CiteData] -> [[[Output]]]) -> [CiteData] -> [[[Output]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CiteData -> [[Output]]) -> [CiteData] -> [[[Output]]]
forall a b. (a -> b) -> [a] -> [b]
map CiteData -> [[Output]]
disambData ([CiteData] -> [(CiteData, [[Output]])])
-> [CiteData] -> [(CiteData, [[Output]])]
forall a b. (a -> b) -> a -> b
$ [CiteData]
needName'
      needName' :: [CiteData]
needName' = [CiteData] -> [CiteData] -> [CiteData]
nub' [CiteData]
needName []
      addLNames :: [CiteData]
addLNames = ((CiteData, [[Output]]) -> CiteData)
-> [(CiteData, [[Output]])] -> [CiteData]
forall a b. (a -> b) -> [a] -> [b]
map (\(c :: CiteData
c,n :: [[Output]]
n) -> CiteData
c { disambed :: [Output]
disambed = if [[Output]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Output]]
n then CiteData -> [Output]
collision CiteData
c else [[Output]] -> [Output]
forall a. [a] -> a
head [[Output]]
n }) [(CiteData, [[Output]])]
disSolved
      nub' :: [CiteData] -> [CiteData] -> [CiteData]
nub' []     r :: [CiteData]
r = [CiteData]
r
      nub' (x :: CiteData
x:xs :: [CiteData]
xs) r :: [CiteData]
r = case [[Output]] -> [[[Output]]] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (CiteData -> [[Output]]
disambData (CiteData -> [[Output]]) -> CiteData -> [[Output]]
forall a b. (a -> b) -> a -> b
$ CiteData -> CiteData
clean CiteData
x)
                           ((CiteData -> [[Output]]) -> [CiteData] -> [[[Output]]]
forall a b. (a -> b) -> [a] -> [b]
map (CiteData -> [[Output]]
disambData (CiteData -> [[Output]])
-> (CiteData -> CiteData) -> CiteData -> [[Output]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CiteData -> CiteData
clean) [CiteData]
r) of
                         Nothing -> [CiteData] -> [CiteData] -> [CiteData]
nub' [CiteData]
xs (CiteData
xCiteData -> [CiteData] -> [CiteData]
forall a. a -> [a] -> [a]
:[CiteData]
r)
                         Just i :: Int
i  -> let y :: CiteData
y = [CiteData]
r [CiteData] -> Int -> CiteData
forall a. [a] -> Int -> a
!! Int
i
                                    in [CiteData] -> [CiteData] -> [CiteData]
nub' [CiteData]
xs (CiteData
y {sameAs :: [Text]
sameAs = CiteData -> Text
key CiteData
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: CiteData -> [Text]
sameAs CiteData
y}
                                                 CiteData -> [CiteData] -> [CiteData]
forall a. a -> [a] -> [a]
: (CiteData -> Bool) -> [CiteData] -> [CiteData]
forall a. (a -> Bool) -> [a] -> [a]
filter (CiteData -> CiteData -> Bool
forall a. Eq a => a -> a -> Bool
/= CiteData
y) [CiteData]
r)

disambAddGivenNames :: [NameData] -> [NameData]
disambAddGivenNames :: [NameData] -> [NameData]
disambAddGivenNames needName :: [NameData]
needName = [NameData]
addGName
    where
      disSolved :: [(NameData, [[Output]])]
disSolved = [NameData] -> [[[Output]]] -> [(NameData, [[Output]])]
forall a b. [a] -> [b] -> [(a, b)]
zip [NameData]
needName ([[[Output]]] -> [[[Output]]]
forall a. Eq a => [[a]] -> [[a]]
disambiguate ([[[Output]]] -> [[[Output]]]) -> [[[Output]]] -> [[[Output]]]
forall a b. (a -> b) -> a -> b
$ (NameData -> [[Output]]) -> [NameData] -> [[[Output]]]
forall a b. (a -> b) -> [a] -> [b]
map NameData -> [[Output]]
nameDisambData [NameData]
needName)
      addGName :: [NameData]
addGName = ((NameData, [[Output]]) -> NameData)
-> [(NameData, [[Output]])] -> [NameData]
forall a b. (a -> b) -> [a] -> [b]
map (\(c :: NameData
c,n :: [[Output]]
n) -> NameData
c { nameDataSolved :: [Output]
nameDataSolved = if [[Output]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Output]]
n then NameData -> [Output]
nameCollision NameData
c else [[Output]] -> [Output]
forall a. [a] -> a
head [[Output]]
n }) [(NameData, [[Output]])]
disSolved

updateContrib :: GiveNameDisambiguation -> [CiteData] -> [NameData] -> Output -> Output
updateContrib :: GiveNameDisambiguation
-> [CiteData] -> [NameData] -> Output -> Output
updateContrib g :: GiveNameDisambiguation
g c :: [CiteData]
c n :: [NameData]
n o :: Output
o
    | OContrib k :: Text
k r :: Text
r s :: [Output]
s d :: [Output]
d dd :: [[Output]]
dd <- Output
o = case (CiteData -> Bool) -> [CiteData] -> [CiteData]
forall a. (a -> Bool) -> [a] -> [a]
filter (CiteData -> Text
key (CiteData -> Text)
-> (CiteData -> [Text]) -> CiteData -> (Text, [Text])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CiteData -> [Text]
sameAs (CiteData -> (Text, [Text]))
-> ((Text, [Text]) -> Bool) -> CiteData -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text -> [Text] -> [Text]) -> (Text, [Text]) -> [Text]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((Text, [Text]) -> [Text])
-> ([Text] -> Bool) -> (Text, [Text]) -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
k) [CiteData]
c of
                                  x :: CiteData
x:_ | [[Output]] -> [[Output]]
clean (CiteData -> [[Output]]
disambData CiteData
x) [[Output]] -> [[Output]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Output]] -> [[Output]]
clean ([Output]
d[Output] -> [[Output]] -> [[Output]]
forall a. a -> [a] -> [a]
:[[Output]]
dd) ->
                                          Text -> Text -> [Output] -> [Output] -> [[Output]] -> Output
OContrib Text
k Text
r ((Output -> Output) -> [Output] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map Output -> Output
processGNames ([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ CiteData -> [Output]
disambed CiteData
x) [] [[Output]]
dd
                                  _ | [CiteData] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CiteData]
c, GiveNameDisambiguation
AllNames <- GiveNameDisambiguation
g -> Text -> Text -> [Output] -> [Output] -> [[Output]] -> Output
OContrib Text
k Text
r ((Output -> Output) -> [Output] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map Output -> Output
processGNames [Output]
s) [Output]
d [[Output]]
dd
                                    | Bool
otherwise             -> Output
o
    | Bool
otherwise = Output
o
    where
      clean :: [[Output]] -> [[Output]]
clean         = if GiveNameDisambiguation
g GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
forall a. Eq a => a -> a -> Bool
== GiveNameDisambiguation
NoGiven then (Output -> Output) -> [[Output]] -> [[Output]]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
rmHashAndGivenNames else [[Output]] -> [[Output]]
forall a. a -> a
id
      processGNames :: Output -> Output
processGNames = if GiveNameDisambiguation
g GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
forall a. Eq a => a -> a -> Bool
/= GiveNameDisambiguation
NoGiven then [NameData] -> Output -> Output
updateOName [NameData]
n else Output -> Output
forall a. a -> a
id

updateOName :: [NameData] -> Output -> Output
updateOName :: [NameData] -> Output -> Output
updateOName n :: [NameData]
n o :: Output
o
    | OName _ _ [] _ <- Output
o = Output
o
    | OName k :: Agent
k x :: [Output]
x _  f :: Formatting
f <- Output
o = case NameData -> [NameData] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Agent -> [Output] -> [[Output]] -> [Output] -> NameData
ND Agent
k ([Output] -> [Output]
clean [Output]
x) [] []) [NameData]
n of
                              Just i :: Int
i -> Agent -> [Output] -> [[Output]] -> Formatting -> Output
OName Agent
emptyAgent (NameData -> [Output]
nameDataSolved (NameData -> [Output]) -> NameData -> [Output]
forall a b. (a -> b) -> a -> b
$ [NameData]
n [NameData] -> Int -> NameData
forall a. [a] -> Int -> a
!! Int
i) [] Formatting
f
                              _      -> Output
o
    | Bool
otherwise           = Output
o
    where
      clean :: [Output] -> [Output]
clean = (Output -> Output) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
rmGivenNames

-- | Evaluate again a citation group with the 'EvalState' 'disamb'
-- field set to 'True' (for matching the @\"disambiguate\"@
-- condition).
reEvaluate :: Style
           -> [CiteData]
           -> [(Cite, Maybe Reference)]
           -> CitationGroup
           -> CitationGroup
reEvaluate :: Style
-> [CiteData]
-> [(Cite, Maybe Reference)]
-> CitationGroup
-> CitationGroup
reEvaluate Style{citation :: Style -> Citation
citation = Citation
ct, csMacros :: Style -> [MacroMap]
csMacros = [MacroMap]
ms , styleLocale :: Style -> [Locale]
styleLocale = [Locale]
lo,
                   styleAbbrevs :: Style -> Abbreviations
styleAbbrevs = Abbreviations
as} l :: [CiteData]
l cr :: [(Cite, Maybe Reference)]
cr (CG a :: [(Cite, Output)]
a f :: Formatting
f d :: Text
d os :: [(Cite, Output)]
os)
    = [(Cite, Output)]
-> Formatting -> Text -> [(Cite, Output)] -> CitationGroup
CG [(Cite, Output)]
a Formatting
f Text
d ([(Cite, Output)] -> CitationGroup)
-> ((((Cite, Maybe Reference), (Cite, Output)) -> [(Cite, Output)])
    -> [(Cite, Output)])
-> (((Cite, Maybe Reference), (Cite, Output)) -> [(Cite, Output)])
-> CitationGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((((Cite, Maybe Reference), (Cite, Output)) -> [(Cite, Output)])
 -> [((Cite, Maybe Reference), (Cite, Output))] -> [(Cite, Output)])
-> [((Cite, Maybe Reference), (Cite, Output))]
-> (((Cite, Maybe Reference), (Cite, Output)) -> [(Cite, Output)])
-> [(Cite, Output)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Cite, Maybe Reference), (Cite, Output)) -> [(Cite, Output)])
-> [((Cite, Maybe Reference), (Cite, Output))] -> [(Cite, Output)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([(Cite, Maybe Reference)]
-> [(Cite, Output)] -> [((Cite, Maybe Reference), (Cite, Output))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Cite, Maybe Reference)]
cr [(Cite, Output)]
os) ((((Cite, Maybe Reference), (Cite, Output)) -> [(Cite, Output)])
 -> CitationGroup)
-> (((Cite, Maybe Reference), (Cite, Output)) -> [(Cite, Output)])
-> CitationGroup
forall a b. (a -> b) -> a -> b
$
      \((c :: Cite
c,mbr :: Maybe Reference
mbr),out :: (Cite, Output)
out) ->
         case Maybe Reference
mbr of
              Just r :: Reference
r | Literal -> Text
unLiteral (Reference -> Literal
refId Reference
r) Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
lkeys ->
                (Cite, Output) -> [(Cite, Output)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Cite, Output) -> [(Cite, Output)])
-> ((Cite, [Output]) -> (Cite, Output))
-> (Cite, [Output])
-> [(Cite, Output)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Output] -> Output) -> (Cite, [Output]) -> (Cite, Output)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Output] -> Formatting -> Output)
-> Formatting -> [Output] -> Output
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Output] -> Formatting -> Output
Output Formatting
emptyFormatting) ((Cite, [Output]) -> [(Cite, Output)])
-> (Cite, [Output]) -> [(Cite, Output)]
forall a b. (a -> b) -> a -> b
$
                      (,) Cite
c ([Output] -> (Cite, [Output])) -> [Output] -> (Cite, [Output])
forall a b. (a -> b) -> a -> b
$ Layout
-> EvalMode
-> Bool
-> [Locale]
-> [MacroMap]
-> [(Text, Text)]
-> Abbreviations
-> Maybe Reference
-> [Output]
evalLayout (Citation -> Layout
citLayout Citation
ct) (Cite -> EvalMode
EvalCite Cite
c) Bool
True [Locale]
lo [MacroMap]
ms (Citation -> [(Text, Text)]
citOptions Citation
ct) Abbreviations
as Maybe Reference
mbr
              _ -> [(Cite, Output)
out]
        where lkeys :: [Text]
lkeys = (CiteData -> Text) -> [CiteData] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map CiteData -> Text
key [CiteData]
l

-- | Check if the 'Style' has any conditional for disambiguation. In
-- this case the conditional will be try after all other
-- disambiguation strategies have failed. To be used with the generic
-- 'query' function.
hasIfDis :: IfThen -> [Bool]
hasIfDis :: IfThen -> [Bool]
hasIfDis (IfThen Condition{disambiguation :: Condition -> [Text]
disambiguation = (_:_)} _ _) = [Bool
True]
hasIfDis _                                              = [Bool
False]

-- | Get the list of disambiguation options set in the 'Style' for
-- citations.
getCitDisambOptions :: Style -> [Text]
getCitDisambOptions :: Style -> [Text]
getCitDisambOptions
    = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst ([(Text, Text)] -> [Text])
-> (Style -> [(Text, Text)]) -> Style -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) "true" (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd) ([(Text, Text)] -> [(Text, Text)])
-> (Style -> [(Text, Text)]) -> Style -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isPrefixOf "disambiguate" (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Text)] -> [(Text, Text)])
-> (Style -> [(Text, Text)]) -> Style -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(Text, Text)]
citOptions (Citation -> [(Text, Text)])
-> (Style -> Citation) -> Style -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation

-- | Group citation data (with possible alternative names) of
-- citations which have a duplicate (same 'collision', and same
-- 'citYear' if year suffix disambiiguation is used). If the first
-- 'Bool' is 'False', then we need to retrieve data for year suffix
-- disambiguation. The second 'Bool' is 'True' when comparing both
-- year and contributors' names for finding duplicates (when the
-- year-suffix option is set).
getDuplCiteData :: GiveNameDisambiguation -> Bool -> Bool -> [CitationGroup] -> [[CiteData]]
getDuplCiteData :: GiveNameDisambiguation
-> Bool -> Bool -> [CitationGroup] -> [[CiteData]]
getDuplCiteData giveNameDisamb :: GiveNameDisambiguation
giveNameDisamb b1 :: Bool
b1 b2 :: Bool
b2 g :: [CitationGroup]
g
    = (CiteData -> CiteData -> Bool) -> [CiteData] -> [[CiteData]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\x :: CiteData
x y :: CiteData
y -> CiteData -> [Output]
collide CiteData
x [Output] -> [Output] -> Bool
forall a. Eq a => a -> a -> Bool
== CiteData -> [Output]
collide CiteData
y) ([CiteData] -> [[CiteData]])
-> ([CiteData] -> [CiteData]) -> [CiteData] -> [[CiteData]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CiteData -> [Output]) -> [CiteData] -> [CiteData]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn CiteData -> [Output]
collide
      ([CiteData] -> [[CiteData]]) -> [CiteData] -> [[CiteData]]
forall a b. (a -> b) -> a -> b
$ [CiteData]
duplicates
    where
      whatToGet :: CiteData -> [Output]
whatToGet  = if Bool
b1 then CiteData -> [Output]
collision else CiteData -> [Output]
disambYS
      collide :: CiteData -> [Output]
collide    = ([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc (GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
giveNameDisamb) ([Output] -> [Output])
-> (CiteData -> [Output]) -> CiteData -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   (Output -> Output) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
rmHashAndGivenNames ([Output] -> [Output])
-> (CiteData -> [Output]) -> CiteData -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   CiteData -> [Output]
whatToGet
      citeData :: [CiteData]
citeData   = (CiteData -> CiteData -> Bool) -> [CiteData] -> [CiteData]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\a :: CiteData
a b :: CiteData
b -> CiteData -> [Output]
collide CiteData
a [Output] -> [Output] -> Bool
forall a. Eq a => a -> a -> Bool
== CiteData -> [Output]
collide CiteData
b Bool -> Bool -> Bool
&& CiteData -> Text
key CiteData
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== CiteData -> Text
key CiteData
b) ([CiteData] -> [CiteData]) -> [CiteData] -> [CiteData]
forall a b. (a -> b) -> a -> b
$
                   (CitationGroup -> [CiteData]) -> [CitationGroup] -> [CiteData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Output -> [CiteData]) -> CitationGroup -> [CiteData]
forall a. (Output -> [a]) -> CitationGroup -> [a]
mapGroupOutput Output -> [CiteData]
getCiteData) [CitationGroup]
g
      duplicates :: [CiteData]
duplicates = [CiteData
c | CiteData
c <- [CiteData]
citeData , CiteData
d <- [CiteData]
citeData , CiteData -> CiteData -> Bool
collides CiteData
c CiteData
d]
      collides :: CiteData -> CiteData -> Bool
collides x :: CiteData
x y :: CiteData
y = CiteData
x CiteData -> CiteData -> Bool
forall a. Eq a => a -> a -> Bool
/= CiteData
y Bool -> Bool -> Bool
&& (CiteData -> [Output]
collide CiteData
x [Output] -> [Output] -> Bool
forall a. Eq a => a -> a -> Bool
== CiteData -> [Output]
collide CiteData
y)
                            Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
b2 Bool -> Bool -> Bool
|| CiteData -> Text
citYear CiteData
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== CiteData -> Text
citYear CiteData
y)

rmExtras :: GiveNameDisambiguation -> [Output] -> [Output]
rmExtras :: GiveNameDisambiguation -> [Output] -> [Output]
rmExtras g :: GiveNameDisambiguation
g os :: [Output]
os
    | Output         x :: [Output]
x _ : xs :: [Output]
xs <- [Output]
os = case GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
x of
                                           [] -> GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
                                           ys :: [Output]
ys -> [Output]
ys [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
    | OContrib _ _ (y :: Output
y:ys :: [Output]
ys) _ _ : xs :: [Output]
xs <- [Output]
os
                                    = if GiveNameDisambiguation
g GiveNameDisambiguation -> GiveNameDisambiguation -> Bool
forall a. Eq a => a -> a -> Bool
== GiveNameDisambiguation
PrimaryName
                                         then Text -> Text -> [Output] -> [Output] -> [[Output]] -> Output
OContrib "" "" [Output
y] [] [] Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
                                         else Text -> Text -> [Output] -> [Output] -> [[Output]] -> Output
OContrib "" "" (Output
yOutput -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:[Output]
ys) [] [] Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
    | OYear{}            : xs :: [Output]
xs <- [Output]
os = GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
    | OYearSuf{}         : xs :: [Output]
xs <- [Output]
os = GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
    | OLabel{}           : xs :: [Output]
xs <- [Output]
os = GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
    | ODel             _ : xs :: [Output]
xs <- [Output]
os = GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
    | OLoc           _ _ : xs :: [Output]
xs <- [Output]
os = GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
    | x :: Output
x                  : xs :: [Output]
xs <- [Output]
os = Output
x Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
    | Bool
otherwise                     = []

-- | For an evaluated citation get its 'CiteData'. The disambiguated
-- citation and the year fields are empty. Only the first list of
-- contributors' disambiguation data are collected for disambiguation
-- purposes.
getCiteData :: Output -> [CiteData]
getCiteData :: Output -> [CiteData]
getCiteData out :: Output
out
    = (Output -> [CiteData]
forall b. Data b => b -> [CiteData]
contribs (Output -> [CiteData])
-> (Output -> [(Text, Text)])
-> Output
-> ([CiteData], [(Text, Text)])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Output -> [(Text, Text)]
forall b. Data b => b -> [(Text, Text)]
years (Output -> ([CiteData], [(Text, Text)]))
-> (([CiteData], [(Text, Text)]) -> [CiteData])
-> Output
-> [CiteData]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([CiteData], [(Text, Text)]) -> [CiteData]
zipData) Output
out
    where
      contribs :: b -> [CiteData]
contribs x :: b
x = case (Output -> [CiteData]) -> b -> [CiteData]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [CiteData]
contribsQ b
x of
                        [] -> [Text
-> [Output]
-> [Output]
-> [[Output]]
-> [Output]
-> [Text]
-> Text
-> CiteData
CD "" [Output
out] [] [] [] [] ""]
                              -- allow title to disambiguate
                        xs :: [CiteData]
xs -> [CiteData]
xs
      years :: b -> [(Text, Text)]
years o :: b
o = case (Output -> [(Text, Text)]) -> b -> [(Text, Text)]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [(Text, Text)]
getYears b
o of
                     [] -> [("","")]
                     r :: [(Text, Text)]
r  -> [(Text, Text)]
r
      zipData :: ([CiteData], [(Text, Text)]) -> [CiteData]
zipData = ([CiteData] -> [(Text, Text)] -> [CiteData])
-> ([CiteData], [(Text, Text)]) -> [CiteData]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([CiteData] -> [(Text, Text)] -> [CiteData])
 -> ([CiteData], [(Text, Text)]) -> [CiteData])
-> ((CiteData -> (Text, Text) -> CiteData)
    -> [CiteData] -> [(Text, Text)] -> [CiteData])
-> (CiteData -> (Text, Text) -> CiteData)
-> ([CiteData], [(Text, Text)])
-> [CiteData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CiteData -> (Text, Text) -> CiteData)
-> [CiteData] -> [(Text, Text)] -> [CiteData]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((CiteData -> (Text, Text) -> CiteData)
 -> ([CiteData], [(Text, Text)]) -> [CiteData])
-> (CiteData -> (Text, Text) -> CiteData)
-> ([CiteData], [(Text, Text)])
-> [CiteData]
forall a b. (a -> b) -> a -> b
$ \c :: CiteData
c y :: (Text, Text)
y -> if CiteData -> Text
key CiteData
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= ""
                                            then CiteData
c {citYear :: Text
citYear = (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
y}
                                            else CiteData
c {key :: Text
key     = (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
y
                                                   ,citYear :: Text
citYear = (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
y}
      contribsQ :: Output -> [CiteData]
contribsQ o :: Output
o
          | OContrib k :: Text
k _ _ d :: [Output]
d dd :: [[Output]]
dd <- Output
o = [Text
-> [Output]
-> [Output]
-> [[Output]]
-> [Output]
-> [Text]
-> Text
-> CiteData
CD Text
k [Output
out] [Output]
d ([Output]
d[Output] -> [[Output]] -> [[Output]]
forall a. a -> [a] -> [a]
:[[Output]]
dd) [] [] ""]
          | Bool
otherwise                = []

getYears :: Output -> [(Text,Text)]
getYears :: Output -> [(Text, Text)]
getYears o :: Output
o
    | OYear x :: Text
x k :: Text
k _ <- Output
o = [(Text
k,Text
x)]
    | Bool
otherwise        = []

getDuplNameData :: [CitationGroup] -> [[NameData]]
getDuplNameData :: [CitationGroup] -> [[NameData]]
getDuplNameData g :: [CitationGroup]
g
    = (NameData -> NameData -> Bool) -> [NameData] -> [[NameData]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\a :: NameData
a b :: NameData
b -> NameData -> [Output]
collide NameData
a [Output] -> [Output] -> Bool
forall a. Eq a => a -> a -> Bool
== NameData -> [Output]
collide NameData
b) ([NameData] -> [[NameData]])
-> ([NameData] -> [NameData]) -> [NameData] -> [[NameData]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameData -> [Output]) -> [NameData] -> [NameData]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn NameData -> [Output]
collide ([NameData] -> [[NameData]]) -> [NameData] -> [[NameData]]
forall a b. (a -> b) -> a -> b
$ [NameData]
duplicates
    where
      collide :: NameData -> [Output]
collide    = NameData -> [Output]
nameCollision
      nameData :: [NameData]
nameData   = [NameData] -> [NameData]
forall a. Eq a => [a] -> [a]
nub ([NameData] -> [NameData]) -> [NameData] -> [NameData]
forall a b. (a -> b) -> a -> b
$ (CitationGroup -> [NameData]) -> [CitationGroup] -> [NameData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Output -> [NameData]) -> CitationGroup -> [NameData]
forall a. (Output -> [a]) -> CitationGroup -> [a]
mapGroupOutput Output -> [NameData]
getName) [CitationGroup]
g
      duplicates :: [NameData]
duplicates = (NameData -> Bool) -> [NameData] -> [NameData]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Output] -> [[Output]] -> Bool) -> [[Output]] -> [Output] -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Output] -> [[Output]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([CitationGroup] -> [[Output]]
getDuplNames [CitationGroup]
g) ([Output] -> Bool) -> (NameData -> [Output]) -> NameData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameData -> [Output]
collide) [NameData]
nameData

getDuplNames :: [CitationGroup] -> [[Output]]
getDuplNames :: [CitationGroup] -> [[Output]]
getDuplNames = [[Output]] -> [[Output]]
forall a. Ord a => [a] -> [a]
ordNub ([[Output]] -> [[Output]])
-> ([CitationGroup] -> [[Output]]) -> [CitationGroup] -> [[Output]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [Output]] -> [[Output]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Output]] -> [[Output]])
-> ([CitationGroup] -> [Maybe [Output]])
-> [CitationGroup]
-> [[Output]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NameData], [Maybe [Output]]) -> [Maybe [Output]]
forall a b. (a, b) -> b
snd (([NameData], [Maybe [Output]]) -> [Maybe [Output]])
-> ([CitationGroup] -> ([NameData], [Maybe [Output]]))
-> [CitationGroup]
-> [Maybe [Output]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NameData] -> NameData -> ([NameData], Maybe [Output]))
-> [NameData] -> [NameData] -> ([NameData], [Maybe [Output]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL [NameData] -> NameData -> ([NameData], Maybe [Output])
dupl [] ([NameData] -> ([NameData], [Maybe [Output]]))
-> ([CitationGroup] -> [NameData])
-> [CitationGroup]
-> ([NameData], [Maybe [Output]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CitationGroup] -> [NameData]
getData
    where
      getData :: [CitationGroup] -> [NameData]
getData = (CitationGroup -> [NameData]) -> [CitationGroup] -> [NameData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Output -> [NameData]) -> CitationGroup -> [NameData]
forall a. (Output -> [a]) -> CitationGroup -> [a]
mapGroupOutput Output -> [NameData]
getName)
      dupl :: [NameData] -> NameData -> ([NameData], Maybe [Output])
dupl a :: [NameData]
a c :: NameData
c = if NameData -> [Output]
nameCollision NameData
c [Output] -> [[Output]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (NameData -> [Output]) -> [NameData] -> [[Output]]
forall a b. (a -> b) -> [a] -> [b]
map NameData -> [Output]
nameCollision [NameData]
a
                 then ([NameData]
a,[Output] -> Maybe [Output]
forall a. a -> Maybe a
Just ([Output] -> Maybe [Output]) -> [Output] -> Maybe [Output]
forall a b. (a -> b) -> a -> b
$ NameData -> [Output]
nameCollision NameData
c)
                 else (NameData
cNameData -> [NameData] -> [NameData]
forall a. a -> [a] -> [a]
:[NameData]
a,Maybe [Output]
forall a. Maybe a
Nothing)

getName :: Output -> [NameData]
getName :: Output -> [NameData]
getName = (Output -> [NameData]) -> Output -> [NameData]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [NameData]
getName'
    where
      getName' :: Output -> [NameData]
getName' o :: Output
o
          | OName i :: Agent
i n :: [Output]
n ns :: [[Output]]
ns _ <- Output
o = [Agent -> [Output] -> [[Output]] -> [Output] -> NameData
ND Agent
i [Output]
n ([Output]
n[Output] -> [[Output]] -> [[Output]]
forall a. a -> [a] -> [a]
:[[Output]]
ns) []]
          | Bool
otherwise           = []

generateYearSuffix :: [Reference] -> [(Text, [Output])] -> [(Text,Text)]
generateYearSuffix :: [Reference] -> [(Text, [Output])] -> [(Text, Text)]
generateYearSuffix refs :: [Reference]
refs
    = ([Text] -> [(Text, Text)]) -> [[Text]] -> [(Text, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Text]
suffs) ([[Text]] -> [(Text, Text)])
-> ([(Text, [Output])] -> [[Text]])
-> [(Text, [Output])]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      -- sort clashing cites using their position in the sorted bibliography
      [[(Text, Int)]] -> [[Text]]
forall b b. [[(b, b)]] -> [[b]]
getFst ([[(Text, Int)]] -> [[Text]])
-> ([(Text, [Output])] -> [[(Text, Int)]])
-> [(Text, [Output])]
-> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [(Text, Int)]) -> [[Text]] -> [[(Text, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map ([(Text, Int)] -> [(Text, Int)]
forall a b. (Ord a, Ord b) => [(a, b)] -> [(a, b)]
sort' ([(Text, Int)] -> [(Text, Int)])
-> ([Text] -> [(Text, Int)]) -> [Text] -> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Int) -> Bool) -> [(Text, Int)] -> [(Text, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(/=) 0 (Int -> Bool) -> ((Text, Int) -> Int) -> (Text, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Text, Int)] -> [(Text, Int)])
-> ([Text] -> [(Text, Int)]) -> [Text] -> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> (Text, Int)) -> [Text] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, Int)
getP) ([[Text]] -> [[(Text, Int)]])
-> ([(Text, [Output])] -> [[Text]])
-> [(Text, [Output])]
-> [[(Text, Int)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      -- group clashing cites
      [[(Text, [Output])]] -> [[Text]]
forall b b. [[(b, b)]] -> [[b]]
getFst ([[(Text, [Output])]] -> [[Text]])
-> ([(Text, [Output])] -> [[(Text, [Output])]])
-> [(Text, [Output])]
-> [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, [Output])] -> Bool)
-> [[(Text, [Output])]] -> [[(Text, [Output])]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\grp :: [(Text, [Output])]
grp -> [(Text, [Output])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, [Output])]
grp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2) ([[(Text, [Output])]] -> [[(Text, [Output])]])
-> ([(Text, [Output])] -> [[(Text, [Output])]])
-> [(Text, [Output])]
-> [[(Text, [Output])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, [Output])] -> [(Text, [Output])])
-> [[(Text, [Output])]] -> [[(Text, [Output])]]
forall a b. (a -> b) -> [a] -> [b]
map [(Text, [Output])] -> [(Text, [Output])]
forall a. Eq a => [a] -> [a]
nub ([[(Text, [Output])]] -> [[(Text, [Output])]])
-> ([(Text, [Output])] -> [[(Text, [Output])]])
-> [(Text, [Output])]
-> [[(Text, [Output])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ((Text, [Output]) -> (Text, [Output]) -> Bool)
-> [(Text, [Output])] -> [[(Text, [Output])]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\a :: (Text, [Output])
a b :: (Text, [Output])
b -> (Text, [Output]) -> [Output]
forall a b. (a, b) -> b
snd (Text, [Output])
a [Output] -> [Output] -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, [Output]) -> [Output]
forall a b. (a, b) -> b
snd (Text, [Output])
b) ([(Text, [Output])] -> [[(Text, [Output])]])
-> ([(Text, [Output])] -> [(Text, [Output])])
-> [(Text, [Output])]
-> [[(Text, [Output])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [(Text, [Output])] -> [(Text, [Output])]
forall a b. (Ord a, Ord b) => [(a, b)] -> [(a, b)]
sort' ([(Text, [Output])] -> [(Text, [Output])])
-> ([(Text, [Output])] -> [(Text, [Output])])
-> [(Text, [Output])]
-> [(Text, [Output])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, [Output]) -> Bool)
-> [(Text, [Output])] -> [(Text, [Output])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Text, [Output]) -> Bool) -> (Text, [Output]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Output] -> Bool)
-> ((Text, [Output]) -> [Output]) -> (Text, [Output]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Output]) -> [Output]
forall a b. (a, b) -> b
snd)
    where
      sort'  :: (Ord a, Ord b) => [(a,b)] -> [(a,b)]
      sort' :: [(a, b)] -> [(a, b)]
sort'  = ((a, b) -> b) -> [(a, b)] -> [(a, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (a, b) -> b
forall a b. (a, b) -> b
snd
      getFst :: [[(b, b)]] -> [[b]]
getFst = ([(b, b)] -> [b]) -> [[(b, b)]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map (([(b, b)] -> [b]) -> [[(b, b)]] -> [[b]])
-> ([(b, b)] -> [b]) -> [[(b, b)]] -> [[b]]
forall a b. (a -> b) -> a -> b
$ ((b, b) -> b) -> [(b, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, b) -> b
forall a b. (a, b) -> a
fst
      getP :: Text -> (Text, Int)
getP k :: Text
k = case (Reference -> Bool) -> [Reference] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
k (Text -> Bool) -> (Reference -> Text) -> Reference -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Text
unLiteral (Literal -> Text) -> (Reference -> Literal) -> Reference -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Literal
refId) [Reference]
refs of
                   Just x :: Int
x -> (Text
k, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
                   _      -> (Text
k,     0)
      suffs :: [Text]
suffs = [Text]
letters [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y | Text
x <- [Text]
letters, Text
y <- [Text]
letters ]
      letters :: [Text]
letters = (Char -> Text) -> String -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton ['a'..'z']

setYearSuffCollision :: Bool -> [CiteData] -> [Output] -> [Output]
setYearSuffCollision :: Bool -> [CiteData] -> [Output] -> [Output]
setYearSuffCollision b :: Bool
b cs :: [CiteData]
cs = (Output -> Output) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc ([CiteData] -> Output -> Output
forall (t :: * -> *). Foldable t => t CiteData -> Output -> Output
setYS [CiteData]
cs) ([Output] -> [Output])
-> ([Output] -> [Output]) -> [Output] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Output -> Output) -> [Output] -> [Output]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Output
x -> if Output -> Bool
hasYearSuf Output
x then Output
x else Output -> Output
addYearSuffix Output
x)
    where
      setYS :: t CiteData -> Output -> Output
setYS c :: t CiteData
c o :: Output
o
          | OYearSuf _ k :: Text
k _ f :: Formatting
f <- Output
o = Text -> Text -> [Output] -> Formatting -> Output
OYearSuf "" Text
k (Text -> t CiteData -> [Output]
forall (t :: * -> *). Foldable t => Text -> t CiteData -> [Output]
getCollision Text
k t CiteData
c) Formatting
f
          | Bool
otherwise             = Output
o
      collide :: CiteData -> [Output]
collide = if Bool
b then CiteData -> [Output]
disambed else CiteData -> [Output]
disambYS
      getCollision :: Text -> t CiteData -> [Output]
getCollision k :: Text
k c :: t CiteData
c = case (CiteData -> Bool) -> t CiteData -> Maybe CiteData
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
k (Text -> Bool) -> (CiteData -> Text) -> CiteData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CiteData -> Text
key) t CiteData
c of
                           Just x :: CiteData
x -> case CiteData -> [Output]
collide CiteData
x of
                                        [] -> [Text -> Formatting -> Output
OStr (CiteData -> Text
citYear CiteData
x) Formatting
emptyFormatting]
                                        ys :: [Output]
ys -> [Output]
ys
                           _      -> []

updateYearSuffixes :: [(Text, Text)] -> Output -> Output
updateYearSuffixes :: [(Text, Text)] -> Output -> Output
updateYearSuffixes yss :: [(Text, Text)]
yss o :: Output
o
 | OYearSuf _ k :: Text
k c :: [Output]
c f :: Formatting
f <- Output
o = case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Text)]
yss of
                             Just x :: Text
x -> Text -> Text -> [Output] -> Formatting -> Output
OYearSuf Text
x Text
k [Output]
c Formatting
f
                             _      -> Output
ONull
 | Bool
otherwise             = Output
o

getYearSuffixes :: CitationGroup -> [(Text,[Output])]
getYearSuffixes :: CitationGroup -> [(Text, [Output])]
getYearSuffixes (CG _ _ _ d :: [(Cite, Output)]
d) = ((Cite, Output) -> (Text, [Output]))
-> [(Cite, Output)] -> [(Text, [Output])]
forall a b. (a -> b) -> [a] -> [b]
map (Cite, Output) -> (Text, [Output])
go [(Cite, Output)]
d
  where go :: (Cite, Output) -> (Text, [Output])
go (c :: Cite
c,x :: Output
x) = (Cite -> Text
citeId Cite
c, Bool -> [Output] -> [Output]
relevant Bool
False [Output
x])
        relevant :: Bool -> [Output] -> [Output] -- bool is true if has contrib
        -- we're only interested in OContrib and OYear,
        -- unless there is no OContrib
        relevant :: Bool -> [Output] -> [Output]
relevant c :: Bool
c (Output xs :: [Output]
xs _ : rest :: [Output]
rest) = Bool -> [Output] -> [Output]
relevant Bool
c [Output]
xs [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ Bool -> [Output] -> [Output]
relevant Bool
c [Output]
rest
        relevant c :: Bool
c (OYear n :: Text
n _ _ : rest :: [Output]
rest) = Text -> Formatting -> Output
OStr Text
n Formatting
emptyFormatting Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: Bool -> [Output] -> [Output]
relevant Bool
c [Output]
rest
        relevant c :: Bool
c (ODate xs :: [Output]
xs : rest :: [Output]
rest)    = Bool -> [Output] -> [Output]
relevant Bool
c [Output]
xs [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ Bool -> [Output] -> [Output]
relevant Bool
c [Output]
rest
        relevant False (OStr s :: Text
s _    : rest :: [Output]
rest) = Text -> Formatting -> Output
OStr Text
s Formatting
emptyFormatting Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: Bool -> [Output] -> [Output]
relevant Bool
False [Output]
rest
        relevant False (OSpace      : rest :: [Output]
rest) = Output
OSpace Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: Bool -> [Output] -> [Output]
relevant Bool
False [Output]
rest
        relevant False (OPan ils :: [Inline]
ils    : rest :: [Output]
rest) = [Inline] -> Output
OPan [Inline]
ils Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: Bool -> [Output] -> [Output]
relevant Bool
False [Output]
rest
        relevant _ (OContrib _ _ v :: [Output]
v _ _ : rest :: [Output]
rest ) = Bool -> [Output] -> [Output]
relevant Bool
False [Output]
v [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ Bool -> [Output] -> [Output]
relevant Bool
True [Output]
rest
        relevant c :: Bool
c (OName _ v :: [Output]
v _ _ : rest :: [Output]
rest ) = Bool -> [Output] -> [Output]
relevant Bool
c [Output]
v [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ Bool -> [Output] -> [Output]
relevant Bool
c [Output]
rest
        relevant c :: Bool
c (_           : rest :: [Output]
rest) = Bool -> [Output] -> [Output]
relevant Bool
c [Output]
rest
        relevant _ []                   = []

rmYearSuff :: [CitationGroup] -> [CitationGroup]
rmYearSuff :: [CitationGroup] -> [CitationGroup]
rmYearSuff = (Output -> Output) -> [CitationGroup] -> [CitationGroup]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
rmYS
    where
      rmYS :: Output -> Output
rmYS o :: Output
o
          | OYearSuf{}   <- Output
o = Output
ONull
          | Bool
otherwise         = Output
o

-- List Utilities

-- | Try to disambiguate a list of lists by returning the first non
-- colliding element, if any, of each list:
--
-- > disambiguate [[1,2],[1,3],[2]] = [[2],[3],[2]]
disambiguate :: (Eq a) => [[a]] -> [[a]]
disambiguate :: [[a]] -> [[a]]
disambiguate [] = []
disambiguate l :: [[a]]
l
    = if  [[a]] -> Bool
forall a. [[a]] -> Bool
hasMult [[a]]
l Bool -> Bool -> Bool
&& Bool -> Bool
not ([[a]] -> Bool
forall a. Eq a => [a] -> Bool
allTheSame [[a]]
l) Bool -> Bool -> Bool
&& [[a]] -> Bool
forall a. Eq a => [a] -> Bool
hasDuplicates [[a]]
heads
      then [[a]] -> [[a]]
forall a. Eq a => [[a]] -> [[a]]
disambiguate ([[a]] -> [[a]]
forall a. [[a]] -> [[a]]
rest [[a]]
l)
      else [[a]]
heads
    where
      heads :: [[a]]
heads = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take 1) [[a]]
l
      rest :: [[a]] -> [[a]]
rest  = ((Bool, [a]) -> [a]) -> [(Bool, [a])] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (\(b :: Bool
b,x :: [a]
x) -> if Bool
b then [a] -> [a]
forall a. [a] -> [a]
tail_ [a]
x else Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take 1 [a]
x) ([(Bool, [a])] -> [[a]])
-> ([[a]] -> [(Bool, [a])]) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [[a]] -> [(Bool, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[a]] -> [Bool]
forall a. Eq a => [a] -> [Bool]
same [[a]]
heads)

      hasMult :: [[a]] -> Bool
hasMult = ([a] -> Bool -> Bool) -> Bool -> [[a]] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\x :: [a]
x -> Bool -> Bool -> Bool
(||) ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1)) Bool
False

      tail_ :: [a] -> [a]
tail_ [x :: a
x] = [a
x]
      tail_  x :: [a]
x  = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
x then [a]
x else [a] -> [a]
forall a. [a] -> [a]
tail [a]
x

-- | For each element a list of 'Bool': 'True' if the element has a
-- duplicate in the list:
--
-- > same [1,2,1] = [True,False,True]
same :: Eq a => [a] -> [Bool]
same :: [a] -> [Bool]
same l :: [a]
l = (a -> Bool) -> [a] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
dupl) [a]
l
    where
      dupl :: [a]
dupl = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> [a]) -> ([a] -> [Maybe a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [Maybe a]) -> [Maybe a]
forall a b. (a, b) -> b
snd (([a], [Maybe a]) -> [Maybe a])
-> ([a] -> ([a], [Maybe a])) -> [a] -> [Maybe a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> ([a], [Maybe a])
macc [] ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
l
      macc :: [a] -> [a] -> ([a], [Maybe a])
macc = ([a] -> a -> ([a], Maybe a)) -> [a] -> [a] -> ([a], [Maybe a])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (([a] -> a -> ([a], Maybe a)) -> [a] -> [a] -> ([a], [Maybe a]))
-> ([a] -> a -> ([a], Maybe a)) -> [a] -> [a] -> ([a], [Maybe a])
forall a b. (a -> b) -> a -> b
$ \a :: [a]
a x :: a
x -> if a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
a
                                 then ([a]
a,a -> Maybe a
forall a. a -> Maybe a
Just a
x)
                                 else (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
a,Maybe a
forall a. Maybe a
Nothing)

hasDuplicates :: Eq a => [a] -> Bool
hasDuplicates :: [a] -> Bool
hasDuplicates = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> ([a] -> [Bool]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [Bool]
forall a. Eq a => [a] -> [Bool]
same

allTheSame :: Eq a => [a] -> Bool
allTheSame :: [a] -> Bool
allTheSame []     = Bool
True
allTheSame (x :: a
x:xs :: [a]
xs) = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) [a]
xs

-- | Add the year suffix to the year. Needed for disambiguation.
addYearSuffix :: Output -> Output
addYearSuffix :: Output -> Output
addYearSuffix o :: Output
o
    | OYear y :: Text
y k :: Text
k     f :: Formatting
f <- Output
o = [Output] -> Formatting -> Output
Output [ Text -> Text -> Formatting -> Output
OYear Text
y Text
k Formatting
emptyFormatting
                                    , Text -> Text -> [Output] -> Formatting -> Output
OYearSuf "" Text
k [] Formatting
emptyFormatting] Formatting
f
    | ODate  (x :: Output
x:xs :: [Output]
xs)   <- Output
o = if (Output -> Bool) -> [Output] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Output -> Bool
hasYear [Output]
xs
                             then [Output] -> Formatting -> Output
Output (Output
x Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [Output -> Output
addYearSuffix (Output -> Output) -> Output -> Output
forall a b. (a -> b) -> a -> b
$ [Output] -> Output
ODate [Output]
xs]) Formatting
emptyFormatting
                             else Output -> Output
addYearSuffix ([Output] -> Formatting -> Output
Output (Output
xOutput -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:[Output]
xs) Formatting
emptyFormatting)
    | Output (x :: Output
x:xs :: [Output]
xs) f :: Formatting
f <- Output
o = if (Output -> Bool) -> [Output] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Output -> Bool
hasYearSuf (Output
x Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [Output]
xs)
                             then [Output] -> Formatting -> Output
Output (Output
x Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [Output]
xs) Formatting
f
                             else if Output -> Bool
hasYear Output
x
                                  then [Output] -> Formatting -> Output
Output (Output -> Output
addYearSuffix Output
x Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [Output]
xs) Formatting
f
                                  else [Output] -> Formatting -> Output
Output (Output
x Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [Output -> Output
addYearSuffix (Output -> Output) -> Output -> Output
forall a b. (a -> b) -> a -> b
$ [Output] -> Formatting -> Output
Output [Output]
xs Formatting
emptyFormatting]) Formatting
f
    | Bool
otherwise            = Output
o

hasYear :: Output -> Bool
hasYear :: Output -> Bool
hasYear = Bool -> Bool
not (Bool -> Bool) -> (Output -> Bool) -> Output -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Output] -> Bool) -> (Output -> [Output]) -> Output -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> [Output]) -> Output -> [Output]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [Output]
getYear
    where getYear :: Output -> [Output]
getYear o :: Output
o
              | OYear{}   <- Output
o = [Output
o]
              | Bool
otherwise      = []


hasYearSuf :: Output -> Bool
hasYearSuf :: Output -> Bool
hasYearSuf = Bool -> Bool
not (Bool -> Bool) -> (Output -> Bool) -> Output -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> (Output -> [Text]) -> Output -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> [Text]) -> Output -> [Text]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [Text]
getYearSuf
    where getYearSuf :: Output -> [Text]
          getYearSuf :: Output -> [Text]
getYearSuf o :: Output
o
              | OYearSuf{}   <- Output
o = ["a"]
              | Bool
otherwise         = []

-- | Removes all given names and name hashes from OName elements.
rmHashAndGivenNames :: Output -> Output
rmHashAndGivenNames :: Output -> Output
rmHashAndGivenNames (OName _ s :: [Output]
s _ f :: Formatting
f) = Agent -> [Output] -> [[Output]] -> Formatting -> Output
OName Agent
emptyAgent [Output]
s [] Formatting
f
rmHashAndGivenNames o :: Output
o               = Output
o

rmGivenNames :: Output -> Output
rmGivenNames :: Output -> Output
rmGivenNames (OName a :: Agent
a s :: [Output]
s _ f :: Formatting
f) = Agent -> [Output] -> [[Output]] -> Formatting -> Output
OName Agent
a [Output]
s [] Formatting
f
rmGivenNames o :: Output
o               = Output
o

-- | Add, with 'proc', a give name to the family name. Needed for
-- disambiguation.
addGivenNames :: [Output] -> [Output]
addGivenNames :: [Output] -> [Output]
addGivenNames
    = Bool -> [Output] -> [Output]
addGN Bool
True
    where
      addGN :: Bool -> [Output] -> [Output]
addGN _ [] = []
      addGN b :: Bool
b (o :: Output
o:os :: [Output]
os)
          | OName i :: Agent
i _ xs :: [[Output]]
xs f :: Formatting
f <- Output
o
          , [[Output]]
xs [[Output]] -> [[Output]] -> Bool
forall a. Eq a => a -> a -> Bool
/= []  = if Bool
b then Agent -> [Output] -> [[Output]] -> Formatting -> Output
OName Agent
i ([[Output]] -> [Output]
forall a. [a] -> a
head [[Output]]
xs) ([[Output]] -> [[Output]]
forall a. [a] -> [a]
tail [[Output]]
xs) Formatting
f Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: Bool -> [Output] -> [Output]
addGN Bool
False [Output]
os else Output
oOutput -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:[Output]
os
          | Bool
otherwise = Output
o Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: Bool -> [Output] -> [Output]
addGN Bool
b [Output]
os

-- | Map the evaluated output of a citation group.
mapGroupOutput :: (Output -> [a]) -> CitationGroup -> [a]
mapGroupOutput :: (Output -> [a]) -> CitationGroup -> [a]
mapGroupOutput f :: Output -> [a]
f (CG _ _ _ os :: [(Cite, Output)]
os) = ((Cite, Output) -> [a]) -> [(Cite, Output)] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Output -> [a]
f (Output -> [a])
-> ((Cite, Output) -> Output) -> (Cite, Output) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cite, Output) -> Output
forall a b. (a, b) -> b
snd) [(Cite, Output)]
os