git.iko.soy/rel8
on master help sign in
Restore test suite
e891d51Shane O'Brien
rel8.cabal+2−1
compare with master
unifiedsplit
@@ -44,7 +44,6 @@ library
44 exposed-modules:
44 exposed-modules:
45 Rel8
45 Rel8
46
46
47− other-modules:
48 Rel8.Aggregate
47 Rel8.Aggregate
49
48
50 Rel8.Expr
49 Rel8.Expr
@@ -148,6 +147,7 @@ library
148 Rel8.Tabulate
147 Rel8.Tabulate
149
148
150 Rel8.Type
149 Rel8.Type
150+ Rel8.Type.Array
151 Rel8.Type.Array1D
151 Rel8.Type.Array1D
152 Rel8.Type.Eq
152 Rel8.Type.Eq
153 Rel8.Type.Information
153 Rel8.Type.Information
@@ -162,6 +162,7 @@ library
162 Rel8.Type.Sum
162 Rel8.Type.Sum
163 Rel8.Type.Tag
163 Rel8.Type.Tag
164
164
165+ other-modules:
165 Rel8.Opaque
166 Rel8.Opaque
166 Rel8.Schema.Structure
167 Rel8.Schema.Structure
167
168
src/Rel8/Expr.hs+2
@@ -50,12 +50,14 @@ instance Sql DBSemigroup a => Semigroup (Expr a) where
50 (<>) = case nullabilization @a of
50 (<>) = case nullabilization @a of
51 Nullable -> liftOpNullable (<>.)
51 Nullable -> liftOpNullable (<>.)
52 NonNullable -> (<>.)
52 NonNullable -> (<>.)
53+ {-# INLINABLE (<>) #-}
53
54
54
55
55instance Sql DBMonoid a => Monoid (Expr a) where
56instance Sql DBMonoid a => Monoid (Expr a) where
56 mempty = case nullabilization @a of
57 mempty = case nullabilization @a of
57 Nullable -> nullify memptyExpr
58 Nullable -> nullify memptyExpr
58 NonNullable -> memptyExpr
59 NonNullable -> memptyExpr
60+ {-# INLINABLE mempty #-}
59
61
60
62
61instance (Sql IsString a, Sql DBType a) => IsString (Expr a) where
63instance (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 )
63import qualified Rel8.Expr as Rel8
63import qualified Rel8.Expr as Rel8
64import qualified Rel8.Expr.Bool as Rel8
64import qualified Rel8.Expr.Bool as Rel8
65import qualified Rel8.Expr.Eq as Rel8
65import qualified Rel8.Expr.Eq as Rel8
66−import qualified Rel8.Kind.Nullability as Rel8
67import qualified Rel8.Query.Aggregate as Rel8
66import qualified Rel8.Query.Aggregate as Rel8
68import qualified Rel8.Query.Distinct as Rel8
67import qualified Rel8.Query.Distinct as Rel8
69import qualified Rel8.Query.Each as Rel8
68import qualified Rel8.Query.Each as Rel8
@@ -77,8 +76,8 @@ import qualified Rel8.Query.Values as Rel8
77import qualified Rel8.Schema.Column as Rel8
76import qualified Rel8.Schema.Column as Rel8
78import qualified Rel8.Schema.Context as Rel8
77import qualified Rel8.Schema.Context as Rel8
79import qualified Rel8.Schema.Generic as Rel8
78import qualified Rel8.Schema.Generic as Rel8
79+import qualified Rel8.Schema.Nullability as Rel8
80import qualified Rel8.Schema.Table as Rel8
80import qualified Rel8.Schema.Table as Rel8
81−import qualified Rel8.Schema.Value as Rel8
82import qualified Rel8.Statement.Delete as Rel8
81import qualified Rel8.Statement.Delete as Rel8
83import qualified Rel8.Statement.Insert as Rel8
82import qualified Rel8.Statement.Insert as Rel8
84import qualified Rel8.Statement.Returning as Rel8
83import qualified Rel8.Statement.Returning as Rel8
@@ -90,6 +89,7 @@ import qualified Rel8.Table.Eq as Rel8
90import qualified Rel8.Table.Insert as Rel8
89import qualified Rel8.Table.Insert as Rel8
91import qualified Rel8.Table.Maybe as Rel8
90import qualified Rel8.Table.Maybe as Rel8
92import qualified Rel8.Table.Serialize as Rel8
91import qualified Rel8.Table.Serialize as Rel8
92+import qualified Rel8.Type as Rel8
93import qualified Rel8.Type.Eq as Rel8
93import qualified Rel8.Type.Eq as Rel8
94
94
95-- scientific
95-- scientific
@@ -436,23 +436,17 @@ testDBType getTestDatabase = testGroup "DBType instances"
436 where
436 where
437 dbTypeTest ::
437 dbTypeTest ::
438 ( Eq a, Show a
438 ( Eq a, Show a
439− , ' ('Rel8.NonNullable, a) ~ Rel8.ToValue a
439+ , Rel8.Sql Rel8.DBType a
440+ , Rel8.IsMaybe a ~ 'False
440− , Rel8.Serializable (Rel8.Expr 'Rel8.NonNullable a) a
441+ , Rel8.Serializable (Rel8.Expr a) a
441− , Rel8.Serializable (Rel8.Expr 'Rel8.Nullable a) (Maybe a)
442+ , Rel8.Serializable (Rel8.Expr (Maybe a)) (Maybe a)
442− )
443− => TestName
443+ ) => TestName -> Gen a -> TestTree
444− -> Gen a
445− -> TestTree
446 dbTypeTest name generator = testGroup name
444 dbTypeTest name generator = testGroup name
447 [ databasePropertyTest name (t (==) generator) getTestDatabase
445 [ databasePropertyTest name (t (==) generator) getTestDatabase
448 , databasePropertyTest ("Maybe " <> name) (t (==) (Gen.maybe generator)) getTestDatabase
446 , databasePropertyTest ("Maybe " <> name) (t (==) (Gen.maybe generator)) getTestDatabase
449 ]
447 ]
450
448
451− t :: forall a b nullability value.
452− ( Show a
453− , '(nullability, value) ~ Rel8.ToValue a
454− , Rel8.Serializable (Rel8.Expr nullability value) a
449+ t :: forall a b. (Show a, Rel8.Sql Rel8.DBType a, Rel8.Serializable (Rel8.Expr a) a)
455− )
456 => (a -> a -> Bool)
450 => (a -> a -> Bool)
457 -> Gen a
451 -> Gen a
458 -> ((Connection -> TestT IO ()) -> PropertyT IO b)
452 -> ((Connection -> TestT IO ()) -> PropertyT IO b)
@@ -461,7 +455,7 @@ testDBType getTestDatabase = testGroup "DBType instances"
461 x <- forAll generator
455 x <- forAll generator
462
456
463 transaction \connection -> do
457 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)
465 diff res eq x
459 diff res eq x
466
460
467 genDay :: Gen Day
461 genDay :: Gen Day
@@ -497,26 +491,21 @@ testDBEq getTestDatabase = testGroup "DBEq instances"
497
491
498 where
492 where
499 dbEqTest ::
493 dbEqTest ::
500− ( Eq a, Show a, Rel8.DBEq a
494+ ( Eq a, Show a
501− , ' ('Rel8.NonNullable, a) ~ Rel8.ToValue a
495+ , Rel8.Sql Rel8.DBEq a
496+ , Rel8.IsMaybe a ~ 'False
502− , Rel8.Serializable (Rel8.Expr 'Rel8.NonNullable a) a
497+ , Rel8.Serializable (Rel8.Expr a) a
503− , Rel8.Serializable (Rel8.Expr 'Rel8.Nullable a) (Maybe a)
498+ , Rel8.Serializable (Rel8.Expr (Maybe a)) (Maybe a)
504− )
505− => TestName
499+ ) => TestName -> Gen a -> TestTree
506− -> Gen a
507− -> TestTree
508 dbEqTest name generator = testGroup name
500 dbEqTest name generator = testGroup name
509 [ databasePropertyTest name (t generator) getTestDatabase
501 [ databasePropertyTest name (t generator) getTestDatabase
510 , databasePropertyTest ("Maybe " <> name) (t (Gen.maybe generator)) getTestDatabase
502 , databasePropertyTest ("Maybe " <> name) (t (Gen.maybe generator)) getTestDatabase
511 ]
503 ]
512
504
513− t :: forall a nullability value.
505+ t :: forall a.
514− ( Eq a
515− , Show a
506+ ( Eq a, Show a
516− , '(nullability, value) ~ Rel8.ToValue a
507+ , Rel8.Sql Rel8.DBEq a
517− , Rel8.Serializable (Rel8.Expr nullability value) a
508+ , Rel8.Serializable (Rel8.Expr a) a
518− , Rel8.KnownNullability nullability
519− , Rel8.DBEq value
520 )
509 )
521 => Gen a
510 => Gen a
522 -> ((Connection -> TestT IO ()) -> PropertyT IO ())
511 -> ((Connection -> TestT IO ()) -> PropertyT IO ())
@@ -525,7 +514,7 @@ testDBEq getTestDatabase = testGroup "DBEq instances"
525 (x, y) <- forAll (liftA2 (,) generator generator)
514 (x, y) <- forAll (liftA2 (,) generator generator)
526
515
527 transaction \connection -> do
516 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
529 res === (x == y)
518 res === (x == y)
530
519
531 cover 1 "Equal" $ x == y
520 cover 1 "Equal" $ x == y