haskell - Simplifying a GADT with Uniplate -

i'm trying answer this stackoverflow question, using uniplate suggested, the solution i've come far pretty ugly.

this seems common issue, wanted know if there more elegant solution.

basically, we've got gadt resolves either expression int or expression bool (ignoring codataif = if (b true) codataif codataif):

data expression     :: int -> expression int     b :: bool -> expression bool     add :: expression int  -> expression int  -> expression int     mul :: expression int  -> expression int  -> expression int     eq  :: expression int  -> expression int  -> expression bool     , :: expression bool -> expression bool -> expression bool     or  :: expression bool -> expression bool -> expression bool     if  :: expression bool -> expression    -> expression -> expression 

and (in version of problem) want able evaluate expression tree bottom-up using simple operation combine leaves new leaf:

step :: expression -> expression step = \case   add (i x) (i y)   -> $ x + y   mul (i x) (i y)   -> $ x * y   eq (i x) (i y)    -> b $ x == y   , (b x) (b y)   -> b $ x && y   or (b x) (b y)    -> b $ x || y   if (b b) x y      -> if b x else y   z                 -> z 

i had difficulty using dataderiving derive uniplate , biplate instances (which maybe should have been red flag), rolled own uniplate instances expression int, expression bool, , biplate instances (expression a) (expression a), (expression int) (expression bool), , (expression bool) (expression int).

this let me come these bottom-up traversals:

evalint :: expression int -> expression int evalint = transform step  evalintbi :: expression bool -> expression bool evalintbi = transformbi (step :: expression int -> expression int)  evalbool :: expression bool -> expression bool evalbool = transform step  evalboolbi :: expression int -> expression int evalboolbi = transformbi (step :: expression bool -> expression bool) 

but since each of these can 1 transformation (combine int leaves or bool leaves, not either), can't complete simplification, must chained manually:

λ example1 if (eq (i 0) (add (i 0) (i 0))) (i 1) (i 2) λ evalint if (eq (i 0) (i 0)) (i 1) (i 2) λ evalboolbi if (b true) (i 1) (i 2) λ evalint 1 λ example2 if (eq (i 0) (add (i 0) (i 0))) (b true) (b false) λ evalintbi if (eq (i 0) (i 0)) (b true) (b false) λ evalbool b true 

my hackish workaround define uniplate instance either (expression int) (expression bool):

type  wexp = either (expression int) (expression bool)  instance uniplate wexp   uniplate = \case       left (add x y)    -> plate (i2 left add)  |* left x  |* left y       left (mul x y)    -> plate (i2 left mul)  |* left x  |* left y       left (if b x y)   -> plate (bi2 left if)  |* right b |* left x  |* left y       right (eq x y)    -> plate (i2 right eq)  |* left x  |* left y       right (and x y)   -> plate (b2 right and) |* right x |* right y       right (or x y)    -> plate (b2 right or)  |* right x |* right y       right (if b x y)  -> plate (b3 right if)  |* right b |* right x |* right y       e                 -> plate e     i2 side op (left x) (left y) = side (op x y)           i2 _ _ _ _ = error "type mismatch"           b2 side op (right x) (right y) = side (op x y)           b2 _ _ _ _ = error "type mismatch"           bi2 side op (right x) (left y) (left z) = side (op x y z)           bi2 _ _ _ _ _ = error "type mismatch"           b3 side op (right x) (right y) (right z) = side (op x y z)           b3 _ _ _ _ _ = error "type mismatch"  evalwexp :: wexp -> wexp evalwexp = transform (either (left . step) (right . step)) 

now can complete simplification:

λ evalwexp . left $ example1 left (i 1) λ evalwexp . right $ example2 right (b true) 

but amount of error , wrapping/unwrapping had make work makes feel inelegant , wrong me.

is there right way solve problem with uniplate?

there isn't right way solve problem uniplate, there right way solve problem same mechanism. uniplate library doesn't support uniplating data type kind * -> *, can create class accommodate that. here's little minimal uniplate library types of kind * -> *. based on current git version of uniplate has been changed use applicative instead of str.

{-# language rankntypes #-}  import control.applicative import control.monad.identity  class uniplate1 f     uniplate1 :: applicative m => f -> (forall b. f b -> m (f b)) -> m (f a)      descend1 :: (forall b. f b -> f b) -> f -> f     descend1 f x = runidentity $ descendm1 (pure . f) x      descendm1 :: applicative m => (forall b. f b -> m (f b)) -> f -> m (f a)     descendm1 = flip uniplate1  transform1 :: uniplate1 f => (forall b. f b -> f b) -> f -> f transform1 f = f . descend1 (transform1 f) 

now can write uniplate1 instance expression:

instance uniplate1 expression     uniplate1 e p = case e of         add x y -> lifta2 add (p x) (p y)         mul x y -> lifta2 mul (p x) (p y)         eq  x y -> lifta2 eq  (p x) (p y)         , x y -> lifta2 , (p x) (p y)         or  x y -> lifta2 or  (p x) (p y)         if  b x y -> pure if <*> p b <*> p x <*> p y         e -> pure e 

this instance similar emap function wrote in my answer original question, except instance places each item applicative functor. descend1 lifts argument identity , runidentity's result, making desend1 identical emap. transform1 identical postmap previous answer.

now, can define reduce in terms of transform1.

reduce = transform1 step 

this enough run example:

"reduce" if (and (b true) (or (b false) (b true))) (add (i 1) (mul (i 2) (i 3))) (i 0) 7