[Haskell-cafe] Uniplate and rewriting with different types

28 Jan 2013

      Hi all,

I have a question about the Uniplate library, regarding rewriting with
transformations that have different types.

With the following type, and transformation functions:

    data Odd = OddOne Even | OddZero Even          deriving (Data,Typeable,Show)
    data Even = EvenOne Odd | EvenZero Odd | Nil   deriving (Data,Typeable,Show)

    t1,t2,t3 :: Even -> Maybe Even

    t1 (EvenOne (OddOne x)) = Just $ EvenOne (OddZero x)
    t1 x                    = Nothing

    t2 (EvenOne (OddZero x)) = Just $ EvenZero (OddOne x)
    t2 x                     = Nothing

    t3 (EvenZero (OddOne x)) = Just $ EvenZero (OddZero x)
    t3 x                     = Nothing

it is easy to combine the transformations into a single
transformation, because they all have the same type.  The result can
then be passed to the Uniplate's "rewriteBi" function:

    allts x = t1 x `mplus` t2 x `mplus` t3 x
    example = OddOne (EvenOne (OddOne (EvenOne (OddOne Nil))))
    go = rewriteBi allts example

But if one of the transformations has a different type, you can't do
it this way.  For instance, redefine t2 to have a different type:

    t2 :: Odd -> Maybe Odd
    t2 (OddZero (EvenOne x)) = Just $ OddZero (EvenZero x)
    t2 x                     = Nothing

and you are stuck because the functions of different types can't be
combined into a single transformation.

My question is: is there a good way to combine the transformation
functions if they have different types?

I have come up with a possible solution (see below), but I am not sure
that it is the right approach, and it is probably inefficient.

Chris Mears

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import Control.Monad.State
import Data.Generics
import Data.Generics.Uniplate.Data

data Odd = OddOne Even | OddZero Even          deriving (Data,Typeable,Show)
data Even = EvenOne Odd | EvenZero Odd | Nil   deriving (Data,Typeable,Show)

t1 (EvenOne (OddOne x)) = Just $ EvenOne (OddZero x)
t1 x                    = Nothing

t2 :: Odd -> Maybe Odd
t2 (OddZero (EvenOne x)) = Just $ OddZero (EvenZero x)
t2 x                     = Nothing

t3 (EvenZero (OddOne x)) = Just $ EvenZero (OddZero x)
t3 x                     = Nothing

-- The transformers are wrapped in an existential type.
data WrappedTransformer from =
  forall to. (Data to, Biplate from to) => WrappedTransformer (to -> Maybe to)

-- Apply a single transformation, and return "Just x" if the
-- transformation fired (where x is the result of the rewriting), and
-- "Nothing" if no transformation fired.
rewriteBiCheck :: Biplate from to => (to -> Maybe to) -> from -> Maybe from
rewriteBiCheck f e =
    case runState (rewriteBiM check e) False of
      (e', True) -> Just e'
      (_, False) -> Nothing
  where check x = case f x of
                    Nothing -> return Nothing
                    Just y -> put True >> return (Just y)

-- Apply a list of wrapped transformations until no more
-- transformations can be applied.
rewriteBiList :: forall from. [WrappedTransformer from] -> from -> from
rewriteBiList transformers m = go transformers m
  where go :: [WrappedTransformer from] -> from -> from
        go [] m = m
        go ((WrappedTransformer t):ts) m = case rewriteBiCheck t m of
                                           Just m' -> go transformers m'
                                           Nothing -> go ts m

-- Test case.
example = OddOne (EvenOne (OddOne (EvenOne (OddOne Nil))))

go = rewriteBiList [ WrappedTransformer t1
                   , WrappedTransformer t2
                   , WrappedTransformer t3 ] example