1{-# OPTIONS -fglasgow-exts #-} 2 3module GZip (tests) where 4 5{- 6 7This test illustrates zipping for the company datatypes which we use a 8lot. We process two companies that happen to agree on the overall 9shape but differ in the salaries in a few positions. So whenever we 10encounter salaries we take the maximum of the two. 11 12-} 13 14import Test.HUnit 15 16import Data.Generics 17import CompanyDatatypes 18 19-- The main function which prints the result of zipping 20tests = gzip (\x y -> mkTT maxS x y) genCom1 genCom2 ~=? output 21 -- NB: the argument has to be eta-expanded to match 22 -- the type of gzip's argument type, which is 23 -- GenericQ (GenericM Maybe) 24 where 25 26 -- Variations on the show case company "genCom" 27 genCom1 = everywhere (mkT (double "Joost")) genCom 28 genCom2 = everywhere (mkT (double "Marlow")) genCom 29 double x (E p@(P y _) (S s)) | x == y = E p (S (2*s)) 30 double _ e = e 31 32 -- Sum up two salaries 33 maxS (S x) (S y) = S (max x y) 34 35 -- Make a two-arguments, generic function transformer 36 mkTT :: (Typeable a, Typeable b, Typeable c) 37 => (a -> a -> a) -> b -> c -> Maybe c 38 mkTT (f::a -> a -> a) x y = 39 case (cast x,cast y) of 40 (Just (x'::a),Just (y'::a)) -> cast (f x' y') 41 _ -> Nothing 42 43output = Just (C [D "Research" (E (P "Laemmel" "Amsterdam") (S 8000.0)) 44 [PU (E (P "Joost" "Amsterdam") (S 2000.0)) 45 ,PU (E (P "Marlow" "Cambridge") (S 4000.0))] 46 ,D "Strategy" (E (P "Blair" "London") (S 100000.0)) []]) 47