Type families and type inference - a question
Daniel Fischer
daniel.is.fischer at web.de
Sun Jan 10 12:11:07 EST 2010
Am Sonntag 10 Januar 2010 17:09:33 schrieb Dmitry Tsygankov:
> 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 #-}
What you need is also
{-# LANGUAGE NoMonomorphismRestriction #-}
Read http://haskell.org/onlinereport/decls.html#sect4.5.5
and http://www.haskell.org/haskellwiki/Monomorphism_restriction
for background.
>
> data Movie = Movie { getDirector :: String }
> data (MovieFinder f) => MovieLister f = MovieLister { getFinder :: f }
Don't do that. Type class constraints on data types probably do not what
you think.
You'll have to put the constraint on the functions using MovieLister
nevertheless.
>
> -- Cannot remove the type signature here
> createLister :: (MovieFinder f) => (FinderResultMonad f) (MovieLister f)
> createLister = fmap MovieLister createFinder
createLister is a top-level binding which is bound by a simple pattern
binding. By the monomorphism restriction, such things must have a
monomorphic type unless a type signature is given. The monomorphic type
assigned to such an entity (if possible) is determined via the defaulting
rules http://haskell.org/onlinereport/decls.html#sect4.3.4
Here, the inferred type is
createLister ::
(f ~ FinderResultMonad a, MovieFinder a, Functor f) =>
f (MovieLister a)
which hasn't the form allowed by the defaulting rules, monomorphising fails
(even if f is resolved to FinderResultMonad a, and the type is written as
createLister :: (MovieFinder a) => FinderResultMonad a (MovieLister a), the
problem remains that MovieFinder is not a class defined in the standard
libraries, hence defaulting isn't possible).
>
> 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?
Monomorphism restriction.
If you can't remove a type signature, it's almost always that (sometimes
it's polymorphic recursion).
> 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?
It can, see below. It just chose to display it in a different form.
> 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?
It's the dreaded MR. That and the often surprising ways of ghci to display
inferred types.
> 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
(Note: Surprisingly (?), if you load a module with
{-# LANGUAGE NoMonomorphismRestriction #-}
, the monomorphsm restriction is still enabled at the ghci prompt, so we
have to disable it for that again - or we could have loaded the module with
$ ghci -XNoMonomorphismRestriction Movie)
*Movie> :set -XNoMonomorphismRestriction
*Movie> let q = fmap MovieLister createFinder
*Movie> :t q
q :: (MovieFinder a) => FinderResultMonad a (MovieLister a)
Okay, what happened there?
> *IfaceInj> :t fmap MovieLister
> fmap MovieLister
>
> :: (MovieFinder a, Functor f) => f a -> f (MovieLister a)
>
> *IfaceInj> :t createFinder
> createFinder :: (MovieFinder a) => FinderResultMonad a a
Now, to infer the type of
fmap MovieLister createFinder,
the type of (fmap MovieLister)'s argument, f a [we ignore contexts for a
moment], has to be unified with the type of createFinder,
FinderResultMoad a a.
That gives, obviously,
f ~ FinderResultMonad a, a further constraint. Joining the constraints, we
get
fmap MovieLister createFinder
:: (f ~ FinderResultMonad a, MovieFinder a, Functor f) =>
f (MovieLister a)
Fine. But now, since the expression is bound to a name, without a type
signature, it must be made monomorphic - but it can't.
The error message isn't helpful, though.
>
> 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.
More information about the Glasgow-haskell-users
mailing list