{-# LANGUAGE PatternGuards #-}------------------------------------------------------------------------------- |-- Module : Text.CSL.Eval.Names-- Copyright : (c) Andrea Rossato-- License : BSD-style (see LICENSE)---- Maintainer : Andrea Rossato <andrea.rossato@unitn.it>-- Stability : unstable-- Portability : unportable---- The CSL implementation-------------------------------------------------------------------------------moduleText.CSL.Eval.NameswhereimportControl.Applicative((<$>))importControl.Monad.StateimportData.Char(toUpper,isLower,isUpper,isSpace)importData.List(nub)importData.Maybe(isJust)importText.CSL.Eval.CommonimportText.CSL.Eval.OutputimportText.CSL.Output.Plain((<>))importText.CSL.Parser(toRead)importText.CSL.ReferenceimportText.CSL.StyleimportText.Pandoc.DefinitionevalNames::Bool->[String]->[Name]->String->StateEvalState[Output]evalNamesskipEdTransnsnld|[sa,sb]<-ns,notskipEdTrans,sa=="editor"&&sb=="translator"||sb=="editor"&&sa=="translator"=doaa<-getAgents'saab<-getAgents'saifaa==abthenmodify(\s->s{edtrans=True})>>evalNamesTrue[sa]nldelseevalNamesTruensnld|(s:xs)<-ns=doresetEtalags<-getAgentssk<-getStringVar"ref-id"p<-gets(citePosition.cite.env)ops<-gets(options.env)aus<-getsauthSubr<-ifs=="author"&&ags/=[]&&p=="subsequent"&&isOptionSet"subsequent-author-substitute"opsthenreturn$outputemptyFormatting$getOptionVal"subsequent-author-substitute"opselsedores<-agentspsagsst<-getfb<-agents"subsequent"sagsputstifres/=[]thenletrole=ifaus=="author"thenaus++"sub"elsesinreturn.return.OContribkroleresfb=<<getsetalelsereturn[]r'<-evalNamesskipEdTransxsnldnum<-getscontNumreturn$ifr/=[]&&r'/=[]thencountnum(r++[ODel$delimops]++r')elsecountnum$cleanOutput(r++r')|otherwise=return[]whereagentspsa=concatMapM(formatNames(hasEtAlnl)dpsa)nldelimops=ifd==[]thengetOptionVal"names-delimiter"opselsedresetEtal=modify(\s->s{etal=[]})countnumx=ifhasCountnl&&num/=[]-- FIXME!! le zero!!then[OContrib[][][ONum(lengthnum)emptyFormatting][][]]elsexhasCount=or.queryhasCount'hasCount'n|NameCount____<-n=[True]|otherwise=[False]-- | The 'Bool' is 'True' when formatting a name with a final "et-al".-- The first 'String' represents the position and the second the role-- (e.i. editor, translator, etc.).formatNames::Bool->Delimiter->String->String->[Agent]->Name->StateEvalState[Output]formatNameseadelpsasn|Namef_ns__<-n,Count<-f=dob<-isBib<$>getsmodeo<-gets(options.env)>>=return.mergeOptionsnsmodify$\st->st{contNum=nub$(++)(take(snd$isEtAlbopas)as)$contNumst}return[]|Nameffmnsdnp<-n=dob<-isBib<$>getsmodeo<-gets(options.env)>>=return.mergeOptionsnsm<-getsmodeletodel=ifdel/=[]thendelelsegetOptionVal"name-delimiter"odel'=ifd/=[]thendelseifodel==[]then", "elseodel(_,i)=isEtAlbopasform=casefofNotSet->casegetOptionVal"name-form"oof[]->Longx->read$toReadx_->fgenNamex=doetal'<-formatEtAloea"et-al"fmdel'xifetal'==[]thendot<-getTermFalseLong"and"return$delimtodel'$formatmoformfmnpxelsedoreturn$(addDelimdel'$formatmoformfmnpx)++etal'setLastNameo$formatNamemFalseffmonp(lastas)updateEtal=<<mapMgenName[1+i..lengthas]genNamei|NameLabelffmpl<-n=when'(isVarSets)$dob<-getsedtransres<-formatLabelffm(isPluralpl$lengthas)$ifbthen"editortranslator"elsesmodify$\st->st{edtrans=False}updateEtal[res]returnres|EtAlfmt<-n=doet<-getsetalo<-gets(options.env)leti=lengthas-lengthett'=ifnulltthen"et-al"elsetr<-mapM(et_aloFalset'fmdel)[i..lengthas]let(r',r'')=caserof(x:xs)->(x,xs++[])_->([],[])updateEtalr''returnr'|otherwise=return[]whereisBib(EvalBiblio_)=TrueisBib_=FalseupdateEtalx=modify$\st->letx'=iflengthx==1thenrepeat$headxelsexinst{etal=ifetalst/=[]thenmap(uncurry(++)).zip(etalst)$x'elsex}isWithLastNameos|"true"<-getOptionVal"et-al-use-last"os,em<-readNum$getOptionVal"et-al-min"os,uf<-readNum$getOptionVal"et-al-use-first"os,em-uf>1=True|otherwise=FalsesetLastNameosx|as/=[],isWithLastNameos=modify$\st->st{lastName=x}|otherwise=return()formatmosffmnpi|(a:xs)<-takeias=formatNamemTrueffmosnpa++concatMap(formatNamemFalseffmosnp)xs|otherwise=concatMap(formatNamemTrueffmosnp).takei$asdelimtosdx|"always"<-getOptionVal"delimiter-precedes-last"os,lengthx==2=addDelimd(initx)++ODel(d<>andStrtos):[lastx]|lengthx==2=addDelimd(initx)++ODel(andStr'tdos):[lastx]|"never"<-getOptionVal"delimiter-precedes-last"os,lengthx>2=addDelimd(initx)++ODel(andStr'tdos):[lastx]|lengthx>2=addDelimd(initx)++ODel(d<>andStrtos):[lastx]|otherwise=addDelimdxandStrtos|"text"<-getOptionVal"and"os=" "++t++" "|"symbol"<-getOptionVal"and"os=" & "|otherwise=[]andStr'tdos=ifandStrtos==[]thendelseandStrtosformatEtAlobtfmdi=doln<-getslastNameifisWithLastNameothencase()of_|(lengthas-i)==1->et_alobtfmdi-- is that correct? FIXME later|(lengthas-i)>1->return$[ODeld,OPan[Str"\x2026"],OSpace]++ln|otherwise->return[]elseet_alobtfmdiet_alobtfmdi=when'(getsmode>>=return.not.isSorting)$ifb||lengthas<=ithenreturn[]elsedox<-getTermFalseLongtwhen'(return$x/=[])$casegetOptionVal"delimiter-precedes-et-al"oof"never"->return.(++)[OSpace]$outputfmx"always"->return.(++)[ODeld]$outputfmx_->ifi>1thenreturn.(++)[ODeld]$outputfmxelsereturn.(++)[OSpace]$outputfmx-- | The first 'Bool' is 'True' if we are evaluating the bibliography.-- The 'String' is the cite position. The function also returns the-- number of contributors to be displayed.isEtAl::Bool->[Option]->String->[Agent]->(Bool,Int)isEtAlbospas|p/="first",isOptionSet"et-al-subsequent-min"os,isOptionSet"et-al-subsequent-use-first"os,le<-etAlMin"et-al-subsequent-min",le'<-etAlMin"et-al-subsequent-use-first",lengthas>=le,lengthas>le'=(,)Truele'|isOptionSet'"et-al-min""et-al-subsequent-min",isOptionSet'"et-al-use-first""et-al-subsequent-use-first",le<-etAlMin'"et-al-min""et-al-subsequent-min",le'<-etAlMin'"et-al-use-first""et-al-subsequent-use-first",lengthas>=le,lengthas>le'=(,)Truele'|isOptionSet'"et-al-min""et-al-subsequent-min",le<-etAlMin'"et-al-min""et-al-subsequent-min",lengthas>=le,lengthas>1=(,)TruegetUseFirst|otherwise=(,)False$lengthaswhereetAlMinx=read$getOptionValxosetAlMin'xy=ifbthenetAlMinxelseread$getOptionVal'xyisOptionSet's1s2=ifbthenisOptionSets1oselseor$(isOptionSets1os):[(isOptionSets2os)]getOptionVal's1s2=ifnull(getOptionVals1os)thengetOptionVals2oselsegetOptionVals1osgetUseFirst=letu=ifbthengetOptionVal"et-al-use-first"oselsegetOptionVal'"et-al-use-first""et-al-subsequent-min"inifnulluthen1elsereadu-- | Generate the 'Agent's names applying et-al options, with all-- possible permutations to disambiguate colliding citations. The-- 'Bool' indicate whether we are formatting the first name or not.formatName::EvalMode->Bool->Form->Formatting->[Option]->[NamePart]->Agent->[Output]formatNamembffmopsnpn|literaln/=[]=return$OName(shown)institution[]fm|Short<-f=return$OName(shown)shortNamedisambdatafm|otherwise=return$OName(shown)(longNamegiven)disambdatafmwhereinstitution=[OStr(literaln)$form"family"]when_co=ifc/=[]thenoelse[]addAffixesssfns=[Output((oStr's(formsf){prefix=[],suffix=[]})++ns)$emptyFormatting{prefix=prefix(formsf),suffix=suffix(formsf)}]forms=casefilter(\(NamePartn'_)->n'==s)npofNamePart_fm':_->fm'_->emptyFormattinghasHyphen=not.null.filter(=='-')hyphen=ifgetOptionVal"initialize-with-hyphen"ops=="false"thengetOptionVal"initialize-with"opselsefilter(not.isSpace)$getOptionVal"initialize-with"ops++"-"isInitx=lengthx==1&&or(mapisUpperx)initialx=ifisJust(lookup"initialize-with"ops)&&getOptionVal"initialize"ops/="false"thenifnot.and.mapisLower$xthenaddInx$getOptionVal"initialize-with"opselse" "++casexof_:'\'':[]->x_->x++" "else" "++ifisJust(lookup"initialize-with"ops)&&isInitxthenaddInx$getOptionVal"initialize-with"opselsexaddInxi=ifhasHyphenxthenhead(takeWhile(/='-')x):hyphen++head(tail$dropWhile(/='-')x):ielseheadx:isortSepgs=when_g$separator++addAffixes(g<+>s)"given"[]separator=ifgetOptionVal"sort-separator"ops==[]thenoStr","++[OSpace]elseoStr(getOptionVal"sort-separator"ops)suff=ifcommaSuffixn&&nameSuffixn/=[]thensuffComelsesuffNoComsuffCom=when_(nameSuffixn)$separator++[OStr(nameSuffixn)fm]suffNoCom=when_(nameSuffixn)$[OSpace,OStr(nameSuffixn)fm]given=when_(givenNamen).unwords.words.concatMapinitial$givenNamengivenLong=when_(givenNamen).unwords'$givenNamenfamily=familyNamenshortName=oStr'(nonDroppingPartn<+>family)(form"family")longNameg=ifisSortingmthenletfirstPart=casegetOptionVal"demote-non-dropping-particle"opsof"never"->nonDroppingPartn<+>family<+>droppingPartn_->family<+>droppingPartn<+>nonDroppingPartnin[OStrfirstPart(form"family")]<++>oStr'g(form"given")++suffComelseif(b&&getOptionVal"name-as-sort-order"ops=="first")||getOptionVal"name-as-sort-order"ops=="all"thenlet(fam,par)=casegetOptionVal"demote-non-dropping-particle"opsof"never"->(nonDroppingPartn<+>family,droppingPartn)"sort-only"->(nonDroppingPartn<+>family,droppingPartn)_->(family,droppingPartn<+>nonDroppingPartn)inoStr'fam(form"family")++sortSepgpar++suffComelseoStr'g(form"given")<++>addAffixes(droppingPartn<+>nonDroppingPartn<+>family)"family"suffdisWithGiven=getOptionVal"disambiguate-add-givenname"ops=="true"initialize=isJust.lookup"initialize-with"$opsisLong=f/=Short&&initializegivenRule=letgr=getOptionVal"givenname-disambiguation-rule"opsinifnullgrthen"by-cite"elsegrdisambdata=case()of_|"all-names-with-initials"<-givenRule,disWithGiven,Short<-f,initialize->[longNamegiven]|"primary-name-with-initials"<-givenRule,disWithGiven,Short<-f,initialize,b->[longNamegiven]|disWithGiven,Short<-f,b,"primary-name"<-givenRule->[longNamegiven,longNamegivenLong]|disWithGiven,Short<-f,"all-names"<-givenRule->[longNamegiven,longNamegivenLong]|disWithGiven,Short<-f,"by-cite"<-givenRule->[longNamegiven,longNamegivenLong]|disWithGiven,isLong->[longNamegivenLong]|otherwise->[]unwords'::[String]->Stringunwords'=unwords.words.foldrconcatWord[]whereconcatWordwws=ifw/=[]&&lastw=='.'thenw++wselsew++' ':wsformatLabel::Form->Formatting->Bool->String->StateEvalState[Output]formatLabelffmps|"locator"<-s=when'(gets(citeLocator.cite.env)>>=return.(/=)[])$do(l,v)<-getLocVarform(\fm'->return.flipOLocemptyFormatting.outputfm')idl('-'`elem`v)|"page"<-s=checkPlural|"volume"<-s=checkPlural|"ibid"<-s=format'sp|otherwise=formatspwherecheckPlural=when'(isVarSets)$dov<-getStringVarsformats('-'`elem`v)format=formoutputidformat'tb=gets(citePosition.cite.env)>>=\po->ifpo=="ibid-with-locator-c"||po=="ibid-c"thenformoutputcapitaltbelseformattbformogtb=return.ofm=<<g.period<$>getTerm(b&&p)ftperiod=ifstripPeriodsfmthenfilter(/='.')elseidcapitalx=toUpper(headx):(tailx)(<+>)::String->String->String[]<+>ss=sss<+>[]=ss<+>ss=iflasts=='\''theninits++"’"++sselses++" "++ss