{- |
This is the main Uniplate module, which defines all the essential operations
in a Haskell 98 compatible manner.
Most functions have an example of a possible use for the function.
To illustate, I have used the @Expr@ type as below:
> data Expr = Val Int
> | Neg Expr
> | Add Expr Expr
-}moduleData.Generics.UniplateStr(moduleData.Generics.UniplateStr,moduleData.Generics.Str)whereimportControl.Monadhiding(mapM)importData.List(inits,tails)importControl.Monad.Statehiding(mapM)importData.TraversableimportPreludehiding(mapM)importData.Generics.PlateInternalimportData.Generics.Str-- * The Class-- | The type of replacing all the children of a node---- Taking a value, the function should return all the immediate children-- of the same type, and a function to replace them.typeUniplateTypeon=on->(Stron,Stron->on)-- | The standard Uniplate class, all operations require this.classUniplateonwhere-- | The underlying method in the class.---- Given @uniplate x = (cs, gen)@---- @cs@ should be a @Str on@, constructed of @Zero@, @One@ and @Two@,-- containing all @x@'s direct children of the same type as @x@. @gen@-- should take a @Str on@ with exactly the same structure as @cs@,-- and generate a new element with the children replaced.---- Example instance:---- > instance Uniplate Expr where-- > uniplate (Val i ) = (Zero , \Zero -> Val i )-- > uniplate (Neg a ) = (One a , \(One a) -> Neg a )-- > uniplate (Add a b) = (Two (One a) (One b), \(Two (One a) (One b)) -> Add a b)uniplate::UniplateTypeon-- | Compatibility method, for direct users of the old list-based 'uniplate' functionuniplateList::Uniplateon=>on->([on],[on]->on)uniplateListx=(c,b.d)where(a,b)=uniplatex(c,d)=strStructurea-- * The Operations-- ** Queries-- | Get all the children of a node, including itself and all children.---- > universe (Add (Val 1) (Neg (Val 2))) =-- > [Add (Val 1) (Neg (Val 2)), Val 1, Neg (Val 2), Val 2]---- This method is often combined with a list comprehension, for example:---- > vals x = [Val i | i <- universe x]universe::Uniplateon=>on->[on]universex=builderfwherefconsnil=gconsnil(Onex)nilgconsnilZerores=resgconsnil(Onex)res=x`cons`gconsnil(fst$uniplatex)resgconsnil(Twoxy)res=gconsnilx(gconsnilyres)-- | Get the direct children of a node. Usually using 'universe' is more appropriate.---- @children = fst . 'uniplate'@children::Uniplateon=>on->[on]childrenx=builderfwherefconsnil=gconsnil(fst$uniplatex)nilgconsnilZerores=resgconsnil(Onex)res=x`cons`resgconsnil(Twoxy)res=gconsnilx(gconsnilyres)-- ** Transformations-- | Transform every element in the tree, in a bottom-up manner.---- For example, replacing negative literals with literals:---- > negLits = trasform f-- > where f (Neg (Lit i)) = Lit (negate i)-- > f x = xtransform::Uniplateon=>(on->on)->on->ontransformf=f.descend(transformf)-- | Monadic variant of 'transform'transformM::(Monadm,Uniplateon)=>(on->mon)->on->montransformMfx=f=<<descendM(transformMf)x-- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot-- be applied anywhere in the result:---- > propRewrite r x = all (isNothing . r) (universe (rewrite r x))---- Usually 'transform' is more appropriate, but 'rewrite' can give better-- compositionality. Given two single transformations @f@ and @g@, you can-- construct @f `mplus` g@ which performs both rewrites until a fixed point.rewrite::Uniplateon=>(on->Maybeon)->on->onrewritef=transformgwheregx=maybex(rewritef)(fx)-- | Monadic variant of 'rewrite'rewriteM::(Monadm,Uniplateon)=>(on->m(Maybeon))->on->monrewriteMf=transformMgwheregx=fx>>=maybe(returnx)(rewriteMf)-- | Perform a transformation on all the immediate children, then combine them back.-- This operation allows additional information to be passed downwards, and can be-- used to provide a top-down transformation.descend::Uniplateon=>(on->on)->on->ondescendfx=generate$fmapfcurrentwhere(current,generate)=uniplatex-- | Monadic variant of 'descend' descendM::(Monadm,Uniplateon)=>(on->mon)->on->mondescendMfx=liftMgenerate$mapMfcurrentwhere(current,generate)=uniplatex-- ** Others-- | Return all the contexts and holes.---- > propUniverse x = universe x == map fst (contexts x)-- > propId x = all (== x) [b a | (a,b) <- contexts x]contexts::Uniplateon=>on->[(on,on->on)]contextsx=(x,id):f(holesx)wherefxs=[(y,ctx.context)|(child,ctx)<-xs,(y,context)<-contextschild]-- | The one depth version of 'contexts'---- > propChildren x = children x == map fst (holes x)-- > propId x = all (== x) [b a | (a,b) <- holes x]holes::Uniplateon=>on->[(on,on->on)]holesx=uncurryf(uniplatex)wherefZero_=[]f(Onei)generate=[(i,generate.One)]f(Twolr)gen=fl(gen.(\i->Twoir))++fr(gen.(\i->Twoli))-- | Perform a fold-like computation on each value,-- technically a paramorphismpara::Uniplateon=>(on->[r]->r)->on->rparaopx=opx$map(paraop)$childrenx