{-# OPTIONS_GHC -fglasgow-exts -cpp -fallow-undecidable-instances #-}{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, ExistentialQuantification, Rank2Types, CPP #-}-- OPTIONS_GHC is required only for 6.4.2, not 6.6.1{- |
This module exports 'Biplate' instances for everything with 'Data' defined.
Using GHC the 'Data' instances can be constructed with @deriving Data@.
-}moduleData.Generics.PlateData(moduleData.Generics.Biplate)whereimportData.Generics.BiplateimportData.Generics.PlateInternalimportData.Generics.StrimportData.GenericsimportData.MaybeimportData.ListimportqualifiedData.IntSetasIntSetimportControl.Monad.State-- | An existential box representing a type which supports SYB-- operations.dataDataBox=foralla.(Typeablea,Dataa)=>DataBoxadataBoxfind=Box{fromBox::foralla.Typeablea=>a->Answerfind}dataAnswera=Hit{fromHit::a}-- you just hit the element you were after (here is a cast)|Follow-- go forward, you will find something|Miss-- you failed to sink my battleship!containsMatch::(Datastart,Typeablestart,Datafind,Typeablefind)=>start->find->Boxfind#if __GLASGOW_HASKELL__ < 606-- GHC 6.4.2 does not export typeRepKey, so we can't do the trick-- as efficiently, so we just give up and revert to always followingcontainsMatchstartfind=Boxquerywherequerya=casecastaofJusty->HityNothing->Follow#else-- GHC 6.6 does contain typeRepKey, so only follow when appropriatecontainsMatchstartfind=BoxquerywheretypeIntx=inlinePerformIO$typeRepKeyxquery::Typeablea=>a->Answerfindquerya=iftifind==tiathenHit(unsafeCasta)elseiftia`IntSet.member`timatchthenFollowelseMisswheretia=typeInt$typeOfatifind=typeInttfindtimatch=IntSet.fromList$maptypeInttmatchtfind=typeOffindtmatch=f[tfind](filter((/=)tfind.fst)$containsListstart)fwanthave=ifnullwant2then[]elsewant2++fwant2nowherewant2=mapfstyes(yes,no)=partition(not.null.intersectwant.snd)havecontainsList::(Dataa,Typeablea)=>a->[(TypeRep,[TypeRep])]containsListx=f[][DataBoxx]wherefdone[]=[]fdone(DataBoxt:odo)|tt`elem`done=fdoneodo|otherwise=(tt,map(\(DataBoxa)->typeOfa)xs):f(tt:done)(xs++odo)wherett=typeOftxs=containstcontains::(Dataa,Typeablea)=>a->[DataBox]containsx=ifisAlgTypedtypthenconcatMapfctrselse[]wherefctr=gmapQDataBox(asTypeOf(fromConstrctr)x)ctrs=dataTypeConstrsdtypdtyp=dataTypeOfx#endifinstance(Dataa,Typeablea)=>Uniplateawhereuniplate=collect_generate(fromBoxanswer)whereanswer::Boxaanswer=containsMatch(undefined::a)(undefined::a)instance(Dataa,Datab,Uniplateb,Typeablea,Typeableb)=>Biplateabwherebiplate=collect_generate_self(fromBoxanswer)whereanswer::Boxbanswer=containsMatch(undefined::a)(undefined::b)newtypeCxa=C{fromC::CCxa}typeCCxa=(Strx,Strx->a)collect_generate_self::(Dataon,Datawith,Typeableon,Typeablewith)=>(foralla.Typeablea=>a->Answerwith)->on->CCwithoncollect_generate_selforaclex=reswhereres=caseoraclexofHity->(Oney,\(Onex)->unsafeCastx)Follow->collect_generateoraclexMiss->(Zero,\_->x)collect_generate::(Dataon,Datawith,Typeableon,Typeablewith)=>(foralla.Typeablea=>a->Answerwith)->on->CCwithoncollect_generateoracleitem=fromC$gfoldlcombinecreateitemwhere-- forall a b . Data a => C with (a -> b) -> a -> C with bcombine(C(c,g))x=casecollect_generate_selforaclexof(c2,g2)->C(Twocc2,\(Twoc'c2')->gc'(g2c2'))-- forall g . g -> C with gcreatex=C(Zero,\_->x)