b95592e · rel8 · git.iko.soy

git.iko.soy/rel8

Flip the argument order for statements

Connection first is much easier to work with, especially when running queries in the REPL.

commitb95592efe106279a952b278aadf7feb099cb18f8 authorOllie Charles <ollie@ocharles.org.uk> dateWed 24 Mar 2021, 09:31 (6 years ago) parent9b5abf2

5 files changed+55−63

compare with master

unifiedsplit

src/Rel8/Statement/Delete.hs+4−5 src/Rel8/Statement/Insert.hs+6−7 src/Rel8/Statement/Select.hs+8−9 src/Rel8/Statement/Update.hs+4−5 tests/Main.hs+33−37

src/Rel8/Statement/Delete.hs+4−5

@@ -13,7 +13,6 @@ where

1313

1414-- base

1515import Control.Exception ( throwIO )

16−import Control.Monad ( (>=>) )

1716import Data.Kind ( Type )

1817import Prelude

1918

@@ -75,10 +74,10 @@ data Delete a where

7574-- >>> mapM_ print =<< select c (each projectSchema)

7675-- Project {projectAuthorId = 2, projectName = "aeson"}

7776-- Project {projectAuthorId = 2, projectName = "text"}

78−delete :: Delete a -> Connection -> IO a

79−delete Delete {from, deleteWhere, returning} =

77+delete :: Connection -> Delete a -> IO a

78+delete c Delete {from, deleteWhere, returning} =

8079 case returning of

81− NumberOfRowsAffected -> Hasql.run session >=> either throwIO pure

80+ NumberOfRowsAffected -> Hasql.run session c >>= either throwIO pure

8281 where

8382 session = Hasql.statement () statement

8483 statement = Hasql.Statement bytes params decode prepare

@@ -91,7 +90,7 @@ delete Delete {from, deleteWhere, returning} =

9190 from' = table $ toColumns <$> from

9291 where' = toColumn . toPrimExpr . deleteWhere . fromColumns

9392

94− Projection project -> Hasql.run session >=> either throwIO pure

93+ Projection project -> Hasql.run session c >>= either throwIO pure

9594 where

9695 session = Hasql.statement () statement

9796 statement = Hasql.Statement bytes params decode prepare

src/Rel8/Statement/Insert.hs+6−7

@@ -15,7 +15,6 @@ where

1515

1616-- base

1717import Control.Exception ( throwIO )

18−import Control.Monad ( (>=>) )

1918import Data.Kind ( Type )

2019import Data.List.NonEmpty ( NonEmpty( (:|) ) )

2120import Prelude

@@ -77,13 +76,13 @@ data OnConflict

7776-- }

7877-- :}

7978-- 1

80−insert :: Insert a -> Connection -> IO a

81−insert Insert {into, rows, onConflict, returning} =

79+insert :: Connection -> Insert a -> IO a

80+insert c Insert {into, rows, onConflict, returning} =

8281 case (rows, returning) of

83− ([], NumberOfRowsAffected) -> const $ pure 0

84− ([], Projection _) -> const $ pure []

82+ ([], NumberOfRowsAffected) -> pure 0

83+ ([], Projection _) -> pure []

8584

86− (x:xs, NumberOfRowsAffected) -> Hasql.run session >=> either throwIO pure

85+ (x:xs, NumberOfRowsAffected) -> Hasql.run session c >>= either throwIO pure

8786 where

8887 session = Hasql.statement () statement

8988 statement = Hasql.Statement bytes params decode prepare

@@ -96,7 +95,7 @@ insert Insert {into, rows, onConflict, returning} =

9695 into' = table $ toColumns <$> into

9796 rows' = toColumns <$> x :| xs

9897

99− (x:xs, Projection project) -> Hasql.run session >=> either throwIO pure

98+ (x:xs, Projection project) -> Hasql.run session c >>= either throwIO pure

10099 where

101100 session = Hasql.statement () statement

102101 statement = Hasql.Statement bytes params decode prepare

