data MentionT f = Mention {
_idxm :: C f Int32
, _eidm :: PrimaryKey EvT f
, _pidm :: C f Text -- PrimaryKey PlebT f
} deriving (Generic, Beamable)
-- readme specified this "Identity trick
type Mention = MentionT
type MentionId = PrimaryKey MentionT Identity
instance Table MentionT where
data PrimaryKey MentionT f = MentionId (C f Int32) deriving (Generic, Beamable)
primaryKey = MentionId . _idxm
mention i id = Mention default_ (val_ . EvId $ i) (val_ id)
insertExpressions :: forall be table s.
(BeamSqlBackend be, Beamable table)
=> (forall s'. [table (QExpr be s')])
-> SqlInsertValues be (table (QExpr be s))
-- like this it works
runInsert $ insert (_mentions spec') $ insertExpressions $ [
Mention default_ (val_ . EvId . wq $ i) (val_ . wq $ id) ]
I think if I specify the s in the type it will work but how do I get the type of s? ( :: _ ) ← asking the compiler doesn’t work.
That said, I don’t think ImpredicativeTypes will help your case, I think you need to eta-expand somewhere. Apparently it does… I’m still not quite sure why.
Also, could you post the full error? I’m not sure where the error is, now that you’ve removed the location information.
Beam seems really useful (auto create tables, auto migrate when adding fields, type safe db actions).
But even with ImpredicativeTypes I hit a similar error. Usually refactoring is fearless, but not here. Things that appear equivalent to me are perceived differently by GHC.
Knowing absolutely nothing about beam, what if you add a type signature to reply? It might need help seeing that there’s a new type variable in the return type
Yes I did that for completeness, but this current version works regardless. However I wanted to refactor because of the name shadowing and hit the error again. It is odd that it is so brittle and I know it’s because of a gap (a chasm?) in my understanding of how beam is using advanced type features.
Ah, you didn’t aftually put the failing version that uses . composition in your original post. The reason that $ does work is that GHC had special rules for impredicativity built-in for a long time and now ImpredicativeTypes is always enabled for $ (even if you do not turn on the extension) for backwards compatibility.
I am still interested in what that failure is after refactoring that you mentioned. Using forall in strange places in types can indeed be brittle. I’d recommend the authors of beam wrap them up in newtypes as much as possible, but of course you can’t do much about it now.
Interesting I didn’t hit it this time. HLS was telling me lies (indicating errors that didn’t show up on compile) and after compile / re-opening editor it’s gone.
/media/o/fc93701e-2604-426d-a833-5e2f42ac1c54/Projects/futr2/src/Nostr/Beam.hs:46:68: error:
• Couldn't match type ‘m0’ with ‘s'’
Expected: [MentionT (QExpr Sqlite s')]
Actual: [MentionT (QExpr Sqlite m0)]
• because type variable ‘s'’ would escape its scope
This (rigid, skolem) type variable is bound by
a type expected by the context:
forall s'. [MentionT (QExpr Sqlite s')]
at src/Nostr/Beam.hs:46:68-69
• In the second argument of ‘($)’, namely ‘mx’
In a stmt of a 'do' block:
runInsert . insert (_mentions spec') . insertExpressions $ mx
In the second argument of ‘($)’, namely
‘do runInsert
$ insertOnConflict
(_plebs spec')
(insertExpressions [Pleb (val_ $ wq pubkey) default_]) anyConflict
onConflictDoNothing
runInsert $ insert (_events spec') (insertValues [toEv e])
let (mx, rx) = gather . catMaybes $ flip map tags ...
runInsert . insert (_mentions spec') . insertExpressions $ mx
....’
• Relevant bindings include
mx :: [MentionT (QExpr Sqlite m0)]
(bound at src/Nostr/Beam.hs:42:14)
|
46 | runInsert . insert (_mentions spec') . insertExpressions $ mx
| ^^
/media/o/fc93701e-2604-426d-a833-5e2f42ac1c54/Projects/futr2/src/Nostr/Beam.hs:47:67: error:
• Couldn't match type ‘m1’ with ‘s'’
Expected: [ReplyT (QExpr Sqlite s')]
Actual: [ReplyT (QExpr Sqlite m1)]
• because type variable ‘s'’ would escape its scope
This (rigid, skolem) type variable is bound by
a type expected by the context:
forall s'. [ReplyT (QExpr Sqlite s')]
at src/Nostr/Beam.hs:47:67-68
• In the second argument of ‘($)’, namely ‘rx’
In a stmt of a 'do' block:
runInsert . insert (_replies spec') . insertExpressions $ rx
In the second argument of ‘($)’, namely
‘do runInsert
$ insertOnConflict
(_plebs spec')
(insertExpressions [Pleb (val_ $ wq pubkey) default_]) anyConflict
onConflictDoNothing
runInsert $ insert (_events spec') (insertValues [toEv e])
let (mx, rx) = gather . catMaybes $ flip map tags ...
runInsert . insert (_mentions spec') . insertExpressions $ mx
....’
• Relevant bindings include
rx :: [ReplyT (QExpr Sqlite m1)] (bound at src/Nostr/Beam.hs:42:18)
|
47 | runInsert . insert (_replies spec') . insertExpressions $ rx
| ^^