1{-# OPTIONS -fglasgow-exts #-} 2{-# LANGUAGE CPP #-} 3 4module Ext1 (tests) where 5 6{- 7 8This example records some experiments with polymorphic datatypes. 9 10-} 11 12import Test.HUnit 13 14import Data.Generics 15#if MIN_VERSION_base(4,8,0) 16import GHC.Base hiding(foldr) 17#else 18import GHC.Base 19#endif 20 21-- Unsafe coerce 22unsafeCoerce :: a -> b 23unsafeCoerce = unsafeCoerce# 24 25 26-- Handy type constructors 27newtype ID x = ID { unID :: x } 28newtype CONST c a = CONST { unCONST :: c } 29 30 31-- Extension of a query with a para. poly. list case 32extListQ' :: Data d 33 => (d -> q) 34 -> (forall d. [d] -> q) 35 -> d -> q 36extListQ' def ext d = 37 if isList d 38 then ext (unsafeCoerce d) 39 else def d 40 41 42-- Test extListQ' 43foo1 :: Data d => d -> Int 44foo1 = const 0 `extListQ'` length 45t1 = foo1 True -- should count as 0 46t2 = foo1 [True,True] -- should count as 2 47 48 49-- Infeasible extension of a query with a data-polymorphic list case 50extListQ'' :: Data d 51 => (d -> q) 52 -> (forall d. Data d => [d] -> q) 53 -> d -> q 54extListQ'' def ext d = 55 if isList d 56 then undefined -- hard to avoid an ambiguous type 57 else def d 58 59 60-- Test extListQ from Data.Generics.Aliases 61foo2 :: Data a => a -> Int 62foo2 = const 0 `ext1Q` list 63 where 64 list :: Data a => [a] -> Int 65 list l = foldr (+) 0 $ map glength l 66 67t3 = foo2 (True,True) -- should count as 0 68t4 = foo2 [(True,True),(True,True)] -- should count as 2+2=4 69 70 71-- Customisation for lists without type cast 72foo3 :: Data a => a -> Int 73foo3 x = if isList x 74 then foldr (+) 0 $ gmapListQ glength x 75 else 0 76 77t5 = foo3 (True,True) -- should count as 0 78t6 = foo3 [(True,True),(True,True)] -- should count as 2+2=4 79 80 81-- Test for list datatype 82isList :: Data a => a -> Bool 83isList x = typeRepTyCon (typeOf x) == 84 typeRepTyCon (typeOf (undefined::[()])) 85 86 87-- Test for nil 88isNil :: Data a => a -> Bool 89isNil x = toConstr x == toConstr ([]::[()]) 90 91 92-- Test for cons 93isCons :: Data a => a -> Bool 94isCons x = toConstr x == toConstr (():[]) 95 96 97-- gmapQ for polymorphic lists 98gmapListQ :: forall a q. Data a => (forall a. Data a => a -> q) -> a -> [q] 99gmapListQ f x = 100 if not $ isList x 101 then error "gmapListQ" 102 else if isNil x 103 then [] 104 else if isCons x 105 then ( gmapQi 0 f x : gmapQi 1 (gmapListQ f) x ) 106 else error "gmapListQ" 107 108 109-- Build nil 110mkNil :: Data a => a 111mkNil = fromConstr $ toConstr ([]::[()]) 112 113 114-- Build cons 115mkCons :: Data a => a 116mkCons = fromConstr $ toConstr ((undefined:undefined)::[()]) 117 118 119-- Main function for testing 120tests = ( t1 121 , ( t2 122 , ( t3 123 , ( t4 124 , ( t5 125 , ( t6 126 )))))) ~=? output 127 128output = (0,(2,(0,(4,(0,4))))) 129