git.iko.soy/squeal
on dev help sign in
fix migrations
07692f9Eitan Chatav
squeal-postgresql/squeal-postgresql.cabal+1−1
compare with dev
unifiedsplit
@@ -26,7 +26,7 @@ library
26 Squeal.PostgreSQL.Definition
26 Squeal.PostgreSQL.Definition
27 Squeal.PostgreSQL.Expression
27 Squeal.PostgreSQL.Expression
28 Squeal.PostgreSQL.Manipulation
28 Squeal.PostgreSQL.Manipulation
29− -- Squeal.PostgreSQL.Migration
29+ Squeal.PostgreSQL.Migration
30 Squeal.PostgreSQL.Pool
30 Squeal.PostgreSQL.Pool
31 Squeal.PostgreSQL.PQ
31 Squeal.PostgreSQL.PQ
32 Squeal.PostgreSQL.Render
32 Squeal.PostgreSQL.Render
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+41−39
@@ -124,11 +124,11 @@ import Squeal.PostgreSQL
124
124
125-- | A `Migration` should contain an inverse pair of
125-- | A `Migration` should contain an inverse pair of
126-- `up` and `down` instructions and a unique `name`.
126-- `up` and `down` instructions and a unique `name`.
127−data Migration io schema0 schema1 = Migration
127+data Migration io db0 db1 = Migration
128 { name :: Text -- ^ The `name` of a `Migration`.
128 { name :: Text -- ^ The `name` of a `Migration`.
129 -- Each `name` in a `Migration` should be unique.
129 -- Each `name` in a `Migration` should be unique.
130− , up :: PQ schema0 schema1 io () -- ^ The `up` instruction of a `Migration`.
130+ , up :: PQ db0 db1 io () -- ^ The `up` instruction of a `Migration`.
131− , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Migration`.
131+ , down :: PQ db1 db0 io () -- ^ The `down` instruction of a `Migration`.
132 }
132 }
133
133
134-- | Run `Migration`s by creating the `MigrationsTable`
134-- | Run `Migration`s by creating the `MigrationsTable`
@@ -137,10 +137,10 @@ data Migration io schema0 schema1 = Migration
137-- execute the `Migration` and insert its row in the `MigrationsTable`.
137-- execute the `Migration` and insert its row in the `MigrationsTable`.
138migrateUp
138migrateUp
139 :: MonadBaseControl IO io
139 :: MonadBaseControl IO io
140− => AlignedList (Migration io) schema0 schema1 -- ^ migrations to run
140+ => AlignedList (Migration io) db0 db1 -- ^ migrations to run
141 -> PQ
141 -> PQ
142− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
142+ ("migrations" ::: MigrationsSchema ': db0)
143− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
143+ ("migrations" ::: MigrationsSchema ': db1)
144 io ()
144 io ()
145migrateUp migration =
145migrateUp migration =
146 define createMigrations
146 define createMigrations
@@ -150,10 +150,10 @@ migrateUp migration =
150
150
151 upMigrations
151 upMigrations
152 :: MonadBaseControl IO io
152 :: MonadBaseControl IO io
153− => AlignedList (Migration io) schema0 schema1
153+ => AlignedList (Migration io) db0 db1
154 -> PQ
154 -> PQ
155− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
155+ ("migrations" ::: MigrationsSchema ': db0)
156− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
156+ ("migrations" ::: MigrationsSchema ': db1)
157 io ()
157 io ()
158 upMigrations = \case
158 upMigrations = \case
159 Done -> return ()
159 Done -> return ()
@@ -161,9 +161,9 @@ migrateUp migration =
161
161
162 upMigration
162 upMigration
163 :: MonadBase IO io
163 :: MonadBase IO io
164− => Migration io schema0 schema1 -> PQ
164+ => Migration io db0 db1 -> PQ
165− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
165+ ("migrations" ::: MigrationsSchema ': db0)
166− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
166+ ("migrations" ::: MigrationsSchema ': db1)
167 io ()
167 io ()
168 upMigration step =
168 upMigration step =
169 queryExecuted step
169 queryExecuted step
@@ -178,9 +178,9 @@ migrateUp migration =
178
178
179 queryExecuted
179 queryExecuted
180 :: MonadBase IO io
180 :: MonadBase IO io
181− => Migration io schema0 schema1 -> PQ
181+ => Migration io db0 db1 -> PQ
182− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
182+ ("migrations" ::: MigrationsSchema ': db0)
183− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
183+ ("migrations" ::: MigrationsSchema ': db0)
184 io Row
184 io Row
185 queryExecuted step = do
185 queryExecuted step = do
186 result <- runQueryParams selectMigration (Only (name step))
186 result <- runQueryParams selectMigration (Only (name step))
@@ -193,10 +193,10 @@ migrateUp migration =
193-- rewind the `Migration` and delete its row in the `MigrationsTable`.
193-- rewind the `Migration` and delete its row in the `MigrationsTable`.
194migrateDown
194migrateDown
195 :: MonadBaseControl IO io
195 :: MonadBaseControl IO io
196− => AlignedList (Migration io) schema0 schema1 -- ^ migrations to rewind
196+ => AlignedList (Migration io) db0 db1 -- ^ migrations to rewind
197 -> PQ
197 -> PQ
198− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
198+ ("migrations" ::: MigrationsSchema ': db1)
199− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
199+ ("migrations" ::: MigrationsSchema ': db0)
200 io ()
200 io ()
201migrateDown migrations =
201migrateDown migrations =
202 define createMigrations
202 define createMigrations
@@ -206,9 +206,9 @@ migrateDown migrations =
206
206
207 downMigrations
207 downMigrations
208 :: MonadBaseControl IO io
208 :: MonadBaseControl IO io
209− => AlignedList (Migration io) schema0 schema1 -> PQ
209+ => AlignedList (Migration io) db0 db1 -> PQ
210− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
210+ ("migrations" ::: MigrationsSchema ': db1)
211− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
211+ ("migrations" ::: MigrationsSchema ': db0)
212 io ()
212 io ()
213 downMigrations = \case
213 downMigrations = \case
214 Done -> return ()
214 Done -> return ()
@@ -216,9 +216,9 @@ migrateDown migrations =
216
216
217 downMigration
217 downMigration
218 :: MonadBase IO io
218 :: MonadBase IO io
219− => Migration io schema0 schema1 -> PQ
219+ => Migration io db0 db1 -> PQ
220− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
220+ ("migrations" ::: MigrationsSchema ': db1)
221− ("schema_migrations" ::: 'Table MigrationsTable ': schema0)
221+ ("migrations" ::: MigrationsSchema ': db0)
222 io ()
222 io ()
223 downMigration step =
223 downMigration step =
224 queryExecuted step
224 queryExecuted step
@@ -233,9 +233,9 @@ migrateDown migrations =
233
233
234 queryExecuted
234 queryExecuted
235 :: MonadBase IO io
235 :: MonadBase IO io
236− => Migration io schema0 schema1 -> PQ
236+ => Migration io db0 db1 -> PQ
237− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
237+ ("migrations" ::: MigrationsSchema ': db1)
238− ("schema_migrations" ::: 'Table MigrationsTable ': schema1)
238+ ("migrations" ::: MigrationsSchema ': db1)
239 io Row
239 io Row
240 queryExecuted step = do
240 queryExecuted step = do
241 result <- runQueryParams selectMigration (Only (name step))
241 result <- runQueryParams selectMigration (Only (name step))
@@ -258,12 +258,14 @@ type MigrationsTable =
258 , "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
258 , "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
259 ]
259 ]
260
260
261+type MigrationsSchema = '["schema_migrations" ::: 'Table MigrationsTable]
262+
261-- | Creates a `MigrationsTable` if it does not already exist.
263-- | Creates a `MigrationsTable` if it does not already exist.
262createMigrations
264createMigrations
263− :: Has "schema_migrations" schema ('Table MigrationsTable)
265+ :: Has "migrations" db MigrationsSchema
264− => Definition schema schema
266+ => Definition db db
265createMigrations =
267createMigrations =
266− createTableIfNotExists #schema_migrations
268+ createTableIfNotExists (#migrations ! #schema_migrations)
267 ( (text & notNullable) `as` #name :*
269 ( (text & notNullable) `as` #name :*
268 (timestampWithTimeZone & notNullable & default_ currentTimestamp)
270 (timestampWithTimeZone & notNullable & default_ currentTimestamp)
269 `as` #executed_at )
271 `as` #executed_at )
@@ -271,25 +273,25 @@ createMigrations =
271
273
272-- | Inserts a `Migration` into the `MigrationsTable`
274-- | Inserts a `Migration` into the `MigrationsTable`
273insertMigration
275insertMigration
274− :: Has "schema_migrations" schema ('Table MigrationsTable)
276+ :: Has "migrations" db MigrationsSchema
275− => Manipulation schema '[ 'NotNull 'PGtext] '[]
277+ => Manipulation db '[ 'NotNull 'PGtext] '[]
276−insertMigration = insertRow_ #schema_migrations
278+insertMigration = insertRow_ (#migrations ! #schema_migrations)
277 ( Set (param @1) `as` #name :*
279 ( Set (param @1) `as` #name :*
278 Default `as` #executed_at )
280 Default `as` #executed_at )
279
281
280-- | Deletes a `Migration` from the `MigrationsTable`
282-- | Deletes a `Migration` from the `MigrationsTable`
281deleteMigration
283deleteMigration
282− :: Has "schema_migrations" schema ('Table MigrationsTable)
284+ :: Has "migrations" db MigrationsSchema
283− => Manipulation schema '[ 'NotNull 'PGtext ] '[]
285+ => Manipulation db '[ 'NotNull 'PGtext ] '[]
284−deleteMigration = deleteFrom_ #schema_migrations (#name .== param @1)
286+deleteMigration = deleteFrom_ (#migrations ! #schema_migrations) (#name .== param @1)
285
287
286-- | Selects a `Migration` from the `MigrationsTable`, returning
288-- | Selects a `Migration` from the `MigrationsTable`, returning
287-- the time at which it was executed.
289-- the time at which it was executed.
288selectMigration
290selectMigration
289− :: Has "schema_migrations" schema ('Table MigrationsTable)
291+ :: Has "migrations" db MigrationsSchema
290− => Query schema '[ 'NotNull 'PGtext ]
292+ => Query db '[ 'NotNull 'PGtext ]
291 '[ "executed_at" ::: 'NotNull 'PGtimestamptz ]
293 '[ "executed_at" ::: 'NotNull 'PGtimestamptz ]
292selectMigration = select
294selectMigration = select
293 (#executed_at `as` #executed_at)
295 (#executed_at `as` #executed_at)
294− ( from (table (#schema_migrations `as` #m))
296+ ( from (table ((#migrations ! #schema_migrations) `as` #m))
295 & where_ (#name .== param @1))
297 & where_ (#name .== param @1))
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+1−1
@@ -246,7 +246,7 @@ class IndexedMonadTransPQ pq where
246 pqEmbed
246 pqEmbed
247 :: Monad m
247 :: Monad m
248 => pq db0 db1 m x
248 => pq db0 db1 m x
249− -> pq (table ': db0) (table : db1) m x
249+ -> pq (schema ': db0) (schema : db1) m x
250
250
251 -- | Run a `Definition` with `LibPQ.exec`, we expect that libpq obeys the law
251 -- | Run a `Definition` with `LibPQ.exec`, we expect that libpq obeys the law
252 --
252 --