git.iko.soy/squeal
on dev help sign in
migration naming
88d4c1fEitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+117−113
compare with dev
unifiedsplit
@@ -31,8 +31,8 @@ type EmailsTable =
31
31
32>>> :{
32>>> :{
33let
33let
34− makeUsers :: Step IO '[] '["users" ::: UsersTable]
34+ makeUsers :: Migration IO '[] '["users" ::: UsersTable]
35− makeUsers = Step
35+ makeUsers = Migration
36 { name = "make users table"
36 { name = "make users table"
37 , up = void . define $
37 , up = void . define $
38 createTable #users
38 createTable #users
@@ -45,9 +45,9 @@ let
45
45
46>>> :{
46>>> :{
47let
47let
48− makeEmails :: Step IO '["users" ::: UsersTable]
48+ makeEmails :: Migration IO '["users" ::: UsersTable]
49 '["users" ::: UsersTable, "emails" ::: EmailsTable]
49 '["users" ::: UsersTable, "emails" ::: EmailsTable]
50− makeEmails = Step
50+ makeEmails = Migration
51 { name = "make emails table"
51 { name = "make emails table"
52 , up = void . define $
52 , up = void . define $
53 createTable #emails
53 createTable #emails
@@ -61,27 +61,30 @@ let
61 }
61 }
62:}
62:}
63
63
64+Now that we have a couple migrations we can chain them together.
65+
66+>>> let migrations = makeUsers :>> makeEmails :>> Done
67+
64>>> :{
68>>> :{
65let
69let
66− numSteps
70+ numMigrations
67− :: Has "migration" schema MigrationTable
71+ :: Has "schema_migrations" schema MigrationsTable
68 => PQ schema schema IO ()
72 => PQ schema schema IO ()
69− numSteps = do
73+ numMigrations = do
70− result <- runQuery (selectStar (from (table (#migration `As` #m))))
74+ result <- runQuery (selectStar (from (table (#schema_migrations `As` #m))))
71 RowNumber num <- ntuples result
75 RowNumber num <- ntuples result
72 liftBase $ print num
76 liftBase $ print num
73:}
77:}
74
78
75−>>> let migration = makeUsers :>> makeEmails :>> Done
76>>> :{
79>>> :{
77withConnection "host=localhost port=5432 dbname=exampledb" $
80withConnection "host=localhost port=5432 dbname=exampledb" $
78− migrateUp migration
81+ migrateUp migrations
79− & pqThen numSteps
82+ & pqThen numMigrations
80− & pqThen (migrateDown migration)
83+ & pqThen (migrateDown migrations)
81:}
84:}
82−NOTICE: relation "migration" already exists, skipping
85+NOTICE: relation "schema_migrations" already exists, skipping
83Row 2
86Row 2
84−NOTICE: relation "migration" already exists, skipping
87+NOTICE: relation "schema_migrations" already exists, skipping
85-}
88-}
86
89
87{-# LANGUAGE
90{-# LANGUAGE
@@ -100,19 +103,20 @@ NOTICE: relation "migration" already exists, skipping
100module Squeal.PostgreSQL.Migration
103module Squeal.PostgreSQL.Migration
101 ( -- * Migration
104 ( -- * Migration
102 Migration (..)
105 Migration (..)
103− , Step (..)
104 , migrateUp
106 , migrateUp
105 , migrateDown
107 , migrateDown
106− -- * MigrationTable
108+ -- * Aligned lists
107− , MigrationTable
109+ , AlignedList (..)
108− , createMigration
110+ , single
109− , insertStep
111+ -- * Migration table
110− , deleteStep
112+ , MigrationsTable
111− , selectStep
113+ , createMigrations
114+ , insertMigration
115+ , deleteMigration
116+ , selectMigration
112 ) where
117 ) where
113
118
114import Control.Category
119import Control.Category
115−-- import Control.Exception.Lifted
116import Control.Monad
120import Control.Monad
117import Control.Monad.Base
121import Control.Monad.Base
118import Control.Monad.Trans.Control
122import Control.Monad.Trans.Control
@@ -124,141 +128,141 @@ import Prelude hiding (id, (.))
124
128
125import Squeal.PostgreSQL
129import Squeal.PostgreSQL
126
130
127−-- | A `Migration` is a schema-aligned sequence of `Step`s.
128−data Migration io schema0 schema1 where
129− Done :: Migration io schema schema
130− (:>>)
131− :: Step io schema0 schema1
132− -> Migration io schema1 schema2
133− -> Migration io schema0 schema2
134−infixr 7 :>>
135−instance Category (Migration io) where
136− id = Done
137− (.) migration = \case
138− Done -> migration
139− step :>> steps -> step :>> (steps >>> migration)
140−
141−-- | A `Step` of a `Migration`, should contain an inverse pair of
131+-- | A `Migration` of a `Migrations`, should contain an inverse pair of
142-- `up` and `down` instructions and a unique `name`.
132-- `up` and `down` instructions and a unique `name`.
143−data Step io schema0 schema1 = Step
133+data Migration io schema0 schema1 = Migration
144− { name :: Text -- ^ The `name` of a `Step`.
134+ { name :: Text -- ^ The `name` of a `Migration`.
145 -- Each `name` in a `Migration` should be unique.
135 -- Each `name` in a `Migration` should be unique.
146− , up :: PQ schema0 schema1 io () -- ^ The `up` instruction of a `Step`.
136+ , up :: PQ schema0 schema1 io () -- ^ The `up` instruction of a `Migration`.
147− , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Step`.
137+ , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Migration`.
148 }
138 }
149
139
140+-- | An `AlignedList` is a type-aligned list or free category.
141+data AlignedList p x0 x1 where
142+ Done :: AlignedList p x x
143+ (:>>) :: p x0 x1 -> AlignedList p x1 x2 -> AlignedList p x0 x2
144+infixr 7 :>>
145+instance Category (AlignedList p) where
146+ id = Done
147+ (.) list = \case
148+ Done -> list
149+ step :>> steps -> step :>> (steps >>> list)
150+
151+single :: p x0 x1 -> AlignedList p x0 x1
152+single step = step :>> Done
153+
150−-- | Run a `Migration` by creating the `MigrationTable`
154+-- | Run a `Migration` by creating the `MigrationsTable`
151−-- if it does not exist and then in a transaction, for each each `Step`
155+-- if it does not exist and then in a transaction, for each each `Migration`
152−-- query to see if the `Step` is executed. If not, then
156+-- query to see if the `Migration` is executed. If not, then
153−-- execute the `Step` and insert its row in `MigrationTable`.
157+-- execute the `Migration` and insert its row in `MigrationsTable`.
154migrateUp
158migrateUp
155 :: MonadBaseControl IO io
159 :: MonadBaseControl IO io
156− => Migration io schema0 schema1 -- ^ migration to run
160+ => AlignedList (Migration io) schema0 schema1 -- ^ migrations to run
157 -> PQ
161 -> PQ
158− ("migration" ::: MigrationTable ': schema0)
162+ ("schema_migrations" ::: MigrationsTable ': schema0)
159− ("migration" ::: MigrationTable ': schema1)
163+ ("schema_migrations" ::: MigrationsTable ': schema1)
160 io ()
164 io ()
161migrateUp migration =
165migrateUp migration =
162− define createMigration
166+ define createMigrations
163 & pqBind okResult
167 & pqBind okResult
164 & pqThen (begin defaultMode)
168 & pqThen (begin defaultMode)
165 & pqBind okResult
169 & pqBind okResult
166− & pqThen (upSteps migration & rollbackOrCommit)
170+ & pqThen (upMigrations migration & rollbackOrCommit)
167 where
171 where
168
172
169− upSteps
173+ upMigrations
170 :: MonadBaseControl IO io
174 :: MonadBaseControl IO io
171− => Migration io schema0 schema1
175+ => AlignedList (Migration io) schema0 schema1
172 -> PQ
176 -> PQ
173− ("migration" ::: MigrationTable ': schema0)
177+ ("schema_migrations" ::: MigrationsTable ': schema0)
174− ("migration" ::: MigrationTable ': schema1)
178+ ("schema_migrations" ::: MigrationsTable ': schema1)
175 io ()
179 io ()
176− upSteps = \case
180+ upMigrations = \case
177 Done -> return ()
181 Done -> return ()
178− step :>> steps -> upStep step & pqThen (upSteps steps)
182+ step :>> steps -> upMigration step & pqThen (upMigrations steps)
179
183
180− upStep
184+ upMigration
181 :: MonadBase IO io
185 :: MonadBase IO io
182− => Step io schema0 schema1 -> PQ
186+ => Migration io schema0 schema1 -> PQ
183− ("migration" ::: MigrationTable ': schema0)
187+ ("schema_migrations" ::: MigrationsTable ': schema0)
184− ("migration" ::: MigrationTable ': schema1)
188+ ("schema_migrations" ::: MigrationsTable ': schema1)
185 io ()
189 io ()
186− upStep step =
190+ upMigration step =
187 queryExecuted step
191 queryExecuted step
188 & pqBind (\ (RowNumber executed) ->
192 & pqBind (\ (RowNumber executed) ->
189 if executed == 1 -- up step has already been executed
193 if executed == 1 -- up step has already been executed
190 then PQ (\ _ -> return (K ())) -- unsafely switch schemas
194 then PQ (\ _ -> return (K ())) -- unsafely switch schemas
191 else
195 else
192 pqEmbed (up step) -- safely switch schemas
196 pqEmbed (up step) -- safely switch schemas
193− & pqThen (manipulateParams insertStep (Only (name step)))
197+ & pqThen (manipulateParams insertMigration (Only (name step)))
194− & pqBind okResult)
195 -- insert execution record
198 -- insert execution record
199+ & pqBind okResult)
196
200
197 queryExecuted
201 queryExecuted
198 :: MonadBase IO io
202 :: MonadBase IO io
199− => Step io schema0 schema1 -> PQ
203+ => Migration io schema0 schema1 -> PQ
200− ("migration" ::: MigrationTable ': schema0)
204+ ("schema_migrations" ::: MigrationsTable ': schema0)
201− ("migration" ::: MigrationTable ': schema0)
205+ ("schema_migrations" ::: MigrationsTable ': schema0)
202 io RowNumber
206 io RowNumber
203 queryExecuted step = do
207 queryExecuted step = do
204− result <- runQueryParams selectStep (Only (name step))
208+ result <- runQueryParams selectMigration (Only (name step))
205 okResult result
209 okResult result
206 ntuples result
210 ntuples result
207
211
208−-- | Rewind a `Migration` by creating the `MigrationTable`
212+-- | Rewind a `Migration` by creating the `MigrationsTable`
209−-- if it does not exist and then in a transaction, for each each `Step`
213+-- if it does not exist and then in a transaction, for each each `Migration`
210−-- query to see if the `Step` is executed. If it is, then
214+-- query to see if the `Migration` is executed. If it is, then
211−-- rewind the `Step` and delete its row in `MigrationTable`.
215+-- rewind the `Migration` and delete its row in `MigrationsTable`.
212migrateDown
216migrateDown
213 :: MonadBaseControl IO io
217 :: MonadBaseControl IO io
214− => Migration io schema0 schema1 -- ^ migration to rewind
218+ => AlignedList (Migration io) schema0 schema1 -- ^ migration to rewind
215 -> PQ
219 -> PQ
216− ("migration" ::: MigrationTable ': schema1)
220+ ("schema_migrations" ::: MigrationsTable ': schema1)
217− ("migration" ::: MigrationTable ': schema0)
221+ ("schema_migrations" ::: MigrationsTable ': schema0)
218 io ()
222 io ()
219migrateDown migration =
223migrateDown migration =
220− define createMigration
224+ define createMigrations
221 & pqBind okResult
225 & pqBind okResult
222 & pqThen (begin defaultMode)
226 & pqThen (begin defaultMode)
223 & pqBind okResult
227 & pqBind okResult
224− & pqThen (downSteps migration & rollbackOrCommit)
228+ & pqThen (downMigrations migration & rollbackOrCommit)
225 where
229 where
226
230
227− downSteps
231+ downMigrations
228 :: MonadBaseControl IO io
232 :: MonadBaseControl IO io
229− => Migration io schema0 schema1 -> PQ
233+ => AlignedList (Migration io) schema0 schema1 -> PQ
230− ("migration" ::: MigrationTable ': schema1)
234+ ("schema_migrations" ::: MigrationsTable ': schema1)
231− ("migration" ::: MigrationTable ': schema0)
235+ ("schema_migrations" ::: MigrationsTable ': schema0)
232 io ()
236 io ()
233− downSteps = \case
237+ downMigrations = \case
234 Done -> return ()
238 Done -> return ()
235− step :>> steps -> downSteps steps & pqThen (downStep step)
239+ step :>> steps -> downMigrations steps & pqThen (downMigration step)
236
240
237− downStep
241+ downMigration
238 :: MonadBase IO io
242 :: MonadBase IO io
239− => Step io schema0 schema1 -> PQ
243+ => Migration io schema0 schema1 -> PQ
240− ("migration" ::: MigrationTable ': schema1)
244+ ("schema_migrations" ::: MigrationsTable ': schema1)
241− ("migration" ::: MigrationTable ': schema0)
245+ ("schema_migrations" ::: MigrationsTable ': schema0)
242 io ()
246 io ()
243− downStep step =
247+ downMigration step =
244 queryExecuted step
248 queryExecuted step
245 & pqBind (\ (RowNumber executed) ->
249 & pqBind (\ (RowNumber executed) ->
246 if executed == 0 -- up step has not been executed
250 if executed == 0 -- up step has not been executed
247 then PQ (\ _ -> return (K ())) -- unsafely switch schemas
251 then PQ (\ _ -> return (K ())) -- unsafely switch schemas
248 else
252 else
249 pqEmbed (down step) -- safely switch schemas
253 pqEmbed (down step) -- safely switch schemas
250− & pqThen (manipulateParams deleteStep (Only (name step)))
254+ & pqThen (manipulateParams deleteMigration (Only (name step)))
251 -- delete execution record
255 -- delete execution record
252 & pqBind okResult)
256 & pqBind okResult)
253
257
254 queryExecuted
258 queryExecuted
255 :: MonadBase IO io
259 :: MonadBase IO io
256− => Step io schema0 schema1 -> PQ
260+ => Migration io schema0 schema1 -> PQ
257− ("migration" ::: MigrationTable ': schema1)
261+ ("schema_migrations" ::: MigrationsTable ': schema1)
258− ("migration" ::: MigrationTable ': schema1)
262+ ("schema_migrations" ::: MigrationsTable ': schema1)
259 io RowNumber
263 io RowNumber
260 queryExecuted step = do
264 queryExecuted step = do
261− result <- runQueryParams selectStep (Only (name step))
265+ result <- runQueryParams selectMigration (Only (name step))
262 okResult result
266 okResult result
263 ntuples result
267 ntuples result
264
268
@@ -272,44 +276,44 @@ okResult result = do
272 Just msg -> error ("migrationDown: " <> show msg)
276 Just msg -> error ("migrationDown: " <> show msg)
273
277
274-- | The `TableType` for a Squeal migration.
278-- | The `TableType` for a Squeal migration.
275−type MigrationTable =
279+type MigrationsTable =
276− '[ "unique_name" ::: 'Unique '["name"]] :=>
280+ '[ "migrations_unique_name" ::: 'Unique '["name"]] :=>
277 '[ "name" ::: 'NoDef :=> 'NotNull 'PGtext
281 '[ "name" ::: 'NoDef :=> 'NotNull 'PGtext
278 , "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
282 , "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
279 ]
283 ]
280
284
281−-- | Creates a `MigrationTable` if it does not already exist.
285+-- | Creates a `MigrationsTable` if it does not already exist.
282−createMigration
286+createMigrations
283− :: Has "migration" schema MigrationTable
287+ :: Has "schema_migrations" schema MigrationsTable
284 => Definition schema schema
288 => Definition schema schema
285−createMigration =
289+createMigrations =
286− createTableIfNotExists #migration
290+ createTableIfNotExists #schema_migrations
287 ( (text & notNull) `As` #name :*
291 ( (text & notNull) `As` #name :*
288 (timestampWithTimeZone & notNull & default_ currentTimestamp)
292 (timestampWithTimeZone & notNull & default_ currentTimestamp)
289 `As` #executed_at :* Nil )
293 `As` #executed_at :* Nil )
290− ( unique (Column #name :* Nil) `As` #unique_name :* Nil )
294+ ( unique (Column #name :* Nil) `As` #migrations_unique_name :* Nil )
291
295
292−-- | Inserts a `Step` into the `MigrationTable`
296+-- | Inserts a `Migration` into the `MigrationsTable`
293−insertStep
297+insertMigration
294− :: Has "migration" schema MigrationTable
298+ :: Has "schema_migrations" schema MigrationsTable
295 => Manipulation schema '[ 'NotNull 'PGtext] '[]
299 => Manipulation schema '[ 'NotNull 'PGtext] '[]
296−insertStep = insertRow_ #migration
300+insertMigration = insertRow_ #schema_migrations
297 ( Set (param @1) `As` #name :*
301 ( Set (param @1) `As` #name :*
298 Default `As` #executed_at :* Nil )
302 Default `As` #executed_at :* Nil )
299
303
300−-- | Deletes a `Step` from the `MigrationTable`
304+-- | Deletes a `Migration` from the `MigrationsTable`
301−deleteStep
305+deleteMigration
302− :: Has "migration" schema MigrationTable
306+ :: Has "schema_migrations" schema MigrationsTable
303 => Manipulation schema '[ 'NotNull 'PGtext ] '[]
307 => Manipulation schema '[ 'NotNull 'PGtext ] '[]
304−deleteStep = deleteFrom_ #migration (#name .== param @1)
308+deleteMigration = deleteFrom_ #schema_migrations (#name .== param @1)
305
309
306−-- | Selects a `Step` from the `MigrationTable`, returning
310+-- | Selects a `Migration` from the `MigrationsTable`, returning
307-- the time at which it was executed.
311-- the time at which it was executed.
308−selectStep
312+selectMigration
309− :: Has "migration" schema MigrationTable
313+ :: Has "schema_migrations" schema MigrationsTable
310 => Query schema '[ 'NotNull 'PGtext ]
314 => Query schema '[ 'NotNull 'PGtext ]
311 '[ "executed_at" ::: 'NotNull 'PGtimestamptz ]
315 '[ "executed_at" ::: 'NotNull 'PGtimestamptz ]
312−selectStep = select
316+selectMigration = select
313 (#executed_at `As` #executed_at :* Nil)
317 (#executed_at `As` #executed_at :* Nil)
314− ( from (table (#migration `As` #m))
318+ ( from (table (#schema_migrations `As` #m))
315 & where_ (#name .== param @1))
319 & where_ (#name .== param @1))