045aae6 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Revert "one way migrations"

045aae6Eitan Chatav7 years ago

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

compare with dev

unifiedsplit

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

39>>> :{

40let

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

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

42− makeUsers = Migration "make users table" Iso

42+ makeUsers = Migration

43+ { name = "make users table"

43− { up = createTable #users

44+ , up = createTable #users

44 ( serial `as` #id :*

45 ( serial `as` #id :*

45 notNullable text `as` #name )

46 notNullable text `as` #name )

46 ( primaryKey #id `as` #pk_users )

47 ( primaryKey #id `as` #pk_users )

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

51>>> :{

52>>> :{

52let

53let

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

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

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

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

55− makeEmails = Migration "make emails table" Iso

56+ makeEmails = Migration

57+ { name = "make emails table"

56− { up = createTable #emails

58+ , up = createTable #emails

57 ( serial `as` #id :*

59 ( serial `as` #id :*

58 notNullable int `as` #user_id :*

60 notNullable int `as` #user_id :*

59 nullable text `as` #email )

61 nullable text `as` #email )

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

83Migrate

85Migrate

84Rollback

86Rollback

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

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

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

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

90>>> withArgs [] main

92>>> withArgs [] main

91Invalid command: "". Use:

93Invalid command: "". Use:

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

140 Migration (..)

142 Migration (..)

141 , Migratory (..)

143 , Migratory (..)

142 , Terminally (..)

144 , Terminally (..)

143− , Iso (..)

144 , terminally

145 , terminally

145 , pureMigration

146 , pureMigration

146− , pureMigrationIso

147 , MigrationsTable

148− , mainMigrateIso

148+ , defaultMain

149 ) where

150

151import Control.Category

@@ -187,7 +187,8 @@ 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`.

190− , instruction :: p schemas0 schemas1 -- ^ The instruction of a `Migration`.

191+ , down :: p schemas1 schemas0 -- ^ The `down` instruction of a `Migration`.

191 } deriving (GHC.Generic)

192 } deriving (GHC.Generic)

192

193

193{- |

194{- |

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

197-}

198-}

198class Category p => Migratory p where

199class Category p => Migratory p where

199

200

200− migrate

201− :: Path (Migration p) schemas0 schemas1

202− -> PQ schemas0 schemas1 IO ()

203−

204 {- |

201 {- |

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

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

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

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

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

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

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

209 -}

206 -}

210 migrateUp

207 migrateUp

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

208+ :: Path (Migration p) schemas0 schemas1

212 -> PQ schemas0 schemas1 IO ()

209 -> PQ schemas0 schemas1 IO ()

213

210

214 {- |

211 {- |

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

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

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

219 -}

216 -}

220 migrateDown

217 migrateDown

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

218+ :: Path (Migration p) schemas0 schemas1

222 -> PQ schemas1 schemas0 IO ()

219 -> PQ schemas1 schemas0 IO ()

223

220

224instance Migratory Definition where

221instance Migratory Definition where

225− migrate = migrate . cmap pureMigration

226− migrateUp = migrateUp . cmap pureMigrationIso

222+ migrateUp = migrateUp . cmap pureMigration

227− migrateDown = migrateDown . cmap pureMigrationIso

223+ migrateDown = migrateDown . cmap pureMigration

228

224

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

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

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

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

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

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

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

237 deriving GHC.Generic

233 deriving GHC.Generic

238

234

239−data Iso c x y = Iso

240− { up :: c x y

241− , down :: c y x

242− } deriving GHC.Generic

243−

244instance

235instance

245 ( IndexedMonadTransPQ trans

236 ( IndexedMonadTransPQ trans

246 , Monad monad

237 , Monad monad

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

265 -> Migration (Terminally PQ IO) schemas0 schemas1

256 -> Migration (Terminally PQ IO) schemas0 schemas1

266pureMigration migration = Migration

257pureMigration migration = Migration

267 { name = name migration

258 { name = name migration

268− , instruction = terminally . define $ instruction migration

259+ , up = terminally . define $ up 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

260+ , down = terminally . define $ down migration

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

282− }

283 }

261 }

284

262

285instance Migratory (Terminally PQ IO) where

263instance Migratory (Terminally PQ IO) where

286

264

287− migrate migration = unsafePQ . transactionally_ $ do

265+ migrateUp migration = unsafePQ . transactionally_ $ do

288 define createMigrations

266 define createMigrations

289 upMigrations migration

267 upMigrations migration

290

268

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

303 upMigration step = do

281 upMigration step = do

304 executed <- queryExecuted step

282 executed <- queryExecuted step

305 unless (executed == 1) $ do

283 unless (executed == 1) $ do

306− unsafePQ . runTerminally $ instruction step

284+ unsafePQ . runTerminally $ up step

307 manipulateParams_ insertMigration (Only (name step))

285 manipulateParams_ insertMigration (Only (name step))

308

286

309 queryExecuted

287 queryExecuted

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

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

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

314 ntuples result

292 ntuples result

315

293

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

317−

318 migrateDown migrations = unsafePQ . transactionally_ $ do

294 migrateDown migrations = unsafePQ . transactionally_ $ do

319 define createMigrations

295 define createMigrations

320 downMigrations migrations

296 downMigrations migrations

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

322 where

298 where

323

299

324 downMigrations

300 downMigrations

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

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

326 -> PQ MigrationsSchemas MigrationsSchemas IO ()

302 -> PQ MigrationsSchemas MigrationsSchemas IO ()

327 downMigrations = \case

303 downMigrations = \case

328 Done -> return ()

304 Done -> return ()

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

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

330

306

331 downMigration

307 downMigration

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

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

333 -> PQ MigrationsSchemas MigrationsSchemas IO ()

309 -> PQ MigrationsSchemas MigrationsSchemas IO ()

334 downMigration step = do

310 downMigration step = do

335 executed <- queryExecuted step

311 executed <- queryExecuted step

336 unless (executed == 0) $ do

312 unless (executed == 0) $ do

337− unsafePQ . runTerminally . down $ instruction step

313+ unsafePQ . runTerminally $ down step

338 manipulateParams_ deleteMigration (Only (name step))

314 manipulateParams_ deleteMigration (Only (name step))

339

315

340 queryExecuted

316 queryExecuted

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

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

342 -> PQ MigrationsSchemas MigrationsSchemas IO Row

318 -> PQ MigrationsSchemas MigrationsSchemas IO Row

343 queryExecuted step = do

319 queryExecuted step = do

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

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

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

403 | MigrateUp

379 | MigrateUp

404 | MigrateDown deriving (GHC.Generic, Show)

380 | MigrateDown deriving (GHC.Generic, Show)

405

381

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

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

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

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

408−mainMigrateIso

384+defaultMain

409 :: Migratory p

385 :: Migratory p

410 => ByteString

386 => ByteString

411 -- ^ connection string

387 -- ^ connection string

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

388+ -> Path (Migration p) db0 db1

413 -- ^ migrations

389 -- ^ migrations

414 -> IO ()

390 -> IO ()

415−mainMigrateIso connectTo migrations = do

391+defaultMain connectTo migrations = do

416 command <- readCommandFromArgs

392 command <- readCommandFromArgs

417 maybe (pure ()) performCommand command

393 maybe (pure ()) performCommand command

418

394