e891d51 · rel8 · git.iko.soy

git.iko.soy/rel8

Restore test suite

commite891d517c0866d58db88e0b6d073d6cc96e423a0 authorShane O'Brien <shane.obrien@circuithub.com> dateTue 23 Mar 2021, 18:16 (6 years ago) parentb983def

3 files changed+24−32

compare with master

unifiedsplit

rel8.cabal+2−1 src/Rel8/Expr.hs+2 tests/Main.hs+20−31

rel8.cabal+2−1

@@ -44,7 +44,6 @@ library

4444 exposed-modules:

4545 Rel8

4646

47− other-modules:

4847 Rel8.Aggregate

4948

5049 Rel8.Expr

@@ -148,6 +147,7 @@ library

148147 Rel8.Tabulate

149148

150149 Rel8.Type

150+ Rel8.Type.Array

151151 Rel8.Type.Array1D

152152 Rel8.Type.Eq

153153 Rel8.Type.Information

@@ -162,6 +162,7 @@ library

162162 Rel8.Type.Sum

163163 Rel8.Type.Tag

164164

165+ other-modules:

165166 Rel8.Opaque

166167 Rel8.Schema.Structure

167168

src/Rel8/Expr.hs+2

@@ -50,12 +50,14 @@ instance Sql DBSemigroup a => Semigroup (Expr a) where

5050 (<>) = case nullabilization @a of

5151 Nullable -> liftOpNullable (<>.)

5252 NonNullable -> (<>.)

53+ {-# INLINABLE (<>) #-}

5354

5455

5556instance Sql DBMonoid a => Monoid (Expr a) where

5657 mempty = case nullabilization @a of

5758 Nullable -> nullify memptyExpr

5859 NonNullable -> memptyExpr

60+ {-# INLINABLE mempty #-}

5961

6062

6163instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where

tests/Main.hs+20−31

@@ -63,7 +63,6 @@ import Control.Monad.Trans.Control ( MonadBaseControl )

6363import qualified Rel8.Expr as Rel8

6464import qualified Rel8.Expr.Bool as Rel8

6565import qualified Rel8.Expr.Eq as Rel8

66−import qualified Rel8.Kind.Nullability as Rel8

6766import qualified Rel8.Query.Aggregate as Rel8

6867import qualified Rel8.Query.Distinct as Rel8

6968import qualified Rel8.Query.Each as Rel8

@@ -77,8 +76,8 @@ import qualified Rel8.Query.Values as Rel8

7776import qualified Rel8.Schema.Column as Rel8

7877import qualified Rel8.Schema.Context as Rel8

7978import qualified Rel8.Schema.Generic as Rel8

79+import qualified Rel8.Schema.Nullability as Rel8

8080import qualified Rel8.Schema.Table as Rel8

81−import qualified Rel8.Schema.Value as Rel8

8281import qualified Rel8.Statement.Delete as Rel8

8382import qualified Rel8.Statement.Insert as Rel8

8483import qualified Rel8.Statement.Returning as Rel8

@@ -90,6 +89,7 @@ import qualified Rel8.Table.Eq as Rel8

9089import qualified Rel8.Table.Insert as Rel8

9190import qualified Rel8.Table.Maybe as Rel8

9291import qualified Rel8.Table.Serialize as Rel8

92+import qualified Rel8.Type as Rel8

9393import qualified Rel8.Type.Eq as Rel8

9494

9595-- scientific

@@ -436,23 +436,17 @@ testDBType getTestDatabase = testGroup "DBType instances"

436436 where

437437 dbTypeTest ::

438438 ( Eq a, Show a

439− , ' ('Rel8.NonNullable, a) ~ Rel8.ToValue a

440− , Rel8.Serializable (Rel8.Expr 'Rel8.NonNullable a) a

441− , Rel8.Serializable (Rel8.Expr 'Rel8.Nullable a) (Maybe a)

442− )

443− => TestName

444− -> Gen a

445− -> TestTree

439+ , Rel8.Sql Rel8.DBType a

440+ , Rel8.IsMaybe a ~ 'False

441+ , Rel8.Serializable (Rel8.Expr a) a

442+ , Rel8.Serializable (Rel8.Expr (Maybe a)) (Maybe a)

443+ ) => TestName -> Gen a -> TestTree

446444 dbTypeTest name generator = testGroup name

447445 [ databasePropertyTest name (t (==) generator) getTestDatabase

448446 , databasePropertyTest ("Maybe " <> name) (t (==) (Gen.maybe generator)) getTestDatabase

449447 ]

450448

451− t :: forall a b nullability value.

452− ( Show a

453− , '(nullability, value) ~ Rel8.ToValue a

454− , Rel8.Serializable (Rel8.Expr nullability value) a

455− )

449+ t :: forall a b. (Show a, Rel8.Sql Rel8.DBType a, Rel8.Serializable (Rel8.Expr a) a)

456450 => (a -> a -> Bool)

457451 -> Gen a

458452 -> ((Connection -> TestT IO ()) -> PropertyT IO b)

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

461455 x <- forAll generator

462456

463457 transaction \connection -> do

464− [res] <- testing Rel8.select connection $ pure (Rel8.lit x :: Rel8.Expr nullability value)

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

465459 diff res eq x

466460

467461 genDay :: Gen Day

@@ -497,26 +491,21 @@ testDBEq getTestDatabase = testGroup "DBEq instances"

497491

498492 where

499493 dbEqTest ::

500− ( Eq a, Show a, Rel8.DBEq a

501− , ' ('Rel8.NonNullable, a) ~ Rel8.ToValue a

502− , Rel8.Serializable (Rel8.Expr 'Rel8.NonNullable a) a

503− , Rel8.Serializable (Rel8.Expr 'Rel8.Nullable a) (Maybe a)

504− )

505− => TestName

506− -> Gen a

507− -> TestTree

494+ ( Eq a, Show a

495+ , Rel8.Sql Rel8.DBEq a

496+ , Rel8.IsMaybe a ~ 'False

497+ , Rel8.Serializable (Rel8.Expr a) a

498+ , Rel8.Serializable (Rel8.Expr (Maybe a)) (Maybe a)

499+ ) => TestName -> Gen a -> TestTree

508500 dbEqTest name generator = testGroup name

509501 [ databasePropertyTest name (t generator) getTestDatabase

510502 , databasePropertyTest ("Maybe " <> name) (t (Gen.maybe generator)) getTestDatabase

511503 ]

512504

513− t :: forall a nullability value.

514− ( Eq a

515− , Show a

516− , '(nullability, value) ~ Rel8.ToValue a

517− , Rel8.Serializable (Rel8.Expr nullability value) a

518− , Rel8.KnownNullability nullability

519− , Rel8.DBEq value

505+ t :: forall a.

506+ ( Eq a, Show a

507+ , Rel8.Sql Rel8.DBEq a

508+ , Rel8.Serializable (Rel8.Expr a) a

520509 )

521510 => Gen a

522511 -> ((Connection -> TestT IO ()) -> PropertyT IO ())

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

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

526515

527516 transaction \connection -> do

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

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

529518 res === (x == y)

530519

531520 cover 1 "Equal" $ x == y