From 30dc0792daf83ce3e05e59719069263ffb88753e Mon Sep 17 00:00:00 2001
From: ralf <unknown>
Date: Tue, 24 Feb 2004 19:49:58 +0000
Subject: [PATCH] [project @ 2004-02-24 19:49:58 by ralf] Proliferation of
 unsafeCoerce in Data.Typeable stopped. (There is now just
 one cast0 which generalises on all previous forms: cast,
 castss, castarr.) Started classes Typeable1/2 for
 unary/binary type constructors. Added instances for lists,
 products, sums, functions, maybies.

---
 Data/Typeable.hs |  119 +++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 83 insertions(+), 36 deletions(-)

diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index 4c8050a..b0b6929 100644
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -2,7 +2,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Typeable
--- Copyright   :  (c) The University of Glasgow 2001
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
@@ -28,8 +28,7 @@ module Data.Typeable
 
 	-- * Type-safe cast
 	cast,			-- :: (Typeable a, Typeable b) => a -> Maybe b
-	castss,			-- a cast for kind "* -> *"
-	castarr,		-- another convenient variation
+	cast0,			-- a flexible variation on cast
 
 	-- * Type representations
 	TypeRep,	-- abstract, instance of: Eq, Show, Typeable
@@ -44,8 +43,13 @@ module Data.Typeable
 	-- * Observation of type representations
 	typerepTyCon,	-- :: TypeRep -> TyCon
 	typerepArgs,	-- :: TypeRep -> [TypeRep]
-	tyconString	-- :: TyCon   -> String
+	tyconString,	-- :: TyCon   -> String
 
+	-- * The Typeable1 class
+	Typeable1( typeOf1 ),	-- :: t a -> TyCon
+	Typeable2( typeOf2 ),	-- :: t a b -> TyCon
+	cast1,			-- :: ... => c (t a) -> Maybe (c (t' a))
+	cast2			-- :: ... => c (t a b) -> Maybe (c (t' a b))
 
   ) where
 
@@ -265,39 +269,16 @@ cast x = r
 	       else Nothing
 
 
--- | A convenient variation for kind \"* -> *\"
-castss :: (Typeable a, Typeable b) => t a -> Maybe (t b)
-castss x = r
-       where
-	 r = if typeOf (get x) == typeOf (get (fromJust r))
-               then Just $ unsafeCoerce x
-	       else Nothing
-         get :: t c -> c
-	 get = undefined
-
-
--- | Another variation
-castarr :: (Typeable a, Typeable b, Typeable c, Typeable d)
-        => (a -> t b) -> Maybe (c -> t d)
-castarr x = r
-       where
-	 r = if typeOf (get x) == typeOf (get (fromJust r))
-               then Just $ unsafeCoerce x
-	       else Nothing
-         get :: (e -> t f) -> (e, f)
-	 get = undefined
-
-{-
-
-The variations castss and castarr are arguably not really needed.
-Let's discuss castss in some detail. To get rid of castss, we can
-require "Typeable (t a)" and "Typeable (t b)" rather than just
-"Typeable a" and "Typeable b". In that case, the ordinary cast would
-work. Eventually, all kinds of library instances should become
-Typeable. (There is another potential use of variations as those given
-above. It allows quantification on type constructors.
+-- | A flexible variation parameterised in a type constructor
+cast0 :: (Typeable a, Typeable b) => c a -> Maybe (c b)
+cast0 x = r
+ where
+  r = if typeOf (getArg x) == typeOf (getArg (fromJust r))
+        then Just $ unsafeCoerce x
+        else Nothing
+  getArg :: c x -> x 
+  getArg = undefined
 
--}
 
 
 -------------------------------------------------------------
@@ -487,3 +468,69 @@ appKey k1 k2
 
 appKeys :: Key -> [Key] -> Key
 appKeys k ks = foldl appKey k ks
+
+
+
+------------------------------------------------------------------------------
+--
+--	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
-- 
1.7.10.4