ff64af3 · squeal · git.iko.soy

git.iko.soy/squeal

terminate

commitff64af36f4e8a1d5dfed2dcf885fd8fdfef701f1 authorEitan Chatav <eitan@Eitans-MacBook-Pro.local> dateSun 14 Apr 2019, 00:50 (8 years ago) parentb91ff6d

3 files changed+28−26

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+5−7 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+10−4 squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+13−15

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+5−7

@@ -186,8 +186,8 @@ class Category p => Migratory p where

186186 {- |

187187 Run an `AlignedList` of `Migration`s.

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

189− In a transaction for each each `Migration`, query to see if the `Migration` has been executed;

190− if not, execute the `Migration` and insert a row in the `MigrationsTable`.

189+ In one transaction, for each each `Migration` query to see if the `Migration` has been executed;

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

191191 -}

192192 migrateUp

193193 :: AlignedList (Migration p) schemas0 schemas1

@@ -196,8 +196,8 @@ class Category p => Migratory p where

196196 {- |

197197 Rewind an `AlignedList` of `Migration`s.

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

199− In a transaction for each each `Migration`, query to see if the `Migration` has been executed;

200− if so, rewind the `Migration` and delete its row in the `MigrationsTable`.

199+ In one transaction, for each each `Migration` query to see if the `Migration` has been executed;

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

201201 -}

202202 migrateDown

203203 :: AlignedList (Migration p) schemas0 schemas1

@@ -249,7 +249,6 @@ instance Migratory (Terminally PQ IO) where

249249

250250 migrateUp migration = unsafePQ $

251251 define createMigrations

252− & pqBind okResult

253252 & pqThen (transactionally_ (upMigrations migration))

254253

255254 where

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

282281

283282 migrateDown migrations = unsafePQ $

284283 define createMigrations

285− & pqBind okResult

286284 & pqThen (transactionally_ (downMigrations migrations))

287285

288286 where

@@ -404,7 +402,7 @@ defaultMain connectTo migrations = do

404402 liftIO $ displayRunned runNames >> displayUnrunned unrunNames

405403

406404 suppressNotices :: PQ schema schema IO ()

407− suppressNotices = void . manipulate $

405+ suppressNotices = manipulate_ $

408406 UnsafeManipulation "SET client_min_messages TO WARNING;"

409407

410408 readCommandFromArgs :: IO (Maybe MigrateCommand)

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+10−4

@@ -245,13 +245,16 @@ class IndexedMonadTransPQ pq where

245245 -> x -> pq schemas0 schemas2 m z

246246 pqAndThen g f x = pqBind g (f x)

247247

248− -- | Run a `Definition` with `LibPQ.exec`, we expect that libpq obeys the law

248+ -- | Run a `Definition` with `LibPQ.exec`.

249249 --

250− -- @define statement1 & pqThen (define statement2) = define (statement1 >>> statement2)@

250+ -- It should be functorial in effect.

251+ --

252+ -- @define id = return ()@

253+ -- @define (statement1 >>> statement2) = define statement1 & pqThen (define statement2)@

251254 define

252255 :: MonadIO io

253256 => Definition schemas0 schemas1

254− -> pq schemas0 schemas1 io (K LibPQ.Result '[])

257+ -> pq schemas0 schemas1 io ()

255258

256259instance IndexedMonadTransPQ PQ where

257260

@@ -269,7 +272,7 @@ instance IndexedMonadTransPQ PQ where

269272 case resultMaybe of

270273 Nothing -> throw $ ResultException

271274 "define: LibPQ.exec returned no results"

272− Just result -> return $ K (K result)

275+ Just result -> K <$> okResult_ result

273276

274277{- | `MonadPQ` is an @mtl@ style constraint, similar to

275278`Control.Monad.State.Class.MonadState`, for using `Database.PostgreSQL.LibPQ` to

@@ -323,6 +326,9 @@ class Monad pq => MonadPQ schemas pq | pq -> schemas where

323326 manipulate :: Manipulation '[] schemas '[] ys -> pq (K LibPQ.Result ys)

324327 manipulate statement = manipulateParams statement ()

325328

329+ manipulate_ :: Manipulation '[] schemas '[] '[] -> pq ()

330+ manipulate_ = void . manipulate

331+

326332 runQueryParams

327333 :: ToParams x params

328334 => Query '[] '[] schemas params ys

squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+13−15

@@ -33,7 +33,6 @@ module Squeal.PostgreSQL.Transaction

3333 , DeferrableMode (..)

3434 ) where

3535

36−import Control.Monad

3736import UnliftIO

3837

3938import Squeal.PostgreSQL.Manipulation

@@ -52,9 +51,9 @@ transactionally

5251 -> tx x -- ^ run inside a transaction

5352 -> tx x

5453transactionally mode tx = mask $ \restore -> do

55− begin mode

56− result <- restore tx `onException` rollback

57− commit

54+ manipulate_ $ begin mode

55+ result <- restore tx `onException` (manipulate_ rollback)

56+ manipulate_ commit

5857 return result

5958

6059-- | Run a computation `transactionally_`, in `defaultMode`.

@@ -81,32 +80,31 @@ transactionallyRetry

8180transactionallyRetry mode tx = mask $ \restore ->

8281 loop . try $ do

8382 x <- restore tx

84− commit

83+ manipulate_ commit

8584 return x

8685 where

8786 loop attempt = do

88− begin mode

87+ manipulate_ $ begin mode

8988 attempt >>= \case

9089 Left (PQException (PQState _ (Just "40001") _)) -> do

91− rollback

90+ manipulate_ rollback

9291 loop attempt

9392 Left err -> do

94− rollback

93+ manipulate_ rollback

9594 throwIO err

9695 Right x -> return x

9796

9897-- | @BEGIN@ a transaction.

99−begin :: MonadPQ schemas tx => TransactionMode -> tx ()

100−begin mode = void . manipulate . UnsafeManipulation $

101− "BEGIN" <+> renderSQL mode <> ";"

98+begin :: TransactionMode -> Manipulation_ schemas () ()

99+begin mode = UnsafeManipulation $ "BEGIN" <+> renderSQL mode

102100

103101-- | @COMMIT@ a transaction.

104−commit :: MonadPQ schemas tx => tx ()

105−commit = void . manipulate $ UnsafeManipulation "COMMIT;"

102+commit :: Manipulation_ schemas () ()

103+commit = UnsafeManipulation "COMMIT"

106104

107105-- | @ROLLBACK@ a transaction.

108−rollback :: MonadPQ schemas tx => tx ()

109−rollback = void . manipulate $ UnsafeManipulation "ROLLBACK;"

106+rollback :: Manipulation_ schemas () ()

107+rollback = UnsafeManipulation "ROLLBACK"

110108

111109-- | The available transaction characteristics are the transaction `IsolationLevel`,

112110-- the transaction `AccessMode` (`ReadWrite` or `ReadOnly`), and the `DeferrableMode`.