diff options
author | Adrien Duclos <adrien.duclos@fretlink.com> | 2020-03-08 14:58:54 +0100 |
---|---|---|
committer | Adrien Duclos <adrien.duclos@fretlink.com> | 2020-03-08 14:58:54 +0100 |
commit | b47ba97be9a51ee4e12df7c4e63e6079e937d0bf (patch) | |
tree | 9ae88e0105a475942692fcaeb8c99a575c13a1d3 | |
parent | 87ac1a449df5104b7e53a716a70b3ad17055338f (diff) | |
download | squeal-hspec-b47ba97be9a51ee4e12df7c4e63e6079e937d0bf.tar.gz squeal-hspec-b47ba97be9a51ee4e12df7c4e63e6079e937d0bf.tar.zst squeal-hspec-b47ba97be9a51ee4e12df7c4e63e6079e937d0bf.zip |
feat(fixture): add ability to pass fixtures to specs
-rw-r--r-- | src/Squeal/PostgreSQL/Hspec.hs | 49 | ||||
-rw-r--r-- | stack.yaml | 2 |
2 files changed, 40 insertions, 11 deletions
diff --git a/src/Squeal/PostgreSQL/Hspec.hs b/src/Squeal/PostgreSQL/Hspec.hs index d96d9a2..70d41b6 100644 --- a/src/Squeal/PostgreSQL/Hspec.hs +++ b/src/Squeal/PostgreSQL/Hspec.hs | |||
@@ -39,9 +39,10 @@ data TestDB a = TestDB | |||
39 | , connectionString :: ByteString | 39 | , connectionString :: ByteString |
40 | } | 40 | } |
41 | 41 | ||
42 | type Fixtures schema = (Pool (K Connection schema) -> IO ()) | 42 | type Fixtures schema a = (Pool (K Connection schema) -> IO a) |
43 | type Actions schema a = PoolPQ schema IO a | 43 | type Actions schema a = PoolPQ schema IO a |
44 | type SquealContext schema = TestDB (K Connection schema) | 44 | type SquealContext schema = TestDB (K Connection schema) |
45 | type FixtureContext schema fix = (SquealContext schema, fix) | ||
45 | 46 | ||
46 | testDBEnv :: String | 47 | testDBEnv :: String |
47 | testDBEnv = "TEST_DB_CONNECTION_STRING" | 48 | testDBEnv = "TEST_DB_CONNECTION_STRING" |
@@ -60,8 +61,8 @@ createTempDB = do | |||
60 | -- | Start a temporary @postgres@ process and create a pool of connections to it | 61 | -- | Start a temporary @postgres@ process and create a pool of connections to it |
61 | setupDB | 62 | setupDB |
62 | :: Migratory p => AlignedList (Migration p) schema0 schema | 63 | :: Migratory p => AlignedList (Migration p) schema0 schema |
63 | -> Fixtures schema | 64 | -> Fixtures schema fix |
64 | -> IO (SquealContext schema) | 65 | -> IO (FixtureContext schema fix) |
65 | setupDB migration fixtures = do | 66 | setupDB migration fixtures = do |
66 | (connectionString, tempDB) <- getOrCreateConnectionString | 67 | (connectionString, tempDB) <- getOrCreateConnectionString |
67 | BSC.putStrLn connectionString | 68 | BSC.putStrLn connectionString |
@@ -74,8 +75,8 @@ setupDB migration fixtures = do | |||
74 | keepConnectionForOneHour | 75 | keepConnectionForOneHour |
75 | poolSizeOfFifty | 76 | poolSizeOfFifty |
76 | withConnection connectionString (migrateUp migration) | 77 | withConnection connectionString (migrateUp migration) |
77 | fixtures pool | 78 | res <- fixtures pool |
78 | pure TestDB {..} | 79 | pure (TestDB {..}, res) |
79 | 80 | ||
80 | -- | Drop all the connections and shutdown the @postgres@ process | 81 | -- | Drop all the connections and shutdown the @postgres@ process |
81 | teardownDB | 82 | teardownDB |
@@ -100,10 +101,27 @@ withDB action testDB = | |||
100 | runDB :: TestDB (K Connection schema) -> Actions schema a -> IO a | 101 | runDB :: TestDB (K Connection schema) -> Actions schema a -> IO a |
101 | runDB = flip withDB | 102 | runDB = flip withDB |
102 | 103 | ||
104 | withFixture :: (fix -> Actions schema a) -> FixtureContext schema fix -> IO a | ||
105 | withFixture action (db, fix) = | ||
106 | runPoolPQ (transactionally_ $ action fix) (pool db) | ||
107 | |||
108 | withoutFixture :: Actions schema a -> FixtureContext schema fix -> IO a | ||
109 | withoutFixture action (db, _) = | ||
110 | runPoolPQ (transactionally_ action) (pool db) | ||
111 | |||
103 | -- | Helper for writing tests. Wrapper around 'it' that uses the passed | 112 | -- | Helper for writing tests. Wrapper around 'it' that uses the passed |
104 | -- in 'TestDB' to run a db transaction automatically for the test. | 113 | -- in 'TestDB' to run a db transaction automatically for the test. |
105 | itDB :: String -> Actions schema a -> SpecWith (TestDB (K Connection schema)) | 114 | itDB :: String -> Actions schema a -> SpecWith (FixtureContext schema ()) |
106 | itDB msg action = it msg $ void . withDB action | 115 | itDB msg action = it msg $ void . withoutFixture action |
116 | |||
117 | -- | Helper for writing tests. Wrapper around 'it' that uses the passed | ||
118 | -- in 'TestDB' to run a db transaction automatically for the test, | ||
119 | -- plus the result of the fixtures. | ||
120 | itDBF :: String -> (fix -> Actions schema a) -> SpecWith (FixtureContext schema fix) | ||
121 | itDBF msg action = it msg $ void . withFixture action | ||
122 | |||
123 | itDBF_ :: String -> Actions schema a -> SpecWith (FixtureContext schema fix) | ||
124 | itDBF_ msg action = it msg $ void . withoutFixture action | ||
107 | 125 | ||
108 | -- | Wraps 'describe' with a | 126 | -- | Wraps 'describe' with a |
109 | -- | 127 | -- |
@@ -120,9 +138,20 @@ itDB msg action = it msg $ void . withDB action | |||
120 | -- hook for stopping a db. | 138 | -- hook for stopping a db. |
121 | describeDB | 139 | describeDB |
122 | :: Migratory p => AlignedList (Migration p) schema0 schema | 140 | :: Migratory p => AlignedList (Migration p) schema0 schema |
123 | -> Fixtures schema | 141 | -> Fixtures schema () |
124 | -> String | 142 | -> String |
125 | -> SpecWith (SquealContext schema) | 143 | -> SpecWith (FixtureContext schema ()) |
126 | -> Spec | 144 | -> Spec |
127 | describeDB migrate fixture str = | 145 | describeDB migrate fixture str = |
128 | beforeAll (setupDB migrate fixture) . afterAll (teardownDB migrate) . describe str | 146 | beforeAll (setupDB migrate fixture) . afterAll (teardownDB migrate . fst) . describe str |
147 | |||
148 | -- | Like `decribeDB`, but allow fixtures to pass | ||
149 | -- | a result to all specs | ||
150 | describeFixtures | ||
151 | :: Migratory p => AlignedList (Migration p) schema0 schema | ||
152 | -> Fixtures schema fix | ||
153 | -> String | ||
154 | -> SpecWith (FixtureContext schema fix) | ||
155 | -> Spec | ||
156 | describeFixtures migrate fixture str = | ||
157 | beforeAll (setupDB migrate fixture) . afterAll (teardownDB migrate . fst) . describe str | ||
@@ -40,7 +40,7 @@ packages: | |||
40 | # using the same syntax as the packages field. | 40 | # using the same syntax as the packages field. |
41 | # (e.g., acme-missiles-0.3) | 41 | # (e.g., acme-missiles-0.3) |
42 | extra-deps: | 42 | extra-deps: |
43 | - squeal-0.5.0.0 | 43 | - squeal-postgresql-0.5.0.0 |
44 | - unliftio-pool-0.2.1.0@sha256:4de658feb1b10051c5af024c20cd7baa369c777716c54a7b3e2888a73286aecf | 44 | - unliftio-pool-0.2.1.0@sha256:4de658feb1b10051c5af024c20cd7baa369c777716c54a7b3e2888a73286aecf |
45 | - records-sop-0.1.0.2 | 45 | - records-sop-0.1.0.2 |
46 | - tmp-postgres-0.1.1.0 | 46 | - tmp-postgres-0.1.1.0 |