@@ -1,30 +1,25 @@
11{-# language BlockArguments #-}
2−{-# language DataKinds #-}
32{-# language DeriveAnyClass #-}
43{-# language DeriveGeneric #-}
54{-# language DerivingStrategies #-}
6−{-# language DisambiguateRecordFields #-}
75{-# language FlexibleContexts #-}
86{-# language FlexibleInstances #-}
9−{-# language GADTs #-}
10−{-# language NamedFieldPuns #-}
7+{-# language MonoLocalBinds #-}
118{-# language OverloadedStrings #-}
129{-# language RecordWildCards #-}
1310{-# language ScopedTypeVariables #-}
1411{-# language StandaloneDeriving #-}
1512{-# language TypeApplications #-}
1613
17−{-# options_ghc -fno-warn-redundant-constraints #-}
18−
1914module Main
2015 ( main
2116 )
2217where
2318
2419-- base
25−import Control.Applicative ( liftA2, liftA3 )
26−import Control.Monad (void)
27−import Control.Monad.IO.Class ( MonadIO, liftIO )
20+import Control.Applicative ( empty, liftA2, liftA3 )
21+import Control.Exception ( bracket, throwIO )
22+import Control.Monad ( (>=>), void )
2823import Data.Bifunctor ( bimap )
2924import Data.Foldable ( for_ )
3025import Data.Int ( Int32, Int64 )
@@ -38,25 +33,26 @@ import GHC.Generics ( Generic )
3833import qualified Data.ByteString.Lazy
3934
4035-- case-insensitive
41−import Data.CaseInsensitive (mk)
36+import Data.CaseInsensitive ( mk )
4237
4338-- containers
4439import qualified Data.Map.Strict as Map
4540
4641-- hasql
47−import Hasql.Connection ( Connection, acquire, release )
42+import Hasql.Connection ( Connection, acquire, release )
4843import Hasql.Session ( sql, run )
4944
45+-- hasql-transaction
46+import Hasql.Transaction ( Transaction, condemn, statement )
47+import qualified Hasql.Transaction.Sessions as Hasql
48+
5049-- hedgehog
5150import Hedgehog ( property, (===), forAll, cover, diff, evalM, PropertyT, TestT, test, Gen )
5251import qualified Hedgehog.Gen as Gen
5352import qualified Hedgehog.Range as Range
5453
55−-- lifted-base
56−import Control.Exception.Lifted ( bracket, throwIO, bracket_ )
57−
58−-- monad-control
59−import Control.Monad.Trans.Control ( MonadBaseControl )
54+-- mmorph
55+import Control.Monad.Morph ( hoist )
6056
6157-- rel8
6258import Rel8 ( Result )
@@ -72,12 +68,16 @@ import Test.Tasty
7268import Test.Tasty.Hedgehog ( testProperty )
7369
7470-- text
75−import Data.Text (Text, pack)
71+import Data.Text ( Text, pack, unpack )
7672import qualified Data.Text.Lazy
73+import Data.Text.Encoding ( decodeUtf8 )
7774
7875-- time
7976import Data.Time
8077
78+-- transformers
79+import Control.Monad.Trans.Class ( lift )
80+
8181-- tmp-postgres
8282import qualified Database.Postgres.Temp as TmpPostgres
8383
@@ -140,19 +140,21 @@ tests =
140140 stopTestDatabase = TmpPostgres.stop
141141
142142
143+connect :: TmpPostgres.DB -> IO Connection
144+connect = acquire . TmpPostgres.toConnectionString >=> either (maybe empty (fail . unpack . decodeUtf8)) pure
145+
146+
143147databasePropertyTest
144148 :: TestName
145− -> (((Connection -> TestT IO ()) -> PropertyT IO ()) -> PropertyT IO ())
149+ -> ((TestT Transaction () -> PropertyT IO ()) -> PropertyT IO ())
146150 -> IO TmpPostgres.DB -> TestTree
147151databasePropertyTest testName f getTestDatabase =
148− withResource connect release $ \c ->
152+ withResource (connect =<< getTestDatabase) release $ \c ->
149153 testProperty testName $ property do
150− connection <- liftIO c
151− f \g -> test $ rollingBack connection $ g connection
152−
153− where
154−
155− connect = either (error . show) return =<< acquire . TmpPostgres.toConnectionString =<< getTestDatabase
154+ connection <- lift c
155+ f $ test . hoist \m -> do
156+ e <- run (Hasql.transaction Hasql.Serializable Hasql.Write (m <* condemn)) connection
157+ either throwIO pure e
156158
157159
158160data TestTable f = TestTable
@@ -184,17 +186,17 @@ testSelectTestTable :: IO TmpPostgres.DB -> TestTree
184186testSelectTestTable = databasePropertyTest "Can SELECT TestTable" \transaction -> do
185187 rows <- forAll $ Gen.list (Range.linear 0 10) genTestTable
186188
187− transaction \connection -> do
188− liftIO $ Rel8.insert connection
189− Rel8.Insert
189+ transaction do
190+ selected <- lift do
191+ statement () $ Rel8.insert Rel8.Insert
190192 { into = testTableSchema
191193 , rows = Rel8.values $ map Rel8.lit rows
192194 , onConflict = Rel8.DoNothing
193195 , returning = pure ()
194196 }
195197
196− selected <- liftIO $ Rel8.select connection do
197− Rel8.each testTableSchema
198+ statement () $ Rel8.select do
199+ Rel8.each testTableSchema
198200
199201 sort selected === sort rows
200202
@@ -211,11 +213,12 @@ testWhere_ = databasePropertyTest "WHERE (Rel8.where_)" \transaction -> do
211213
212214 let expected = filter (\t -> testTableColumn2 t == magicBool) rows
213215
214− transaction \connection -> do
215− selected <- liftIO $ Rel8.select connection do
216− t <- Rel8.values $ Rel8.lit <$> rows
217− Rel8.where_ $ testTableColumn2 t Rel8.==. Rel8.lit magicBool
218− return t
216+ transaction do
217+ selected <- lift do
218+ statement () $ Rel8.select do
219+ t <- Rel8.values $ Rel8.lit <$> rows
220+ Rel8.where_ $ testTableColumn2 t Rel8.==. Rel8.lit magicBool
221+ return t
219222
220223 sort selected === sort expected
221224
@@ -228,11 +231,12 @@ testFilter :: IO TmpPostgres.DB -> TestTree
228231testFilter = databasePropertyTest "filter" \transaction -> do
229232 rows <- forAll $ Gen.list (Range.linear 1 10) genTestTable
230233
231− transaction \connection -> do
234+ transaction do
232235 let expected = filter testTableColumn2 rows
233236
234− selected <- liftIO $ Rel8.select connection
235− $ Rel8.filter testTableColumn2 =<< Rel8.values (Rel8.lit <$> rows)
237+ selected <- lift do
238+ statement () $ Rel8.select do
239+ Rel8.filter testTableColumn2 =<< Rel8.values (Rel8.lit <$> rows)
236240
237241 sort selected === sort expected
238242
@@ -247,9 +251,10 @@ testLimit = databasePropertyTest "LIMIT (Rel8.limit)" \transaction -> do
247251
248252 n <- forAll $ Gen.integral (Range.linear 0 10)
249253
250− transaction \connection -> do
251− selected <- liftIO $ Rel8.select connection do
252− Rel8.limit n $ Rel8.values (Rel8.lit <$> rows)
254+ transaction do
255+ selected <- lift do
256+ statement () $ Rel8.select do
257+ Rel8.limit n $ Rel8.values (Rel8.lit <$> rows)
253258
254259 diff (length selected) (<=) (fromIntegral n)
255260
@@ -267,9 +272,10 @@ testUnion = databasePropertyTest "UNION (Rel8.union)" \transaction -> evalM do
267272 left <- forAll $ Gen.list (Range.linear 0 10) genTestTable
268273 right <- forAll $ Gen.list (Range.linear 0 10) genTestTable
269274
270− transaction \connection -> do
271− selected <- liftIO $ Rel8.select connection do
272− Rel8.values (Rel8.lit <$> nub left) `Rel8.union` Rel8.values (Rel8.lit <$> nub right)
275+ transaction do
276+ selected <- lift do
277+ statement () $ Rel8.select do
278+ Rel8.values (Rel8.lit <$> nub left) `Rel8.union` Rel8.values (Rel8.lit <$> nub right)
273279
274280 sort selected === sort (nub (left ++ right))
275281
@@ -278,9 +284,11 @@ testDistinct :: IO TmpPostgres.DB -> TestTree
278284testDistinct = databasePropertyTest "DISTINCT (Rel8.distinct)" \transaction -> do
279285 rows <- forAll $ Gen.list (Range.linear 0 10) genTestTable
280286
281− transaction \connection -> do
282− selected <- liftIO $ Rel8.select connection $ Rel8.distinct do
283− Rel8.values (Rel8.lit <$> rows)
287+ transaction do
288+ selected <- lift do
289+ statement () $ Rel8.select do
290+ Rel8.distinct do
291+ Rel8.values (Rel8.lit <$> rows)
284292
285293 sort selected === nub (sort rows)
286294
@@ -293,8 +301,10 @@ testExists :: IO TmpPostgres.DB -> TestTree
293301testExists = databasePropertyTest "EXISTS (Rel8.exists)" \transaction -> do
294302 rows <- forAll $ Gen.list (Range.linear 0 10) genTestTable
295303
296− transaction \connection -> do
297− exists <- liftIO $ Rel8.select connection $ Rel8.exists $ Rel8.values $ Rel8.lit <$> rows
304+ transaction do
305+ exists <- lift do
306+ statement () $ Rel8.select do
307+ Rel8.exists $ Rel8.values $ Rel8.lit <$> rows
298308
299309 case rows of
300310 [] -> exists === [False]
@@ -305,9 +315,10 @@ testOptional :: IO TmpPostgres.DB -> TestTree
305315testOptional = databasePropertyTest "Rel8.optional" \transaction -> do
306316 rows <- forAll $ Gen.list (Range.linear 0 10) genTestTable
307317
308− transaction \connection -> do
309− selected <- liftIO $ Rel8.select connection do
310− Rel8.optional $ Rel8.values (Rel8.lit <$> rows)
318+ transaction do
319+ selected <- lift do
320+ statement () $ Rel8.select do
321+ Rel8.optional $ Rel8.values (Rel8.lit <$> rows)
311322
312323 case rows of
313324 [] -> selected === [Nothing]
@@ -318,9 +329,10 @@ testAnd :: IO TmpPostgres.DB -> TestTree
318329testAnd = databasePropertyTest "AND (&&.)" \transaction -> do
319330 (x, y) <- forAll $ liftA2 (,) Gen.bool Gen.bool
320331
321− transaction \connection -> do
322− [result] <- liftIO $ Rel8.select connection $ pure $
323− Rel8.lit x Rel8.&&. Rel8.lit y
332+ transaction do
333+ [result] <- lift do
334+ statement () $ Rel8.select do
335+ pure $ Rel8.lit x Rel8.&&. Rel8.lit y
324336
325337 result === (x && y)
326338
@@ -329,9 +341,10 @@ testOr :: IO TmpPostgres.DB -> TestTree
329341testOr = databasePropertyTest "OR (||.)" \transaction -> do
330342 (x, y) <- forAll $ liftA2 (,) Gen.bool Gen.bool
331343
332− transaction \connection -> do
333− [result] <- liftIO $ Rel8.select connection $ pure $
334− Rel8.lit x Rel8.||. Rel8.lit y
344+ transaction do
345+ [result] <- lift do
346+ statement () $ Rel8.select $ pure $
347+ Rel8.lit x Rel8.||. Rel8.lit y
335348
336349 result === (x || y)
337350
@@ -340,9 +353,10 @@ testLogicalFixities :: IO TmpPostgres.DB -> TestTree
340353testLogicalFixities = databasePropertyTest "Logical operator fixities" \transaction -> do
341354 (u, v, w, x) <- forAll $ (,,,) <$> Gen.bool <*> Gen.bool <*> Gen.bool <*> Gen.bool
342355
343− transaction \connection -> do
344− [result] <- liftIO $ Rel8.select connection $ pure $
345− Rel8.lit u Rel8.||. Rel8.lit v Rel8.&&. Rel8.lit w Rel8.==. Rel8.lit x
356+ transaction do
357+ [result] <- lift do
358+ statement () $ Rel8.select do
359+ pure $ Rel8.lit u Rel8.||. Rel8.lit v Rel8.&&. Rel8.lit w Rel8.==. Rel8.lit x
346360
347361 result === (u || v && w == x)
348362
@@ -351,9 +365,10 @@ testNot :: IO TmpPostgres.DB -> TestTree
351365testNot = databasePropertyTest "NOT (not_)" \transaction -> do
352366 x <- forAll Gen.bool
353367
354− transaction \connection -> do
355− [result] <- liftIO $ Rel8.select connection $ pure $
356− Rel8.not_ $ Rel8.lit x
368+ transaction do
369+ [result] <- lift do
370+ statement () $ Rel8.select do
371+ pure $ Rel8.not_ $ Rel8.lit x
357372
358373 result === not x
359374
@@ -362,9 +377,10 @@ testBool :: IO TmpPostgres.DB -> TestTree
362377testBool = databasePropertyTest "ifThenElse_" \transaction -> do
363378 (x, y, z) <- forAll $ liftA3 (,,) Gen.bool Gen.bool Gen.bool
364379
365− transaction \connection -> do
366− [result] <- liftIO $ Rel8.select connection $ pure $
367− Rel8.bool (Rel8.lit z) (Rel8.lit y) (Rel8.lit x)
380+ transaction do
381+ [result] <- lift do
382+ statement () $ Rel8.select do
383+ pure $ Rel8.bool (Rel8.lit z) (Rel8.lit y) (Rel8.lit x)
368384
369385 result === if x then y else z
370386
@@ -376,9 +392,10 @@ testAp = databasePropertyTest "Cartesian product (<*>)" \transaction -> do
376392 (Gen.list (Range.linear 1 10) genTestTable)
377393 (Gen.list (Range.linear 1 10) genTestTable)
378394
379− transaction \connection -> do
380− result <- liftIO $ Rel8.select connection $ do
381− liftA2 (,) (Rel8.values (Rel8.lit <$> rows1)) (Rel8.values (Rel8.lit <$> rows2))
395+ transaction do
396+ result <- lift do
397+ statement () $ Rel8.select do
398+ liftA2 (,) (Rel8.values (Rel8.lit <$> rows1)) (Rel8.values (Rel8.lit <$> rows2))
382399
383400 sort result === sort (liftA2 (,) rows1 rows2)
384401
@@ -407,21 +424,22 @@ testDBType getTestDatabase = testGroup "DBType instances"
407424 where
408425 dbTypeTest :: (Eq a, Show a, Rel8.DBType a) => TestName -> Gen a -> TestTree
409426 dbTypeTest name generator = testGroup name
410− [ databasePropertyTest name (t (==) generator) getTestDatabase
411− , databasePropertyTest ("Maybe " <> name) (t (==) (Gen.maybe generator)) getTestDatabase
427+ [ databasePropertyTest name (t generator) getTestDatabase
428+ , databasePropertyTest ("Maybe " <> name) (t (Gen.maybe generator)) getTestDatabase
412429 ]
413430
414− t :: forall a b. (Show a, Rel8.Sql Rel8.DBType a)
415− => (a -> a -> Bool)
416− -> Gen a
417− -> ((Connection -> TestT IO ()) -> PropertyT IO b)
431+ t :: forall a b. (Eq a, Show a, Rel8.Sql Rel8.DBType a)
432+ => Gen a
433+ -> (TestT Transaction () -> PropertyT IO b)
418434 -> PropertyT IO b
419− t eq generator transaction = do
435+ t generator transaction = do
420436 x <- forAll generator
421437
422− transaction \connection -> do
423− [res] <- liftIO $ Rel8.select connection $ pure (Rel8.litExpr x)
424− diff res eq x
438+ transaction do
439+ [res] <- lift do
440+ statement () $ Rel8.select do
441+ pure (Rel8.litExpr x)
442+ diff res (==) x
425443
426444 genDay :: Gen Day
427445 genDay = do
@@ -463,13 +481,15 @@ testDBEq getTestDatabase = testGroup "DBEq instances"
463481
464482 t :: forall a. (Eq a, Show a, Rel8.Sql Rel8.DBEq a)
465483 => Gen a
466− -> ((Connection -> TestT IO ()) -> PropertyT IO ())
484+ -> (TestT Transaction () -> PropertyT IO ())
467485 -> PropertyT IO ()
468486 t generator transaction = do
469487 (x, y) <- forAll (liftA2 (,) generator generator)
470488
471− transaction \connection -> do
472− [res] <- liftIO $ Rel8.select connection $ pure $ Rel8.litExpr x Rel8.==. Rel8.litExpr y
489+ transaction do
490+ [res] <- lift do
491+ statement () $ Rel8.select do
492+ pure $ Rel8.litExpr x Rel8.==. Rel8.litExpr y
473493 res === (x == y)
474494
475495
@@ -477,9 +497,10 @@ testTableEquality :: IO TmpPostgres.DB -> TestTree
477497testTableEquality = databasePropertyTest "TestTable equality" \transaction -> do
478498 (x, y) <- forAll $ liftA2 (,) genTestTable genTestTable
479499
480− transaction \connection -> do
481− [eq] <- liftIO $ Rel8.select connection do
482− pure $ Rel8.lit x Rel8.==: Rel8.lit y
500+ transaction do
501+ [eq] <- lift do
502+ statement () $ Rel8.select do
503+ pure $ Rel8.lit x Rel8.==: Rel8.lit y
483504
484505 eq === (x == y)
485506
@@ -488,8 +509,10 @@ testFromString :: IO TmpPostgres.DB -> TestTree
488509testFromString = databasePropertyTest "FromString" \transaction -> do
489510 str <- forAll $ Gen.list (Range.linear 0 10) Gen.unicode
490511
491− transaction \connection -> do
492− [result] <- liftIO $ Rel8.select connection $ pure $ fromString str
512+ transaction do
513+ [result] <- lift do
514+ statement () $ Rel8.select do
515+ pure $ fromString str
493516 result === pack str
494517
495518
@@ -497,10 +520,11 @@ testCatMaybeTable :: IO TmpPostgres.DB -> TestTree
497520testCatMaybeTable = databasePropertyTest "catMaybeTable" \transaction -> do
498521 rows <- forAll $ Gen.list (Range.linear 0 10) genTestTable
499522
500− transaction \connection -> do
501− selected <- liftIO $ Rel8.select connection do
502− testTable <- Rel8.values $ Rel8.lit <$> rows
503− Rel8.catMaybeTable $ Rel8.bool Rel8.nothingTable (pure testTable) (testTableColumn2 testTable)
523+ transaction do
524+ selected <- lift do
525+ statement () $ Rel8.select do
526+ testTable <- Rel8.values $ Rel8.lit <$> rows
527+ Rel8.catMaybeTable $ Rel8.bool Rel8.nothingTable (pure testTable) (testTableColumn2 testTable)
504528
505529 sort selected === sort (filter testTableColumn2 rows)
506530
@@ -509,9 +533,10 @@ testCatMaybe :: IO TmpPostgres.DB -> TestTree
509533testCatMaybe = databasePropertyTest "catMaybe" \transaction -> evalM do
510534 rows <- forAll $ Gen.list (Range.linear 0 10) $ Gen.maybe Gen.bool
511535
512− transaction \connection -> do
513− selected <- evalM $ liftIO $ Rel8.select connection do
514− Rel8.catNull =<< Rel8.values (map Rel8.lit rows)
536+ transaction do
537+ selected <- lift do
538+ statement () $ Rel8.select do
539+ Rel8.catNull =<< Rel8.values (map Rel8.lit rows)
515540
516541 sort selected === sort (catMaybes rows)
517542
@@ -520,9 +545,10 @@ testMaybeTable :: IO TmpPostgres.DB -> TestTree
520545testMaybeTable = databasePropertyTest "maybeTable" \transaction -> evalM do
521546 (rows, def) <- forAll $ liftA2 (,) (Gen.list (Range.linear 0 10) genTestTable) genTestTable
522547
523− transaction \connection -> do
524− selected <- liftIO $ Rel8.select connection $
525− Rel8.maybeTable (Rel8.lit def) id <$> Rel8.optional (Rel8.values (Rel8.lit <$> rows))
548+ transaction do
549+ selected <- lift do
550+ statement () $ Rel8.select do
551+ Rel8.maybeTable (Rel8.lit def) id <$> Rel8.optional (Rel8.values (Rel8.lit <$> rows))
526552
527553 case rows of
528554 [] -> selected === [def]
@@ -549,9 +575,10 @@ testNestedTables = databasePropertyTest "Nested TestTables" \transaction -> eval
549575 Gen.list (Range.linear 0 10) $
550576 liftA2 TwoTestTables genTestTable genTestTable
551577
552− transaction \connection -> do
553− selected <- liftIO $ Rel8.select connection do
554− Rel8.values (Rel8.lit <$> rows)
578+ transaction do
579+ selected <- lift do
580+ statement () $ Rel8.select do
581+ Rel8.values (Rel8.lit <$> rows)
555582
556583 sort selected === sort rows
557584
@@ -561,11 +588,12 @@ testMaybeTableApplicative = databasePropertyTest "MaybeTable (<*>)" \transaction
561588 rows1 <- genRows
562589 rows2 <- genRows
563590
564− transaction \connection -> do
565− selected <- liftIO $ Rel8.select connection do
566− as <- Rel8.optional (Rel8.values (Rel8.lit <$> rows1))
567− bs <- Rel8.optional (Rel8.values (Rel8.lit <$> rows2))
568− pure $ liftA2 (,) as bs
591+ transaction do
592+ selected <- lift do
593+ statement () $ Rel8.select do
594+ as <- Rel8.optional (Rel8.values (Rel8.lit <$> rows1))
595+ bs <- Rel8.optional (Rel8.values (Rel8.lit <$> rows2))
596+ pure $ liftA2 (,) as bs
569597
570598 case (rows1, rows2) of
571599 ([], []) -> selected === [Nothing]
@@ -577,14 +605,6 @@ testMaybeTableApplicative = databasePropertyTest "MaybeTable (<*>)" \transaction
577605 genRows = forAll do
578606 Gen.list (Range.linear 0 10) $ liftA2 TestTable (Gen.text (Range.linear 0 10) Gen.unicode) (pure True)
579607
580−rollingBack
581− :: (MonadBaseControl IO m, MonadIO m)
582− => Connection -> m a -> m a
583−rollingBack connection =
584− bracket_
585− (liftIO (run (sql "BEGIN") connection))
586− (liftIO (run (sql "ROLLBACK") connection))
587−
588608
589609genTestTable :: Gen (TestTable Result)
590610genTestTable = do
@@ -597,17 +617,16 @@ testUpdate :: IO TmpPostgres.DB -> TestTree
597617testUpdate = databasePropertyTest "Can UPDATE TestTable" \transaction -> do
598618 rows <- forAll $ Gen.map (Range.linear 0 5) $ liftA2 (,) genTestTable genTestTable
599619
600− transaction \connection -> do
601− liftIO $ Rel8.insert connection
602− Rel8.Insert
620+ transaction do
621+ selected <- lift do
622+ statement () $ Rel8.insert Rel8.Insert
603623 { into = testTableSchema
604624 , rows = Rel8.values $ map Rel8.lit $ Map.keys rows
605625 , onConflict = Rel8.DoNothing
606626 , returning = pure ()
607627 }
608628
609− liftIO $ Rel8.update connection
610− Rel8.Update
629+ statement () $ Rel8.update Rel8.Update
611630 { target = testTableSchema
612631 , from = pure ()
613632 , set = \_ r ->
@@ -628,8 +647,8 @@ testUpdate = databasePropertyTest "Can UPDATE TestTable" \transaction -> do
628647 , returning = pure ()
629648 }
630649
631− selected <- liftIO $ Rel8.select connection do
632− Rel8.each testTableSchema
650+ statement () $ Rel8.select do
651+ Rel8.each testTableSchema
633652
634653 sort selected === sort (Map.elems rows)
635654
@@ -642,26 +661,26 @@ testDelete :: IO TmpPostgres.DB -> TestTree
642661testDelete = databasePropertyTest "Can DELETE TestTable" \transaction -> do
643662 rows <- forAll $ Gen.list (Range.linear 0 5) genTestTable
644663
645− transaction \connection -> do
646− liftIO $ Rel8.insert connection
647− Rel8.Insert
664+ transaction do
665+ (deleted, selected) <- lift do
666+ statement () $ Rel8.insert Rel8.Insert
648667 { into = testTableSchema
649668 , rows = Rel8.values $ map Rel8.lit rows
650669 , onConflict = Rel8.DoNothing
651670 , returning = pure ()
652671 }
653672
654− deleted <-
655− liftIO $ Rel8.delete connection
656− Rel8.Delete
673+ deleted <- statement () $ Rel8.delete Rel8.Delete
657674 { from = testTableSchema
658675 , using = pure ()
659676 , deleteWhere = const testTableColumn2
660677 , returning = Rel8.Projection id
661678 }
662679
663− selected <- liftIO $ Rel8.select connection do
664− Rel8.each testTableSchema
680+ selected <- statement () $ Rel8.select do
681+ Rel8.each testTableSchema
682+
683+ pure (deleted, selected)
665684
666685 sort (deleted <> selected) === sort rows
667686
@@ -679,9 +698,10 @@ testSelectNestedPairs :: IO TmpPostgres.DB -> TestTree
679698testSelectNestedPairs = databasePropertyTest "Can SELECT nested pairs" \transaction -> do
680699 rows <- forAll $ Gen.list (Range.linear 0 10) $ HKNestedPair <$> liftA2 (,) genTestTable genTestTable
681700
682− transaction \connection -> do
683− selected <- liftIO $ Rel8.select connection do
684− Rel8.values $ map Rel8.lit rows
701+ transaction do
702+ selected <- lift do
703+ statement () $ Rel8.select do
704+ Rel8.values $ map Rel8.lit rows
685705
686706 sort selected === sort rows
687707
@@ -690,18 +710,20 @@ testSelectArray :: IO TmpPostgres.DB -> TestTree
690710testSelectArray = databasePropertyTest "Can SELECT Arrays (with aggregation)" \transaction -> do
691711 rows <- forAll $ Gen.list (Range.linear 1 10) Gen.bool
692712
693− transaction \connection -> do
694− selected <- liftIO $ Rel8.select connection do
695− Rel8.many $ Rel8.values (map Rel8.lit rows)
713+ transaction do
714+ selected <- lift do
715+ statement () $ Rel8.select do
716+ Rel8.many $ Rel8.values (map Rel8.lit rows)
696717
697718 selected === [foldMap pure rows]
698719
699− selected' <- liftIO $ Rel8.select connection $ do
700− a <- Rel8.catListTable =<< do
701− Rel8.many $ Rel8.values (map Rel8.lit rows)
702− b <- Rel8.catListTable =<< do
703− Rel8.many $ Rel8.values (map Rel8.lit rows)
704− pure (a, b)
720+ selected' <- lift do
721+ statement () $ Rel8.select do
722+ a <- Rel8.catListTable =<< do
723+ Rel8.many $ Rel8.values (map Rel8.lit rows)
724+ b <- Rel8.catListTable =<< do
725+ Rel8.many $ Rel8.values (map Rel8.lit rows)
726+ pure (a, b)
705727
706728 selected' === liftA2 (,) rows rows
707729
@@ -723,10 +745,11 @@ testNestedMaybeTable :: IO TmpPostgres.DB -> TestTree
723745testNestedMaybeTable = databasePropertyTest "Can nest MaybeTable within other tables" \transaction -> do
724746 let example = NestedMaybeTable { nmt1 = True, nmt2 = Just (TestTable "Hi" True) }
725747
726− transaction \connection -> do
727− selected <- liftIO $ Rel8.select connection do
728− x <- Rel8.values [Rel8.lit example]
729− pure $ Rel8.maybeTable (Rel8.lit False) (\_ -> Rel8.lit True) (nmt2 x)
748+ transaction do
749+ selected <- lift do
750+ statement () $ Rel8.select do
751+ x <- Rel8.values [Rel8.lit example]
752+ pure $ Rel8.maybeTable (Rel8.lit False) (\_ -> Rel8.lit True) (nmt2 x)
730753
731754 selected === [True]
732755
@@ -734,11 +757,12 @@ testNestedMaybeTable = databasePropertyTest "Can nest MaybeTable within other ta
734757testEvaluate :: IO TmpPostgres.DB -> TestTree
735758testEvaluate = databasePropertyTest "evaluate has the evaluation order we expect" \transaction -> do
736759
737− transaction \connection -> do
738− selected <- liftIO $ Rel8.select connection do
739− x <- Rel8.values (Rel8.lit <$> ['a', 'b', 'c'])
740− y <- Rel8.evaluate (Rel8.nextval "test_seq")
741− pure (x, (y, y))
760+ transaction do
761+ selected <- lift do
762+ statement () $ Rel8.select do
763+ x <- Rel8.values (Rel8.lit <$> ['a', 'b', 'c'])
764+ y <- Rel8.evaluate (Rel8.nextval "test_seq")
765+ pure (x, (y, y))
742766
743767 normalize selected ===
744768 [ ('a', (0, 0))
@@ -746,11 +770,12 @@ testEvaluate = databasePropertyTest "evaluate has the evaluation order we expect
746770 , ('c', (2, 2))
747771 ]
748772
749− selected' <- liftIO $ Rel8.select connection do
750− x <- Rel8.values (Rel8.lit <$> ['a', 'b', 'c'])
751− y <- Rel8.values (Rel8.lit <$> ['d', 'e', 'f'])
752− z <- Rel8.evaluate (Rel8.nextval "test_seq")
753− pure ((x, y), (z, z))
773+ selected' <- lift do
774+ statement () $ Rel8.select do
775+ x <- Rel8.values (Rel8.lit <$> ['a', 'b', 'c'])
776+ y <- Rel8.values (Rel8.lit <$> ['d', 'e', 'f'])
777+ z <- Rel8.evaluate (Rel8.nextval "test_seq")
778+ pure ((x, y), (z, z))
754779
755780 normalize selected' ===
756781 [ (('a', 'd'), (0, 0))
@@ -768,13 +793,3 @@ testEvaluate = databasePropertyTest "evaluate has the evaluation order we expect
768793 normalize :: [(x, (Int64, Int64))] -> [(x, (Int64, Int64))]
769794 normalize [] = []
770795 normalize xs@((_, (i, _)) : _) = map (fmap (\(a, b) -> (a - i, b - i))) xs
771−
772−{-
773− selected <- liftIO $ Rel8.select connection do
774− x <- Rel8.values (Rel8.lit <$> ['a', 'b', 'c'])
775− x <- Rel8.values (Rel8.lit <$> ['d', 'e', 'f'])
776− y <- Rel8.evaluate (Rel8.nextval "test_seq")
777− pure (x, y, y)
778−
779− selected === [('a', 1, 1), ('b', 2, 2), ('c', 3, 3)]
780−-}