Instantly share code, notes, and snippets.

What would you like to do?
Uniplate functions universe and transform implemented in the Multiplate API.
{-# 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)
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment