[Haskell-cafe] Problem with tuple with one element constrained
Justus Adam
dev at justus.science
Tue Apr 18 20:44:53 UTC 2017
I am not sure really what you are trying to do, but here are a few
approaches which I think may solve your problem.
1. Calculate the monadic value outside or fmap over the tuple
constructor
for instance
do
x <- functionCall
return (y, x)
or
(y, ) <$> functionCall
(uses the TupleSections extension)
2. Use explicit forall and scoped type variables
If you really want to return a tuple with that monadic value from a
function then the `Monad m` constraint must be on the function itself.
Like so
Compiled with ExplicitForAll and ScopedTypeVariables
myFunction :: forall m. Monad m => m ...
myFunction =
let
x :: m SomeType
(y, x) = (..., return ...)
in ...
Which binds `m` to be of the same type as the outer `m`.
This is necessary as there must be some way that even from outside the
function we can figure out what concretely `m` actually is. Ergo it must
be bound in some way to the functions type signature.
3. ExistentialTypes
If you __really__ think you only need a `Monad` constraint on this type
(which I doubt) you can use an existential to wrap things into generic
monads.
(Uses ExistentialTypes)
data ExtMonad a = forall m. Monad m => ExtMonad m a
The thing I don't quite understand is, if you have a function call,
which produces the value, doesn't that call return a concrete monad?
Rather than just `Monad m`?
It sounds to me like you're actually barking up the wrong tree when you
try and do what you are doing here so I suggest using something like
approach 1 or 2 and perhaps rethinking if your problem may lay somewhere
else.
Regards
Justus
--
Justus Adam
dev at justus.science
On Tue, Apr 18, 2017, at 12:41 PM, Tyson Whitehead wrote:
> I've been unable to get the following (simplified) code to be accepted by
> GHCi (8.0.1 and 8.0.2)
>
> Prelude> let (x, y) = (1, return 2)
> <interactive>:1:5: error:
> • Could not deduce (Monad m0)
> from the context: Num t
> bound by the inferred type for ‘x’:
> Num t => t
> at <interactive>:1:5-24
> The type variable ‘m0’ is ambiguous
> • When checking that the inferred type
> x :: forall a (m :: * -> *) t. (Num a, Num t, Monad m) => t
> is as general as its inferred signature
> x :: forall t. Num t => t
>
> and I don't seem to be able to provide a type signatures that GHCi is
> okay with
>
> Prelude> let { x :: Int; y :: Monad m => m Int; (x, y) = (1, return 2) }
> <interactive>:5:40: error:
> • Ambiguous type variable ‘m0’
> prevents the constraint ‘(Monad m0)’ from being solved.
> • When checking that the inferred type
> x :: forall a (m :: * -> *) t (m1 :: * -> *).
> (Num a, Num t, Monad m) =>
> t
> is as general as its signature
> x :: Int
>
> Prelude> let (x, y) = (1, return 2) :: (Int, Monad m => m Int)
> <interactive>:4:31: error:
> • Illegal qualified type: Monad m => m Int
> GHC doesn't yet support impredicative polymorphism
> • In an expression type signature: (Int, Monad m => m Int)
> In the expression: (1, return 2) :: (Int, Monad m => m Int)
> In a pattern binding:
> (x, y) = (1, return 2) :: (Int, Monad m => m Int)
>
> Prelude> let (x,y) = (1,return 2) :: Monad m => (Int, m Int)
> <interactive>:7:5: error:
> • Ambiguous type variable ‘m0’
> prevents the constraint ‘(Monad m0)’ from being solved.
> • When checking that the inferred type
> x :: forall (m :: * -> *). Monad m => Int
> is as general as its inferred signature
> x :: Int
>
> It seems the constraint on y leaks to x where it isn't well formed? Any
> help and/or explanations would be greatly appreciated. In my actual code
> the assignment is from the return value of a function so I can't just
> split it into two separate statements.
>
> Thanks! -Tyson
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
More information about the Haskell-Cafe
mailing list