src/Rel8/Statement/Select.hs+8−9

@@ -9,7 +9,6 @@ where

1010-- base

1111import Control.Exception ( throwIO )

12−import Control.Monad ( (>=>) )

1312import Prelude

1413

1514-- hasql

@@ -32,10 +31,10 @@ import Data.Text.Encoding ( encodeUtf8 )

3231

3332-- | Run a @SELECT@ query, returning all rows.

3433select :: forall exprs a. Serializable exprs a

35− => Query exprs -> Connection -> IO [a]

36−select query = case sqlForQuery query of

37− Nothing -> const $ pure []

38− Just sql -> Hasql.run session >=> either throwIO pure

34+ => Connection -> Query exprs -> IO [a]

35+select c query = case sqlForQuery query of

36+ Nothing -> pure []

37+ Just sql -> Hasql.run session c >>= either throwIO pure

3938 where

4039 session = Hasql.statement () statement

4140 statement = Hasql.Statement bytes params decode prepare

@@ -49,10 +48,10 @@ selectWithNames :: forall exprs a names.

4948 ( Selects names exprs

5049 , Serializable exprs a

5150 )

52− => names -> Query exprs -> Connection -> IO [a]

53−selectWithNames names query = case sqlForQueryWithNames names query of

54− Nothing -> const $ pure []

55− Just sql -> Hasql.run session >=> either throwIO pure

51+ => Connection -> names -> Query exprs -> IO [a]

52+selectWithNames c names query = case sqlForQueryWithNames names query of

53+ Nothing -> pure []

54+ Just sql -> Hasql.run session c >>= either throwIO pure

5655 where

5756 session = Hasql.statement () statement

5857 statement = Hasql.Statement bytes params decode prepare

src/Rel8/Statement/Update.hs+4−5

@@ -12,7 +12,6 @@ where

1212

1313-- base

1414import Control.Exception ( throwIO )

15−import Control.Monad ( (>=>) )

1615import Data.Kind ( Type )

1716import Prelude

1817

@@ -82,10 +81,10 @@ data Update a where

8281-- Project {projectAuthorId = 2, projectName = "aeson"}

8382-- Project {projectAuthorId = 2, projectName = "text"}

8483-- Project {projectAuthorId = 1, projectName = "Rel8!"}

85−update :: Update a -> Connection -> IO a

86−update Update {target, set, updateWhere, returning} =

84+update :: Connection -> Update a -> IO a

85+update c Update {target, set, updateWhere, returning} =

8786 case returning of

88− NumberOfRowsAffected -> Hasql.run session >=> either throwIO pure

87+ NumberOfRowsAffected -> Hasql.run session c >>= either throwIO pure

8988 where

9089 session = Hasql.statement () statement

9190 statement = Hasql.Statement bytes params decode prepare

@@ -99,7 +98,7 @@ update Update {target, set, updateWhere, returning} =

9998 set' = toColumns . set . fromColumns

10099 where' = toColumn . toPrimExpr . updateWhere . fromColumns

101100

102− Projection project -> Hasql.run session >=> either throwIO pure

101+ Projection project -> Hasql.run session c >>= either throwIO pure

103102 where

104103 session = Hasql.statement () statement

105104 statement = Hasql.Statement bytes params decode prepare

tests/Main.hs+33−37

@@ -214,7 +214,7 @@ testSelectTestTable = databasePropertyTest "Can SELECT TestTable" \transaction -

214214

215215 transaction \connection -> do

216216 void do

217− testing Rel8.insert connection

217+ liftIO $ Rel8.insert connection

218218 Rel8.Insert

219219 { into = testTableSchema

220220 , rows = map (Rel8.toInsert . Rel8.lit) rows

@@ -222,7 +222,7 @@ testSelectTestTable = databasePropertyTest "Can SELECT TestTable" \transaction -

222222 , returning = Rel8.NumberOfRowsAffected

223223 }

224224

225− selected <- testing Rel8.select connection do

