[Haskell-cafe] A yet another question about subtyping and heterogeneous collections

[Dmitry Vyal]

On 10/18/2012 03:20 PM, MigMit wrote:
> Why do you need "ALike x", "BLike x" etc.? Why not just "Like u x"?
>

Hmm, looks like a nice idea. I tried it, unfortunately I can't cope with 
compiler error messages:

tst.hs:32:15:
     Context reduction stack overflow; size = 201
     Use -fcontext-stack=N to increase stack size to N
       Upcast a b
     In the first argument of `(.)', namely `(upcast :: b -> a)'
     In the expression: (upcast :: b -> a) . (upcast :: c -> b)
     In the expression: (upcast :: b -> a) . (upcast :: c -> b) $ x


{-# LANGUAGE FlexibleInstances, UndecidableInstances, 
OverlappingInstances, ExistentialQuantification, DeriveDataTypeable, 
MultiParamTypeClasses, FlexibleContexts,
IncoherentInstances #-}

import Data.Typeable
import Data.Maybe

data A = A {a_x :: Int} deriving (Show, Typeable)
data B = B {b_x :: Int, b_a :: A} deriving (Show, Typeable)
data C = C {c_z :: Int, c_b :: B} deriving (Show, Typeable)
data D = D {d_w :: Int, d_c :: C, d_a :: A} deriving (Show, Typeable)

class Upcast c x where
   upcast :: x -> c

instance Upcast x x where
   upcast = id

instance Upcast A B where upcast = b_a
instance Upcast B C where upcast = c_b
instance Upcast C D where upcast = d_c

instance (Upcast a b, Upcast b c) => Upcast a c where
   upcast = (upcast :: b -> a) . (upcast :: c -> b)

a1 = A 1
b1 = B 2 (A 2)
c1 = C 3 b1
d1 = D 4 c1 (A 10)

print_a :: Upcast A x => x -> String
print_a v = "A = " ++ show (a_x $ upcast v)

sum_a :: (Upcast A x, Upcast A y) => x -> y -> String
sum_a v1 v2 = "A1 = " ++ show (a_x $ upcast v1) ++ " A2 = " ++ show (a_x 
$ upcast v2)


data LikeA = forall a. (Upcast A a, Typeable a) => LikeA a

--instance Upcast a LikeA where
--  upcast (LikeA x) = upcast x

lst_a = [LikeA a1, LikeA b1, LikeA c1, LikeA d1]

get_mono :: Typeable b => [LikeA] -> [b]
get_mono = catMaybes . map ((\(LikeA x) -> cast x))

data LikeC = forall c. (Upcast C c, Typeable c) => LikeC c

--instance Upcast C LikeC where
--  upcast (LikeC x) = upcast x

lst_c = [LikeC c1, LikeC d1]