[Haskell-cafe] Problem with result-type context restrictions
in typeclasses.
Ryan Ingram
ryani.spam at gmail.com
Wed Sep 30 03:14:05 EDT 2009
You can require the associated type to have a particular instance, like
this:
class (Bar (Ret c)) => Cls c where
type Ret c
foo :: c -> Ret c
Another option is to use existential types:
data HasBar = forall a. Bar a => HasBar a
class Cls c where
foo :: c -> HasBar
You then have to wrap the result of "foo" by "HasBar"; then you can get the
instance back out by case-matching on HasBar. This is basically the same as
Miguel's solution of returning a dictionary, except the dictionary is
implicitly held in the existential instead of explicit.
-- ryan
On Tue, Sep 29, 2009 at 10:25 PM, DNM <dnmehay at gmail.com> wrote:
>
> Dan, thanks again for the response.
>
> I changed my code to use type families to let each Cls instance (actually a
> more complicated instance in my code) determine which Bar instance type it
> will return, but this didn't seem to work. The problem is that the client
> of the typeclass instance methds ('useThisStuff', which calls on 'toNum'
> and
> 'foo' in the contrived example) expects some guarantee that (Ret c) is
> going
> to be an instance of Bar. The actual client code I'm using complains when
> it sees that the associated type doesn't guarantee that an instance of the
> appropriate class is instantiated. I don't see any way to guarantee this
> without adding a context restriction in the class-level definition of Ret
> c,
> something like:
>
> class Cls c where
> type Ret c :: (Bar *) => * -- or a better name
> foo :: c -> Ret c
>
> which isn't legal Haskell. What I want to say is "define Ret c however you
> want, but make sure it is an instance of Bar" in the *class-level
> definition
> of Ret c*, so that any client of 'Cls' will know that Ret c will be
> foo-able.
>
> Maybe I'm missing some subtlety of type families...
>
> Any suggestions?
>
> --D.N.
>
>
> Daniel Peebles wrote:
> >
> > In your class, you have:
> >
> > class Cls c where
> > foo :: (Bar b) => c -> b
> >
> > There's an implicit forall for b, meaning that the caller of the
> > method gets to choose what it wants for b (as long as it's an instance
> > of Bar). For you to be able to write such a method you'd need to write
> > functions that can return any instance of Bar. One solution to this is
> > to turn on the GHC extension -XTypeFamilies, and then modify your code
> > as follows:
> >
> > class Cls c where
> > type Ret c :: * -- or a better name
> > foo :: c -> Ret c
> >
> > instance Cls G where
> > type Ret G = FU
> > foo = fuu
> >
> > That should work (although I haven't tested it).
> >
> > What type families do in this case is allow you to write not only
> > methods associated with typeclasses, but type functions associated
> > with them too. In this case you can think of Ret as a function that
> > takes a type (G in the instance above) and returns another type (FU).
> > Each instance can define new mappings for Ret.
> >
> > Hope this helps!
> >
> > Dan
> > On Tue, Sep 29, 2009 at 10:48 PM, DNM <dnmehay at gmail.com> wrote:
> >> Correction by the author:
> >>
> >>> It seems that ghc doesn't like the fact that I am saying 'foo' must
> >>> return a class 'b' of typeclass 'Bar', while providing a function that
> >>> returns a concrete data instance of 'Bar' (viz., FU or FI) later on
> >>> when I implement 'foo' in each type classes.
> >>
> >> Should read:
> >>
> >> It seems that ghc doesn't like the fact that I am saying 'foo' must
> >> return something of TYPE 'b' implementing typeclass 'Bar', while
> >> providing
> >> a function that returns a concrete data instance of 'Bar' (viz., FU or
> >> FI)
> >> later on when I implement 'foo' in each type classes.
> >>
> >> On Sep 29, 10:43 pm, DNM <dnme... at gmail.com> wrote:
> >>> N.B. I'm a newbie to Haskell, and this problem is a bit complex, so
> >>> bear with me.
> >>>
> >>> I'm using typeclasses to implement a sort of common interface for all
> >>> things -- call them things of type 'Cls' -- that can be expected to
> >>> implement a set of functions -- an 'interface' in OOP-speak. (Yes,
> >>> yes, I'm aware that typeclasses are subtly different and far superior,
> >>> but my Haskell-ese is still a bit rudimentary.)
> >>>
> >>> Essentially, I want to have a typeclass that expects its instances to
> >>> have an accessor function that results in something that is an
> >>> instance of another typeclass whose instances can perform some
> >>> operation. The ghc type-checker doesn't seem to like my code,
> >>> though, and I can't seem to figure out why.
> >>>
> >>> To make it concrete, I've typed up some dummy typeclasses and a dummy
> >>> function that uses their instances to illustrate what I mean, as well
> >>> as the form of the ghc(i) error.
> >>>
> >>> ------------- BEGIN CODE ------------------
> >>> class Cls c where
> >>> foo :: (Bar b) => c -> b
> >>>
> >>> class Bar b where
> >>> toNum :: b -> Int
> >>>
> >>> -- | One implementation of Cls
> >>> data D = D {fu :: FU}
> >>> data FU = FU {num :: Int}
> >>>
> >>> instance Cls D where
> >>> foo = fu
> >>> instance Bar FU where
> >>> toNum f = (num f) + 47
> >>>
> >>> -- | Another implementation of Cls
> >>> data E = E {fi :: FI}
> >>> data FI = FI {nuum :: Int}
> >>>
> >>> instance Cls E where
> >>> foo = fi
> >>> instance Bar FI where
> >>> toNum f = (nuum f) + 100
> >>>
> >>> -- | Yet another (this one re-uses FI)
> >>> data F = F {fii :: FI}
> >>>
> >>> instance Cls F where
> >>> foo = fii
> >>>
> >>> -- | And one last one, just to stress that
> >>> -- I really need to implement multiple
> >>> -- instances of Cls.
> >>> data G = G {fuu :: FU}
> >>>
> >>> instance Cls G where
> >>> foo = fuu
> >>>
> >>> -- | Good. Now, the function 'useThisStuff' need
> >>> -- not know anything about it's payload
> >>> -- other than that it its args are Cls's
> >>> -- (hence they are foo'able things that
> >>> -- can be used to construct an Int answer).
> >>> useThisStuff :: (Cls x, Cls y) => x -> y -> Int
> >>> useThisStuff x y =
> >>> (toNum $ foo x) + (toNum $ foo y)
> >>> ------------- END CODE --------------------
> >>>
> >>> When I type this up in a file and try to load it in ghci, I get the
> >>> following error message(s):
> >>>
> >>> ------------- BEGIN ERROR MSG ----------
> >>> Prelude> :load Typeclasses.hs
> >>> [1 of 1] Compiling Typeclasses ( Typeclasses.hs, interpreted )
> >>>
> >>> Typeclasses.hs:14:10:
> >>> Couldn't match expected type `b' against inferred type `FU'
> >>> `b' is a rigid type variable bound by
> >>> the type signature for `foo' at Typeclasses.hs:4:16
> >>> Expected type: D -> b
> >>> Inferred type: D -> FU
> >>> In the expression: fu
> >>> In the definition of `foo': foo = fu
> >>>
> >>> Typeclasses.hs:23:10:
> >>> Couldn't match expected type `b' against inferred type `FI'
> >>> `b' is a rigid type variable bound by
> >>> the type signature for `foo' at Typeclasses.hs:4:16
> >>> Expected type: E -> b
> >>> Inferred type: E -> FI
> >>> In the expression: fi
> >>> In the definition of `foo': foo = fi
> >>>
> >>> Typeclasses.hs:31:10:
> >>> Couldn't match expected type `b' against inferred type `FI'
> >>> `b' is a rigid type variable bound by
> >>> the type signature for `foo' at Typeclasses.hs:4:16
> >>> Expected type: F -> b
> >>> Inferred type: F -> FI
> >>> In the expression: fii
> >>> In the definition of `foo': foo = fii
> >>>
> >>> Typeclasses.hs:39:10:
> >>> Couldn't match expected type `b' against inferred type `FU'
> >>> `b' is a rigid type variable bound by
> >>> the type signature for `foo' at Typeclasses.hs:4:16
> >>> Expected type: G -> b
> >>> Inferred type: G -> FU
> >>> In the expression: fuu
> >>> In the definition of `foo': foo = fuu
> >>> Failed, modules loaded: none.
> >>> ------------- END ERROR MSG ------------
> >>>
> >>> It seems that ghc doesn't like the fact that I am saying 'foo' must
> >>> return a class 'b' of typeclass 'Bar', while providing a function that
> >>> returns a concrete data instance of 'Bar' (viz., FU or FI) later on
> >>> when I implement 'foo' in each type classes. Repeated for
> >>> convenience:
> >>>
> >>> class Cls c where
> >>> foo :: (Bar b) => c -> b
> >>> ...
> >>> -- (e.g.)
> >>> data G = G {fuu :: FU}
> >>> instance Cls G where
> >>> foo = fuu
> >>>
> >>> Does anyone have any clue as to what I'm doing wrong (language
> >>> extensions that I may need, etc.)?
> >>>
> >>> Is is because I'm using context restrictions on the *result* type of a
> >>> typeclass method? I've written other typeclasses with methods that
> >>> say, essentially:
> >>>
> >>> class A a where
> >>> blah :: (MonadPlus m) => a -> a -> m a
> >>>
> >>> with no issues. The restriction there is not on the return type a, but
> >>> rather on some monadic 'wrapper' around it. This may be why that code
> >>> works.
> >>>
> >>> Please advise. Any help is greatly appreciated.
> >>>
> >>> --D.N. (Dennis)
> >>> _______________________________________________
> >>> Haskell-Cafe mailing list
> >>> Haskell-C... at haskell.orghttp://
> www.haskell.org/mailman/listinfo/haskell-cafe
> >> _______________________________________________
> >> Haskell-Cafe mailing list
> >> Haskell-Cafe at haskell.org
> >> http://www.haskell.org/mailman/listinfo/haskell-cafe
> >>
> > _______________________________________________
> > Haskell-Cafe mailing list
> > Haskell-Cafe at haskell.org
> > http://www.haskell.org/mailman/listinfo/haskell-cafe
> >
> >
>
> --
> View this message in context:
> http://www.nabble.com/Problem-with-result-type-context-restrictions-in-typeclasses.-tp25674141p25675199.html
> Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090930/f4d38442/attachment.html
More information about the Haskell-Cafe
mailing list