225+ selected <- liftIO $ Rel8.select connection do

226226 Rel8.each testTableSchema

227227

228228 sort selected === sort rows

@@ -241,7 +241,7 @@ testWhere_ = databasePropertyTest "WHERE (Rel8.where_)" \transaction -> do

241241 let expected = filter (\t -> testTableColumn2 t == magicBool) rows

242242

243243 transaction \connection -> do

244− selected <- testing Rel8.select connection do

244+ selected <- liftIO $ Rel8.select connection do

245245 t <- Rel8.values $ Rel8.lit <$> rows

246246 Rel8.where_ $ testTableColumn2 t Rel8.==. Rel8.lit magicBool

247247 return t

@@ -260,7 +260,7 @@ testFilter = databasePropertyTest "filter" \transaction -> do

260260 transaction \connection -> do

261261 let expected = filter testTableColumn2 rows

262262

263− selected <- testing Rel8.select connection

263+ selected <- liftIO $ Rel8.select connection

264264 $ Rel8.filter testTableColumn2 =<< Rel8.values (Rel8.lit <$> rows)

265265

266266 sort selected === sort expected

@@ -277,7 +277,7 @@ testLimit = databasePropertyTest "LIMIT (Rel8.limit)" \transaction -> do

277277 n <- forAll $ Gen.integral (Range.linear 0 10)

278278

279279 transaction \connection -> do

280− selected <- testing Rel8.select connection do

280+ selected <- liftIO $ Rel8.select connection do

281281 Rel8.limit n $ Rel8.values (Rel8.lit <$> rows)

282282

283283 diff (length selected) (<=) (fromIntegral n)

@@ -297,7 +297,7 @@ testUnion = databasePropertyTest "UNION (Rel8.union)" \transaction -> evalM do

297297 right <- forAll $ Gen.list (Range.linear 0 10) genTestTable

298298

299299 transaction \connection -> do

300− selected <- testing Rel8.select connection do

300+ selected <- liftIO $ Rel8.select connection do

301301 Rel8.values (Rel8.lit <$> nub left) `Rel8.union` Rel8.values (Rel8.lit <$> nub right)

302302

303303 sort selected === sort (nub (left ++ right))

@@ -308,7 +308,7 @@ testDistinct = databasePropertyTest "DISTINCT (Rel8.distinct)" \transaction -> d

308308 rows <- forAll $ Gen.list (Range.linear 0 10) genTestTable

309309

310310 transaction \connection -> do

311− selected <- testing Rel8.select connection $ Rel8.distinct do

311+ selected <- liftIO $ Rel8.select connection $ Rel8.distinct do

312312 Rel8.values (Rel8.lit <$> rows)

313313

314314 sort selected === nub (sort rows)

@@ -323,7 +323,7 @@ testExists = databasePropertyTest "EXISTS (Rel8.exists)" \transaction -> do

323323 rows <- forAll $ Gen.list (Range.linear 0 10) genTestTable

324324

325325 transaction \connection -> do

326− exists <- testing Rel8.select connection $ Rel8.exists $ Rel8.values $ Rel8.lit <$> rows

326+ exists <- liftIO $ Rel8.select connection $ Rel8.exists $ Rel8.values $ Rel8.lit <$> rows

327327

328328 case rows of

329329 [] -> exists === [False]

@@ -335,7 +335,7 @@ testOptional = databasePropertyTest "Rel8.optional" \transaction -> do

335335 rows <- forAll $ Gen.list (Range.linear 0 10) genTestTable

336336

337337 transaction \connection -> do

338− selected <- testing Rel8.select connection do

338+ selected <- liftIO $ Rel8.select connection do

339339 Rel8.optional $ Rel8.values (Rel8.lit <$> rows)

340340

341341 case rows of

@@ -348,7 +348,7 @@ testAnd = databasePropertyTest "AND (&&.)" \transaction -> do

348348 (x, y) <- forAll $ liftA2 (,) Gen.bool Gen.bool

