Uniplate functions universe and transform implemented in the Multiplate API.

uni2multi.hs

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ViewPatterns #-}
import Data.Generics.Uniplate.Operations (Uniplate(..))
import Data.Generics.Str

import Data.Generics.Multiplate
import Data.Functor.Constant
import Data.Functor.Identity
import Data.Traversable (traverse)

import Control.Newtype

instance Newtype (Constant a b) a where pack = Constant; unpack = getConstant
instance Newtype (Identity a  ) a where pack = Identity; unpack = runIdentity



newtype Uni on f = Uni { uni :: on -> f on }

instance Newtype (Uni on f) (on -> f on) where pack = Uni; unpack = uni


instance Uniplate on => Multiplate (Uni on) where
  
  multiplate (Uni f) = Uni (descendA f)
    where 
      descendA f (uniplate -> (current, generate)) = fmap generate (traverse f current)

  mkPlate builder = Uni (builder uni)


universe :: Uniplate on => on -> [on]
universe = ala' Constant (under Uni preorderFold) return

transform :: Uniplate on => (on -> on) -> on -> on
transform = ala' Identity (under Uni mapFamily)



data Expr = Val Int
           | Neg Expr
           | Add Expr Expr
           deriving (Show)

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)

expr = Add (Val 1) (Neg (Val 2))
testu = universe expr
testt = transform f expr
    where f (Neg (Val i)) = Val (negate i)
          f x = x