@@ -31,8 +31,8 @@ type EmailsTable =
3131
3232>>> :{
3333let
34− makeUsers :: Step IO '[] '["users" ::: UsersTable]
35− makeUsers = Step
34+ makeUsers :: Migration IO '[] '["users" ::: UsersTable]
35+ makeUsers = Migration
3636 { name = "make users table"
3737 , up = void . define $
3838 createTable #users
@@ -45,9 +45,9 @@ let
4545
4646>>> :{
4747let
48− makeEmails :: Step IO '["users" ::: UsersTable]
48+ makeEmails :: Migration IO '["users" ::: UsersTable]
4949 '["users" ::: UsersTable, "emails" ::: EmailsTable]
50− makeEmails = Step
50+ makeEmails = Migration
5151 { name = "make emails table"
5252 , up = void . define $
5353 createTable #emails
@@ -61,27 +61,30 @@ let
6161 }
6262:}
6363
64+Now that we have a couple migrations we can chain them together.
65+
66+>>> let migrations = makeUsers :>> makeEmails :>> Done
67+
6468>>> :{
6569let
66− numSteps
67− :: Has "migration" schema MigrationTable
70+ numMigrations
71+ :: Has "schema_migrations" schema MigrationsTable
6872 => PQ schema schema IO ()
69− numSteps = do
70− result <- runQuery (selectStar (from (table (#migration `As` #m))))
73+ numMigrations = do
74+ result <- runQuery (selectStar (from (table (#schema_migrations `As` #m))))
7175 RowNumber num <- ntuples result
7276 liftBase $ print num
7377:}
7478
75−>>> let migration = makeUsers :>> makeEmails :>> Done
7679>>> :{
7780withConnection "host=localhost port=5432 dbname=exampledb" $
78− migrateUp migration
79− & pqThen numSteps
80− & pqThen (migrateDown migration)
81+ migrateUp migrations
82+ & pqThen numMigrations
83+ & pqThen (migrateDown migrations)
8184:}
82−NOTICE: relation "migration" already exists, skipping
85+NOTICE: relation "schema_migrations" already exists, skipping
8386Row 2
84−NOTICE: relation "migration" already exists, skipping
87+NOTICE: relation "schema_migrations" already exists, skipping
8588-}
8689
8790{-# LANGUAGE
@@ -100,19 +103,20 @@ NOTICE: relation "migration" already exists, skipping
100103module Squeal.PostgreSQL.Migration
101104 ( -- * Migration
102105 Migration (..)
103− , Step (..)
104106 , migrateUp
105107 , migrateDown
106− -- * MigrationTable
107− , MigrationTable
108− , createMigration
109− , insertStep
110− , deleteStep
111− , selectStep
108+ -- * Aligned lists
109+ , AlignedList (..)
110+ , single
111+ -- * Migration table
112+ , MigrationsTable
113+ , createMigrations
114+ , insertMigration
115+ , deleteMigration
116+ , selectMigration
112117 ) where
113118
114119import Control.Category
115−-- import Control.Exception.Lifted
116120import Control.Monad
117121import Control.Monad.Base
118122import Control.Monad.Trans.Control
@@ -124,141 +128,141 @@ import Prelude hiding (id, (.))
124128
125129import Squeal.PostgreSQL
126130
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
142132-- `up` and `down` instructions and a unique `name`.
143−data Step io schema0 schema1 = Step
144− { name :: Text -- ^ The `name` of a `Step`.
133+data Migration io schema0 schema1 = Migration
134+ { name :: Text -- ^ The `name` of a `Migration`.
145135 -- Each `name` in a `Migration` should be unique.
146− , up :: PQ schema0 schema1 io () -- ^ The `up` instruction of a `Step`.
147− , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Step`.
136+ , up :: PQ schema0 schema1 io () -- ^ The `up` instruction of a `Migration`.
137+ , down :: PQ schema1 schema0 io () -- ^ The `down` instruction of a `Migration`.
148138 }
149139
150−-- | Run a `Migration` by creating the `MigrationTable`
151−-- if it does not exist and then in a transaction, for each each `Step`
152−-- query to see if the `Step` is executed. If not, then
153−-- execute the `Step` and insert its row in `MigrationTable`.
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+
154+-- | Run a `Migration` by creating the `MigrationsTable`
155+-- if it does not exist and then in a transaction, for each each `Migration`
156+-- query to see if the `Migration` is executed. If not, then
157+-- execute the `Migration` and insert its row in `MigrationsTable`.
154158migrateUp
155159 :: MonadBaseControl IO io
156− => Migration io schema0 schema1 -- ^ migration to run
160+ => AlignedList (Migration io) schema0 schema1 -- ^ migrations to run
157161 -> PQ
158− ("migration" ::: MigrationTable ': schema0)
159− ("migration" ::: MigrationTable ': schema1)
162+ ("schema_migrations" ::: MigrationsTable ': schema0)
163+ ("schema_migrations" ::: MigrationsTable ': schema1)
160164 io ()
161165migrateUp migration =
162− define createMigration
166+ define createMigrations
163167 & pqBind okResult
164168 & pqThen (begin defaultMode)
165169 & pqBind okResult
166− & pqThen (upSteps migration & rollbackOrCommit)
170+ & pqThen (upMigrations migration & rollbackOrCommit)
167171 where
168172
169− upSteps
173+ upMigrations
170174 :: MonadBaseControl IO io
171− => Migration io schema0 schema1
175+ => AlignedList (Migration io) schema0 schema1
172176 -> PQ
173− ("migration" ::: MigrationTable ': schema0)
174− ("migration" ::: MigrationTable ': schema1)
177+ ("schema_migrations" ::: MigrationsTable ': schema0)
178+ ("schema_migrations" ::: MigrationsTable ': schema1)
175179 io ()
176− upSteps = \case
180+ upMigrations = \case
177181 Done -> return ()
178− step :>> steps -> upStep step & pqThen (upSteps steps)
182+ step :>> steps -> upMigration step & pqThen (upMigrations steps)
179183
180− upStep
184+ upMigration
181185 :: MonadBase IO io
182− => Step io schema0 schema1 -> PQ
183− ("migration" ::: MigrationTable ': schema0)
184− ("migration" ::: MigrationTable ': schema1)
186+ => Migration io schema0 schema1 -> PQ
187+ ("schema_migrations" ::: MigrationsTable ': schema0)
188+ ("schema_migrations" ::: MigrationsTable ': schema1)
185189 io ()
186− upStep step =
190+ upMigration step =
187191 queryExecuted step
188192 & pqBind (\ (RowNumber executed) ->
189193 if executed == 1 -- up step has already been executed
190194 then PQ (\ _ -> return (K ())) -- unsafely switch schemas
191195 else
192196 pqEmbed (up step) -- safely switch schemas
193− & pqThen (manipulateParams insertStep (Only (name step)))
194− & pqBind okResult)
197+ & pqThen (manipulateParams insertMigration (Only (name step)))
195198 -- insert execution record
199+ & pqBind okResult)
196200
197201 queryExecuted
198202 :: MonadBase IO io
199− => Step io schema0 schema1 -> PQ
200− ("migration" ::: MigrationTable ': schema0)
201− ("migration" ::: MigrationTable ': schema0)
203+ => Migration io schema0 schema1 -> PQ
204+ ("schema_migrations" ::: MigrationsTable ': schema0)
205+ ("schema_migrations" ::: MigrationsTable ': schema0)
202206 io RowNumber
203207 queryExecuted step = do
204− result <- runQueryParams selectStep (Only (name step))
208+ result <- runQueryParams selectMigration (Only (name step))
205209 okResult result
206210 ntuples result
207211
208−-- | Rewind a `Migration` by creating the `MigrationTable`
209−-- if it does not exist and then in a transaction, for each each `Step`
210−-- query to see if the `Step` is executed. If it is, then
211−-- rewind the `Step` and delete its row in `MigrationTable`.
212+-- | Rewind a `Migration` by creating the `MigrationsTable`
213+-- if it does not exist and then in a transaction, for each each `Migration`
214+-- query to see if the `Migration` is executed. If it is, then
215+-- rewind the `Migration` and delete its row in `MigrationsTable`.
212216migrateDown
213217 :: MonadBaseControl IO io
214− => Migration io schema0 schema1 -- ^ migration to rewind
218+ => AlignedList (Migration io) schema0 schema1 -- ^ migration to rewind
215219 -> PQ
216− ("migration" ::: MigrationTable ': schema1)
217− ("migration" ::: MigrationTable ': schema0)
220+ ("schema_migrations" ::: MigrationsTable ': schema1)
221+ ("schema_migrations" ::: MigrationsTable ': schema0)
218222 io ()
219223migrateDown migration =
220− define createMigration
224+ define createMigrations
221225 & pqBind okResult
222226 & pqThen (begin defaultMode)
223227 & pqBind okResult
224− & pqThen (downSteps migration & rollbackOrCommit)
228+ & pqThen (downMigrations migration & rollbackOrCommit)
225229 where
226230
227− downSteps
231+ downMigrations
228232 :: MonadBaseControl IO io
229− => Migration io schema0 schema1 -> PQ
230− ("migration" ::: MigrationTable ': schema1)
231− ("migration" ::: MigrationTable ': schema0)
233+ => AlignedList (Migration io) schema0 schema1 -> PQ
234+ ("schema_migrations" ::: MigrationsTable ': schema1)
235+ ("schema_migrations" ::: MigrationsTable ': schema0)
232236 io ()
233− downSteps = \case
237+ downMigrations = \case
234238 Done -> return ()
235− step :>> steps -> downSteps steps & pqThen (downStep step)
239+ step :>> steps -> downMigrations steps & pqThen (downMigration step)
236240
237− downStep
241+ downMigration
238242 :: MonadBase IO io
239− => Step io schema0 schema1 -> PQ
240− ("migration" ::: MigrationTable ': schema1)
241− ("migration" ::: MigrationTable ': schema0)
243+ => Migration io schema0 schema1 -> PQ
244+ ("schema_migrations" ::: MigrationsTable ': schema1)
245+ ("schema_migrations" ::: MigrationsTable ': schema0)
242246 io ()
243− downStep step =
247+ downMigration step =
244248 queryExecuted step
245249 & pqBind (\ (RowNumber executed) ->
246250 if executed == 0 -- up step has not been executed
247251 then PQ (\ _ -> return (K ())) -- unsafely switch schemas
248252 else
249253 pqEmbed (down step) -- safely switch schemas
250− & pqThen (manipulateParams deleteStep (Only (name step)))
254+ & pqThen (manipulateParams deleteMigration (Only (name step)))
251255 -- delete execution record
252256 & pqBind okResult)
253257
254258 queryExecuted
255259 :: MonadBase IO io
256− => Step io schema0 schema1 -> PQ
257− ("migration" ::: MigrationTable ': schema1)
258− ("migration" ::: MigrationTable ': schema1)
260+ => Migration io schema0 schema1 -> PQ
261+ ("schema_migrations" ::: MigrationsTable ': schema1)
262+ ("schema_migrations" ::: MigrationsTable ': schema1)
259263 io RowNumber
260264 queryExecuted step = do
261− result <- runQueryParams selectStep (Only (name step))
265+ result <- runQueryParams selectMigration (Only (name step))
262266 okResult result
263267 ntuples result
264268
@@ -272,44 +276,44 @@ okResult result = do
272276 Just msg -> error ("migrationDown: " <> show msg)
273277
274278-- | The `TableType` for a Squeal migration.
275−type MigrationTable =
276− '[ "unique_name" ::: 'Unique '["name"]] :=>
279+type MigrationsTable =
280+ '[ "migrations_unique_name" ::: 'Unique '["name"]] :=>
277281 '[ "name" ::: 'NoDef :=> 'NotNull 'PGtext
278282 , "executed_at" ::: 'Def :=> 'NotNull 'PGtimestamptz
279283 ]
280284
281−-- | Creates a `MigrationTable` if it does not already exist.
282−createMigration
283− :: Has "migration" schema MigrationTable
285+-- | Creates a `MigrationsTable` if it does not already exist.
286+createMigrations
287+ :: Has "schema_migrations" schema MigrationsTable
284288 => Definition schema schema
285−createMigration =
286− createTableIfNotExists #migration
289+createMigrations =
290+ createTableIfNotExists #schema_migrations
287291 ( (text & notNull) `As` #name :*
288292 (timestampWithTimeZone & notNull & default_ currentTimestamp)
289293 `As` #executed_at :* Nil )
290− ( unique (Column #name :* Nil) `As` #unique_name :* Nil )
294+ ( unique (Column #name :* Nil) `As` #migrations_unique_name :* Nil )
291295
292−-- | Inserts a `Step` into the `MigrationTable`
293−insertStep
294− :: Has "migration" schema MigrationTable
296+-- | Inserts a `Migration` into the `MigrationsTable`
297+insertMigration
298+ :: Has "schema_migrations" schema MigrationsTable
295299 => Manipulation schema '[ 'NotNull 'PGtext] '[]
296−insertStep = insertRow_ #migration
300+insertMigration = insertRow_ #schema_migrations
297301 ( Set (param @1) `As` #name :*
298302 Default `As` #executed_at :* Nil )
299303
300−-- | Deletes a `Step` from the `MigrationTable`
301−deleteStep
302− :: Has "migration" schema MigrationTable
304+-- | Deletes a `Migration` from the `MigrationsTable`
305+deleteMigration
306+ :: Has "schema_migrations" schema MigrationsTable
303307 => Manipulation schema '[ 'NotNull 'PGtext ] '[]
304−deleteStep = deleteFrom_ #migration (#name .== param @1)
308+deleteMigration = deleteFrom_ #schema_migrations (#name .== param @1)
305309
306−-- | Selects a `Step` from the `MigrationTable`, returning
310+-- | Selects a `Migration` from the `MigrationsTable`, returning
307311-- the time at which it was executed.
308−selectStep
309− :: Has "migration" schema MigrationTable
312+selectMigration
313+ :: Has "schema_migrations" schema MigrationsTable
310314 => Query schema '[ 'NotNull 'PGtext ]
311315 '[ "executed_at" ::: 'NotNull 'PGtimestamptz ]
312−selectStep = select
316+selectMigration = select
313317 (#executed_at `As` #executed_at :* Nil)
314− ( from (table (#migration `As` #m))
318+ ( from (table (#schema_migrations `As` #m))
315319 & where_ (#name .== param @1))