349349

350350 transaction \connection -> do

351− [result] <- testing Rel8.select connection $ pure $

351+ [result] <- liftIO $ Rel8.select connection $ pure $

352352 Rel8.lit x Rel8.&&. Rel8.lit y

353353

354354 result === (x && y)

@@ -359,7 +359,7 @@ testOr = databasePropertyTest "OR (||.)" \transaction -> do

359359 (x, y) <- forAll $ liftA2 (,) Gen.bool Gen.bool

360360

361361 transaction \connection -> do

362− [result] <- testing Rel8.select connection $ pure $

362+ [result] <- liftIO $ Rel8.select connection $ pure $

363363 Rel8.lit x Rel8.||. Rel8.lit y

364364

365365 result === (x || y)

@@ -370,7 +370,7 @@ testLogicalFixities = databasePropertyTest "Logical operator fixities" \transact

370370 (u, v, w, x) <- forAll $ (,,,) <$> Gen.bool <*> Gen.bool <*> Gen.bool <*> Gen.bool

371371

372372 transaction \connection -> do

373− [result] <- testing Rel8.select connection $ pure $

373+ [result] <- liftIO $ Rel8.select connection $ pure $

374374 Rel8.lit u Rel8.||. Rel8.lit v Rel8.&&. Rel8.lit w Rel8.==. Rel8.lit x

375375

376376 result === (u || v && w == x)

@@ -381,7 +381,7 @@ testNot = databasePropertyTest "NOT (not_)" \transaction -> do

381381 x <- forAll Gen.bool

382382

383383 transaction \connection -> do

384− [result] <- testing Rel8.select connection $ pure $

384+ [result] <- liftIO $ Rel8.select connection $ pure $

385385 Rel8.not_ $ Rel8.lit x

386386

387387 result === not x

@@ -392,7 +392,7 @@ testBool = databasePropertyTest "ifThenElse_" \transaction -> do

392392 (x, y, z) <- forAll $ liftA3 (,,) Gen.bool Gen.bool Gen.bool

393393

394394 transaction \connection -> do

395− [result] <- testing Rel8.select connection $ pure $

395+ [result] <- liftIO $ Rel8.select connection $ pure $

396396 Rel8.bool (Rel8.lit z) (Rel8.lit y) (Rel8.lit x)

397397

398398 result === if x then y else z

@@ -406,7 +406,7 @@ testAp = databasePropertyTest "Cartesian product (<*>)" \transaction -> do

406406 (Gen.list (Range.linear 1 10) genTestTable)

407407

408408 transaction \connection -> do

409− result <- testing Rel8.select connection $ do

409+ result <- liftIO $ Rel8.select connection $ do

410410 liftA2 (,) (Rel8.values (Rel8.lit <$> rows1)) (Rel8.values (Rel8.lit <$> rows2))

411411

412412 sort result === sort (liftA2 (,) rows1 rows2)

@@ -455,7 +455,7 @@ testDBType getTestDatabase = testGroup "DBType instances"

455455 x <- forAll generator

456456

457457 transaction \connection -> do

458− [res] <- testing Rel8.select connection $ pure (Rel8.lit x :: Rel8.Expr a)

458+ [res] <- liftIO $ Rel8.select connection $ pure (Rel8.lit x :: Rel8.Expr a)

459459 diff res eq x

460460

461461 genDay :: Gen Day

@@ -514,7 +514,7 @@ testDBEq getTestDatabase = testGroup "DBEq instances"

514514 (x, y) <- forAll (liftA2 (,) generator generator)

515515

516516 transaction \connection -> do

517− [res] <- testing Rel8.select connection $ pure $ Rel8.lit @(Rel8.Expr a) x Rel8.==. Rel8.lit y

517+ [res] <- liftIO $ Rel8.select connection $ pure $ Rel8.lit @(Rel8.Expr a) x Rel8.==. Rel8.lit y

518518 res === (x == y)

519519

