ff64af3 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

terminate

ff64af3Eitan Chatav8 years ago

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

compare with dev

unifiedsplit

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

186 {- |

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

188 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;

189+ In one 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`.

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

191 -}

192 migrateUp

193 :: AlignedList (Migration p) schemas0 schemas1

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

196 {- |

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

198 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;

199+ In one 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`.

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

201 -}

202 migrateDown

203 :: AlignedList (Migration p) schemas0 schemas1

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

249

250 migrateUp migration = unsafePQ $

251 define createMigrations

252− & pqBind okResult

253 & pqThen (transactionally_ (upMigrations migration))

252 & pqThen (transactionally_ (upMigrations migration))

254

253

255 where

254 where

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

282

281

283 migrateDown migrations = unsafePQ $

282 migrateDown migrations = unsafePQ $

284 define createMigrations

283 define createMigrations

285− & pqBind okResult

286 & pqThen (transactionally_ (downMigrations migrations))

284 & pqThen (transactionally_ (downMigrations migrations))

287

285

288 where

286 where

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

404 liftIO $ displayRunned runNames >> displayUnrunned unrunNames

402 liftIO $ displayRunned runNames >> displayUnrunned unrunNames

405

403

406 suppressNotices :: PQ schema schema IO ()

404 suppressNotices :: PQ schema schema IO ()

407− suppressNotices = void . manipulate $

405+ suppressNotices = manipulate_ $

408 UnsafeManipulation "SET client_min_messages TO WARNING;"

406 UnsafeManipulation "SET client_min_messages TO WARNING;"

409

407

410 readCommandFromArgs :: IO (Maybe MigrateCommand)

408 readCommandFromArgs :: IO (Maybe MigrateCommand)

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

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

245 -> x -> pq schemas0 schemas2 m z

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

247

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

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

249 --

250+ -- It should be functorial in effect.

251+ --

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

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

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

251 define

254 define

252 :: MonadIO io

255 :: MonadIO io

253 => Definition schemas0 schemas1

256 => Definition schemas0 schemas1

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

257+ -> pq schemas0 schemas1 io ()

255

258

256instance IndexedMonadTransPQ PQ where

259instance IndexedMonadTransPQ PQ where

257

260

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

269 case resultMaybe of

272 case resultMaybe of

270 Nothing -> throw $ ResultException

273 Nothing -> throw $ ResultException

271 "define: LibPQ.exec returned no results"

274 "define: LibPQ.exec returned no results"

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

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

273

276

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

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

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

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

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

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

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

324 manipulate statement = manipulateParams statement ()

327 manipulate statement = manipulateParams statement ()

325

328

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

330+ manipulate_ = void . manipulate

331+

326 runQueryParams

332 runQueryParams

327 :: ToParams x params

333 :: ToParams x params

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

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

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

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

33 , DeferrableMode (..)

34 ) where

36−import Control.Monad

37import UnliftIO

36import UnliftIO

39import Squeal.PostgreSQL.Manipulation

38import Squeal.PostgreSQL.Manipulation

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

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

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

53 -> tx x

52 -> tx x

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

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

55− begin mode

54+ manipulate_ $ begin mode

56− result <- restore tx `onException` rollback

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

57− commit

56+ manipulate_ commit

58 return result

57 return result

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

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

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

81transactionallyRetry mode tx = mask $ \restore ->

80transactionallyRetry mode tx = mask $ \restore ->

82 loop . try $ do

81 loop . try $ do

83 x <- restore tx

82 x <- restore tx

84− commit

83+ manipulate_ commit

85 return x

84 return x

86 where

85 where

87 loop attempt = do

86 loop attempt = do

88− begin mode

87+ manipulate_ $ begin mode

89 attempt >>= \case

88 attempt >>= \case

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

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

91− rollback

90+ manipulate_ rollback

92 loop attempt

91 loop attempt

93 Left err -> do

92 Left err -> do

94− rollback

93+ manipulate_ rollback

95 throwIO err

94 throwIO err

96 Right x -> return x

95 Right x -> return x

98-- | @BEGIN@ a transaction.

97-- | @BEGIN@ a transaction.

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

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

100−begin mode = void . manipulate . UnsafeManipulation $

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

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

102

100

103-- | @COMMIT@ a transaction.

101-- | @COMMIT@ a transaction.

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

102+commit :: Manipulation_ schemas () ()

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

103+commit = UnsafeManipulation "COMMIT"

106

104

107-- | @ROLLBACK@ a transaction.

105-- | @ROLLBACK@ a transaction.

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

106+rollback :: Manipulation_ schemas () ()

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

107+rollback = UnsafeManipulation "ROLLBACK"

110

108

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

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

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

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