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