In a pure functional language, the only thing you can do with a value is apply a function to it.
In other words, if you want to do anything interesting with a value of type a you need a function (for example) with type f :: a -> b and then apply it. If someone hands you (flip apply) a with type (a -> b) -> b, is that a suitable replacement for a?
And what would you call something with type (a -> b) -> b? Seeing as it appears to be a stand-in for an a, I'd be tempted to call it a proxy, or something from http://www.thesaurus.com/browse/proxy.
luqui's answer is excellent but I'm going to offer another explanation of forall b. (a -> b) -> b === a for a couple reasons: First, because I think the generalization to Codensity is a bit overenthusiastic. And second, because it's an opportunity to tie a bunch of interesting things together. Onwards!
z5h's Magic Box
Imagine that someone flipped a coin and then put it in a magic box. You can't see inside the box but if you choose a type b and pass the box a function with the type Bool -> b, the box will spit out a b. What can we learn about this box without looking inside it? Can we learn what the state of the coin is? Can we learn what mechanism the box uses to produce the b? As it turns out, we can do both.
We can define the box as a rank 2 function of type Box Bool where
type Box a = forall b. (a -> b) -> b
(Here, the rank 2 type means that the box maker chooses a and the box user chooses b.)
We put the a in the box and then we close the box, creating... a closure.
-- Put the a in the box.
box :: a -> Box a
box a f = f a
For example, box True. Partial application is just a clever way to create closures!
Now, is the coin heads or tails? Since I, the box user, am allowed to choose b, I can choose Bool and pass in a function Bool -> Bool. If I choose id :: Bool -> Bool then the question is: will the box spit out the value it contains? The answer is that the box will either spit out the value it contains or it will spit out nonsense (a bottom value like undefined). In other words, if you get an answer then that answer must be correct.
-- Get the a out of the box.
unbox :: Box a -> a
unbox f = f id
Because we can't generate arbitrary values in Haskell, the only sensical thing the box can do is apply the given function to the value it is hiding. This is a consequence of parametric polymorphism, also known as parametricity.
Now, to show that Box a is isomorphic to a, we need to prove two things about boxing and unboxing. We need to prove that you get out what you put in and that you can put in what you get out.
unbox . box = id
box . unbox = id
I'll do the first one and leave the second as an exercise for the reader.
unbox . box
= {- definition of (.) -}
\b -> unbox (box b)
= {- definition of unbox and (f a) b = f a b -}
\b -> box b id
= {- definition of box -}
\b -> id b
= {- definition of id -}
\b -> b
= {- definition of id, backwards -}
id
(If these proofs seem rather trivial, that's because all (total) polymorphic functions in Haskell are natural transformations and what we're proving here is naturality. Parametricity once again provides us with theorems for low, low prices!)
As an aside and another exercise for the reader, why can't I actually define rebox with (.)?
rebox = box . unbox
Why do I have to inline the definition of (.) myself like some sort of cave person?
rebox :: Box a -> Box a
rebox f = box (unbox f)
(Hint: what are the types of box, unbox, and (.)?)
Identity and Codensity and Yoneda, Oh My!
Now, how can we generalize Box? luqui uses Codensity: both bs are generalized by an arbitrary type constructor which we will call f. This is the Codensity transform of f a.
type CodenseBox f a = forall b. (a -> f b) -> f b
If we fix f ~ Identity then we get back Box. However, there's another option: we can hit only the return type with f:
type YonedaBox f a = forall b. (a -> b) -> f b
(I've sort of given away the game here with this name but we'll come back to that.) We can also fix f ~ Identity here to recover Box, but we let the box user pass in a normal function rather than a Kleisli arrow. To understand what we're generalizing, let's look again at the definition of box:
box a f = f a
Well, this is just flip ($), isn't it? And it turns out that our other two boxes are built by generalizing ($): CodenseBox is a partially applied, flipped monadic bind and YonedaBox is a partially applied flip fmap. (This also explains why Codensity f is a Monad and Yoneda f is a Functor for any choice of f: The only way to create one is by closing over a bind or fmap, respectively.) Furthermore, both of these esoteric category theory concepts are really generalizations of a concept that is familiar to many working programmers: the CPS transform!
In other words, YonedaBox is the Yoneda Embedding and the properly abstracted box/unbox laws for YonedaBox are the proof of the Yoneda Lemma!
TL;DR:
forall b. (a -> b) -> b === a is an instance of the Yoneda Lemma.
This question is a window into a number of deeper concepts.
First, note there is an ambiguity in this question. Do we mean the type forall b. (a -> b) -> b, such that we can instantiate b with whatever type we like, or do we mean (a -> b) -> b for some specific b that we cannot choose.
We can formalize this distinction in Haskell thus:
newtype Cont b a = Cont ((a -> b) -> b)
newtype Cod a = Cod (forall b. (a -> b) -> b)
Here we see some vocabulary. The first type is the Cont monad, the second is CodensityIdentity, though my familiarity with the latter term isn't strong enough to say what you should call that in English.
Cont b a can't be equivalent to a unless a -> b can hold at least as much information as a (see Dan Robertson's comment below). So, for example, notice that you can never get anything out of ContVoida.
Cod a is equivalent to a. To see this it is enough to witness the isomorphism:
toCod :: a -> Cod a
fromCod :: Cod a -> a
whose implementations I'll leave as an exercise. If you want to really do it up, you can try to prove that this pair really is an isomorphism. fromCod . toCod = id is easy, but toCod . fromCod = id requires the free theorem for Cod.
The other answers have done a great job describing the relationship between the types forall b . (a -> b) -> b and a but I'd like to point out one caveat because it leads to some interesting open questions that I have been working on.
Technically, forall b . (a -> b) -> b and a are not isomorphic in a langauge like Haskell which (1) allows you to write an expression that doesn't terminate and (2) is either call-by-value (strict) or contains seq. My point here is not to be nitpicky or show that parametricity is weakened in Haskell (as is well-known) but that there may be neat ways to strengthen it and in some sense reclaim isomorphisms like this one.
There are some terms of type forall b . (a -> b) -> b that cannot be expressed as an a. To see why, let's start by looking at the proof Rein left as an exercise, box . unbox = id. It turns out this proof is actually more interesting than the one in his answer, as it relies on parametricity in a crucial way.
box . unbox
= {- definition of (.) -}
\m -> box (unbox m)
= {- definition of box -}
\m f -> f (unbox m)
= {- definition of unbox -}
\m f -> f (m id)
= {- free theorem: f (m id) = m f -}
\m f -> m f
= {- eta: (\f -> m f) = m -}
\m -> m
= {- definition of id, backwards -}
id
The interesting step, where parametricity comes into play, is applying the free theorem f (m id) = m f. This property is a consequence of forall b . (a -> b) -> b, the type of m. If we think of m as a box with an underlying value of type a inside, then the only thing m can do with its argument is apply it to this underlying value and return the result. On the left side, this means that f (m id) extracts the underlying value from the box, and passes it to f. On the right, this means that m applies f directly to the underlying value.
Unfortunately, this reasoning doesn't quite hold when we have terms like the m and f below.
m :: (Bool -> b) -> b
m k = seq (k true) (k false)
f :: Bool -> Int
f x = if x then ⊥ else 2`
Recall we wanted to show f (m id) = m f
f (m id)
= {- definition f -}
if (m id) then ⊥ else 2
= {- definition of m -}
if (seq (id true) (id false)) then ⊥ else 2
= {- definition of id -}
if (seq true (id false)) then ⊥ else 2
= {- definition of seq -}
if (id false) then ⊥ else 2
= {- definition of id -}
if false then ⊥ else 2
= {- definition of if -}
2
m f
= {- definition of m -}
seq (f true) (f false)
= {- definition of f -}
seq (if true then ⊥ else 2) (f false)
= {- definition of if -}
seq ⊥ (f false)
= {- definition of seq -}
⊥
Clearly 2 is not equal to ⊥ so we have lost our free theorem and the isomorphism between a and (a -> b) -> b with it. But what happened, exactly? Essentially, m isn't just a nicely behaved box because it applies its argument to two different underlying values (and uses seq to ensure both of these applications are actually evaluated), which we can observe by passing in a continuation that terminates on one of these underlying values, but not the other. In other words, m id = false isn't really a faithful representation of m as a Bool because it 'forgets' the fact that m calls its input with both true and false.
The problem is a result of the interaction between three things:
The presence of nontermination.
The presence of seq.
The fact that terms of type forall b . (a -> b) -> b may apply their input multiple times.
There isn't much hope of getting around points 1 or 2. Linear types may give us an opportunity to combat the third issue, though. A linear function of type a ⊸ b is a function from type a to type b which must use its input exactly once. If we require m to have the type forall b . (a -> b) ⊸ b, then this rules out our counterexample to the free theorem and should let us show an isomorphism between a and forall b . (a -> b) ⊸ b even in the presence of nontermination and seq.
This is really cool! It shows that linearity has the ability to 'rescue' interesting properties by taming effects that can make true equational reasoning difficult.
One big issue remains, though. We don't yet have techniques to prove the free theorem we need for the type forall b . (a -> b) ⊸ b. It turns out current logical relations (the tools we normally use to do such proofs) haven't been designed to take into account linearity in the way that is needed. This problem has implications for establishing correctness for compilers that do CPS translations.
In Haskell, a type constructor can take a type argument, of course.
A function a -> b, when looked at as a "type with a funny constructor name", has type (->) a b. That makes it a type constructor (->) with two arguments, a and b. This is frequently encountered in the "reader" pattern as in its Functor and Applicative instances:
instance Functor ((->) a) where
fmap = (.)
instance Applicative ((->) a) where
pure = const
(<*>) f g x = f x (g x)
When I first tried to understand uses of this instance, as in
fmap (+1) (*2) 3 (=== (+1) . (*2) $ 3 === 3*2+1 === 7)
my reaction was "Ok, (+1) has type Int -> Int, which is (->) Int Int, so that matches Functor.... but where is the Int? I make a Maybe Int by calling Just 1, but I don't ever make a (->) Int Int by applying anything to an Int. In fact, I destroy a ((->) Int Int) by applying it to an Int! (Yeah, there's Nothing, but that seems... degenerate.)"
This all works (of course), as long as I remember that just because a type is built from a constructor+argument, that doesn't mean its values are built from a correspondingly typed constructor+argument. And some of the most interesting and powerful (and tricky to understand) type constructors are like this ((->), Lens, Arrow, etc)
(OK, really it's Num a => a, not Int, but let's ignore that, not relevant)
Is there a name for this concept? What is the appropriate mental model for thinking about type constructors, without leaning on the misleading and disempowering crutch interpretation "Foo a is a structure Foo containing value(s) of type a)?
This concept is known as a contravariant functor, on in Haskell-speak a Contravariant type.
class Contravariant f where
contramap :: (b -> a) -> f a -> f b
-- compare
class Functor f where
fmap :: (a -> b) -> f a -> f b
More generally, we can think of type variables in a type as having contravariant or covariant nature (at its simplest). For instance, by default we have
newtype Reader t a = Reader (t -> a)
instance Functor (Reader t) where
fmap ab (Reader ta) = Reader (ab . ta)
Which indicates that the second type parameter to Reader is covariant, while if we reverse the order
newtype RevReader a t = RevReader (t -> a)
instance Contravariant (RevReader a) where
contramap st (RevReader ta) = RevReader (ta . st)
A useful intuition for Contravariant types is that they have the ability to consume zero, one, or many values of the contravariant parameter instead of containing zero, one, or many values of the covariant parameter like we often think of when considering Functors.
Combining these two notions is the Profunctor
class Profunctor p where
dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
which, as we notice, demands that p is of kind * -> * -> * where the first type parameter is contravariant and the second covariant. This class well characterizes the (->) type constructor
instance Profuntor (->) where
dimap f g h = g . h . f
Again, if we think of contravariant type parameters as being consumed and covariant ones as being produced this is quite amenable of the typical intuition around (->) types.
A few more examples of types which contravariant parameters include Relation
newtype Relation t = Relation (t -> t -> Bool)
instance Contravariant Relation where
contramap g (Relation pred) = Relation $ \a b -> pred (g a) (g b)
Or Fold which represents a left fold as a data type
newtype Fold a b = Fold b (a -> Fold a b)
instance Profunctor Fold where
dimap f g (Fold b go) = Fold (g b) (go . f)
sumF :: Num a => Fold a a
sumF = go 0 where
go n = Fold n (\i -> go (n + i))
With Fold a b we see that it consumes an arbitrary number of a types to produce one b type.
Generally what we find is that while it's often the case that we have covariant and "container" (strictly positive) types where values of some type c a are produced from a constructor of type a -> c a and some filler values a, in general that doesn't hold. In particular we have covariant types like that, but also contravariant ones which are often processes which somehow consume values of their parameterized type variables, or even more exotic ones like phantom types which utterly ignore their type variables
newtype Proxy a = Proxy -- need no `a`, produce no `a`
-- we have both this instance
instance Functor Proxy where
fmap _ Proxy = Proxy
-- and this one, though both instances ignore the passed function
instance Contravariant Proxy where
contramap _ Proxy = Proxy
and... "nothing special" type variables which cannot have any sort of nature, usually because they're being used as both covariant and contravariant types.
data Endo a = Endo (a -> a)
-- no instance Functor Endo or Contravariant Endo, it needs to treat
-- the input `a` differently from the output `a` such as in
--
-- instance Profunctor (->) where
Finally, a type constructor which takes multiple arguments may have different natures for each argument. In Haskell, the final type parameter is usually treated specially, though.
I know that fmap has type (a -> b) -> f a -> f b where f is a functor (and does different things depending on what the functor is). My basic question is this: given some invocation fmap r x, how does ghc figure out what the functor f is, just given the types of x and r?
Let me make this more precise. Suppose f and f' are functors such that f a = f' a for some type a, but f b and f' b are different. If r has type a -> b and x has type f a, it seems there are two different possible results for fmap r x: something of type f b and something of type f' b. How is this ambiguity resolved?
A secondary question: I wanted to test this out by making a weird functor -- maybe something that takes a to [Int] for any type a and does something stupid to functions... but I apparently haven't found the right bit of syntax that allows me to specify functors this way. (Is there something like data Newtype a = [Int] that works? It seems I'd need to make a typeclass name before I can make it an instance of functor.)
EDIT: I get it now, but for the record, the real issue (which is only implicit in my question) was that I didn't realize you can't have a functor Foo such that Foo a is a type like Int that already exists.
I think the general answer you're looking for is that Haskell types are organized using "kinds", which are like types of types.
Here's the Functor class
class Functor f where
fmap :: (a -> b) -> f a -> f b
It's not explicit, but this means that f is a type constructor with kind * -> *. Only types with that kind can be made Functors.
This is actually a rather strong statement. It means that any Functor must be parametric in a type argument. Now consider your statement:
Suppose f and f' are functors such that f a = f' a for some type a,
but f b and f' b are different.
Given the kind system, this isn't possible. Since a Functor is parametric in its type argument, f a = f' a implies f = f', therefore f b = f' b.
I'm not entirely sure what you're asking for with the "weird functor", but it sounds like something that couldn't be expressed with the Functor type class. IIRC Functor can only express endofunctors on Hask; you may need a different abstraction that allows for functors between categories.
Haskell type classes are based on first-order logic resolution. A type class constraint on a type variable is a predicate (you may have seen error messages indicating this if you ever tried to use a type class name where a type name was required) in that logic system.
Haskell requires a unique solution for each (Predicate, Type) pair throughout the program, so you will not be able to create two different Functor instances over Int, for example. The standard way around this, such as in the Monoid class for numeric types that could provide either a summation or product depending on how you define the monoidal operator you want to use, is to provide newtype wrappers over the concrete type that you want the class to have different instances for.
So, for Monoid, we have newtype Sum a = Sum { getSum :: a } and instance Num a => Monoid (Sum a) for the sum monoid and newtype Product a = Product { getProduct :: a } and instance Num a => Monoid (Product a) for the product monoid.
Note that since type only creates an alias for a type, it's not sufficient to provide multiple class instances for a type. The newtype declaration is like type in the sense that it does not produce any additional run-time structure for the new type, but it is unlike type in that it creates a new type rather than a type alias.
It depends on what argument you pass it. For example a list is a functor and so is Maybe
main = do
putStrLn $ show (double [1..5])
putStrLn $ show (double (Just 3))
putStrLn $ show (double Nothing)
double :: (Functor f, Num a) => f a -> f a
double = fmap (*2)
*Main> main
[2,4,6,8,10]
Just 6
Nothing
This double function will work for any functor that is holding an Num.
"Suppose f and f' are functors such that f a = f' a for some type a, but f b and f' b are different."
This doesn't really make sense. Either f and f' are the same, or they aren't. You seem to be suggesting some kind of in-between state where it varies depending on the argument type; that can't happen.
"If r has type a -> b and x has type f a, it seems there are two different possible results for fmap r x: something of type f b and something of type f' b. How is this ambiguity resolved?"
Where did f' come from? Nothing in the above signatures mentions it. Since x has type f a, it follows that the result of fmap must have some type beginning with f - in this case f b, since r :: a -> b. This is perfectly unambiguous. The result of fmap is always in the same functor as you started with.
Learn You a Haskell has an example about functors. I can read LYAH, and text, and figure out what is supposed to happen -- but I don't know enough to write something like this. I'm finding this problem often in Haskell.
instance Functor (Either a) where
fmap f (Right x) = Right (f x)
fmap f (Left x) = Left x
However, I'm confused.. Why doesn't this comple
instance Functor (Either a) where
fmap f (Right x) = Right (x)
fmap f (Left x) = Left (f x)
If f isn't being used in the top definition, then what else constrains x such that it can't satisfy Left
Here's the functor class:
class Functor f where
fmap :: (a -> b) -> f a -> f b
Note that "f" by itself is a type constructor because it's applied to a type variable in the fmap line. Here are some examples to make this clear:
Type constructors:
IO
Maybe
Either String
Types:
IO Char
Maybe a
Either String String
"Maybe a" is a type with one type constructor (the "Maybe") and one type variable (the "a"). It's not something concrete yet, but it is usable in type signatures for polymorphic functions.
"Either" is a type constructor that takes two type arguments, so even after you apply one (e.g. Either String it's still a type constructor because it can take another type argument.
The point of this is: when you define a Functor instance, the type constructor f cannot change. This is because it's represented by the same variable, f, as both the argument and result of fmap. The only type that's allowed to change is the type that's applied to the f constructor.
When you write instance Functor (Either c), Either c is filled in for f everywhere in the declaration of fmap. This gives fmap the following type for this instance:
fmap :: (a -> b) -> (Either c) a -> (Either c) b
With the definition of Either, the only useful way to get this type is by applying the Right value to the function. Remember that "Either" has two possible values with possibly different types. Here the Left value has type 'c', so you can't apply it to the function (which expects an 'a')[1], and the result also wouldn't be correct because you'd be left with Either b a, which doesn't match the class definition.
After replacing "f" with "Either c" to get the above type signature for fmap with the "Either c" instance, writing the implementation is next. There are two cases to consider, the Left and the Right. The type signature tells us that the type of the Left side, "c", can't change. We also don't have any way to change the value because we don't know what type it actually is. All we can do is leave it alone:
fmap f (Left rval) = Left rval
For the Right side, the type signature says that we have to change from a value with type "a" to a value with type "b". The first argument is a function to do exactly that, so we use the function with the input value to get the new output. Putting the two together gives the full definition
instance Functor (Either c) where
fmap f (Right rval) = Right (f rval)
fmap f (Left lval) = Left lval
There's a more general principle at work here which is why writing a Functor instance that adjusts the Left side is impossible, at least with the Prelude definitions. Copying some code from above:
class Functor f where
fmap :: (a -> b) -> f a -> f b
instance Functor (Either c) where ...
Even though we have a type variable 'c' in the instance definition, we can't use it in any of the class methods because it's not mentioned in the class definition. So you can't write
leftMap :: (c -> d) -> Either c a -> Either d a
leftMap mapfunc (Left x) = Left (mapfunc x)
leftMap mapfunc (Right x) = Right x
instance Functor (Either c) where
--fmap :: (c -> d) -> Either c a -> Either d a
fmap = leftMap
The result of leftMap, and thus fmap, is now (Either d) a. The (Either c) has changed to an (Either d), but this isn't allowed because there's no way to express it in the Functor class. To express this, you'd need a class with two type variables, e.g.
class BiFunctor f where
lMap :: (a -> b) -> f a c -> f b c
rMap :: (c -> d) -> f a c -> f a d
biMap :: (a -> b) -> (c -> d) -> f a c -> f b d
In this class, since both the left and right type variables are in scope, it's possible to write methods that operate on either (or both) sides.
instance BiFunctor Either where
lMap = leftMap
rMap = rightMap --the same as the standard fmap definition
biMap fl fr e = rMap fr (lMap fl e)
Although in practice people usually just write "biMap" for the BiFunctor class and use "id" for the other function if a left or right mapping is necessary.
[1] More accurately, the Left value has type 'c', the function expects an 'a', but the type checker can't unify those types because the 'c' type isn't in scope in the class definition.
Left and Right aren't types, and Left x and Right y are of the same type. They are just constructors of Either. You may consider
Left :: c -> Either c d
Right :: d -> Either c d
You can have 2 fmap declarations because we know the Left's and the Right's are different values. It's just like
g :: Int -> Int
g 1 = 2
g 2 = 4
g n = n
Here we can't say 1 and 2 and n are different "types" just because pattern matching works.
The Functor class is defined such that
class Functor f where
fmap :: (a -> b) -> f a -> f b
Note that a and b are arbitrary types. For clarity, let's rename the a in your instance to c, and the function f to func.
instance Functor (Either c) where
fmap func (Right x) = Right (x)
fmap func (Left x) = Left (func x)
Assume your Either follows the default definition
data Either c d = Left c | Right d
then by your definition,
fmap func (Right x) = Right x
-- # (a -> b) -> f a f b
-- # f = Either c
this forces a = b, and
fmap func (Left x) = Left (func x)
-- # (a -> b) -> f a f b
-- # f = Either c
forces c = a = b. Both are not valid considering a, b and c are independent arbitrary types.
Ok so here's another very simple try at this.
You ask why this doesn't compile:
instance Functor (Either a) where
fmap f (Right x) = Right (x)
fmap f (Left x) = Left (f x)
So let's try to simplify the problem by trying to define the same function without putting it as part of a class instance declaration:
That gives us
foo f (Right x) = Right (x)
foo f (Left x) = Left (f x)
Which indeed does compile. ghci tells us the type signature:
*Main> :t foo
foo :: (t1 -> a) -> Either t1 t -> Either a t
We'll rename some of the variables to get something more uniform looking:
foo :: (a -> b) -> Either a c -> Either b c
That makes perfect sense. It takes a function and applies it to the Left of an Either.
But what's the signature for fmap?
*Main> :t fmap
fmap :: (Functor f) => (a -> b) -> f a -> f b
So let's substitute Either c for f in the fmap signature (I renamed Either a to Either c to keep our two different as from getting mixed up):
fmap :: (a -> b) -> Either c a -> Either c b
Do you see the problem? Your function is perfectly valid -- it just has a different type than what fmap for Either a must necessarily have.
This is a sort of beautiful thing about types. Given the signature for fmap, there is really only one meaningful implementation for fmap on Either a.
Sometimes, when we're lucky and careful, we can end up in similar situations -- given a type signature, the function almost writes itself.
Edit: trying to answer the questions below.
1) There's no "composition of two functions" going on. To get the type signature for fmap over Either a just go through the fmap function signature, and every place you see f, replace it with Either a. We would call that a "specialization" of the type signature of fmap. Which is to say, it is strictly less general than the normal type of fmap -- anyplace that requires a function of the more specialized type, you can pass in something of the general type with no problems.
2) Your function for mapping over the left side (which I named "foo" in the above examples) is just fine. It works fine, it does what you want. You just can't name it fmap and use it in a Functor instance. Personally, I'd name it something like onLeft or mapLeft.
All the following can be ignored/is for information, but not a suggestion for future reading in the near future/actual use:
If one wants to get very technical, because you can map over both the left and the right side (although you can only declare Functor for the latter), Either is not only a Functor, but a Bifunctor. This is provided in, e.g., ekmett's Category-Extras library ( see http://hackage.haskell.org/packages/archive/category-extras/0.44.4/doc/html/Control-Bifunctor.html).
There's lots of cool stuff involving calculating with programs, and "origami programming" that uses bifunctors more rigorously. You can read about it here: http://lambda-the-ultimate.org/node/1360. But, you probably don't want to, at least until you're much more familiar with Haskell. It is computer-sciency, mathy, researchy, and very cool, but not necessary at all to understand idiomatic Haskell programming.
While I will eventually cleave to your format, I'm going to start with something in a slightly different format, as I think it will make my explanation clearer.
Let's consider a different datatype
data Choice a = Default Integer | Chosen a
-- This corresponds to your top, working, instance.
instance Functor Choice where
fmap f (Default i) = Default i
fmap f (Chosen a) = Chosen (f a)
It should be clear why this instance works. However, what about the following:
-- Broken!
instance Functor Choice where
fmap f (Default i) = Default (f i)
fmap f (Chosen a) = Chosen a
You should be able to see why this doesn't work. The type of fmap is Functor f => (a -> b) -> f a -> f b; in this context, it's (a -> b) -> Choice a -> Choice b. Thus, the f argument has the type a -> b. However, in the second (failed) instance declaration, you write f i. We know, because of the datatype declaration, that i must be an Integer, so we can't apply f to it. Similarly, since a has type a, Chosen a will have type Chosen a, not type Chosen b. Thus, the Functor instance on the bottom can't work.
Well, your top instance for Either works because, like in the Choice example, it obeys the types. Let's look at it, with a few renamings:
instance Functor (Either c) where
fmap f (Left c) = Left c
fmap f (Right a) = Right (f a)
This instance declaration doesn't declare an instance of Functor for Either—it can't. Something which is an instance of Functor must take one type parameter. Thus, Int can't be a functor, since Int takes no type parameters, but [] and Maybe can be, since [a] and Maybe a are complete types. Either, however, takes two type parameters: Either a b. Thus, what this instance does is declare that Either c is a functor for any possible c. That c is fixed for the duration of the instance declaration. So let's go through and add types (this is not legal syntax!):
instance Functor (Either c) where
fmap :: forall a b. (a -> b) -> (Either c) a -> (Either c) b
fmap f (Left (c :: c)) = Left c
fmap f (Right (a :: a)) = Right (f a :: b)
Since f has type a -> b, but c's type is fixed at c, we can't possibly write Left (f c); and even if we could, we want the c to be left alone, so that we can return an (Either c) b. Similarly, we must apply f to a in order to get something of type b.
This is also why your bottom instance doesn't work: you have a function which needs to work for any type being applied only to the fixed type c, and you leave the type you need to transform alone. Let's look at it, again with type signatures added:
instance Functor (Either c) where
fmap :: forall a b. (a -> b) -> (Either c) a -> (Either c) b
fmap f (Left (c :: c)) = Left (f c)
fmap f (Right (a :: a)) = Right a
Here, your first part of the function definition attempts to apply a function f :: a -> b to something of the fixed type c, which cannot work, so this already fails. But let's look at what type this generates. In this case, we'd expect that (somehow) f c would have the type b, and a would have the type a. In that case, we're returning a value of type Either b a, which is still not allowed.
Basically, the problem stems from this. First, note that f is the same in between the two function definition clauses, so it can't change between lines. Second, note that we are fixing c, and declaring an instance for that c. This is true for any c, but we only look at one at a time. Finally, because of this, Left's argument is not parametrized by the type that f expects; it's guaranteed to have some fixed type c. This means that (a) you can't apply f to it, and (b) you must apply it to Right's argument, since otherwise you won't change the type you're expected to change.
(Edit to try to answer the question better)
The definition of Either is:
data Either a b = Left a | Right b
So "Either" takes two type arguments. By the way, technically "Either" is not actually a type but a type constructor; it takes type arguments to create a type.
The definition of Functor is:
class Functor f where
fmap :: (p -> q) -> f p -> f q
So in this class definition any type "f" that is an instance of Functor must take a type argument. This isn't declared; it is inferred from the "f p" and "f q"; since "f" is being given a type parameter here it must be a type that takes one.
(Note: the original definition used "a" and "b" instead of "p" and "q". I'm using different letters to keep things distinct from "Either a b" when I get to that later)
In most cases "f" is a container type like a list or a tree. So for instance you have
data Tree a = ...
instance Functor Tree where
fmap func_a2b tree_of_a = ... -- tree of b.
However "Either" takes two type parameters, so how can we fit it into this scheme? The answer is that types can have partial application just like functions. In the same way as
I can declare a function
foo x y = ...
and then say "foo 2" in order to get a new function that expects the second argument, so I can say "Either a" to get a new type that expects the second type argument.
Now look at the original instance:
instance Functor (Either a) where ....
So here "Either a" is a type constructor that expects one more argument, just like Functor expects of its instances. So the type of "fmap" for "Either a" will be
fmap :: (p -> q) -> Either a p -> Either a q
So now in the "where" clause you have to give a definition of "fmap" that has this type. The first one you quote has this type because the second type parameter is used for the "Right" constructor, and that is the one that the function is applied to. The second one won't work, because it would have the type
fmap :: (p -> q) -> Either p a -> Either q a
And that is not what the Functor class says its going to be.
Belive it or not, this isn't magic. It all has to do with the type Either a b not being the same type as Either b a. Here is the definition of Either from Prelude
data Either a b = Left a | Right b
... Notice How the type variable a comes first, then b, and also notice that we only include a in the declaration of the Either Functor:
instance Functor (Either a) where
fmap f (Right x) = Right (f x)
fmap f (Left x) = Left x
Now lets look at the definition of the Maybe Functor
instance Functor Maybe where
fmap = map
Here there is no type variable, Although Maybe takes one type parameter (like Maybe Int). What I am trying to get to is that types aren't functors, type constructors are functors (functors have kind *->*).
So let f :: b -> c, in the version of the Either Functor that works, the x from (Left x) is of type a, which is fine since it's (Either a) that is a functor, the x in (Right x) is of Type b so (Right x) is of type ((Either a) b), and (Right (f x)) is of type ((Either a) c), therefore fmap is of type (b->c) -> ((Either a) b) -> ((Either a) c), as required.
In your version that failed, we have that x in (Right (x)) is not of type a, but of type b, So (Right (x)) is not of type ((Either a) c) which doesn't fit with the type of fmap.
so to sum it up: the fmap that works comes out : (b -> c) -> (Either a) b -> (Either a) c,
but the one that doesn't work comes out: (b -> c) -> (Either b) a -> (Either c) a and thats not the right type for fmap.
Hopefully, this will help...
First, though, some background:
1) Functor needs a "type constructor", a (well, not a type per se,...) type that "needs" another regular type given to it to form a "full type", just like a generic in Java/C++.
So, for example, List is a Functor (it is, by the way), or Array, because (among other things) the full type isn't just List, but List<A>. So, :
A Functor takes a "type constructor", an incomplete type.
2) Either is a constructor type that Haskell folks (read: Edward Kmett, and other well-math-endowed all-stars) call a bifunctor. It needs two types given to it to be complete. For example, a full use of Either is: Either Integer String which means (yeah, yeah, "duh!") it's either a (Left) Integer, or a (Right) String. So, this means Either Integer is an incomplete type that is either a Left Integer or a Right...b when you
decide what that "b" is supposed to be.
Now, for the fun part!
The top stuff works because, fmap uses some type constructor, and uses it with an a -> b function to make a similar function from f a to f b - the hands-down favorite example for this in Haskell is the one for lists, AKA map :: (a -> b) -> ([a] -> [b]), where the Functor is the [ ] part. Now, using something like Either a (let's go ahead and use Either Integer from earlier), fmap's type signature looks like this:
fmap :: (a -> b) -> (Either Integer a -> Either Integer b)
and the two examples (from the Top part) show what fmap does with representative values of that Either Integer a type, in order to get an Either Integer b-typed value.
Now, yours -bottom- doesn't work, because:
You have a function, f, that takes
as to bs.
Your Left type has to be type
Integer, and stay an Integer (or
type Float, and stay a Float, what
ever type is the left one of the
two types of the Either type
you're using).
Your Right type has to be of
whatever type that the function
takes ("a"), and go to the type
that the function makes ("b").
It has to do this (but your stuff doesn't - that's why it doesn't work), because that's the type that fmap needs to have. Specifically, you have these equations:
fmap f (Right x) = Right (x)
fmap f (Left x) = Left (f x)
Your equations give fmap the types:
fmap :: (a -> b) -> Either c d -> Either c d
fmap :: (a -> b) -> Either a d -> Either b d
which not only doesn't fit what fmap wants, but it isn't even consistent with each other!
I'm sorry I wrote half a book to wade through, but I hope that gives some insight to you.
Top works because fmap::(b -> c) -> Either a b -> Either a c and yours -bottom- doesn't work because that would require fmap::(a -> c) -> Either a b -> Either a c. But, it would work if you changed Either to
data Either' a b = Left' b | Right' a deriving (Eq, Show)
instance Functor (Either' a) where
fmap f (Right' x) = Right' (x)
fmap f (Left' x) = Left' (f x)
The instance you're trying to write, let's call it fmap2 for now, has the following type:
fmap2 :: (a -> b) -> Either a c -> Either b c
If you set the LANGUAGE pragma TypeOperators, GHC also accepts the type
fmap2 :: (a -> b) -> (a `Either` c) -> (b `Either` c)
In an ideal world this also would work:
fmap2 :: (a -> b) -> (`Either` c) a -> (`Either` c) b
which would give a Functor instance for (`Either` c) but the similarity between normal operators (and their sections) and type operators breaks down at this point (unless there's a GHC option I'm missing!)
In short: your understanding of functors is okay, but you're bitten by the lack of type-level lambdas.
Ehm... How about a few words about "kinds" ?..
That may simplify understanding, I guess.
Remember what is currying. I.e. in ghci:
Prelude> let f x y z = x + y * z
f :: (Num a) => a -> a -> a -> a
Prelude> :t f 1
f 1 :: (Num t) => t -> t -> t
Prelude> :t f 1 2
f 1 2 :: (Num t) => t -> t
Prelude> :t f 1 2 3
f 1 2 3 :: (Num t) => t
The same things you have with types. When you say Either kind of that type is * -> * -> * (i.e. it takes two types and produces type) and when you say Either a kind is * -> * and for Either a b it's * (btw Monad a and Functor a requires a to be of kind * -> *, as I remember).
So when you say type Either a that means type that is still incomplete (requires some "argument" to be bound), so fmap :: (a -> b) -> f a -> f b becomes fmap :: (a -> b) -> (Either c) a -> (Either c) b when f substituted by Either c.