Hello! I’m trying out eff but I think that my issue is not specific to that library.
I am trying to write a memorable password generator as an exercise in working with State and Reader. My state is modeled as a tuple:
type PwGen g = (g, Text)
where g is supposed to be some instance of RandomGen. Here’s an example function that doesn’t compile; it is just a helper function that replaces the current state’s generator with a new one (plus another helper function gets, which I wrote just to prove that I could at least make something work):
gets :: (State s m) => (s -> a) -> m a
gets f = f <$> get
updateGen :: (State (PwGen g) m) => g -> m ()
updateGen g = do
pw <- gets snd
put (g, pw)
I didn’t include the RandomGen g constraint in the context of updateGen because I don’t actually use any of those methods. In any event, here’s what GHC says about that:
[1 of 2] Compiling MemorablePassword.Generator
/workspaces/memorable-password-generator/src/MemorablePassword/Generator.hs:24:9: error:
• Could not deduce (State (a0, b0) m) arising from a use of ‘gets’
from the context: State (PwGen g) m
bound by the type signature for:
updateGen :: forall g (m :: * -> *). State (PwGen g) m => g -> m ()
at src/MemorablePassword/Generator.hs:22:1-45
The type variables ‘a0’, ‘b0’ are ambiguous
Relevant bindings include
updateGen :: g -> m ()
(bound at src/MemorablePassword/Generator.hs:23:1)
These potential instances exist:
instance Monad m => State s (StateT s m)
-- Defined in ‘Control.Effect.State’
...plus one instance involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In a stmt of a 'do' block: pw <- gets snd
In the expression:
do pw <- gets snd
put (g, pw)
In an equation for ‘updateGen’:
updateGen g
= do pw <- gets snd
put (g, pw)
|
24 | pw <- gets snd
| ^^^^^^^^
/workspaces/memorable-password-generator/src/MemorablePassword/Generator.hs:25:3: error:
• Could not deduce (State (g, b0) m) arising from a use of ‘put’
from the context: State (PwGen g) m
bound by the type signature for:
updateGen :: forall g (m :: * -> *). State (PwGen g) m => g -> m ()
at src/MemorablePassword/Generator.hs:22:1-45
The type variable ‘b0’ is ambiguous
Relevant bindings include
pw :: b0 (bound at src/MemorablePassword/Generator.hs:24:3)
g :: g (bound at src/MemorablePassword/Generator.hs:23:11)
updateGen :: g -> m ()
(bound at src/MemorablePassword/Generator.hs:23:1)
These potential instances exist:
instance Monad m => State s (StateT s m)
-- Defined in ‘Control.Effect.State’
...plus one instance involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In a stmt of a 'do' block: put (g, pw)
In the expression:
do pw <- gets snd
put (g, pw)
In an equation for ‘updateGen’:
updateGen g
= do pw <- gets snd
put (g, pw)
|
25 | put (g, pw)
| ^^^^^^^^^^^
At first I thought I might need to make a functional dependency m -> g, since presumably the particular monad I use has the generator type built in, but it seems that functional dependencies don’t actually work on top-level functions, just class/instance declarations.
I can tell from this message what is going on—I’m missing something that tells GHC that get has type PwGen g, since all it seems to be able to infer is that it’s a tuple from my use of snd. I haven’t been able to figure out exactly how to actually give it that information though.
My guess is that it has something to do with type applications, since I spotted that being used in the documentation for eff. I’m clearly not doing that right though:
updateGen :: (State (PwGen g) m) => g -> m ()
updateGen g = do
pw <- gets @(PwGen g) snd
put (g, pw)
yields
[1 of 2] Compiling MemorablePassword.Generator
/workspaces/memorable-password-generator/src/MemorablePassword/Generator.hs:24:22: error:
Not in scope: type variable ‘g’
|
24 | pw <- gets @(PwGen g) snd
|
I tried adding RandomGen g as well as forall g. to the context (the latter also needed me to enable ExplicitForAll) but I still got the same error that the type variable g was not in scope.
