{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} module Main where --import Control.Monad import Data.Generics.Geniplate data T a = T { x :: Int, y :: a } deriving (Show) data B a = MT Bool | Bin (B a) a Bool (B a) deriving (Show) tree x = Bin (Bin (MT True) x True (MT False)) x False (MT True) uni :: [(Maybe Int, T Int, [Double])] -> [Int] uni = $(universeBi 'uni) uniT :: [(Maybe Int, T Int, [Double])] -> [Int] uniT = $(universeBiT [ [t|Maybe Int|] ] 'uniT) uni2 :: [B Bool] -> [Int] uni2 = $(universeBi 'uni2) uni3 :: [B Bool] -> [Bool] uni3 = $(universeBi 'uni3) uni4 :: B Char -> [B Char] uni4 = $(universeBi 'uni4) uni5 :: [Int] -> [[Int]] uni5 = $(universeBi 'uni5) trans :: (Int -> Int) -> [(Bool,T String)] -> [(Bool,T String)] trans = $(transformBi 'trans) trans1 :: (Bool -> Bool) -> B Char -> B Char trans1 = $(transformBi 'trans1) trans2 :: (Bool -> Bool) -> B Bool -> B Bool trans2 = $(transformBi 'trans2) trans4 :: (B Char -> B Char) -> B Char -> B Char trans4 = $(transformBi 'trans4) trans5 :: (Int -> Maybe Int) -> [Int] -> Maybe [Int] trans5 = $(transformBiM 'trans5) trans6 :: (Int -> Maybe Int) -> [(Int, Bool)] -> Maybe [(Int, Bool)] trans6 = $(transformBiM 'trans6) trans7 :: (Int -> IO Int) -> B Int -> IO (B Int) trans7 = $(transformBiM 'trans7) trans8 :: (Bool -> IO Bool) -> B Bool -> IO (B Bool) trans8 = $(transformBiM 'trans8) trans9 :: (B Char -> IO (B Char)) -> B Char -> IO (B Char) trans9 = $(transformBiM 'trans9) main :: IO () main = do print $ uni [(Just 12, T 1 2, [1.1]), (Just 345, T 3 4, [2.2]), (Nothing, T 5 6, [3.3])] print $ uniT [(Just 12, T 1 2, [1.1]), (Just 345, T 3 4, [2.2]), (Nothing, T 5 6, [3.3])] print $ uni2 $ [tree True, tree False] print $ uni3 $ [tree True, tree False] print $ trans (+1) [(True,T 1 "a"), (False,T 2 "b")] print $ trans1 not $ tree 'a' print $ trans2 not $ tree True print $ uni4 $ tree 'a' let f (MT b) = MT (not b) f (Bin t1 x b t2) = Bin t1 x (not b) t2 print $ trans4 f $ tree 'a' print $ uni5 [1,2] print $ trans5 Just [1,2,3] print $ trans5 (\ x -> if x==2 then Nothing else Just x) [1,2,3] print $ trans6 Just [(1, True)] trans7 (\ x -> do print x; return (x+100)) (tree 3) >>= print trans8 (\ x -> do print x; return (not x)) (tree True) >>= print trans9 (\ x -> do print x; return x) (tree 'a') >>= print