on dev help sign in
fixes?
12c531aEitan Chatav
squeal-postgresql/exe/Example.hs+5−1
@@ -122,7 +122,11 @@ main = do
122
122
123main2 :: IO ()
123main2 :: IO ()
124main2 = void $
124main2 = void $
125− withConnection "host=localhost port=5432 dbname=exampledb" . runPQ $
125+ withConnection "host=localhost port=5432 dbname=exampledb" . goPQ $
126 define setup
126 define setup
127 & pqThen session
127 & pqThen session
128 & thenDefine teardown
128 & thenDefine teardown
129+ where
130+ goPQ pq conn = do
131+ SOP.K x <- runPQ pq conn
132+ return (x, SOP.K (SOP.unK conn))
squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+5−5
@@ -17,7 +17,7 @@ import Control.Monad.Base
17import Control.Monad.Trans
17import Control.Monad.Trans
18import Control.Monad.Trans.Control
18import Control.Monad.Trans.Control
19import Data.Pool
19import Data.Pool
20−import Generics.SOP (K)
20+import Generics.SOP (K(..))
21
21
22import Squeal.PostgreSQL.PQ
22import Squeal.PostgreSQL.PQ
23import Squeal.PostgreSQL.Schema
23import Squeal.PostgreSQL.Schema
@@ -48,22 +48,22 @@ instance MonadBase b m => MonadBase b (PoolPQ schema m) where
48instance MonadBaseControl IO io => MonadPQ schema (PoolPQ schema io) where
48instance MonadBaseControl IO io => MonadPQ schema (PoolPQ schema io) where
49 manipulateParams manipulation params = PoolPQ $ \ pool -> do
49 manipulateParams manipulation params = PoolPQ $ \ pool -> do
50 withResource pool $ \ conn -> do
50 withResource pool $ \ conn -> do
51− (K result :: K Result schema) <- flip runPQ conn $
51+ (K result :: K (K Result ys) schema) <- flip runPQ conn $
52 manipulateParams manipulation params
52 manipulateParams manipulation params
53 return result
53 return result
54 traversePrepared manipulation params = PoolPQ $ \ pool ->
54 traversePrepared manipulation params = PoolPQ $ \ pool ->
55 withResource pool $ \ conn -> do
55 withResource pool $ \ conn -> do
56− (result :: K Result schema) <- flip runPQ conn $
56+ (K result :: K (list (K Result ys)) schema) <- flip runPQ conn $
57 traversePrepared manipulation params
57 traversePrepared manipulation params
58 return result
58 return result
59 traversePrepared_ manipulation params = PoolPQ $ \ pool -> do
59 traversePrepared_ manipulation params = PoolPQ $ \ pool -> do
60 withResource pool $ \ conn -> do
60 withResource pool $ \ conn -> do
61− (_ :: K Result schema) <- flip runPQ conn $
61+ (_ :: K () schema) <- flip runPQ conn $
62 traversePrepared_ manipulation params
62 traversePrepared_ manipulation params
63 return ()
63 return ()
64 liftPQ m = PoolPQ $ \ pool ->
64 liftPQ m = PoolPQ $ \ pool ->
65 withResource pool $ \ conn -> do
65 withResource pool $ \ conn -> do
66− (result :: K Result schema) <- flip runPQ conn $
66+ (K result :: K result schema) <- flip runPQ conn $
67 liftPQ m
67 liftPQ m
68 return result
68 return result
69
69
squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+7
@@ -16,6 +16,7 @@ module Squeal.PostgreSQL.Transaction
16 , begin
16 , begin
17 , commit
17 , commit
18 , rollback
18 , rollback
19+ , onExceptionRollback
19 , TransactionMode (..)
20 , TransactionMode (..)
20 , IsolationLevel (..)
21 , IsolationLevel (..)
21 , ReadWriteMode (..)
22 , ReadWriteMode (..)
@@ -27,6 +28,8 @@ import Data.ByteString
27import Data.Monoid
28import Data.Monoid
28import Generics.SOP
29import Generics.SOP
29
30
31+import qualified Database.PostgreSQL.LibPQ as LibPQ
32+
30import Squeal.PostgreSQL.Manipulation
33import Squeal.PostgreSQL.Manipulation
31import Squeal.PostgreSQL.Prettyprint
34import Squeal.PostgreSQL.Prettyprint
32import Squeal.PostgreSQL.PQ
35import Squeal.PostgreSQL.PQ
@@ -57,6 +60,10 @@ commit = manipulate $ UnsafeManipulation "COMMIT;"
57rollback :: MonadPQ schema tx => tx (K Result NilRelation)
60rollback :: MonadPQ schema tx => tx (K Result NilRelation)
58rollback = manipulate $ UnsafeManipulation "ROLLBACK;"
61rollback = manipulate $ UnsafeManipulation "ROLLBACK;"
59
62
63+onExceptionRollback :: PQ schema0 schema1 IO x -> PQ schema0 schema1 IO x
64+onExceptionRollback u = PQ $ \ conn -> mask $ \ restore ->
65+ restore (runPQ u conn) `onException` LibPQ.exec (unK conn) "ROLLBACK"
66+
60data TransactionMode = TransactionMode
67data TransactionMode = TransactionMode
61 { isolationLevel :: IsolationLevel
68 { isolationLevel :: IsolationLevel
62 , readWriteMode :: ReadWriteMode
69 , readWriteMode :: ReadWriteMode