[Haskell-cafe] Function that put elements in Left or Right side of Either depending on type
Kristoffer Føllesdal
kfollesdal at gmail.com
Thu Mar 3 15:04:07 UTC 2016
I want a function fun :: q -> Either a b where q is of type a or b. fun shall work in the following way
fun x gives Left x if x :: a
fun x gives Right x if x :: b
Following is a more precise description of what I want. I have function fun1 and fun2
newtype Vec k b = V [(b,k)] deriving (Eq,Ord,Show)
fun1 :: (Num k) => a -> Either a (Vec k a)
fun1 = Left
fun2 :: (Num k) => Vec k a -> Either a (Vec k a)
fun2 = Right
that work in the following way
{-
>>> fun1 6
Left 6
>>> fun2 (V[(6,1)])
Right (V [(6,1)])
-}
I want a overloaded function ‘fun' such that
{-
>>> fun 6
Left 6
>>> fun (V[(6,1)])
Right (V[(6,1)])
-}
I have tried to use a type class to do this (see code below). But when I try
>>> fun 6
I get the following error
Could not deduce (Num a0)
from the context (Num a, Fun a b v)
bound by the inferred type for ‘it’:
(Num a, Fun a b v) => Either b (v b)
at <interactive>:70:1-5
The type variable ‘a0’ is ambiguous
When checking that ‘it’ has the inferred type
it :: forall a b (v :: * -> *).
(Num a, Fun a b v) =>
Either b (v b)
Probable cause: the inferred type is ambiguous
Is the someone that have know how I can solve this?
Kristoffer
——— CODE ———
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
newtype Vec k b = V [(b,k)] deriving (Eq,Ord,Show)
fun1 :: (Num k) => a -> Either a (Vec k a)
fun1 = Left
fun2 :: (Num k) => Vec k a -> Either a (Vec k a)
fun2 = Right
class Fun a b v where
fun :: a -> Either b (v b)
instance (Num k) => Fun t t (Vec k) where
fun = fun1
instance (Num k) => Fun (Vec k t) t (Vec k) where
fun = fun2
More information about the Haskell-Cafe
mailing list