I'm trying to write something that appears to be analagous to "rank 2 types", but for constraints instead. (Or, maybe it's not correct to assume changing -> in the definition of "rank 2 types" to => is meaningful; please edit the question if you think up better terminology).
setup
First, the Suitable typeclass (from Data.Suitable, the base of rmonad) can be used to denote types of values which can be used. In this question, I'll use
Suitable m a
to denote that value a can be used as a value for some functions of the monad m (in particular, if m is a DSL, then its values are usually a which are suitable), for example
class PrintSuitable m where
printSuitable :: Suitable m a => a -> m ()
See the top comment for RMonad [ link ] and its source for an example of how to use Suitable. For example, one could define Suitable m (Map a b), and print the number of elements in the map.
question
goal: Now, I have a monad transformer MyMonadT, and want to make MyMonadT m a PrintSuitable instance whenever m is a PrintSuitable instance.
rank 2 constraints motivation: The issue is that the type a is introduced with regard to the printSuitable function, i.e. does not appear in the class signature. Since one can only add constraints to the class signature (additional constraints to an instance function implementation are illegal), it makes sense to say something about all a in the class signature (line 2 below).
Below shows the intended code.
instance (PrintSuitable m, MonadTrans t,
(forall a. Suitable (t m) a => Suitable m a), -- rank 2 constraint
) => PrintSuitable (t m) where
printSuitable = lift ...
-- MyMonadT doesn't change what values are Suitable, hence the rank 2 expression,
-- (forall a. Suitable (t m) a => Suitable m a) should hold true
data instance Constraints (MyMonadT m) a =
Suitable m a => MyMonadT_Constraints
instance Suitable m a => Suitable (MyMonadT m) a where -- the important line
constraints = MyMonadT_Constraints
instance MonadTrans MyMonadT where ...
-- now, MyMonadT m is a PrintSuitable whenever m is a PrintSuitable
-- the manual solution, without using MonadTrans, looks roughly like this
instance PrintSuitable m => PrintSuitable (t m) where
printSuitable a = withResConstraints $ \MyMonadT_Constraints -> ...
the constraint indicated says that anything that's suitable in (t m) is suitable in m. But, of course, this isn't valid Haskell; how could one encode a functional equivalent?
Thanks in advance!!!
Doing what you asked for
If you look in my constraints package on hackage, there is
Data.Constraint.Forall
That can be used to create quantified constraints, and using inst with the other constraint combinators from the package and by making a helper constraint to put the argument in the right position, you can directly encode what you are asking for.
A description of the reflection machinery is on my blog.
http://comonad.com/reader/2011/what-constraints-entail-part-1/
http://comonad.com/reader/2011/what-constraints-entail-part-2/
However, this requires a bleeding edge GHC.
For many cases you can often ape this by making a rank 2 version of your particular constraint though.
class Monoid1 m where
mappend1 :: m a -> m a -> m a
mempty1 :: m a
but in your case you want not only a rank 2 constraint but a constraint implication.
Using the machinery from that package we could make
class SuitableLowering t m where
lowerSuitability :: Suitable (t m) a :- Suitable m a
Then you can use
instance (PrintSuitable m, SuitableLowering t m) => PrintSuitable (t m) where
and use expr \\ lowerSuitability to manually bring into scope the Suitable m a instance in a context where you know Suitable (t m) a.
But this is a really dangerous way to express an instance, because it precludes you ever making something is of kind (* -> *) -> * -> * an instance of PrintSuitable in any other way and may interfere with defining your base case if you aren't careful!
Doing what you need
The right way to do this is to give up on defining a single instance that covers all cases, and instead define a printSuitableDefault that could be used for any appropriate transformer.
Assuming the existence of RMonadTrans as mentioned in Daniel's response
class RMonadTrans t where
rlift :: Suitable m a => m a -> t m a
we can define:
printSuitableDefault :: (RMonadTrans t, Suitable m a) => a -> t ()
printSuitableDefault = ...
instance PrintSuitable m => PrintSuitable (Foo m) where
printSuitable = printSuitableDefault
instance PrintSuitable m => PrintSuitable (Bar m) where
printSuitable = printsuitableDefault
You aren't likely to have too many rmonad transformers, and this ensures that if you want to make one print a different way you have that flexibility.
Doing what you need slightly more nicely under a bleeding edge compiler
Under 7.3.x (current GHC HEAD) or later you can even use the new default declarations to make this a little less painful.
class RMonad m => PrintSuitable m where
printSuitable :: a -> m ()
default printSuitable :: (RMonadTrans t, RMonad n, Suitable n a, m ~ t n) =>
a -> t n ()
printSuitable = <the default lifted definition>
then the instances for each transformer can just look like:
instance PrintSuitable m => PrintSuitable (Foo m)
instance PrintSuitable m => PrintSuitable (Bar m)
and you can define your nice printSuitable base case for some retricted monad without worries about overlap.
I don't think MonadTrans will be of use here, since lift requires m to be a Monad. Can you work with
class RMonadTrans t where
rlift :: Suitable m a => m a -> t m a
instance (RMonadTrans t, Suitable m a) => Suitable (t m) a where
constraints = ???
A related thing is that you can define an instance:
{-# LANGUAGE FlexibleInstances, FlexibleContexts,
UndecidableInstances, MultiParamTypeClasses #-}
module Foo where
import Control.Monad.Trans
class Suitable m a where
foo :: m a -> Int
class PrintSuitable m where
printSuitable :: Suitable m a => a -> m ()
instance (PrintSuitable m, MonadTrans t, Suitable (t m) a) => Suitable m a where
foo = const 5
instance (PrintSuitable m, MonadTrans t) => PrintSuitable (t m) where
printSuitable = undefined
So you don't need the constraint. Will that help?
Related
I don't have quite the vocabulary for phrasing this question (and therefore for searching for answers, so apologies if the answer is easily available). Consider the following
class RunFoo m where
runFoo :: m a -> a
class RunFooWrapper m where
doRunFoo :: (RunFoo n) => n a -> m a
newtype RunFast a = RunFast a
newtype RunSlow a = RunSlow a
fooExample :: (RunFoo m) => m Bool
fooExample = undefined
fooWrapperExample :: (RunFooWrapper m) => m Bool
fooWrapperExample = doRunFoo fooExample
This does not compile: Could not deduce (RunFoo n0) arising from a use of ‘doRunFoo’.
It seems that the compiler (GHC 7.10) is insisting on a concrete instantiation of the m from fooExample, and is therefore refusing to continue. But in this case I can't see why the program is ill-typed - fooExample explicitly defines a RunFoo m and all doRunFoo requires is a RunFoo x. So why doesn't this work?
As a supplementary question, is there some kind of special extension (something to do with existential types perhaps) that would allow a program like this? Ideally I'd like to be able to say that doRunFoo takes anything defined existentially (?) as RunFoo m => m (rather than taking any concrete instantiation of RunFoo).
Motivation
I'd like to create composable functions that operate on some aspect of a type constrained by a typeclass - I can provide a concrete example of what I mean if necessary!
Edit with more motivation and alternative implementation
I was curious about the answer to this question in the general case, but I thought I'd add that in the context I ran across this issue what I really wanted is for a sort of constrained delegation between monads. So I wanted to write functions in a monad constrained only by a typeclass that invoked monads in another type class. The top level function could then be run in different contexts, performing the same logic but with the underlying implementation swapped out according to the wrapping monad. As there was a one-to-one correspondence between the wrapping and the implementation monad I was able to use type families to do this, so
class (RunFoo (RunFooM m)) => RunFooWrapper m where
type RunFooM m :: * -> *
doRunFoo :: RunFooM m a -> m a
instance RunFooWrapper RunFooWrapperSlow where
type RunFooM RunFooWrapperSlow = RunSlow
doRunFoo :: [...]
This meant that the resolution of the fooExample m was determined by the class context of the wrapper monad, and seems to work fine, but it is a very narrow solution compared to that provided by haoformayor.
RankNTypes
{-# language RankNTypes #-}
class RunFoo m where
runFoo :: m a -> a
class RunFooWrapper m where
doRunFoo :: (forall n. RunFoo n => n a) -> m a
fooExample :: RunFoo m => m Bool
fooExample = undefined
fooWrapperExample :: RunFooWrapper m => m Bool
fooWrapperExample = doRunFoo fooExample
The (forall n. RunFoo n => n a) -> m a is the key difference. It lets you pass in fooExample, which has the type forall m. RunFoo m => m Bool (the forall being implicitly added by the compiler) and so the m unifies with the n and everybody is happy. Though I cannot read minds, I believe this type reflects your true intent. You only wanted a RunFoo instance, nothing more, and having the n scoped to the first argument provides it.
The problem was that your given code is implicitly typed as forall n. RunFoo n => n a -> m a. That means you need to first pick an n such that RunFoo n and then come up with a value with type n a to pass in as the first argument. This simple act of moving the parentheses (increasing the rank of n) changes the meaning entirely.
For an example of someone who had the same problem, see this Stack Overflow question. For a better explanation of RankNTypes than I could provide, see Oliver's blog post on it.
OK, I don't see how it can be done, but knowing that Haskell is a language of infinite depth, I decided to ask this here before giving up.
Suppose we have a value that is polymorphic, for example:
foo :: Monad m => m Int
foo = return Int
Obviously, depending on context, m can be instantiated to different types. I wonder if it's possible now to take this abstract piece of code and use it in several different contexts inside the same function (for example to reduce boilerplate when covering code):
bar :: Monad m => m Int -> Property
bar m = conjoin
[ checkIt (runIdentityT m)
, checkIt (runReaderT m ())
, …
]
Where checkIt accepts some concrete monad. Since foo is essentially abstract description how to do something, it should be possible to use it in several contexts, but the problem is obviously that if we promise to work with any Monad m => m Int in signature of bar, then we cannot write this function on less abstract level since then it's not possible to accommodate to every possible instance of Monad in its implementation.
Is there a way to pass foo into bar so it can be used in several type contexts inside it?
You want rank-2 types:
bar :: (forall m. Monad m => m Int) -> Property
bar m = conjoin
[ checkIt (runIdentityT m)
, checkIt (runReaderT m ())
, …
]
Now, bar foo will type check.
Concretely, the type (forall m. Monad m => m Int) requires the argument to be polymorphic and usable for all monads m. By comparison, the original type
bar :: Monad m => m Int -> Property
only requires the argument to have a type of the form m Int for some monad m. In your case, you clearly want "for all", and not "for some".
You can enable rank-2 types by putting at the top of your file the following line:
{-# LANGUAGE Rank2Types #-}
On a more theoretical note, my guts are telling me that the type
(forall m. Monad m => m Int)
is actually isomorphic to
Int
with isomorphisms:
iso :: Int -> (forall m. Monad m => m Int)
iso x = return x
osi :: (forall m. Monad m => m Int) -> Int
osi m = runIdentity m
The above should indeed be an isomorphism thanks to the free theorem associated to forall m. Monad m => m Int.
If my intuition is correct, as I believe, this means that every value of the type forall m. Monad m => m Int has to have the form return x for some integer x.
So, the final counter-question is: why don't you simply pass an Int, and remove the unneeded rank-2 machinery?
I have a data structure (it's a specific subclass of rose-tree that forms a lattice with greatest-lower bound and lowest-upper bound functions), and it supports two perfectly reasonable functions to serve as the Monoid class's mappend.
Is there any way to support anonymous Monoid instances in haskell? Is this an instance where I should consider using something like Template-Haskell to generate my typeclasses for me?
What I'd love is a makeMonoid :: (RT a -> RT a -> RT a) -> Monoid a to let me create the instance on the fly, but I understand that that's incoherent with the stock typesystem as I understand it.
I'm okay with it if I just need to pick a default merge function and write newtypes for other merges, just curious
You can create "local" instances of Monoid on the fly, using the tools in the reflection package. There's a ready-made example in the repository. This answer explains it a little.
This is a newtype wrapper over values of type a, on which we will define our Monoid instance.
newtype M a s = M { runM :: a } deriving (Eq,Ord)
Notice that there is a phantom type s that does not appear in the right hand side. It will carry extra information necessary for the local Monoid instance to work.
This is a record whose fields represent the two operation of the Monoid class:
data Monoid_ a = Monoid_ { mappend_ :: a -> a -> a, mempty_ :: a }
The following is the Monoid instance definition for M:
instance Reifies s (Monoid_ a) => Monoid (M a s) where
mappend a b = M $ mappend_ (reflect a) (runM a) (runM b)
mempty = a where a = M $ mempty_ (reflect a)
It says: "whenever s is a type-level representation of our Monoid dictionary Monoid_, we can reflect it back to obtain the dictionary, and use the fields to implement the Monoid operations for M".
Notice that the actual value a passed to reflect is not used, it is passed only as a "proxy" of type M a s that tells reflect which type (s) to use to "bring back the record".
The actual local instance is constructed using the reify function:
withMonoid :: (a -> a -> a) -> a -> (forall s. Reifies s (Monoid_ a) => M a s) -> a
withMonoid f z v = reify (Monoid_ f z) (runM . asProxyOf v)
asProxyOf :: f s -> Proxy s -> f s
asProxyOf a _ = a
The asProxyOf function is a trick to convince the compiler that the phantom type used in the monoid is the same as the one in the Proxy supplied by reify.
A lot of constraints seem to come together. Let's abstract these away.
type MonadNumState a m = (MonadState a m, Num a)
MonadNumState is just a constraint synonym, so I get the benefit of functional dependencies at every use, and can easily throw a MonadNumState a m into a context. Now, suppose I wish to abstract this into a constraint family:
class Iterator t where
type MonadIter t a m :: Constraint
next :: (MonadIter t a m) => m t
...
instance Iterator Foo where
type MonadIter Foo a m = (MonadState a m, Num a)
...
instance Iterator Bar where
type MonadIter Bar a m = (MonadRandom m, MonadSplit a m, RandomGen a)
...
But now a is not a functional dependency. next is virtually unusable since a cannot be inferred. What can I do? Well, I could, of course, use a type family instead. MonadState is written using fundeps, but it should be easy to convert the fundeps to type families.
instance (MonadState s m) => MonadStateFamily m where
type St m = s
get' = get
...
instance (MonadStateFamily m) => MonadState (St m) m where
get = get'
...
Guess not.
Foo.hs:25:3:
The RHS of an associated type declaration mentions type variable `s'
All such variables must be bound on the LHS
What else might I be able to do? What I really want is to existentially quantify away s. I've not found any way to do that without explicit dictionary passing.
So, how do I get the benefit of fundeps for constraint families?
You can consider using a standalone type family instead of an associated type
type family StateType (m:: * -> *)
Then you can define
class MonadStateFamily m where
get' :: m (StateType m)
instance (MonadState s m, s ~ StateType m) => MonadStateFamily m where
get' = get
and use it on a concrete monad like this:
type instance StateType (State s) = s
getState :: State s s
getState = get'
Lets say I have a function
f :: State [Int] Int
and a function:
g :: StateT [Int] IO Int
I want to use f in g and pass the state between them. Is there a library function for
StateT (return . runState f)? Or in general, given a monad transformer with a corresponding monad, is there a library function for it?
In even more general, what you're trying to do is apply a transformation to an inner layer of a transformer stack. For two arbitrary monads, the type signature might look something like this:
fmapMT :: (MonadTrans t, Monad m1, Monad m2) => (m1 a -> m2 a) -> t m1 a -> t m2 a
Basically a higher-level fmap. In fact, it would probably make even more sense to combine it with a map over the final parameter as well:
fmapMT :: (MonadTrans t, Monad m1, Monad m2) => (m1 a -> m2 b) -> t m1 a -> t m2 b
Clearly this isn't going to be possible in all cases, though when the "source" monad is Identity it's likely to be easier, but I can imagine defining another type class for the places it does work. I don't think there's anything like this in the typical monad transformer libraries; however, some browsing on hackage turns up something very similar in the Monatron package:
class MonadT t => FMonadT t where
tmap' :: FunctorD m -> FunctorD n -> (a -> b)
-> (forall x. m x -> n x) -> t m a -> t n b
tmap :: (FMonadT t, Functor m, Functor n) => (forall b. m b -> n b)
-> t m a -> t n a
tmap = tmap' functor functor id
In the signature for tmap', the FunctorD types are basically ad-hoc implementations of fmap instead of using Functor instances directly.
Also, for two Functor-like type constructors F and G, a function with a type like (forall a. F a -> G a) describes a natural transformation from F to G. There's quite possibly another implementation of the transformer map that you want somewhere in the category-extras package but I'm not sure what the category-theoretic version of a monad transformer would be so I don't know what it might be called.
Since tmap requires only a Functor instance (which any Monad must have) and a natural transformation, and any Monad has a natural transformation from the Identity monad provided by return, the function you want can be written generically for any instance of FMonadT as tmap (return . runIdentity)--assuming the "basic" monad is defined as a synonym for the transformer applied to Identity, at any rate, which is generally the case with transformer libraries.
Getting back to your specific example, note that Monatron does indeed have an instance of FMonadT for StateT.
What you are asking for is a mapping (known as a monad morphism) from a monad StateT m to StateT n. I'll be using the the mmorph library, which provides a very nice set of tools for working with monad morphisms.
To perform the State -> StateT m transform you are looking for, we'll start by defining a morphism to generalize the Identity monad embedded in State,
generalize :: Monad m => Identity a -> m a
generalize = return . runIdentity
Next we'll want to lift this morphism to act on the inner monad of your StateT. That is, we want a function which given a mapping from one monad to another (e.g. our generalize morphism), will give us a function acting on the base monad of a monad transformer, e.g. t Identity a -> t m a. You'll find this resembles the hoist function of mmorph's MFunctor class,
hoist :: Monad m => (forall a. m a -> n a) -> t m b -> t n b
Putting the pieces together,
myAction :: State s Int
myAction = return 2
myAction' :: Monad m => StateT s m Int
myAction' = hoist generalize myAction
Such a function is not definable for all monad transformers. The Cont r monad, for example, can't be lifted into ContT r IO because that would require turning a continuation in the IO monad (a -> IO r) into a pure continuation (a -> r).