@@ -38,10 +38,9 @@ Now we can define some `Migration`s to make our tables.
3838
3939>>> :{
4040let
41− makeUsers :: Migration Definition (Public '[]) '["public" ::: '["users" ::: 'Table UsersTable]]
42− makeUsers = Migration
43− { name = "make users table"
44− , up = createTable #users
41+ makeUsers :: Migration (Iso Definition) (Public '[]) '["public" ::: '["users" ::: 'Table UsersTable]]
42+ makeUsers = Migration "make users table" Iso
43+ { up = createTable #users
4544 ( serial `as` #id :*
4645 notNullable text `as` #name )
4746 ( primaryKey #id `as` #pk_users )
@@ -51,11 +50,10 @@ let
5150
5251>>> :{
5352let
54− makeEmails :: Migration Definition '["public" ::: '["users" ::: 'Table UsersTable]]
53+ makeEmails :: Migration (Iso Definition) '["public" ::: '["users" ::: 'Table UsersTable]]
5554 '["public" ::: '["users" ::: 'Table UsersTable, "emails" ::: 'Table EmailsTable]]
56− makeEmails = Migration
57− { name = "make emails table"
58− , up = createTable #emails
55+ makeEmails = Migration "make emails table" Iso
56+ { up = createTable #emails
5957 ( serial `as` #id :*
6058 notNullable int `as` #user_id :*
6159 nullable text `as` #email )
@@ -85,9 +83,9 @@ withConnection "host=localhost port=5432 dbname=exampledb" $
8583Migrate
8684Rollback
8785
88−We can also create a simple executable using `defaultMain`.
86+We can also create a simple executable using `mainMigrateIso`.
8987
90−>>> let main = defaultMain "host=localhost port=5432 dbname=exampledb" migrations
88+>>> let main = mainMigrateIso "host=localhost port=5432 dbname=exampledb" migrations
9189
9290>>> withArgs [] main
9391Invalid command: "". Use:
@@ -142,10 +140,12 @@ module Squeal.PostgreSQL.Migration
142140 Migration (..)
143141 , Migratory (..)
144142 , Terminally (..)
143+ , Iso (..)
145144 , terminally
146145 , pureMigration
146+ , pureMigrationIso
147147 , MigrationsTable
148− , defaultMain
148+ , mainMigrateIso
149149 ) where
150150
151151import Control.Category
@@ -187,8 +187,7 @@ import Squeal.PostgreSQL.Transaction
187187data Migration p schemas0 schemas1 = Migration
188188 { name :: Text -- ^ The `name` of a `Migration`.
189189 -- Each `name` in a `Migration` should be unique.
190− , up :: p schemas0 schemas1 -- ^ The `up` instruction of a `Migration`.
191− , down :: p schemas1 schemas0 -- ^ The `down` instruction of a `Migration`.
190+ , instruction :: p schemas0 schemas1 -- ^ The instruction of a `Migration`.
192191 } deriving (GHC.Generic)
193192
194193{- |
@@ -198,6 +197,10 @@ SQL `Definition`s and the category of impure `Terminally` `PQ` `IO` actions.
198197-}
199198class Category p => Migratory p where
200199
200+ migrate
201+ :: Path (Migration p) schemas0 schemas1
202+ -> PQ schemas0 schemas1 IO ()
203+
201204 {- |
202205 Run a `Path` of `Migration`s.
203206 Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.
@@ -205,7 +208,7 @@ class Category p => Migratory p where
205208 if not, `up` the `Migration` and insert its `name` in the `MigrationsTable`.
206209 -}
207210 migrateUp
208− :: Path (Migration p) schemas0 schemas1
211+ :: Path (Migration (Iso p)) schemas0 schemas1
209212 -> PQ schemas0 schemas1 IO ()
210213
211214 {- |
@@ -215,12 +218,13 @@ class Category p => Migratory p where
215218 if so, `down` the `Migration` and delete its `name` in the `MigrationsTable`.
216219 -}
217220 migrateDown
218− :: Path (Migration p) schemas0 schemas1
221+ :: Path (Migration (Iso p)) schemas0 schemas1
219222 -> PQ schemas1 schemas0 IO ()
220223
221224instance Migratory Definition where
222− migrateUp = migrateUp . cmap pureMigration
223− migrateDown = migrateDown . cmap pureMigration
225+ migrate = migrate . cmap pureMigration
226+ migrateUp = migrateUp . cmap pureMigrationIso
227+ migrateDown = migrateDown . cmap pureMigrationIso
224228
225229{- | `Terminally` turns an indexed monad transformer and the monad it transforms
226230into a category by restricting the return type to @()@ and permuting the type variables.
@@ -232,6 +236,11 @@ newtype Terminally trans monad x0 x1 = Terminally
232236 { runTerminally :: trans x0 x1 monad () }
233237 deriving GHC.Generic
234238
239+data Iso c x y = Iso
240+ { up :: c x y
241+ , down :: c y x
242+ } deriving GHC.Generic
243+
235244instance
236245 ( IndexedMonadTransPQ trans
237246 , Monad monad
@@ -256,13 +265,26 @@ pureMigration
256265 -> Migration (Terminally PQ IO) schemas0 schemas1
257266pureMigration migration = Migration
258267 { name = name migration
259− , up = terminally . define $ up migration
260− , down = terminally . define $ down migration
268+ , instruction = terminally . define $ instruction migration
269+ }
270+
271+-- | A `pureMigrationIso` turns a reversible `Migration`
272+-- involving only pure SQL
273+-- `Definition`s into a `Migration` that may be combined with arbitrary `IO`.
274+pureMigrationIso
275+ :: Migration (Iso Definition) schemas0 schemas1
276+ -> Migration (Iso (Terminally PQ IO)) schemas0 schemas1
277+pureMigrationIso migration = Migration
278+ { name = name migration
279+ , instruction = Iso
280+ { up = terminally . define . up $ instruction migration
281+ , down = terminally . define . down $ instruction migration
282+ }
261283 }
262284
263285instance Migratory (Terminally PQ IO) where
264286
265− migrateUp migration = unsafePQ . transactionally_ $ do
287+ migrate migration = unsafePQ . transactionally_ $ do
266288 define createMigrations
267289 upMigrations migration
268290
@@ -281,7 +303,7 @@ instance Migratory (Terminally PQ IO) where
281303 upMigration step = do
282304 executed <- queryExecuted step
283305 unless (executed == 1) $ do
284− unsafePQ . runTerminally $ up step
306+ unsafePQ . runTerminally $ instruction step
285307 manipulateParams_ insertMigration (Only (name step))
286308
287309 queryExecuted
@@ -291,6 +313,8 @@ instance Migratory (Terminally PQ IO) where
291313 result <- runQueryParams selectMigration (Only (name step))
292314 ntuples result
293315
316+ migrateUp = migrate . cmap (\(Migration n iso) -> Migration n (up iso))
317+
294318 migrateDown migrations = unsafePQ . transactionally_ $ do
295319 define createMigrations
296320 downMigrations migrations
@@ -298,23 +322,23 @@ instance Migratory (Terminally PQ IO) where
298322 where
299323
300324 downMigrations
301− :: Path (Migration (Terminally PQ IO)) schemas0 schemas1
325+ :: Path (Migration (Iso (Terminally PQ IO))) schemas0 schemas1
302326 -> PQ MigrationsSchemas MigrationsSchemas IO ()
303327 downMigrations = \case
304328 Done -> return ()
305329 step :>> steps -> downMigrations steps >> downMigration step
306330
307331 downMigration
308− :: Migration (Terminally PQ IO) schemas0 schemas1
332+ :: Migration (Iso (Terminally PQ IO)) schemas0 schemas1
309333 -> PQ MigrationsSchemas MigrationsSchemas IO ()
310334 downMigration step = do
311335 executed <- queryExecuted step
312336 unless (executed == 0) $ do
313− unsafePQ . runTerminally $ down step
337+ unsafePQ . runTerminally . down $ instruction step
314338 manipulateParams_ deleteMigration (Only (name step))
315339
316340 queryExecuted
317− :: Migration (Terminally PQ IO) schemas0 schemas1
341+ :: Migration (Iso (Terminally PQ IO)) schemas0 schemas1
318342 -> PQ MigrationsSchemas MigrationsSchemas IO Row
319343 queryExecuted step = do
320344 result <- runQueryParams selectMigration (Only (name step))
@@ -379,16 +403,16 @@ data MigrateCommand
379403 | MigrateUp
380404 | MigrateDown deriving (GHC.Generic, Show)
381405
382−{- | `defaultMain` creates a simple executable
406+{- | `mainMigrateIso` creates a simple executable
383407from a connection string and a list of `Migration`s. -}
384−defaultMain
408+mainMigrateIso
385409 :: Migratory p
386410 => ByteString
387411 -- ^ connection string
388− -> Path (Migration p) db0 db1
412+ -> Path (Migration (Iso p)) db0 db1
389413 -- ^ migrations
390414 -> IO ()
391−defaultMain connectTo migrations = do
415+mainMigrateIso connectTo migrations = do
392416 command <- readCommandFromArgs
393417 maybe (pure ()) performCommand command
394418