module Text.CSL.Proc where
import Control.Arrow ( (&&&), (***) )
import Data.Char ( chr )
import Data.List ( elemIndex, findIndices
, sortBy, mapAccumL, nub )
import Data.Maybe
import Data.Ord ( comparing )
import Text.CSL.Eval
import Text.CSL.Proc.Collapse
import Text.CSL.Proc.Disamb
import Text.CSL.Reference
import Text.CSL.Style
processCitations :: Style -> [Reference] -> [[(String, String)]] -> [[FormattedOutput]]
processCitations s rs
= citations . citeproc s rs
processBibliography :: Style -> [Reference] -> [[FormattedOutput]]
processBibliography s rs
= bibliography $ citeproc s rs [zip (map citeKey rs) (repeat "")]
citeproc :: Style -> [Reference] -> [[(String, String)]] -> BiblioData
citeproc s rs cs
= BD citsOutput biblioOutput
where
biblioRefs = refsYSuffix . procRefs s . map (getReference rs) .
nub . map (id *** const []) . concat $ cs
biblioOutput = if "disambiguate-add-year-suffix" `elem` getCitDisambOptions s
then map (map formatOutput) $ proc addYearSuffix $ procBiblio s biblioRefs
else map (map formatOutput) $ procBiblio s biblioRefs
outputGroups = map $ \(CG fm d os) -> map formatOutput $ outputList fm d os
citsOutput = outputGroups $ collapseCitGroups s $ disambCitations s biblioRefs cs
procBiblio :: Style -> [Reference] -> [[Output]]
procBiblio (Style {biblio = mb, csMacros = ms , csTerms = ts}) rs
= maybe [] process mb
where
format b = uncurry $ evalLayout (bibLayout b) False ts ms (bibOptions b)
render b = map (format b) $ chkAut [] rs
process b = flip map (render b) $ uncurry outputList (layFormat &&& layDelim $ bibLayout b)
chkAut _ [] = []
chkAut a (x:xs) = if author x `elem` a
then ("subsequent",x) : chkAut a xs
else ("first" ,x) : chkAut (author x : a) xs
procRefs :: Style -> [Reference] -> [Reference]
procRefs (Style {biblio = mb, csMacros = ms , csTerms = ts}) rs
= maybe rs process mb
where
citNum x = x { citationNumber = maybe 0 ((+) 1 . fromIntegral) . elemIndex x $ rs }
sort b = evalSorting ts ms (bibOptions b) (bibSort b)
process b = map fst . sortBy (comparing snd) . map (citNum &&& sort b) $ rs
refsYSuffix :: [Reference] -> [Reference]
refsYSuffix rs
= update indices
where
ryear a b = issued a == issued b && issued a /= []
auth a b = author a == author b && author a /= []
edit a b = editor a == editor b && editor a /= []
tran a b = translator a == translator b && translator a /= []
comp a b = (ryear a b && auth a b) ||
(ryear a b && edit a b) ||
(ryear a b && tran a b)
update l = fst $ mapAccumL check rs l
check r (i,s) = flip (,) [] $ take i r ++ [(r !! i){yearSuffix = s}] ++ drop (i + 1) r
indices = concatMap (flip zip suffixes) . nub $ map needed rs
needed r = case () of
_ | i <- findIndices (comp r) rs
, length i > 1 -> i
| otherwise -> []
suffixes :: [String]
suffixes
= l ++ [x ++ y | x <- l, y <- l ]
where
l = map (return . chr) [97..122]