<div dir="ltr">You can use close type families to do the trick. Here's an example:<div><br><div><div>    {-# LANGUAGE ScopedTypeVariables, Rank2Types, DataKinds, TypeFamilies, PolyKinds, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}</div><div>    import Data.Proxy</div><div><br></div><div>    class ToEither a b k where</div><div>        type TheType a b k :: *</div><div>        toEither :: proxy k -> TheType a b k -> Either a b</div><div><br></div><div>    instance ToEither a b "Left" where</div><div>        type TheType a b "Left" = a</div><div>        toEither _ = Left</div><div><br></div><div>    instance ToEither a b "Right" where</div><div>        type TheType a b "Right" = b</div><div>        toEither _ = Right</div><div><br></div><div>    type family Select a b r where</div><div>        Select a a r = "ambiguous"</div><div>        Select a b a = "Left"</div><div>        Select a b b = "Right"</div><div>        Select x y z = "unknown"</div><div><br></div><div>    fun :: forall a b r. (ToEither a b (Select a b r), r ~ TheType a b (Select a b r)) => r -> Either a b</div><div>    fun = toEither (Proxy :: Proxy (Select a b r))</div></div><div><div><br></div><div>Note that fun doesn't work well without explicit type signatures.<br></div></div></div></div><div class="gmail_extra"><br><div class="gmail_quote">2016-03-03 7:04 GMT-08:00 Kristoffer Føllesdal <span dir="ltr"><<a href="mailto:kfollesdal@gmail.com" target="_blank">kfollesdal@gmail.com</a>></span>:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">I want a function fun :: q -> Either a b where q is of type a or b.  fun shall work in the following way<br>
<br>
fun x    gives    Left x     if x :: a<br>
fun x    gives    Right x   if x :: b<br>
<br>
Following is a more precise description of what I want. I have function fun1 and fun2<br>
<br>
newtype Vec k b = V [(b,k)] deriving (Eq,Ord,Show)<br>
<br>
fun1 :: (Num k) => a -> Either a (Vec k a)<br>
fun1 = Left<br>
<br>
fun2 :: (Num k) => Vec k a -> Either a (Vec k a)<br>
fun2 = Right<br>
<br>
that work in the following way<br>
<br>
{-<br>
>>> fun1 6<br>
Left 6<br>
<br>
>>> fun2 (V[(6,1)])<br>
Right (V [(6,1)])<br>
-}<br>
<br>
I want a overloaded function ‘fun' such that<br>
<br>
{-<br>
>>> fun 6<br>
Left 6<br>
<br>
>>> fun (V[(6,1)])<br>
Right (V[(6,1)])<br>
-}<br>
<br>
I have tried to use a type class to do this (see code below). But when I try<br>
>>> fun 6<br>
<br>
I get the following error<br>
<br>
 Could not deduce (Num a0)<br>
    from the context (Num a, Fun a b v)<br>
      bound by the inferred type for ‘it’:<br>
                 (Num a, Fun a b v) => Either b (v b)<br>
      at <interactive>:70:1-5<br>
    The type variable ‘a0’ is ambiguous<br>
    When checking that ‘it’ has the inferred type<br>
      it :: forall a b (v :: * -> *).<br>
            (Num a, Fun a b v) =><br>
            Either b (v b)<br>
    Probable cause: the inferred type is ambiguous<br>
<br>
Is the someone that have know how I can solve this?<br>
<br>
Kristoffer<br>
<br>
——— CODE ———<br>
<br>
{-# LANGUAGE MultiParamTypeClasses #-}<br>
{-# LANGUAGE FlexibleInstances #-}<br>
<br>
newtype Vec k b = V [(b,k)] deriving (Eq,Ord,Show)<br>
<br>
fun1 :: (Num k) => a -> Either a (Vec k a)<br>
fun1 = Left<br>
<br>
fun2 :: (Num k) => Vec k a -> Either a (Vec k a)<br>
fun2 = Right<br>
<br>
class Fun a b v  where<br>
  fun :: a -> Either b (v b)<br>
<br>
instance (Num k) => Fun t t (Vec k) where<br>
  fun = fun1<br>
<br>
instance (Num k) => Fun (Vec k t) t (Vec k) where<br>
  fun = fun2<br>
<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
</blockquote></div><br></div>