circuithub/rel8
1
1
Fork 0
mirror of https://github.com/circuithub/rel8.git synced 2024-09-11 16:05:41 +03:00
Code Issues Projects Releases Wiki Activity

Fix incorrect >>= implementation for Query (#73)

Browse Source
This commit is contained in:
Shane 2021-06-22 23:01:46 +01:00 committed by GitHub
parent f36d7d03dd
commit 70ce05d8d1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Rel8/Query.hs
View File

@ -174,7 +174,7 @@ instance Monad Query where
Opaleye.QueryArr qa = q dummies
((m, a), query', tag') = qa ((), query, tag)
Query q' = f a
(dummies', lquery, tag'') =
(dummies', query'', tag'') =
( dummy : dummies
, Opaleye.Rebind True bindings query'
, Opaleye.next tag'
@ -185,11 +185,16 @@ instance Monad Query where
random = Opaleye.FunExpr "random" []
name = Opaleye.extractAttr "dummy" tag'
Opaleye.QueryArr qa' = Opaleye.lateral $ \_ -> q' dummies'
((m'@(Any needsDummies), b), rquery, tag''') = qa' ((), Opaleye.Unit, tag'')
lquery'
| needsDummies = lquery
-- NOTE: query''' and needsDummies are corecursive; only laziness saves
-- us here.
--
-- This refactoring, if adopted, would allow us to do this without
-- relying on laziness:
-- https://github.com/tomjaguarpaw/haskell-opaleye/commit/8a23f5028ab7396290984d63a8316949909fdbb4
((m'@(Any needsDummies), b), query'''', tag''') = qa' ((), query''', tag'')
query'''
| needsDummies = query''
| otherwise = query'
query'''' = Opaleye.times lquery' rquery
m'' = m <> m'
in
((m'', b), query'''', tag''')