{-# LANGUAGE PatternGuards #-}-- | Expand type synonyms in data declarations.-- -- This is needed for some type based derivations.moduleLanguage.Haskell.TH.ExpandSynonym(expandData)whereimportLanguage.Haskell.THimportLanguage.Haskell.TH.CompatimportLanguage.Haskell.TH.DataimportData.Generics-- | Expand type synonyms in a data declarationexpandData::DataDef->QDataDefexpandData=everywhereM(mkMexpandType)expandType::Type->QTypeexpandTypet=expandType't[]-- Walk over a type, collecting applied argumentsexpandType'::Type->[Type]->QTypeexpandType'(AppTtarg)args=expandType't(arg:args)expandType't@(ConTname)args=doresult<-expandSynnameargscaseresultofJust(t',args')->everywhereM(mkMexpandType)$foldlAppTt'args'_->return$foldlAppTtargsexpandType'targs=return$foldlAppTtargs-- Is the name a type synonym and are there enough arguments? if so, apply itexpandSyn::Name->[Type]->Q(Maybe(Type,[Type]))expandSynnameargs=recover(returnNothing)$doinfo<-reifynamecaseinfoofTyConI(TySynD_synArgst)|lengthargs>=lengthsynArgs->return$Just(substitute(mapfromTyVarsynArgs)argsInstt,argsMore)-- instantiate type synonymwhere(argsInst,argsMore)=splitAt(lengthsynArgs)args_->returnNothing-- `recover` return Nothing-- Substitute names for types in a typesubstitute::[Name]->[Type]->Type->Typesubstitutensts=subst(zipnsts)wheresubsts(ForallTnsctxt)=ForallTnsctx(subst(filter((`notElem`(mapfromTyVarns)).fst)s)t)substs(VarTn)|Justt'<-lookupns=t'substs(AppTab)=AppT(substsa)(substsb)subst_t=t