{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PatternGuards #-}
#if MIN_VERSION_base(4,9,0)
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif
module Text.CSL.Proc.Disamb where
import Prelude
import Control.Arrow (second, (&&&), (>>>))
import Data.List (elemIndex, find, findIndex, groupBy,
isPrefixOf, mapAccumL, nub, nubBy, sortOn)
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)
disambCitations :: Style -> [Reference] -> Citations -> [CitationGroup]
-> ([(String, String)], [CitationGroup])
disambCitations :: Style
-> [Reference]
-> Citations
-> [CitationGroup]
-> ([(String, String)], [CitationGroup])
disambCitations s :: Style
s bibs :: [Reference]
bibs cs :: Citations
cs groups :: [CitationGroup]
groups
= (,) [(String, String)]
yearSuffs [CitationGroup]
citOutput
where
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)
refs :: [[(Cite, Maybe Reference)]]
refs = [Reference] -> Citations -> [[(Cite, Maybe Reference)]]
processCites [Reference]
bibs Citations
cs
nameDupls :: [[NameData]]
nameDupls = [CitationGroup] -> [[NameData]]
getDuplNameData [CitationGroup]
groups
duplics :: [[CiteData]]
duplics = GiveNameDisambiguation
-> Bool -> Bool -> [CitationGroup] -> [[CiteData]]
getDuplCiteData GiveNameDisambiguation
giveNameDisamb Bool
hasNamesOpt Bool
hasYSuffOpt [CitationGroup]
groups
disOpts :: [String]
disOpts = Style -> [String]
getCitDisambOptions Style
s
hasNamesOpt :: Bool
hasNamesOpt = "disambiguate-add-names" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
disOpts
hasGNameOpt :: Bool
hasGNameOpt = "disambiguate-add-givenname" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
disOpts
hasYSuffOpt :: Bool
hasYSuffOpt = "disambiguate-add-year-suffix" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
disOpts
giveNameDisamb :: GiveNameDisambiguation
giveNameDisamb = case String -> [(String, String)] -> String
getOptionVal "givenname-disambiguation-rule"
(Citation -> [(String, String)]
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
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
reEval :: [CiteData]
reEval = let chk :: [CiteData] -> [CiteData]
chk = if Bool
hasYSuffOpt then (CiteData -> Bool) -> [CiteData] -> [CiteData]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) [] (String -> Bool) -> (CiteData -> String) -> CiteData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CiteData -> String
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 :: [(String, String)]
yearSuffs = Bool -> [(String, String)] -> [(String, String)]
forall a. Bool -> [a] -> [a]
when_ Bool
hasYSuffOpt ([(String, String)] -> [(String, String)])
-> ([CitationGroup] -> [(String, String)])
-> [CitationGroup]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Reference] -> [(String, [Output])] -> [(String, String)]
generateYearSuffix [Reference]
bibs ([(String, [Output])] -> [(String, String)])
-> ([CitationGroup] -> [(String, [Output])])
-> [CitationGroup]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CitationGroup -> [(String, [Output])])
-> [CitationGroup] -> [(String, [Output])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CitationGroup -> [(String, [Output])]
getYearSuffixes ([CitationGroup] -> [(String, String)])
-> [CitationGroup] -> [(String, String)]
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 ([(String, String)] -> Output -> Output
updateYearSuffixes [(String, String)]
yearSuffs) [CitationGroup]
withYearS
else [CitationGroup]
withYearS
citOutput :: [CitationGroup]
citOutput = if [String]
disOpts [String] -> [String] -> 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 :: String
k c :: [Output]
c ys :: [Output]
ys d :: [[Output]]
d r :: [Output]
r s :: [String]
s y :: String
y) = String
-> [Output]
-> [Output]
-> [[Output]]
-> [Output]
-> [String]
-> String
-> CiteData
CD String
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 [String]
s String
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 :: String
d os :: [(Cite, Output)]
os) = [(Cite, Output)]
-> Formatting -> String -> [(Cite, Output)] -> CitationGroup
CG [(Cite, Output)]
cs Formatting
fm String
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
| 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 :: [String]
sameAs = CiteData -> String
key CiteData
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: CiteData -> [String]
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 :: String
k r :: String
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 -> String
key (CiteData -> String)
-> (CiteData -> [String]) -> CiteData -> (String, [String])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CiteData -> [String]
sameAs (CiteData -> (String, [String]))
-> ((String, [String]) -> 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
>>> (String -> [String] -> [String]) -> (String, [String]) -> [String]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((String, [String]) -> [String])
-> ([String] -> Bool) -> (String, [String]) -> Bool
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
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) ->
String -> String -> [Output] -> [Output] -> [[Output]] -> Output
OContrib String
k String
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 -> String -> String -> [Output] -> [Output] -> [[Output]] -> Output
OContrib String
k String
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
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 :: String
d os :: [(Cite, Output)]
os)
= [(Cite, Output)]
-> Formatting -> String -> [(Cite, Output)] -> CitationGroup
CG [(Cite, Output)]
a Formatting
f String
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 -> String
unLiteral (Reference -> Literal
refId Reference
r) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
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]
-> [(String, String)]
-> Abbreviations
-> Maybe Reference
-> [Output]
evalLayout (Citation -> Layout
citLayout Citation
ct) (Cite -> EvalMode
EvalCite Cite
c) Bool
True [Locale]
lo [MacroMap]
ms (Citation -> [(String, String)]
citOptions Citation
ct) Abbreviations
as Maybe Reference
mbr
_ -> [(Cite, Output)
out]
where lkeys :: [String]
lkeys = (CiteData -> String) -> [CiteData] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CiteData -> String
key [CiteData]
l
hasIfDis :: IfThen -> [Bool]
hasIfDis :: IfThen -> [Bool]
hasIfDis (IfThen Condition{disambiguation :: Condition -> [String]
disambiguation = (_:_)} _ _) = [Bool
True]
hasIfDis _ = [Bool
False]
getCitDisambOptions :: Style -> [String]
getCitDisambOptions :: Style -> [String]
getCitDisambOptions
= ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst ([(String, String)] -> [String])
-> (Style -> [(String, String)]) -> Style -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) "true" (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd) ([(String, String)] -> [(String, String)])
-> (Style -> [(String, String)]) -> Style -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf "disambiguate" (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) ([(String, String)] -> [(String, String)])
-> (Style -> [(String, String)]) -> Style -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [(String, String)]
citOptions (Citation -> [(String, String)])
-> (Style -> Citation) -> Style -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Citation
citation
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 -> String
key CiteData
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== CiteData -> String
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 -> String
citYear CiteData
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== CiteData -> String
citYear CiteData
y)
rmExtras :: GiveNameDisambiguation -> [Output] -> [Output]
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 String -> String -> [Output] -> [Output] -> [[Output]] -> Output
OContrib [] [] [Output
y] [] [] Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: GiveNameDisambiguation -> [Output] -> [Output]
rmExtras GiveNameDisambiguation
g [Output]
xs
else String -> String -> [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 = []
getCiteData :: Output -> [CiteData]
getCiteData :: Output -> [CiteData]
getCiteData out :: Output
out
= (Output -> [CiteData]
forall b. Data b => b -> [CiteData]
contribs (Output -> [CiteData])
-> (Output -> [(String, String)])
-> Output
-> ([CiteData], [(String, String)])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Output -> [(String, String)]
forall b. Data b => b -> [(String, String)]
years (Output -> ([CiteData], [(String, String)]))
-> (([CiteData], [(String, String)]) -> [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], [(String, String)]) -> [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
[] -> [String
-> [Output]
-> [Output]
-> [[Output]]
-> [Output]
-> [String]
-> String
-> CiteData
CD [] [Output
out] [] [] [] [] []]
xs :: [CiteData]
xs -> [CiteData]
xs
years :: b -> [(String, String)]
years o :: b
o = case (Output -> [(String, String)]) -> b -> [(String, String)]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [(String, String)]
getYears b
o of
[] -> [([],[])]
r :: [(String, String)]
r -> [(String, String)]
r
zipData :: ([CiteData], [(String, String)]) -> [CiteData]
zipData = ([CiteData] -> [(String, String)] -> [CiteData])
-> ([CiteData], [(String, String)]) -> [CiteData]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([CiteData] -> [(String, String)] -> [CiteData])
-> ([CiteData], [(String, String)]) -> [CiteData])
-> ((CiteData -> (String, String) -> CiteData)
-> [CiteData] -> [(String, String)] -> [CiteData])
-> (CiteData -> (String, String) -> CiteData)
-> ([CiteData], [(String, String)])
-> [CiteData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CiteData -> (String, String) -> CiteData)
-> [CiteData] -> [(String, String)] -> [CiteData]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((CiteData -> (String, String) -> CiteData)
-> ([CiteData], [(String, String)]) -> [CiteData])
-> (CiteData -> (String, String) -> CiteData)
-> ([CiteData], [(String, String)])
-> [CiteData]
forall a b. (a -> b) -> a -> b
$ \c :: CiteData
c y :: (String, String)
y -> if CiteData -> String
key CiteData
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= []
then CiteData
c {citYear :: String
citYear = (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
y}
else CiteData
c {key :: String
key = (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
y
,citYear :: String
citYear = (String, String) -> String
forall a b. (a, b) -> b
snd (String, String)
y}
contribsQ :: Output -> [CiteData]
contribsQ o :: Output
o
| OContrib k :: String
k _ _ d :: [Output]
d dd :: [[Output]]
dd <- Output
o = [String
-> [Output]
-> [Output]
-> [[Output]]
-> [Output]
-> [String]
-> String
-> CiteData
CD String
k [Output
out] [Output]
d ([Output]
d[Output] -> [[Output]] -> [[Output]]
forall a. a -> [a] -> [a]
:[[Output]]
dd) [] [] []]
| Bool
otherwise = []
getYears :: Output -> [(String,String)]
getYears :: Output -> [(String, String)]
getYears o :: Output
o
| OYear x :: String
x k :: String
k _ <- Output
o = [(String
k,String
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] -> [(String, [Output])] -> [(String,String)]
generateYearSuffix :: [Reference] -> [(String, [Output])] -> [(String, String)]
generateYearSuffix refs :: [Reference]
refs
= ([String] -> [(String, String)])
-> [[String]] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [String]
suffs) ([[String]] -> [(String, String)])
-> ([(String, [Output])] -> [[String]])
-> [(String, [Output])]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[[(String, Int)]] -> [[String]]
forall b b. [[(b, b)]] -> [[b]]
getFst ([[(String, Int)]] -> [[String]])
-> ([(String, [Output])] -> [[(String, Int)]])
-> [(String, [Output])]
-> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [(String, Int)]) -> [[String]] -> [[(String, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map ([(String, Int)] -> [(String, Int)]
forall a b. (Ord a, Ord b) => [(a, b)] -> [(a, b)]
sort' ([(String, Int)] -> [(String, Int)])
-> ([String] -> [(String, Int)]) -> [String] -> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Int) -> Bool) -> [(String, Int)] -> [(String, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(/=) 0 (Int -> Bool) -> ((String, Int) -> Int) -> (String, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Int) -> Int
forall a b. (a, b) -> b
snd) ([(String, Int)] -> [(String, Int)])
-> ([String] -> [(String, Int)]) -> [String] -> [(String, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (String, Int)) -> [String] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (String, Int)
getP) ([[String]] -> [[(String, Int)]])
-> ([(String, [Output])] -> [[String]])
-> [(String, [Output])]
-> [[(String, Int)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[[(String, [Output])]] -> [[String]]
forall b b. [[(b, b)]] -> [[b]]
getFst ([[(String, [Output])]] -> [[String]])
-> ([(String, [Output])] -> [[(String, [Output])]])
-> [(String, [Output])]
-> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, [Output])] -> Bool)
-> [[(String, [Output])]] -> [[(String, [Output])]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\grp :: [(String, [Output])]
grp -> [(String, [Output])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, [Output])]
grp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2) ([[(String, [Output])]] -> [[(String, [Output])]])
-> ([(String, [Output])] -> [[(String, [Output])]])
-> [(String, [Output])]
-> [[(String, [Output])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, [Output])] -> [(String, [Output])])
-> [[(String, [Output])]] -> [[(String, [Output])]]
forall a b. (a -> b) -> [a] -> [b]
map [(String, [Output])] -> [(String, [Output])]
forall a. Eq a => [a] -> [a]
nub ([[(String, [Output])]] -> [[(String, [Output])]])
-> ([(String, [Output])] -> [[(String, [Output])]])
-> [(String, [Output])]
-> [[(String, [Output])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((String, [Output]) -> (String, [Output]) -> Bool)
-> [(String, [Output])] -> [[(String, [Output])]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\a :: (String, [Output])
a b :: (String, [Output])
b -> (String, [Output]) -> [Output]
forall a b. (a, b) -> b
snd (String, [Output])
a [Output] -> [Output] -> Bool
forall a. Eq a => a -> a -> Bool
== (String, [Output]) -> [Output]
forall a b. (a, b) -> b
snd (String, [Output])
b) ([(String, [Output])] -> [[(String, [Output])]])
-> ([(String, [Output])] -> [(String, [Output])])
-> [(String, [Output])]
-> [[(String, [Output])]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(String, [Output])] -> [(String, [Output])]
forall a b. (Ord a, Ord b) => [(a, b)] -> [(a, b)]
sort' ([(String, [Output])] -> [(String, [Output])])
-> ([(String, [Output])] -> [(String, [Output])])
-> [(String, [Output])]
-> [(String, [Output])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [Output]) -> Bool)
-> [(String, [Output])] -> [(String, [Output])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, [Output]) -> Bool) -> (String, [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)
-> ((String, [Output]) -> [Output]) -> (String, [Output]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [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 :: String -> (String, Int)
getP k :: String
k = case (Reference -> Bool) -> [Reference] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
k (String -> Bool) -> (Reference -> String) -> Reference -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> String
unLiteral (Literal -> String)
-> (Reference -> Literal) -> Reference -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Literal
refId) [Reference]
refs of
Just x :: Int
x -> (String
k, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
_ -> (String
k, 0)
suffs :: [String]
suffs = [String]
letters [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y | String
x <- [String]
letters, String
y <- [String]
letters ]
letters :: [String]
letters = (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ShowS
forall a. a -> [a] -> [a]
:[]) ['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 :: String
k _ f :: Formatting
f <- Output
o = String -> String -> [Output] -> Formatting -> Output
OYearSuf [] String
k (String -> t CiteData -> [Output]
forall (t :: * -> *).
Foldable t =>
String -> t CiteData -> [Output]
getCollision String
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 :: String -> t CiteData -> [Output]
getCollision k :: String
k c :: t CiteData
c = case (CiteData -> Bool) -> t CiteData -> Maybe CiteData
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
k (String -> Bool) -> (CiteData -> String) -> CiteData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CiteData -> String
key) t CiteData
c of
Just x :: CiteData
x -> case CiteData -> [Output]
collide CiteData
x of
[] -> [String -> Formatting -> Output
OStr (CiteData -> String
citYear CiteData
x) Formatting
emptyFormatting]
ys :: [Output]
ys -> [Output]
ys
_ -> []
updateYearSuffixes :: [(String, String)] -> Output -> Output
updateYearSuffixes :: [(String, String)] -> Output -> Output
updateYearSuffixes yss :: [(String, String)]
yss o :: Output
o
| OYearSuf _ k :: String
k c :: [Output]
c f :: Formatting
f <- Output
o = case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k [(String, String)]
yss of
Just x :: String
x -> String -> String -> [Output] -> Formatting -> Output
OYearSuf String
x String
k [Output]
c Formatting
f
_ -> Output
ONull
| Bool
otherwise = Output
o
getYearSuffixes :: CitationGroup -> [(String,[Output])]
getYearSuffixes :: CitationGroup -> [(String, [Output])]
getYearSuffixes (CG _ _ _ d :: [(Cite, Output)]
d) = ((Cite, Output) -> (String, [Output]))
-> [(Cite, Output)] -> [(String, [Output])]
forall a b. (a -> b) -> [a] -> [b]
map (Cite, Output) -> (String, [Output])
go [(Cite, Output)]
d
where go :: (Cite, Output) -> (String, [Output])
go (c :: Cite
c,x :: Output
x) = (Cite -> String
citeId Cite
c, Bool -> [Output] -> [Output]
relevant Bool
False [Output
x])
relevant :: Bool -> [Output] -> [Output]
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 :: String
n _ _ : rest :: [Output]
rest) = String -> Formatting -> Output
OStr String
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 :: String
s _ : rest :: [Output]
rest) = String -> Formatting -> Output
OStr String
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
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
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
addYearSuffix :: Output -> Output
addYearSuffix :: Output -> Output
addYearSuffix o :: Output
o
| OYear y :: String
y k :: String
k f :: Formatting
f <- Output
o = [Output] -> Formatting -> Output
Output [ String -> String -> Formatting -> Output
OYear String
y String
k Formatting
emptyFormatting
, String -> String -> [Output] -> Formatting -> Output
OYearSuf [] String
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
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> (Output -> [String]) -> Output -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> [String]) -> Output -> [String]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Output -> [String]
getYearSuf
where getYearSuf :: Output -> [String]
getYearSuf :: Output -> [String]
getYearSuf o :: Output
o
| OYearSuf{} <- Output
o = ["a"]
| Bool
otherwise = []
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
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
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