520520 cover 1 "Equal" $ x == y

@@ -526,7 +526,7 @@ testTableEquality = databasePropertyTest "TestTable equality" \transaction -> do

526526 (x, y) <- forAll $ liftA2 (,) genTestTable genTestTable

527527

528528 transaction \connection -> do

529− [eq] <- testing Rel8.select connection do

529+ [eq] <- liftIO $ Rel8.select connection do

530530 pure $ Rel8.lit x Rel8.==: Rel8.lit y

531531

532532 eq === (x == y)

@@ -540,7 +540,7 @@ testFromString = databasePropertyTest "FromString" \transaction -> do

540540 str <- forAll $ Gen.list (Range.linear 0 10) Gen.unicode

541541

542542 transaction \connection -> do

543− [result] <- testing Rel8.select connection $ pure $ fromString str

543+ [result] <- liftIO $ Rel8.select connection $ pure $ fromString str

544544 result === pack str

545545

546546

@@ -549,7 +549,7 @@ testCatMaybeTable = databasePropertyTest "catMaybeTable" \transaction -> do

549549 rows <- forAll $ Gen.list (Range.linear 0 10) genTestTable

550550

551551 transaction \connection -> do

552− selected <- testing Rel8.select connection do

552+ selected <- liftIO $ Rel8.select connection do

553553 testTable <- Rel8.values $ Rel8.lit <$> rows

554554 Rel8.catMaybeTable $ Rel8.bool Rel8.nothingTable (pure testTable) (testTableColumn2 testTable)

555555

@@ -561,7 +561,7 @@ testCatMaybe = databasePropertyTest "catMaybe" \transaction -> evalM do

561561 rows <- forAll $ Gen.list (Range.linear 0 10) $ Gen.maybe Gen.bool

562562

563563 transaction \connection -> do

564− selected <- evalM $ testing Rel8.select connection do

564+ selected <- evalM $ liftIO $ Rel8.select connection do

565565 Rel8.catNullable =<< Rel8.values (map Rel8.lit rows)

566566

567567 sort selected === sort (catMaybes rows)

@@ -572,7 +572,7 @@ testMaybeTable = databasePropertyTest "maybeTable" \transaction -> evalM do

572572 (rows, def) <- forAll $ liftA2 (,) (Gen.list (Range.linear 0 10) genTestTable) genTestTable

573573

574574 transaction \connection -> do

575− selected <- testing Rel8.select connection $

575+ selected <- liftIO $ Rel8.select connection $

576576 Rel8.maybeTable (Rel8.lit def) id <$> Rel8.optional (Rel8.values (Rel8.lit <$> rows))

577577

578578 case rows of

@@ -601,7 +601,7 @@ testNestedTables = databasePropertyTest "Nested TestTables" \transaction -> eval

601601 liftA2 TwoTestTables genTestTable genTestTable

602602

603603 transaction \connection -> do

604− selected <- testing Rel8.select connection do

604+ selected <- liftIO $ Rel8.select connection do

605605 Rel8.values (Rel8.lit <$> rows)

606606

607607 sort selected === sort rows

@@ -613,7 +613,7 @@ testMaybeTableApplicative = databasePropertyTest "MaybeTable (<*>)" \transaction

613613 rows2 <- genRows

614614

615615 transaction \connection -> do

616− selected <- testing Rel8.select connection do

616+ selected <- liftIO $ Rel8.select connection do

617617 as <- Rel8.optional (Rel8.values (Rel8.lit <$> rows1))

618618 bs <- Rel8.optional (Rel8.values (Rel8.lit <$> rows2))

619619 pure $ liftA2 (,) as bs

@@ -649,7 +649,7 @@ testUpdate = databasePropertyTest "Can UPDATE TestTable" \transaction -> do

649649 rows <- forAll $ Gen.map (Range.linear 0 5) $ liftA2 (,) genTestTable genTestTable

650650

651651 transaction \connection -> do

652− void $ testing Rel8.insert connection

