[Haskell-cafe] Instances for (->) a (b :: * -> *)?
lists+haskell-cafe at jimpryor.net
lists+haskell-cafe at jimpryor.net
Fri Jun 17 05:33:36 UTC 2016
If one wants to declare instances for a type schema `a -> _`, one writes
something like this:
instance Context => Class parameters ... ((->) a) where { ... }
But what if you want to declare instances for a type schema `a -> b _`,
that is, where the slot to be filled is not just the result of (->) a,
but rather the composition of that together with another type operation
b :: * -> *? I'd like to write something like this:
instance Context => Class parameters ... ((->) a (b :: *->*)) where
{ ...}
or:
instance Context => Class parameters ... ((->) a (b *)) where { ...}
but these don't work. Is it possible to do this?
Concretely, here's what I'm trying to achieve. I wrote a typeclass for
MonadReaders that are embedded inside (one level) of other MonadReaders,
like this:
{-# LANGUAGE FunctionalDependencies FlexibleInstances
UndecidableInstances #-}
class MonadReader w m => DeepMonadReader w r m | m -> r where
{ deepask :: m r
; deepask = deepreader id
; deeplocal :: (r -> r) -> m a -> m a
; deepreader :: (r -> a) -> m a
; deepreader f = do { r <- deepask; return (f r) }
}
instance MonadReader r m => DeepMonadReader w r (ReaderT w m) where
{ deepask = lift ask
; deeplocal = mapReaderT . local
; deepreader = lift . reader
}
It'd be nice to also provide an instance something like this:
instance MonadReader r m => DeepMonadReader w r ((->) w (m :: * ->
*)) where
{ deepask = \w -> ask
; deeplocal f xx = \w -> local f (xx w)
; deepreader xx = \w -> reader xx
}
--
Jim Pryor
jim at jimpryor.net
More information about the Haskell-Cafe
mailing list