moduleData.Record.Label.TH(mkLabels,mkLabelsNoTypes)whereimportControl.MonadimportData.CharimportLanguage.Haskell.TH.Syntax-- | Derive lenses including type signatures for all the record selectors in a datatype.mkLabels::[Name]->Q[Dec]mkLabels=liftMconcat.mapM(mkLabels1True)-- | Derive lenses without type signatures for all the record selectors in a datatype.mkLabelsNoTypes::[Name]->Q[Dec]mkLabelsNoTypes=liftMconcat.mapM(mkLabels1False)-- Helpers.mkLabels1::Bool->Name->Q[Dec]mkLabels1sigsn=doi<-reifynlet-- only process data and newtype declarations, filter out all constructors and the type variables(cs',vars)=caseiofTyConI(DataD__vscs_)->(cs,vs)TyConI(NewtypeD__vsc_)->([c],vs)_->([],undefined)-- we are only interested in lenses of record constructorsls'=[l|RecC_ls<-cs',l<-ls]return(concatMap(mkLabel1sigsnvars)ls')mkLabel1::Bool->Name->[TyVarBndr]->VarStrictType->[Dec]mkLabel1sigstypeNamebinders(name,_,t)=let-- Generate a name for the lens:-- If the original selector starts with an _, remove it and make the next-- character lowercase. Otherwise, add 'l', and make the next character-- uppercase.lensName=mkName$casenameBasenameof('_':c:rest)->toLowerc:rest(f:rest)->'l':toUpperf:rest_->error"Invalid name"-- The source type of a lenssource=foldlappTv(ConTtypeName)binders-- The type of the lenslensType=ForallTbinders[]$AppT(AppT(ConT$mkName":->")source)tin(ifsigsthen[SigDlensNamelensType]else[])++[functionBodylensNamename]appTv::Type->TyVarBndr->TypeappTvt(PlainTVn)=AppTt(VarTn)appTv_v=error$"Kinded type variable not supported: "++showvfunctionBody::Name->Name->DecfunctionBodylensNamefieldName=FunDlensName[Clause[](NormalB(AppE(AppE(VarE(mkName"lens"))(VarEfieldName))-- getter(LamE[VarP(mkName"b"),VarP(mkName"a")]-- setter(RecUpdE(VarE(mkName"a"))[(fieldName,VarE(mkName"b"))]))))[]]