[Haskell-cafe] Uniplate and rewriting with different types
Chris Mears
chris at cmears.id.au
Tue Jan 29 00:38:55 CET 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
More information about the Haskell-Cafe
mailing list