383e277 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

one way migrations

383e277Eitan Chatav7 years ago

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+53−29

compare with dev

unifiedsplit

@@ -38,10 +38,9 @@ Now we can define some `Migration`s to make our tables.

39>>> :{

40let

41− makeUsers :: Migration Definition (Public '[]) '["public" ::: '["users" ::: 'Table UsersTable]]

41+ makeUsers :: Migration (Iso Definition) (Public '[]) '["public" ::: '["users" ::: 'Table UsersTable]]

42− makeUsers = Migration

42+ makeUsers = Migration "make users table" Iso

43− { name = "make users table"

44− , up = createTable #users

43+ { up = createTable #users

45 ( serial `as` #id :*

44 ( serial `as` #id :*

46 notNullable text `as` #name )

45 notNullable text `as` #name )

47 ( primaryKey #id `as` #pk_users )

46 ( primaryKey #id `as` #pk_users )

@@ -51,11 +50,10 @@ let

52>>> :{

51>>> :{

53let

52let

54− makeEmails :: Migration Definition '["public" ::: '["users" ::: 'Table UsersTable]]

53+ makeEmails :: Migration (Iso Definition) '["public" ::: '["users" ::: 'Table UsersTable]]

55 '["public" ::: '["users" ::: 'Table UsersTable, "emails" ::: 'Table EmailsTable]]

54 '["public" ::: '["users" ::: 'Table UsersTable, "emails" ::: 'Table EmailsTable]]

56− makeEmails = Migration

55+ makeEmails = Migration "make emails table" Iso

57− { name = "make emails table"

58− , up = createTable #emails

56+ { up = createTable #emails

59 ( serial `as` #id :*

57 ( serial `as` #id :*

60 notNullable int `as` #user_id :*

58 notNullable int `as` #user_id :*

61 nullable text `as` #email )

59 nullable text `as` #email )

@@ -85,9 +83,9 @@ withConnection "host=localhost port=5432 dbname=exampledb" $

85Migrate

83Migrate

86Rollback

84Rollback

88−We can also create a simple executable using `defaultMain`.

86+We can also create a simple executable using `mainMigrateIso`.

90−>>> let main = defaultMain "host=localhost port=5432 dbname=exampledb" migrations

88+>>> let main = mainMigrateIso "host=localhost port=5432 dbname=exampledb" migrations

92>>> withArgs [] main

90>>> withArgs [] main

93Invalid command: "". Use:

91Invalid command: "". Use:

@@ -142,10 +140,12 @@ module Squeal.PostgreSQL.Migration

142 Migration (..)

140 Migration (..)

143 , Migratory (..)

141 , Migratory (..)

144 , Terminally (..)

142 , Terminally (..)

143+ , Iso (..)

145 , terminally

144 , terminally

146 , pureMigration

145 , pureMigration

146+ , pureMigrationIso

147 , MigrationsTable

148− , defaultMain

148+ , mainMigrateIso

149 ) where

150

151import Control.Category

@@ -187,8 +187,7 @@ import Squeal.PostgreSQL.Transaction

187data Migration p schemas0 schemas1 = Migration

188 { name :: Text -- ^ The `name` of a `Migration`.

189 -- 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`.

192 } deriving (GHC.Generic)

191 } deriving (GHC.Generic)

193

192

194{- |

193{- |

@@ -198,6 +197,10 @@ SQL `Definition`s and the category of impure `Terminally` `PQ` `IO` actions.

198-}

197-}

199class Category p => Migratory p where

198class Category p => Migratory p where

200

199

200+ migrate

201+ :: Path (Migration p) schemas0 schemas1

202+ -> PQ schemas0 schemas1 IO ()

203+

201 {- |

204 {- |

202 Run a `Path` of `Migration`s.

205 Run a `Path` of `Migration`s.

203 Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.

206 Create the `MigrationsTable` as @public.schema_migrations@ if it does not already exist.

@@ -205,7 +208,7 @@ class Category p => Migratory p where

205 if not, `up` the `Migration` and insert its `name` in the `MigrationsTable`.

208 if not, `up` the `Migration` and insert its `name` in the `MigrationsTable`.

206 -}

209 -}

207 migrateUp

210 migrateUp

208− :: Path (Migration p) schemas0 schemas1

211+ :: Path (Migration (Iso p)) schemas0 schemas1

209 -> PQ schemas0 schemas1 IO ()

212 -> PQ schemas0 schemas1 IO ()

210

213

211 {- |

214 {- |

@@ -215,12 +218,13 @@ class Category p => Migratory p where

215 if so, `down` the `Migration` and delete its `name` in the `MigrationsTable`.

218 if so, `down` the `Migration` and delete its `name` in the `MigrationsTable`.

216 -}

219 -}

217 migrateDown

220 migrateDown

218− :: Path (Migration p) schemas0 schemas1

221+ :: Path (Migration (Iso p)) schemas0 schemas1

219 -> PQ schemas1 schemas0 IO ()

222 -> PQ schemas1 schemas0 IO ()

220

223

221instance Migratory Definition where

224instance Migratory Definition where

225+ migrate = migrate . cmap pureMigration

222− migrateUp = migrateUp . cmap pureMigration

226+ migrateUp = migrateUp . cmap pureMigrationIso

223− migrateDown = migrateDown . cmap pureMigration

227+ migrateDown = migrateDown . cmap pureMigrationIso

224

228

225{- | `Terminally` turns an indexed monad transformer and the monad it transforms

229{- | `Terminally` turns an indexed monad transformer and the monad it transforms

226into a category by restricting the return type to @()@ and permuting the type variables.

230into a category by restricting the return type to @()@ and permuting the type variables.

@@ -232,6 +236,11 @@ newtype Terminally trans monad x0 x1 = Terminally

232 { runTerminally :: trans x0 x1 monad () }

236 { runTerminally :: trans x0 x1 monad () }

233 deriving GHC.Generic

237 deriving GHC.Generic

234

238

239+data Iso c x y = Iso

240+ { up :: c x y

241+ , down :: c y x

242+ } deriving GHC.Generic

243+

235instance

244instance

236 ( IndexedMonadTransPQ trans

245 ( IndexedMonadTransPQ trans

237 , Monad monad

246 , Monad monad

@@ -256,13 +265,26 @@ pureMigration

256 -> Migration (Terminally PQ IO) schemas0 schemas1

265 -> Migration (Terminally PQ IO) schemas0 schemas1

257pureMigration migration = Migration

266pureMigration migration = Migration

258 { name = name migration

267 { name = name 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

259− , up = terminally . define $ up migration

280+ { up = terminally . define . up $ instruction migration

260− , down = terminally . define $ down migration

281+ , down = terminally . define . down $ instruction migration

282+ }

261 }

283 }

262

284

263instance Migratory (Terminally PQ IO) where

285instance Migratory (Terminally PQ IO) where

264

286

265− migrateUp migration = unsafePQ . transactionally_ $ do

287+ migrate migration = unsafePQ . transactionally_ $ do

266 define createMigrations

288 define createMigrations

267 upMigrations migration

289 upMigrations migration

268

290

@@ -281,7 +303,7 @@ instance Migratory (Terminally PQ IO) where

281 upMigration step = do

303 upMigration step = do

282 executed <- queryExecuted step

304 executed <- queryExecuted step

283 unless (executed == 1) $ do

305 unless (executed == 1) $ do

284− unsafePQ . runTerminally $ up step

306+ unsafePQ . runTerminally $ instruction step

285 manipulateParams_ insertMigration (Only (name step))

307 manipulateParams_ insertMigration (Only (name step))

286

308

287 queryExecuted

309 queryExecuted

@@ -291,6 +313,8 @@ instance Migratory (Terminally PQ IO) where

291 result <- runQueryParams selectMigration (Only (name step))

313 result <- runQueryParams selectMigration (Only (name step))

292 ntuples result

314 ntuples result

293

315

316+ migrateUp = migrate . cmap (\(Migration n iso) -> Migration n (up iso))

317+

294 migrateDown migrations = unsafePQ . transactionally_ $ do

318 migrateDown migrations = unsafePQ . transactionally_ $ do

295 define createMigrations

319 define createMigrations

296 downMigrations migrations

320 downMigrations migrations

@@ -298,23 +322,23 @@ instance Migratory (Terminally PQ IO) where

298 where

322 where

299

323

300 downMigrations

324 downMigrations

301− :: Path (Migration (Terminally PQ IO)) schemas0 schemas1

325+ :: Path (Migration (Iso (Terminally PQ IO))) schemas0 schemas1

302 -> PQ MigrationsSchemas MigrationsSchemas IO ()

326 -> PQ MigrationsSchemas MigrationsSchemas IO ()

303 downMigrations = \case

327 downMigrations = \case

304 Done -> return ()

328 Done -> return ()

305 step :>> steps -> downMigrations steps >> downMigration step

329 step :>> steps -> downMigrations steps >> downMigration step

306

330

307 downMigration

331 downMigration

308− :: Migration (Terminally PQ IO) schemas0 schemas1

332+ :: Migration (Iso (Terminally PQ IO)) schemas0 schemas1

309 -> PQ MigrationsSchemas MigrationsSchemas IO ()

333 -> PQ MigrationsSchemas MigrationsSchemas IO ()

310 downMigration step = do

334 downMigration step = do

311 executed <- queryExecuted step

335 executed <- queryExecuted step

312 unless (executed == 0) $ do

336 unless (executed == 0) $ do

313− unsafePQ . runTerminally $ down step

337+ unsafePQ . runTerminally . down $ instruction step

314 manipulateParams_ deleteMigration (Only (name step))

338 manipulateParams_ deleteMigration (Only (name step))

315

339

316 queryExecuted

340 queryExecuted

317− :: Migration (Terminally PQ IO) schemas0 schemas1

341+ :: Migration (Iso (Terminally PQ IO)) schemas0 schemas1

318 -> PQ MigrationsSchemas MigrationsSchemas IO Row

342 -> PQ MigrationsSchemas MigrationsSchemas IO Row

319 queryExecuted step = do

343 queryExecuted step = do

320 result <- runQueryParams selectMigration (Only (name step))

344 result <- runQueryParams selectMigration (Only (name step))

@@ -379,16 +403,16 @@ data MigrateCommand

379 | MigrateUp

403 | MigrateUp

380 | MigrateDown deriving (GHC.Generic, Show)

404 | MigrateDown deriving (GHC.Generic, Show)

381

405

382−{- | `defaultMain` creates a simple executable

406+{- | `mainMigrateIso` creates a simple executable

383from a connection string and a list of `Migration`s. -}

407from a connection string and a list of `Migration`s. -}

384−defaultMain

408+mainMigrateIso

385 :: Migratory p

409 :: Migratory p

386 => ByteString

410 => ByteString

387 -- ^ connection string

411 -- ^ connection string

388− -> Path (Migration p) db0 db1

412+ -> Path (Migration (Iso p)) db0 db1

389 -- ^ migrations

413 -- ^ migrations

390 -> IO ()

414 -> IO ()

391−defaultMain connectTo migrations = do

415+mainMigrateIso connectTo migrations = do

392 command <- readCommandFromArgs

416 command <- readCommandFromArgs

393 maybe (pure ()) performCommand command

417 maybe (pure ()) performCommand command

394

418