Suppose i have a datatype MayFail defined as following
data MayFail e a = Error e | Result a
deriving (Show)
So it's either a result or an error. I now want to write a Functor for it but this is where it gets confusing.
MayFail has two types, either e or a. So why do I have to write the functor as follows
instance Functor (MayFail e) where
fmap _ (Error e) = Error e
fmap f (Result x) = Result (f x)
and not instance Functor (MayFail e a) where?
What is the syntactic rule behind this?
Your question is a bit unclear, but I assume you're asking why you have to use e in instance Functor (MayFail e) instead of just writing instance Functor MayFail.
This is because Functor takes a type parameter of kind Type -> Type, and MayFail on its own would have kind Type -> Type -> Type. (Using MayFail e a would also be wrong, as its kind is just Type.)
MayFail :: Type -> Type -> Type is not a functor, but a bifunctor:
-- somewhat simplified definition
class Bifunctor p where
-- p :: Type -> Type -> Type
bimap :: (a -> c) -> (c -> d) -> p a b -> p c d
instance Bifunctor MayFail where
bimap f _ (Error e) = Error (f e)
bimap _ g (Result x) = Result (g x)
But, for any fixed error type e, the result of the partial application MayFail e :: Type -> Type is a functor:
instance Functor (MayFail e) where
fmap _ (Error e) = Error e
fmap f (Result x) = Result (f x)
-- Or, using the Bifunctor instance,
-- fmap = bimap id
In some sense, a bifunctor is a mapping of types to functors.
The Functor class is defined as
class Functor f where
fmap :: (a -> b) -> f a -> f b
That is, the type constructor f must accept a single type argument (otherwise f a and f b in the type signature of fmap would be invalid).
Formally this means f must have kind Type -> Type (also known as * -> * in older versions of GHC).
This is different from e.g. Eq or Show, which look like this (simplified):
class Eq a where
(==) :: a -> a -> Bool
class Show a where
show :: a -> String
Here the parameter a is used as a type itself.
Your type, data MayFail e a, has two parameters. If we were to plug just MayFail into the Functor definition, as in
instance Functor MayFail where ...
this would implicitly declare fmap as
fmap :: (a -> b) -> MayFail a -> MayFail b
which is a kind error: MayFail a is not a type because MayFail takes two arguments.
Similarly, if we tried
instance Functor (MayFail x y) where ...
then fmap would end up having the type
fmap :: (a -> b) -> MayFail x y a -> MayFail x y b
which is also a kind error: MayFail only takes two arguments, not three.
The only way to form a sensible type signature is to set f = MayFail e, because then f a becomes MayFail e a (and f b becomes MayFail e b), which is well-formed.
Related
Suppose we have some class Foo such that an instance of Foo f gives us everything necessary to implement Functor f, Foldable f and Traversable f. To avoid overlapping instances, can witness this relationship between Foo and Functor, Foldable, Traversable under a newtype wrapper:
type Foo :: (Type -> Type) -> Constraint
class Foo f
where
{- ... -}
type FoonessOf :: (Type -> Type) -> Type -> Type
newtype FoonessOf f a = FoonessOf (f a)
instance Foo f => Functor (FoonessOf f)
where
fmap = _
instance Foo f => Foldable (FoonessOf f)
where
foldMap = _
instance Foo f => Traversable (FoonessOf f)
where
traverse = _
Now suppose we have some type constructor:
data Bar a = Bar {- ... -}
such that there is an:
instance Foo Bar
where
{- ... -}
We'd like to equip Bar with the instances implied by its "Foo-ness". Since Bar a is Coercible to FoonessOf Bar a, we'd expect to be able to derive the instances via the FoonessOf Bar:
deriving via (FoonessOf Bar) instance Functor Bar
deriving via (FoonessOf Bar) instance Foldable Bar
And this works handily for typeclasses such as Functor and Foldable
Unfortunately when we try to do the same thing with Traversable, things go awry:
[typecheck -Wdeferred-type-errors] [E] • Couldn't match representation of type ‘f1 (Foo Bar a1)’
with that of ‘f1 (Bar a1)’
arising from a use of ‘ghc-prim-0.6.1:GHC.Prim.coerce’
NB: We cannot know what roles the parameters to ‘f1’ have;
we must assume that the role is nominal
• In the expression:
ghc-prim-0.6.1:GHC.Prim.coerce
#(Foo Bar (f a) -> f (Foo Bar a)) #(Bar (f a) -> f (Bar a))
(sequenceA #(Foo Bar)) ::
forall (f :: TYPE ghc-prim-0.6.1:GHC.Types.LiftedRep
-> TYPE ghc-prim-0.6.1:GHC.Types.LiftedRep)
(a :: TYPE ghc-prim-0.6.1:GHC.Types.LiftedRep).
Applicative f => Bar (f a) -> f (Bar a)
In an equation for ‘sequenceA’:
sequenceA
= ghc-prim-0.6.1:GHC.Prim.coerce
#(Foo Bar (f a) -> f (Foo Bar a)) #(Bar (f a) -> f (Bar a))
(sequenceA #(Foo Bar)) ::
forall (f :: TYPE ghc-prim-0.6.1:GHC.Types.LiftedRep
-> TYPE ghc-prim-0.6.1:GHC.Types.LiftedRep)
(a :: TYPE ghc-prim-0.6.1:GHC.Types.LiftedRep).
Applicative f => Bar (f a) -> f (Bar a)
When typechecking the code for ‘sequenceA’
in a derived instance for ‘Traversable Bar’:
To see the code I am typechecking, use -ddump-deriv
In the instance declaration for ‘Traversable Bar’
——————————————————————————————————————————————————————————————————————————————
...
So the questions I have are:
Is it possible to come up with some other scheme for deriving-via the instance Traversable Bar?
Is it possible to come up with some modification of the Traversable class that can be derived via a newtype?
I suspect the answer to 1. is: no, the situation cannot be salvaged, and it is impossible to obtain an instance of Traversable using DerivingVia.
As far as 2. goes, it's useful to try and reproduce the problem in a simpler context. Consider the following:
-- Remember to turn on ScopedTypeVariables!
data A = A
newtype B = B A
a :: forall f. f A -> f A
a = id
b :: forall f. f B -> f B
b = coerce $ a #f
It seems like this should work, but alas:
[typecheck -Wdeferred-type-errors] [E] • Couldn't match representation of type ‘f A’ with that of ‘f B’
arising from a use of ‘coerce’
NB: We cannot know what roles the parameters to ‘f’ have;
we must assume that the role is nominal
• In the expression: coerce $ a #f
In an equation for ‘b’: b = coerce $ a #f
• Relevant bindings include
b :: f B -> f B
The problem has to do with the "roles" of type constructors' parameters, and the way role inference works. For our purposes, roles come in two varieties: "representational" and "non-representational". Also for our purposes, the difference between the two can be approximated to the following: a type constructor F :: Type -> Type has a parameter of a "representational" role if there is an instance of Representational F, where:
type Representational :: (Type -> Type) -> Constraint
type Representational f = forall x y. Coercible x y => Coercible (f x) (f y)
Otherwise, the parameter of F is non-representational.
The typechecker lets you annotate the roles of type parameters in various places (although strangely enough, not in the kind). Sadly, there is no way to annotate the roles of a higher kinded type variable. What we can do however is just ask for Representational f directly:
b' :: forall f. Representational f => f B -> f B
b' = coerce $ a #f
which now typechecks. This suggests a possible way to tweak the Traversable typeclass to make it derivable via coercions.
Now let's look at the type of the Traversable operation sequenceA:
class Traversable t
where
sequenceA :: forall f. Applicative f => forall a. t (f a) -> f (t a)
{- ... -}
NB: There's that pesky forall f again, meaning f is taken to have a type parameter of a nominal role.
What DerivingVia is going to do is attempt to coerce between:
sequenceA #T1 :: forall f. Applicative f => forall a. T1 (f a) -> f (T2 a)
and:
sequenceA #T2 :: forall f. Applicative f => forall a. T2 (f a) -> f (T2 a)
Despite T1 (FoonessOf Bar) and T2 (Bar) being "parametrically" coercible, this coercion will fail, because the coercion of the entire operation will decompose eventually to the coercion the typechecker complained about:
Couldn't match representation of type
‘f1 (Foo Bar a1)’
with that of
‘f1 (Bar a1)’
This doesn't work because of f's parameter being considered to have a nominal role, as we discussed.
As with our simplified example above, the fix is straightforward: just ask for Representational f:
type Traversable' :: (Type -> Type) -> Constraint
class Traversable' t
where
traverse :: (Representational f, Applicative f) => (a -> f b) -> t (f a) -> f (t b)
And now at last we can derive an instance of Traversable' via the FoonessOf Bar:
instance Foo f => Traversable' (FoonessOf f)
where
traverse = _
deriving via (FoonessOf Bar) instance Traversable' Bar
If I define:
class Contravariant f where
contramap :: (b -> a) -> f a -> f b
type Op r a = (->) a r
And want to define:
instance Contravariant (Op r) where
contramap f g = g . f
I get the error that instance type must not be synonyms. So I guess i need something akin to:
instance Contravariant ((->) _ r) where
contramap f g = g . f
Which of course does not work. How can I get this instance of Contravariant to work ?
As per the comments, the usual method is to define a newtype. Note that the syntax is much the same as defining a data type, except that you use newtype in place of data and are only permitted one field. In particular, you need a constructor, which is frequently given the same name as the type:
newtype Op r a = Op (a -> r)
-- ^^ ^^ ^^^^^^^^
-- newtype constructor field
This has the effect of defining a type isomorphic to a -> r but with the type parameter a coming "last" in the full type Op r a, which allows you to define a Contravariant instance for Op r. Note that you'll need to unwrap and wrap the constructor where appropriate:
instance Contravariant (Op r) where
contramap f (Op g) = Op (g . f)
For additional evidence that this is correct way to do it, note that the definitions in Data.Functor.Contravariant from base are already set up like this, except they've decided to use a field accessor getOp:
-- from the Data.Functor.Contravariant source
newtype Op a b = Op { getOp :: b -> a }
instance Contravariant (Op a) where
contramap f g = Op (getOp g . f)
How to declare Functor instance of this data type:
data Productish a b = Productish a b
I've tried this:
instance (Functor a, Functor b) => Productish a b where
fmap f (Productish a b) = Productish (f a) (f b)
but compiler had showed error:
error: ‘fmap’ is not a (visible) method of class ‘Productish’
Firstly, your syntax is wrong. To define a Functor instance on Productish, you will need to do instance Functor (Productish a b) where ….
But there is also a more serious problem: The Functor typeclass can only be used to define a functor on one variable. So in order to define a Functor instance, you need to partially apply your data type. For instance, here’s the Maybe instance:
data Maybe a = Just a | Nothing
instance Functor Maybe where -- note that this isn’t ‘instance Functor (Maybe a)’!
fmap f (Just a) = Just (f a)
fmap f Nothing = Nothing
Similarly, to define a Functor instance for your Productish, you need to do:
instance Functor (Productish a) where
fmap f (Productish a b) = Productish a (f b)
(Note that you don’t need a Functor constraint on a, since you don’t need to map over a.)
So with Functor alone, you can only map over the second argument.
Luckily, there is also a typeclass which lets you map over both arguments. It’s called Bifunctor, and lives in the Data.Bifunctor module:
class Bifunctor p where
bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
first :: (a -> b) -> p a c -> p b c
second :: (b -> c) -> p a b -> p a c
So to make a Bifunctor instance for your Productish type, use:
instance Bifunctor Productish where
bimap f g (Productish a b) = Productish (f a) (g b)
first f p = bimap f id p
second g p = bimap id g p
Brent Yorgey's Typeclassopedia gives the following exercise:
Give an example of a type of kind * -> * which cannot be made an
instance of Functor (without using undefined).
Please tell me what "cannot be made an instance of Functor" means.
Also, I'd appreciate an example, but perhaps as a spoiler so that you can, please, guide me to the answer.
Let's talk about variances.
Here's the basic notion. Consider the type A -> B. What I want you to imagine is that such a type is similar to "having a B" and also "owing an A". In fact, if you pay back your A you immediately receive your B. Functions are kind of like escrow in that way.
The notion of "having" and "owing" can extend to other types. For instance, the simplest container
newtype Box a = Box a
behaves like this: if you "have" a Box a then you also "have" an a. We consider types which have kind * -> * and "have" their argument to be (covariant) functors and we can instantiate them to Functor
instance Functor Box where fmap f (Box a) = Box (f a)
What happens if we consider the type of predicates over a type, like
newtype Pred a = Pred (a -> Bool)
in this case, if we "have" a Pred a, we actually "owe" an a. This arises from the a being on the left side of the (->) arrow. Where fmap of Functor is defined by passing the function into the container and applying it to all the places where we "have" our inner type, we can't do the same for Pred a since we don't "have" and as.
Instead, we'll do this
class Contravariant f where
contramap :: (a -> b) -> (f b -> f a)
Now that contramap is like a "flipped" fmap? It will allow us to apply the function to the places where we "own" a b in Pred b in order to receive a Pred a. We might call contramap "barter" because it encodes the idea that if you know how to get bs from as then you can turn a debt of bs into a debt of as.
Let's see how it works
instance Contravariant Pred where
contramap f (Pred p) = Pred (\a -> p (f a))
we just run our trade using f prior to passing it on into the predicate function. Wonderful!
So now we have covariant and contravariant types. Technically, these are known as covariant and contravariant "functors". I'll also state immediately that almost always a contravariant functor is not also covariant. This, thus, answers your question: there exist a bunch of contravariant functors which are not able to be instantiated to Functor. Pred is one of them.
There are tricky types which are both contravariant and covariant functors, though. In particular, the constant functors:
data Z a = Z -- phantom a!
instance Functor Z where fmap _ Z = Z
instance Contravariant Z where contramap _ Z = Z
In fact, you can essentially prove that anything which is both Contravariant and Functor has a phantom parameter.
isPhantom :: (Functor f, Contravariant f) => f a -> f b -- coerce?!
isPhantom = contramap (const ()) . fmap (const ()) -- not really...
On the other hand, what happens with a type like
-- from Data.Monoid
newtype Endo a = Endo (a -> a)
In Endo a we both owe and receive an a. Does that mean we're debt free? Well, no, it just means that Endo wants to be both covariant and contravariant and does not have a phantom parameter. The result: Endo is invariant and can instantiate neither Functor nor Contravariant.
A type t of kind * -> * can be made an instance of Functor if and only if it is possible to implement a law-abiding instance of the Functor class for it. So that means you have to implement the Functor class, and your fmap has to obey the Functor laws:
fmap id x == x
fmap f (fmap g x) == fmap (f . g) x
So basically, to solve this, you have to name some type of your choice and prove that there's no lawful implementation of fmap for it.
Let's start with a non-example, to set the tone. (->) :: * -> * -> * is the function type constructor, as seen in function types like String -> Int :: *. In Haskell, you can partially apply type constructors, so you can have types like (->) r :: * -> *. This type is a Functor:
instance Functor ((->) r) where
fmap f g = f . g
Intuitively, the Functor instance here allows you to apply f :: a -> b to the return value of a function g :: r -> a "before" (so to speak) you apply g to some x :: r. So for example, if this is the function that returns the length of its argument:
length :: [a] -> Int
...then this is the function that returns twice the length of its argument:
twiceTheLength :: [a] -> Int
twiceTheLength = fmap (*2) length
Useful fact: the Reader monad is just a newtype for (->):
newtype Reader r a = Reader { runReader :: r -> a }
instance Functor (Reader r) where
fmap f (Reader g) = Reader (f . g)
instance Applicative (Reader r) where
pure a = Reader (const a)
Reader f <*> Reader a = Reader $ \r -> f r (a r)
instance Monad (Reader r) where
return = pure
Reader f >>= g = Reader $ \r -> runReader g (f r) r
Now that we have that non-example out of the way, here's a type that can't be made into a Functor:
type Redaer a r = Redaer { runRedaer :: r -> a }
-- Not gonna work!
instance Functor (Redaer a) where
fmap f (Redaer g) = ...
Yep, all I did is spell the name backwards, and more importantly, flip the order of the type parameters. I'll let you try and figure out why this type can't be made an instance of Functor.
I wrote something like this:
instance Functor (Either e) where
fmap _ (Left a) = Left a
fmap f (Right b) = Right (f b)
How do I do the same if I want fmap to change the value only if it's Left?
I mean, what syntax do I use to indicate that I use type Either _ b instead of Either a _?
I don't think there's a way to do that directly, unfortunately. With a function you can use flip to partially apply the second argument, but that doesn't work with type constructors like Either.
The simplest thing is probably wrapping it in a newtype:
newtype Mirror b a = Mirrored (Either a b)
instance Functor (Mirror e) where
fmap _ (Mirrored (Right a)) = Mirrored $ Right a
fmap f (Mirrored (Left b)) = Mirrored $ Left (f b)
Wrapping with newtype is also the standard way to create multiple instances for a single type, such as Sum and Product being instances of Monoid for numeric types. Otherwise, you can only have one instance per type.
Additionally, depending on what it is you want to do, another option is to ignore Functor and define your own type class like this:
class Bifunctor f where
bimap :: (a -> c) -> (b -> d) -> f a b -> f c d
instance Bifunctor Either where
bimap f _ (Left a) = Left $ f a
bimap _ g (Right b) = Right $ g b
instance Bifunctor (,) where
bimap f g (a, b) = (f a, g b)
Obviously, that class is twice as much fun as a regular Functor. Of course, you can't make a Monad instance out of that very easily.
You can't make the instance you are looking for directly.
In order for type inference and type classes to work, there is a certain positional bias to the ordering of arguments in the types. It has been shown that if we allowed arbitrary reordering of the arguments when instantiating type classes, that type inference becomes intractable.
You could use a Bifunctor class that can map over both arguments separately.
class Bifunctor f where
bimap :: (a -> b) -> (c -> d) -> f a c -> f b d
first :: (a -> b) -> f a c -> f b c
second :: (c -> d) -> f a c -> f a d
first f = bimap f id
second = bimap id
instance Bifunctor Either where
bimap f _ (Left a) = Left (f a)
bimap _ g (Right b) = Right (g b)
instance Bifunctor (,) where
bimap f g (a,b) = (f a, g b)
Or you could use a Flip combinator like:
newtype Flip f a b = Flip { unFlip :: f b a }
Generalized versions of both of these are available in category-extras on hackage. The latter even includes an instance for Functor (Flip Either a) because Either is a Bifunctor. (I should probably fix that to only require a PFunctor)
Ultimately, the order of arguments in a type constructor is important in determining what classes you can instantiate. You may need to use newtype wrappers (like Flip above) to put the arguments where they need to be to qualify to construct an instance of another typeclass. This is the price we pay for the inference of type class constraints.
You essentially need a 'flip' combinator on types. A newtype wrapper that inverts the order should work, as camccann says. Note that you can't use a 'type' synonym, as they may not be partially applied.