codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
{-# LANGUAGE DeriveDataTypeable, RankNTypes#-} {-# OPTIONS -Wall #-} import Data.Data import Data.Maybe(maybeToList) import Data.Generics.Schemes data ABC = ABC Int Double String deriving (Eq, Show, Data, Typeable) data A = A String | Abc B C deriving (Eq, Show, Data, Typeable) data B = B Double | Bca C A deriving (Eq, Show, Data, Typeable) data C = C Int | Cab A B deriving (Eq, Show, Data, Typeable) abc1 :: ABC abc1 = ABC 2012 1.1 "Tatsu" a1 :: A a1 = Abc (Bca (Cab (A "Happy") (B 4.2)) (Abc (B 5.6) (C 512))) (Cab (Abc (B 8.4) (C 208)) (Bca (C 2012) (A "New Year!"))) recMapQ' :: forall a a1 a2. (Data a1, Data a2) => (a1->a) -> a2 -> [a] recMapQ' f x = (maybeToList $ fmap f (cast x)) ++ concat (gmapQ (recMapQ' f) x) recMapQ :: forall a a1 a2. (Data a1, Data a2) => (a1->a) -> a2 -> [a] recMapQ f x = case fmap f (cast x) of Just y -> [y] Nothing -> concat (gmapQ (recMapQ f) x) recMapT :: forall a b. (Data a, Data b) => (b -> b) -> a -> a recMapT f x = let y = gmapT (recMapT f) x in case (>>= cast) $ fmap f $ cast x of Just z -> z Nothing -> y caster :: (Typeable a) => (a -> a) -> (forall b. Typeable b => b -> b) caster f x = case (cast =<<) $ fmap f $ cast x of Just y -> y Nothing -> x main :: IO () main = do print a1 print $ gsize a1 print $ recMapQ ("Very " ++) a1 print $ recMapT ("Very " ++) a1 -- print $ everywhere (caster $ ("Very " ++)) a1 -- print $ everywhere'(caster $ ("Very " ++)) a1
Private
[
?
]
Run code
Submit