{-# LANGUAGE TemplateHaskell, CPP #-}moduleHappstack.Data.SerializeTH(deriveSerialize,deriveSerializeFor)whereimportHappstack.Data.SerializeimportLanguage.Haskell.THimportControl.MonadimportData.BinarydataClass=Tagged[(Name,Int)]Cxt[Name]-- | Derives an instance of Serialize for the provided type-- Should work in most cases if the type is already and instance-- of Version. -- Ex: @$(deriveSerialize ''Foo)@deriveSerialize::Name->Q[Dec]deriveSerializename=doc<-parseInfonamecasecofTaggedconscxkeys->doletcontext=[mkCtx''Serialize[varTkey]|key<-keys]++mapreturncxi<-instanceD(sequencecontext)(mkType''Serialize[mkTypename(mapvarTkeys)])[putCopyFncons,getCopyFncons]return[i]whereputCopyFncons=doinp<-newName"inp"letputCopyBody=appE(varE'contain)$caseE(varEinp)$[doargs<-replicateMnArgs(newName"arg")letmatchCon=conPconName(mapvarPargs)matchmatchCon(normalB(putCopyWorkargsi))[]|((conName,nArgs),i)<-zipcons[0..]]putCopyWorkargsi=doE$[noBindS[|putWord8$(litE(integerLi))|]]++[noBindS[|safePut$(varEarg)|]|arg<-args]funD'putCopy[clause[varPinp](normalBputCopyBody)[]]getCopyFncons=letgetCopyBody=doc<-newName"c"appE(varE'contain)$doE[bindS(varPc)[|getWord8|],noBindS$caseE(varEc)$[doargs<-replicateMnArgs(newName"arg")match(litP(integerLi))(normalB$getCopyWorkconNameargs)[]|((conName,nArgs),i)<-zipcons[0..]]++[match(returnWildP)(normalB[|error"Wrong serialization type"|])[]]]getCopyWorkconNameargs=doE$[bindS(varParg)[|safeGet|]|arg<-args]++[noBindS[|return$(foldlappE(conEconName)(mapvarEargs))|]]infunD'getCopy[clause[](normalBgetCopyBody)[]]#if MIN_VERSION_template_haskell(2,4,0)mkCtx=classP#elsemkCtx=mkType#endif-- | Derives Serialize for a list of typesderiveSerializeFor::[Name]->Q[Dec]deriveSerializeFor=liftMconcat.mapMderiveSerializemkType::Name->[TypeQ]->TypeQmkTypecon=foldlappT(conTcon)parseInfo::Name->QClassparseInfoname=doinfo<-reifynamecaseinfoofTyConI(DataDcx_keyscs_)->return$Tagged(mapconInfocs)cx$mapconvkeysTyConI(NewtypeDcx_keyscon_)->return$Tagged[conInfocon]cx$mapconvkeys_->error"Invalid input"whereconInfo(NormalCnargs)=(n,lengthargs)conInfo(RecCnargs)=(n,lengthargs)conInfo(InfixC_n_)=(n,2)conInfo(ForallC__con)=conInfocon#if MIN_VERSION_template_haskell(2,4,0)conv(PlainTVnm)=nmconv(KindedTVnm_)=nm#elseconv=id#endif