+
+
+
+------------------------------------------------------------------------------
+--
+-- Typeable adopted for unary type constructors
+-- This adoption is at an experimental stage.
+--
+------------------------------------------------------------------------------
+
+
+-- | Variant for unary type constructors
+class Typeable (t ()) => Typeable1 t where
+ typeOf1 :: t a -> TyCon
+
+
+-- | Variant for binary type constructors
+class Typeable (t () ()) => Typeable2 t where
+ typeOf2 :: t a b -> TyCon
+
+
+-- | Instance for lists
+instance Typeable1 [] where
+ typeOf1 _ = typerepTyCon (typeOf (undefined::[()]))
+
+
+-- | Instance for maybes
+instance Typeable1 Maybe where
+ typeOf1 _ = typerepTyCon (typeOf (undefined::Maybe ()))
+
+
+-- | Instance for products
+instance Typeable2 (,) where
+ typeOf2 _ = typerepTyCon (typeOf (undefined::((),())))
+
+
+-- | Instance for sums
+instance Typeable2 Either where
+ typeOf2 _ = typerepTyCon (typeOf (undefined::Either () ()))
+
+
+-- | Instance for functions
+instance Typeable2 (->) where
+ typeOf2 _ = typerepTyCon (typeOf (undefined::() -> ()))
+
+
+-- | Cast for * -> *
+cast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a))
+cast1 x = r
+ where
+ r = if typeOf1 (getArg x) == typeOf1 (getArg (fromJust r))
+ then Just $ unsafeCoerce x
+ else Nothing
+ getArg :: c x -> x
+ getArg = undefined
+
+
+-- | Cast for * -> * -> *
+cast2 :: (Typeable2 t, Typeable2 t') => c (t a b) -> Maybe (c (t' a b))
+cast2 x = r
+ where
+ r = if typeOf2 (getArg x) == typeOf2 (getArg (fromJust r))
+ then Just $ unsafeCoerce x
+ else Nothing
+ getArg :: c x -> x
+ getArg = undefined