Type families and type inference - a question
Dmitry Tsygankov
dmitry.tsygankov at gmail.com
Sun Jan 10 11:09:33 EST 2010
Dear all,
I was playing around recently with translating the dependency injection idea
(http://martinfowler.com/articles/injection.html) into Haskell, and got to
the following code:
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
data Movie = Movie { getDirector :: String }
data (MovieFinder f) => MovieLister f = MovieLister { getFinder :: f }
-- Cannot remove the type signature here
createLister :: (MovieFinder f) => (FinderResultMonad f) (MovieLister f)
createLister = fmap MovieLister createFinder
class (Monad (FinderResultMonad f), Functor (FinderResultMonad f)) =>
MovieFinder f where
type FinderResultMonad f :: * -> *
createFinder :: (FinderResultMonad f) f
findAll :: f -> (FinderResultMonad f) [Movie]
It may be dumb (well, the Java version isn't particularly useful either),
but the thing I really do not understand is the type signature - why can't I
simply remove it?
Some output from GHCi:
GHCi, version 6.12.1: http://www.haskell.org/ghc/ :? for help
*IfaceInj> :t fmap MovieLister
fmap MovieLister
:: (MovieFinder a, Functor f) => f a -> f (MovieLister a)
*IfaceInj> :t createFinder
createFinder :: (MovieFinder f) => FinderResultMonad f f
Looks reasonable so far...
*IfaceInj> :t fmap MovieLister createFinder
fmap MovieLister createFinder
:: (f ~ FinderResultMonad a, MovieFinder a, Functor f) =>
f (MovieLister a)
Here's the first WTF. If the type inference engine knows that f ~
FinderResultMonad a, it can 'guess' the type
(MovieFinder a, Functor (FinderResultMonad a)) => (FinderResultMonad a)
(MovieLister a)
, can't it? And since there's a constraint on the MovieFinder type class, it
can further 'guess'
(MovieFinder a) => (FinderResultMonad a) (MovieLister a)
, which is exactly the type signature I have written by hand, but it
doesn't. Is it a bug, a missing feature, or just my lack of knowledge?
OK, so far, so good, let's call it a missing feature or something that is
impossible to implement.
*IfaceInj> let q = fmap MovieLister createFinder
<interactive>:1:25:
Couldn't match expected type `FinderResultMonad a'
against inferred type `f'
NB: `FinderResultMonad' is a type function, and may not be injective
In the second argument of `fmap', namely `createFinder'
In the expression: fmap MovieLister createFinder
In the definition of `q': q = fmap MovieLister createFinder
Here's the second WTF. It seems like the type inference engine CAN infer the
type of (fmap MovieLister createFinder). If I manually enter the type
inferred by ':t fmap MovieLister createFinder' to the signature of
createLister, everything compiles OK. But if I remove the type signature
from createLister completely, I get the same error:
*IfaceInj> :load "/home/dima/projects/IfaceInj.hs"
[1 of 1] Compiling IfaceInj ( /home/dima/projects/IfaceInj.hs,
interpreted )
/home/dima/projects/IfaceInj.hs:9:32:
Couldn't match expected type `FinderResultMonad a'
against inferred type `f'
NB: `FinderResultMonad' is a type function, and may not be injective
In the second argument of `fmap', namely `createFinder'
In the expression: fmap MovieLister createFinder
In the definition of `createLister':
createLister = fmap MovieLister createFinder
Failed, modules loaded: none.
That looks like a bug to me, but I can't be sure since I have no real
experience in Haskell.
Any ideas?
Regards,
Dmitry.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/glasgow-haskell-users/attachments/20100110/4fdd07a8/attachment.html
More information about the Glasgow-haskell-users
mailing list