652+ void $ liftIO $ Rel8.insert connection

653653 Rel8.Insert

654654 { into = testTableSchema

655655 , rows = map (Rel8.toInsert . Rel8.lit) $ Map.keys rows

@@ -657,7 +657,7 @@ testUpdate = databasePropertyTest "Can UPDATE TestTable" \transaction -> do

657657 , returning = Rel8.NumberOfRowsAffected

658658 }

659659

660− void $ testing Rel8.update connection

660+ void $ liftIO $ Rel8.update connection

661661 Rel8.Update

662662 { target = testTableSchema

663663 , set = \r ->

@@ -678,7 +678,7 @@ testUpdate = databasePropertyTest "Can UPDATE TestTable" \transaction -> do

678678 , returning = Rel8.NumberOfRowsAffected

679679 }

680680

681− selected <- testing Rel8.select connection do

681+ selected <- liftIO $ Rel8.select connection do

682682 Rel8.each testTableSchema

683683

684684 sort selected === sort (Map.elems rows)

@@ -693,7 +693,7 @@ testDelete = databasePropertyTest "Can DELETE TestTable" \transaction -> do

693693 rows <- forAll $ Gen.list (Range.linear 0 5) genTestTable

694694

695695 transaction \connection -> do

696− void $ testing Rel8.insert connection

696+ void $ liftIO $ Rel8.insert connection

697697 Rel8.Insert

698698 { into = testTableSchema

699699 , rows = map (Rel8.toInsert . Rel8.lit) rows

@@ -702,14 +702,14 @@ testDelete = databasePropertyTest "Can DELETE TestTable" \transaction -> do

702702 }

703703

704704 deleted <-

705− testing Rel8.delete connection

705+ liftIO $ Rel8.delete connection

706706 Rel8.Delete

707707 { from = testTableSchema

708708 , deleteWhere = testTableColumn2

709709 , returning = Rel8.Projection id

710710 }

711711

712− selected <- testing Rel8.select connection do

712+ selected <- liftIO $ Rel8.select connection do

713713 Rel8.each testTableSchema

714714

715715 sort (deleted <> selected) === sort rows

@@ -729,7 +729,7 @@ testSelectNestedPairs = databasePropertyTest "Can SELECT nested pairs" \transact

729729 rows <- forAll $ Gen.list (Range.linear 0 10) $ HKNestedPair <$> liftA2 (,) genTestTable genTestTable

730730

731731 transaction \connection -> do

732− selected <- testing Rel8.select connection do

732+ selected <- liftIO $ Rel8.select connection do

733733 Rel8.values $ map Rel8.lit rows

734734

735735 sort selected === sort rows

@@ -740,7 +740,7 @@ testSelectArray = databasePropertyTest "Can SELECT Arrays (with aggregation)" \t

740740 rows <- forAll $ Gen.list (Range.linear 1 10) Gen.bool

741741

742742 transaction \connection -> do

743− selected <- testing Rel8.select connection $ Rel8.aggregate do

743+ selected <- liftIO $ Rel8.select connection $ Rel8.aggregate do

744744 Rel8.listAgg <$> Rel8.values (map Rel8.lit rows)

745745

746746 selected === [foldMap pure rows]

@@ -764,12 +764,8 @@ testNestedMaybeTable = databasePropertyTest "Can nest MaybeTable within other ta

764764 let example = NestedMaybeTable { nmt1 = True, nmt2 = Just (TestTable "Hi" True) }

765765

766766 transaction \connection -> do

767− selected <- testing Rel8.select connection do

767+ selected <- liftIO $ Rel8.select connection do

768768 x <- Rel8.values [Rel8.lit example]

769769 pure $ Rel8.maybeTable (Rel8.lit False) (\_ -> Rel8.lit True) (nmt2 x)

770770

771771 selected === [True]

772−

773−

774−testing :: MonadIO m => (a -> Connection -> IO b) -> Connection -> a -> m b

775−testing f connection a = liftIO $ f a connection