instance (Monad m, Embeds (Either e) m) => MonadError e m where
but that fails with
• Illegal instance declaration for ‘MonadError e m’
The liberal coverage condition fails in class ‘MonadError’
for functional dependency: ‘m -> e’
Reason: lhs type ‘m’ does not determine rhs type ‘e’
Un-determined variable: e
even with
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
Is there a way to lift this restriction, or to say with a constraint that such an instance holds only when e can be deduced from m?
Do you have a FunDep on class Embeds? I’d expect something like
{-# LANGUAGE KindSignatures #-}
class Embeds (ee :: * -> *) (m :: * -> *) | m -> ee where ...
Explanation: with UndecidableInstances, it’s Ok for m not to determine e within the MonadError head. Then in that case the instance’s constraints must do the determining. So we need a constraint mentioning both m and e. That must be Embeds, as the only constraint that mentions both types.
Edit: I’ve added KindSignatures, to get the class Embeds as a valid constraint.
Then … if Embeds can’t be used to deduce, you could invent a whole other class/constraint for the purpose. [Ah, I see you’ve added class Depends as I was typing.] That seems terribly ad-hoc; without knowing the wider … emm … requirements context.
Doesn’t it? If you’re embedding something within something, I’d expect the embedded something to appear within the ‘outer’ something. As you’ve defined it, the two type constructors wouldn’t need anything in common at all. Perhaps you could reveal some typical instances for Embeds?
Thanks for posting your code. I’m more interested in what instances you’ll need for Depends, because what I see for Embeds is … problematic. You have many instances overlapping in awkward ways, not just the one marked OVERLAPPING.
Suppose from a usage of method embed, the compiler infers the [W]anted instance is Embeds (t0 m0) (t0 m0),
this matches instance Embeds m m; but also
matches instance Embeds (t n) (t m).
Neither declared instance is more specific (so the OVERLAPPING is no help).
Which instance do you expect to apply, and why?
This is known as a ‘partial overlap’: neither declared instance is more specific, nor are they apart. IOW there are some [W]anteds that match both, some that match only one, some that match only the other.
Nearly all of the possible pairings of the instance heads are partially overlapping.
Thanks, but no that isn’t similar: there’s a single instance exploiting a ‘dirty trick’ that is pure evil. There are no overlapping instances. The author gives plenty of warning:
This module is intended for internal use only, and may change without
warning in subsequent releases.
… type inference goes into a loop and stops with “reduction stack overflow” message
“natural transformation” suggests there could/should be a FunDep. But …
instance (Monad m, Embeds (Either e) m) => MonadError e m where
looks like the FunDep would go the other way round [***]: from m to Either e. And your narratives for the Embeds instances also seem to be ‘backwards’ vs how I’d put it, for example:
-- if @m@ is a `Monad` and @t@ is a `MonadTrans`, then `Embeds n m` implies `Embeds n (t m)`
instance (Monad m, MonadTrans t, Embeds n m) => Embeds n (t m) where
embed :: n a -> (t m) a
This instance decl says: if the compiler finds a call to embed with inferred type embed :: n a -> (t m) a (but not type embed :: (t n) a -> (t m) a [**]) then:
require t to be a MonadTrans;
– that is, the compiler does not look at t being a MonadTrans as a precondition of selecting this instance;
require Embeds n m – which complies with the Coverage Conditions, being strictly smaller than the instance head.
(And if there were a FunDep on Embeds the right way round, the recursive call would satisfy liberal coverage.)
[**] because embed :: (t n) a -> (t m) a that you write as embed :: t n a -> t m a in the MFunctor instance, is strictly more specific partially overlapping, so sometimes shadows the MonadTrans instance; OVERLAPPING is half-correct there.
I say half-correct because what if we have embed :: (t0 n0) a -> (t1 m1) a? That is, different transformers/functors: do you want to select the MFunctor instance with n ~ (t0 n0)?
Perhaps the logic you’re trying to get to is:
If the two Embeds functors are the same, select the id instance; otherwise
If the Embeds functors are of the form (t n) (t m) – that is, same t – select the MFunctor instance, which’ll then require MFunctor t;
If embed :: Identity a -> m a (irrespective of the form of m), select the id instance …
beware type inference might have to work quite hard there to confirm or reject Identity, so instance selection is likely to get stuck at this point;
If all the above fails, but at least we have embed :: n a -> (t m) a, select the MonadTrans instance, so requiring MonadTrans t.
This is what I’d call ‘advanced abuse’ of overlaps. It’s achievable, and it can support a FunDep on Embeds. But it’s not what those instances are saying at the moment.
[***] Addit: " Embeds m n … natural transformation from m to n" is saying in the case of: instance (Applicative m) => Embeds Identity m ... you can go from Identity to any Applicative whatsoever(?)
Let me try to provide some answers to your questions:
I’m more interested in what instances you’ll need for Depends
Don’t mind Depends too much, it was more a curiosity than anything. I was investigating how Embeds compares to mtl and wanted to check whether I was able to write an instance for MonadError e m given instances Monad m and Embeds (Either e) m. Writing it like instance (Monad m, Embeds (Either e) m) => MonadError e m where creates the initial error I posted, and I was curious about how to solve it.
Suppose from a usage of method embed, the compiler infers the [W]anted instance is Embeds (t0 m0) (t0 m0),
this matches instance Embeds m m; but also
matches instance Embeds (t n) (t m).
Neither declared instance is more specific (so the OVERLAPPING is no help).
Which instance do you expect to apply, and why?
I guess the answer here is that Embeds m m should take the priority. This partial overlap should be solvable adding a
instance {-# OVERLAPPING #-} Embeds (t n) (t m) where
embeds :: (t n) a -> (t m) a
embeds = id
correct?
instance (Applicative m) => Embeds Identity m ... you can go from Identity to any Applicative whatsoever(?)
yes… it’s basically saying (up to newtypes) that pure can lift a value into any Applicative. This instance is useful to infer that State s = StateT s Identity embeds into StateT s m, for any applicative m
Perhaps the logic you’re trying to get to is:
If the two Embeds functors are the same, select the id instance; otherwise
If the Embeds functors are of the form (t n) (t m) – that is, same t – select the MFunctor instance, which’ll then require MFunctor t;
If embed :: Identity a -> m a (irrespective of the form of m), select the id instance …
beware type inference might have to work quite hard there to confirm or reject Identity, so instance selection is likely to get stuck at this point;
If all the above fails, but at least we have embed :: n a -> (t m) a, select the MonadTrans instance, so requiring MonadTrans t.
Yes, that makes sense to me. To achieve such a behavior, and correct the current one, is it enough to add {-# OVERLAPPING #-} instances for the cases where the current instances intersect?
Possibly related question: other than checking by hand that it works in every case I can think of, is there any other way to check that the declared instances make sense? Does an automated tool, which could check whether the instances in scope could create issues, exist?
Your current embed = id instance has head Embeds m m. So do you mean:
instance {-# OVERLAPPING #-} Embeds (t m) (t m) where -- params same type
embeds :: (t m) a -> (t m) a
embeds = id
[Apparently yes, see later comment that uses Embeds (t n) (t n).]
The overlapping rules and controlling pragmas are documented here.
And will all params for all instances be of the form (t m) rather than bare m? Then that would be good to document in your instances. IOW
Embeds (t m) (t m) is strictly more specific than (OVERLAPPING)
Embeds (t n) (t m) – hoist instance – is strictly more specific than
Embeds (t1 n) (t m) – lift instance – needs constraint Embeds (t1 n) m =>.
But! The Identity instance doesn’t fit anywhere in that hierarchy. Since your instances are wanting MonadTrans or MFunctor constraints, I wonder if that should rather use IdentityT? Which is already an instance of both classes, so doesn’t need any special mention.
That tool is (or should be) GHC. So I’m a lot surprised your code as given earlier compiled. (Or did you have IncoherentInstances set? See the docos for why that and INCOHERENT are deprecated, as if the names don’t tell you.)
As a pro tip, I prefer to put OVERLAPPABLE on the more-general instances, as a warning to the reader that instance is not as it seems.
Addit: (More code arrived as I was typing.)
I strongly recommend you throw out the Embeds m m instance. (It still partially overlaps, although you’ve introduced an instance that shadows it. Other compilers would reject it; GHC accepts it but GHC’s behaviour facing this complexity is too liable to disintegrate – see for example Trac ticket #10675, and the DYSFUNCTIONAL drive-by comment above.)
instance {-# OVERLAPPING #-} Embeds (t m) (t m) where -- params same type
embeds :: (t m) a -> (t m) a
embeds = id
yes, absolutely. Sorry for the mistake.
I’ll try to write some more tests for more cases and see where I get stuck.
That tool is (or should be) GHC. So I’m a lot surprised your code as given earlier compiled.
I don’t have IncoherentInstances set anywhere. I might well be wrong, but GHC in my experience usually fails when it is not able to infer an instance for a typeclass usage, it does not fails when you just have written the instances (e.g. see Haskell Playground)
GHC only checks overlap when you use a type class. Having it check when defining/importing instances would solve a lot of problems (see 4.3 of the Non-Reformist Reform for Haskell Modularity), but sadly that was never implemented. One challenge is that the check might take quadratic time in some cases.
Edit: I’m a bit confused myself, because the document I link to does say GHC should have a check at instance definition sites:
Consequently, GHC attempts to enforce the property by checking only instance definition sites [18], […]
[18]: When typechecking a module, GHC checks that each new instance definition does not conflict with any instances defined upstream or with any other instances in the same module.
Edit 2: The GHC docs do say:
It is fine for there to be a potential of overlap […]; an error is only reported if a particular constraint matches more than one.
Edit 3: Ah, I think “does not conflict with” in the first quote means that it only checks that the instances are not literally duplicates. And it says that GHC does not even do that check for instances across different independent modules. Indeed you can write modules like this:
module Foo where
class Foo a where
foo :: a -> String
module A where
import Foo
instance Foo a where
foo _ = "A"
module B where
import Foo
instance Foo a where
foo _ = "B"
module C where
import A
import B
It will only throw an error if you actually use the constraint:
module Main where
import Foo
import A
import B
main = putStrLn (foo ())
error: [GHC-43085]
• Overlapping instances for Foo () arising from a use of ‘foo’
Matching instances:
instance Foo a -- Defined in ‘A’
instance Foo a -- Defined in ‘B’
• In the first argument of ‘putStrLn’, namely ‘(foo ())’
In the expression: putStrLn (foo ())
In an equation for ‘main’: main = putStrLn (foo ())
|
5 | main = putStrLn (foo ())
| ^^^
Thanks for saying that out loud, and I think you’re right to find the docos ambivalent. (At risk of wandering off topic …)
Answer 2: That tool is dear old Hugs. If I’m struggling with tangled instances, I trim the code down to just the class and instance heads, and feed it to Hugs. This does validate all instances immediately, and does reject if there’s “a potential of overlap” – that is, partial overlap. Also doesn’t get confused by orphan instances – it cross-validates all imports, so would reject that just-added multi-module example.
The vast majority of instances to import are from Prelude/core libraries. These classes are H2010-compliant, so don’t use overlaps – and so orphan instances aren’t problematic either. If we could tell the compiler that, it would only need check against overlap pairwise on instances, rather than quadrilaterally validating chains of (partial) overlap.
pragma [NO]OVERLAPS in the class decl should do it.
LANGUAGE [No]OverlappingClasses would set the default for classes declared in a module.