{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, IncoherentInstances, TypeFamilies #-}

data Box a = Box a

class Boxed b v where
    unwrap :: b -> v

instance Boxed b v => Boxed (Box b) v where
    unwrap (Box x) = unwrap x

instance (l ~ r) => Boxed l r where
    unwrap x = x

> unwrap (Box(Box(Box(Box(123)))))
123

template<class T>
struct Box
{
private:
    T _value;

public:
    T Get() const
    {
        return _value;
    }

    Box(T const& value)
        : _value(value)
    {}
};

template<class T>
Box<T> box(T const& value)
{
    return Box<T>(value);
}

template<class T>
struct UnwrapBoxedType
{
    typedef T type;
};

template<class T>
struct UnwrapBoxedType<Box<T> >
{
    typedef typename UnwrapBoxedType<T>::type type;
};

template<class T>
T unwrap(T const& value)
{
    return value;
}

template<class T>
typename UnwrapBoxedType<T>::type unwrap(Box<T> const& box)
{
    return unwrap(box.Get());
}

int main()
{
    std::cout << unwrap(box(box(box(box(box(box(123))))))) << std::endl;
    return 0;
}

>>> unwrap (Box (Box (Box (Box (Value 123)))))
D>>123
D>>

V>Ну, введя доп. рантайм флаг (дискриминатор алг. типа) можно на любом языке аналогично сделать.

{-# RULES
"unwrap/box"    forall b. unwrap (Box b) = unwrap b
"unwrap/value"  forall v. unwrap (Value v) = v
  #-}

main = do putStrLn test 
test = unwrap (Box (Box (Box (Box (Value "foo")))))

==================== Grand total simplifier statistics ====================
Total ticks:     36

8 PreInlineUnconditionally
4 UnfoldingDone
7 RuleFired
    1 unpack
    1 unpack-list
    4 unwrap/box
    1 unwrap/value
2 LetFloatFromLet
15 BetaReduction
10 SimplifierDone

template<class T>
struct Box
{
private:
    T _value;

public:
    T Get() const
    {
        return _value;
    }

    Box(T const& value)
        : _value(value)
    {}
};

template<class T>
Box<T> box(T const& value)
{
    return Box<T>(value);
}

template<class T>
struct Unwrap
{
    T operator()(T const& value)
    {
        return value;
    }
};

template<class T>
struct Unwrap<Box<T>>
{    
    auto operator()(Box<T> const& box) -> decltype(Unwrap<T>()(box.Get()))
    {
        return Unwrap<T>()(box.Get());
    }
};

template<class T>
auto unwrap(Box<T> const& box) -> decltype(Unwrap<Box<T>>()(box.Get()))
{
    return Unwrap<Box<T>>()(box.Get());
}

int main()
{
    std::cout << unwrap(box(box(box(box(box(box(123))))))) << std::endl;
    return 0;
}

int unwrap(int const& value)
{
    return value;
}

template<class T>
typename UnwrapBoxedType<T>::type unwrap(Box<T> const& box) 
{
    return unwrap(box.Get());
}

data Boxes a = Value a | Box (Boxes a)

unwrap :: Boxes t -> t
unwrap (Box b)   = unwrap b
unwrap (Value v) = v

> unwrap (Box (Box (Box (Box (Value 123)))))
123

data Box a = Box a

unwrap :: ??? -> t
???


unwrap (Box(Box(Box(Box(123)))))

interface IBoxedValue { object Value { get; } }
interface IBoxedValue<T> { T Value { get;} }

class Box<T> : IBoxedValue<T>, IBoxedValue { ... }

object GetRealObject(object o) {
  object tmp;
  while(null != (tmp=(o as IBoxedValue)))
    o = tmp.Value;

  return o;
}

auto p = &unwrap<Box<Box<Box<Box<Box<int>>>>>>;

L>instance (l ~ r) => Boxed l r where
L>    unwrap x = x

instance Boxed v v

instance (l ~ r) => Boxed l r

instance Boxed b v => Boxed (Box b) v where
    unwrap (Box x) = unwrap x

instance (l ~ r) => Boxed l r where
    unwrap x = x

L>То, чем ты занимаешься, называется "извращение". Присоединюсь, если ты не против

class Funct a b c d where
    f_map :: (a -> b) -> c -> d

instance (Functor m, Funct a b c d) => Funct a b (m c) (m d) where
    f_map = fmap . f_map

instance (a ~ c, b ~ d) => Funct a b c d where
    f_map = id

f_map not [True]

<interactive>:1:0:
Couldn't match expected type `[Bool]' against inferred type `Bool'
When generalising the type(s) for `it'

instance (Functor m, Funct a b c d) => Funct a b (m c) (m d) where
    f_map = fmap . f_map

instance Boxed b v => Boxed (Box b) v where
    unwrap (Box x) = unwrap x

f_map not [True]

instance (a ~ c, b ~ d) => Funct a b c d where

class Funct a b c d where
    f_map :: (a -> b) -> c -> d

instance (Funct a b c d) => Funct a b [c] [d] where
    f_map = map . f_map

instance (a ~ c, b ~ d) => Funct a b c d where
    f_map = id

data Box a = Box a

class Unboxable m where
    unbox :: m a -> a

instance Unboxable Box where
    unbox (Box a) = a

instance Unboxable [] where
    unbox [a] = a


class Boxed b v where
    unwrap :: b -> v

instance (Unboxable m, Boxed b v) => Boxed (m b) v where
    unwrap a = unwrap (unbox a)

instance (l ~ r) => Boxed l r where
    unwrap x = x

*Main> unwrap (Box [Box [[5]]])
5

Suppose that from the RHS of f we get the constraint C Int [b]. But GHC does not commit to instance (C), because in a particular call of f, b might be instantiate to Int, in which case instance (D) would be more specific still. So GHC rejects the program. (If you add the flag -XIncoherentInstances, GHC will instead pick (C), without complaining about the problem of subsequent instantiations.)

    Overlapping instances for Funct Bool Bool [Bool] d
      arising from a use of `f_map' at A.hs:12:14-29
    Matching instances:
      instance [overlap ok] (a ~ c, b ~ d) => Funct a b c d
        -- Defined at A.hs:9:9-39
      instance [overlap ok] (Funct a b c d) => Funct a b [c] [d]
        -- Defined at A.hs:6:9-44
    (The choice depends on the instantiation of `d'
     To pick the first instance above, use -XIncoherentInstances
     when compiling the other instance declarations)
    In the first argument of `print', namely `(f_map not [True])'
    In the expression: print (f_map not [True])
    In the definition of `main': main = print (f_map not [True])

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances,
TypeFamilies, IncoherentInstances, ScopedTypeVariables #-}

class Funct a b c d where
    f_map :: (a -> b) -> c -> d

instance (Functor m, Funct a b c d, m d ~ e) => Funct a b (m c) e where
    f_map = fmap . (f_map :: (a -> b) -> c -> d)

instance (a ~ c, b ~ d) => Funct a b c d where
    f_map = id

*Main> f_map (+1) [[Just [5]]]
[[Just [6]]]

instance (Boxed b v) => Boxed (Box b) v where
  unwrap (Box b) = (unsafePerformIO $ putStrLn "unwrapping Box...") `seq` unwrap b

// шаблон, который будем рефакторить (тяжеловесный)

template<class T> void foo(T x)
{
  ...................
  ... bar(x,x,x); ...
  ... buz<T>();   ...
  ...................
}

///////////////////////
// в хедере

namespace foo_aux // это пользователю не потребуется - только для инстанцирования шаблона
{
  struct FooBase
  {
    void foo(void*); // паттерн "Шаблонный метод"
    // детали для метода
    virtual void bar(void*,void*,void*) = 0;
    virtual void buz() = 0;
  };
  template<class T> struct Foo : FooBase
  {
    // реализация деталей
    void bar(void* a, void* b, void* c) { ::bar(*(T*)a, *(T*)b, *(T*)c); }
    void buz() { ::buz<T>(); }
  };
}

template<class T> void foo(T x) { foo_aux::Foo<T>().foo(&x); }

/////////////////////////
// где-то глубоко в .cpp

namespace foo_aux
{
  void FooBase::foo(void* x)
  {
    .........................
    ... this->bar(x,x,x); ...
    ... this->buz();      ...
    .........................
  }
}

-- class Boxed w v where unwrap :: w -> v
data Boxed w v = Boxed { unwrap :: w -> v }

-- instance Bool String where unwrap = ...
boxedBoolString = Boxed unwrap
  where
    unwrap = ... -- конкретная реализация

-- let { x :: String ; x = unwrap True }
let x = unwrap boxedBoolString True

> head [v | (v :: Int) <- universeBi $ Box $ Box $ Box $ Box $ Box (42 :: Int)]
42

К>Ну и что такое, по твоему, boxedBoolString? Словарь и есть

boxedBoxAny boxedDict (Box boxed) = (unwrap boxedDict) boxed

boxedBoxAny (boxedBoxAny (boxedBoxAny boxedBoolString))

К>А в С++ шаблонная функция должна быть или полностью на виду, или программист должен нарожать конкретных экземпляров с полностью подставленными параметрами. Близкий аналог — это С++ные интерфейсы, но там полиморфизм куда более бедный и скованный, чем у хаскелла или ML

void foo(IX*);
IY* bar(IX*);
void buz(IY*);

void foo(IX* x) // полиморфная функция, принимает интерфейс (словарь класса подмонтирован к объекту)
{
  IY* y = bar(y); // фиг его знает, что там делает bar и какой фактический тип вернёт...
  buz(y);           // но словарь класса Y подмонтирован к объекту, поэтому нам настаёт щасте
}

К>>А в С++ шаблонная функция должна быть или полностью на виду, или программист должен нарожать конкретных экземпляров с полностью подставленными параметрами. Близкий аналог — это С++ные интерфейсы, но там полиморфизм куда более бедный и скованный, чем у хаскелла или ML

К>>void foo(IX*);
К>>IY* bar(IX*);
К>>void buz(IY*);

К>>void foo(IX* x) // полиморфная функция, принимает интерфейс (словарь класса подмонтирован к объекту)
К>>{
К>>  IY* y = bar(y); // фиг его знает, что там делает bar и какой фактический тип вернёт...
К>>  buz(y);           // но словарь класса Y подмонтирован к объекту, поэтому нам настаёт щасте
К>>}
К>>

L>Обычные однопараметрические классы? Что-то лучше от объяснения не стало, я ещё больше запутался

class IY y where buz :: y -> String
class IX x where bar :: forall y . IY y => x -> y

foo :: IX x => x -> IO ()
foo x = do
  let y = bar x
  let s = buz y
  putStrLn "hello, " ++ s

data Y1 = Y1
instance IY Y1 where buz = "one"

data Y2 = Y2 s
instance IY Y2 where buz = "two " ++ s

data X = forall y . IY y => X y
instance IX x where bar (X y) = y
instance IX x => IX [x] where bar = bar . hd

main = do
  let x1 = [X Y1]
  let x2 = [X (Y2 "test")]
  foo x1
  foo x2
  foo (x1++x2)

L>>Обычные однопараметрические классы? Что-то лучше от объяснения не стало, я ещё больше запутался

class IY y where buz :: y -> String
class IY y => IX x y where bar :: x -> y

data Y1 = Y1
instance IY Y1 where buz _ = "one"

data Y2 = Y2 String
instance IY Y2 where buz (Y2 s) = "two " ++ s

data X y = X y
instance (IY y, y ~ r) => IX (X y) r where bar (X y) = y
instance (IX x y, IY y) => IX [x] y where bar = bar . head

foo x = do
  let y = bar x
  let s = buz y
  putStrLn $ "hello, " ++ s

main = do
  let x1 = [X Y1]
  let x2 = [X (Y2 "test")]
  foo x1
  foo x2

К>class IX x where bar :: forall y . IY y => x -> y

L>Никак Строгая типизация. Но если очень надо, то всякие Dynamic и прочее.

{-# LANGUAGE ExistentialQuantification #-}

data X = forall y . Show y => X y -- возьмём уже готовый класс, чтобы сразу и наглядно

instance Show X where -- и X тоже в этот класс поместим, чтобы не возиться
  show (X y) = "X $ " ++ show y

-- автоматически получили instance Show [X]

main = putStrLn $ show [X 1, X "hello", X $ X [X 123]] -- нагородили чёрте что, но это работает!

instance Show X where
  show x = "X $ " ++ show (getY x)

showY :: X -> String
showY (X y) = show y

instance Show X where
  show x = "X $ " ++ showY x

applyToY :: (forall y . Show y => y -> String) -> X -> String
applyToY f (X y) = f y

instance Show X where
  show x = "X $ " ++ applyToY show x

К>Почему мир так жесток?

data X = forall IY y. X y (y -> IO ())

class IY y where
  buz :: y -> IO ()

data PtrY = forall y . IY y => PtrY y
instance IY PtrY where
  buz (PtrY y) = buz y


class IX x where
  bar :: x -> PtrY