git.iko.soy/squeal
on dev help sign in
bunch of things
commitff65b050a21cbd9ec65238319ece71f5a00a9f43 authorEitan Chatav <eitan.chatav@gmail.com> dateMon 5 Mar 2018, 22:56 (9 years ago) parentd8cece9
4 files changed+17−9
compare with dev
unifiedsplit
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+11−3 squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+4−4 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+2 squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs−2
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+11−3
@@ -1,5 +1,6 @@
11{-# LANGUAGE
22 ScopedTypeVariables
3+ , OverloadedStrings
34#-}
45
56module Squeal.PostgreSQL.Migration
@@ -9,9 +10,13 @@ module Squeal.PostgreSQL.Migration
910 ) where
1011
1112import Control.Category
12−-- import Control.Exception.Lifted
13+import Control.Exception.Lifted
14+import Control.Monad
1315import Data.Function ((&))
1416import Generics.SOP
17+import Prelude hiding (id, (.))
18+
19+import qualified Database.PostgreSQL.LibPQ as LibPQ
1520
1621import Squeal.PostgreSQL.PQ
1722import Squeal.PostgreSQL.Transaction
@@ -34,10 +39,13 @@ up
3439 -> IO (K MigrationResult schema1)
3540up (Migration mUp _) = runPQ $
3641 begin (TransactionMode RepeatableRead ReadWrite)
37− & pqThen mUp
38− & pqBind ( \ result -> do
42+ & pqThen (restorably mUp)
43+ & pqBind ( \ result ->
3944 commit >> return result
4045 )
46+ where
47+ restorably u = PQ $ \ conn -> mask $ \ restore ->
48+ restore (runPQ u conn) `onException` LibPQ.exec (unK conn) "ROLLBACK"
4149
4250data MigrationResult
4351 = MigrationSuccess
squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+4−4
@@ -48,22 +48,22 @@ instance MonadBase b m => MonadBase b (PoolPQ schema m) where
4848instance MonadBaseControl IO io => MonadPQ schema (PoolPQ schema io) where
4949 manipulateParams manipulation params = PoolPQ $ \ pool -> do
5050 withResource pool $ \ conn -> do
51− (result, _ :: K Connection schema) <- flip runPQ conn $
51+ (K result :: K Result schema) <- flip runPQ conn $
5252 manipulateParams manipulation params
5353 return result
5454 traversePrepared manipulation params = PoolPQ $ \ pool ->
5555 withResource pool $ \ conn -> do
56− (result, _ :: K Connection schema) <- flip runPQ conn $
56+ (result :: K Result schema) <- flip runPQ conn $
5757 traversePrepared manipulation params
5858 return result
5959 traversePrepared_ manipulation params = PoolPQ $ \ pool -> do
6060 withResource pool $ \ conn -> do
61− (_, _ :: K Connection schema) <- flip runPQ conn $
61+ (_ :: K Result schema) <- flip runPQ conn $
6262 traversePrepared_ manipulation params
6363 return ()
6464 liftPQ m = PoolPQ $ \ pool ->
6565 withResource pool $ \ conn -> do
66− (result, _ :: K Connection schema) <- flip runPQ conn $
66+ (result :: K Result schema) <- flip runPQ conn $
6767 liftPQ m
6868 return result
6969
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+2
@@ -41,6 +41,7 @@ module Squeal.PostgreSQL.Schema
4141 , ColumnType
4242 , ColumnsType
4343 , RelationType
44+ , NilRelation
4445 , RelationsType
4546 , TableType
4647 , TablesType
@@ -281,6 +282,7 @@ type TablesType = [(Symbol,TableType)]
281282-- >>> :kind Relation
282283-- Relation :: [(Symbol, NullityType)]
283284type RelationType = [(Symbol,NullityType)]
285+type family NilRelation :: RelationType where NilRelation = '[]
284286
285287-- | `RelationsType` is a row of `RelationType`s, thought of as a product.
286288type RelationsType = [(Symbol,RelationType)]
squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs−2
@@ -47,8 +47,6 @@ transactionally_
4747 => tx x -> tx x
4848transactionally_ = transactionally (TransactionMode ReadCommitted ReadWrite)
4949
50−type family NilRelation :: RelationType where NilRelation = '[]
51−
5250begin :: MonadPQ schema tx => TransactionMode -> tx (K Result NilRelation)
5351begin mode = manipulate . UnsafeManipulation $
5452 "BEGIN" <+> renderTransactionMode mode <> ";"