git.iko.soy/squeal
on dev help sign in
bunch of things
ff65b05Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+11−3
compare with dev
unifiedsplit
@@ -1,5 +1,6 @@
1{-# LANGUAGE
1{-# LANGUAGE
2 ScopedTypeVariables
2 ScopedTypeVariables
3+ , OverloadedStrings
3#-}
4#-}
4
5
5module Squeal.PostgreSQL.Migration
6module Squeal.PostgreSQL.Migration
@@ -9,9 +10,13 @@ module Squeal.PostgreSQL.Migration
9 ) where
10 ) where
10
11
11import Control.Category
12import Control.Category
12−-- import Control.Exception.Lifted
13+import Control.Exception.Lifted
14+import Control.Monad
13import Data.Function ((&))
15import Data.Function ((&))
14import Generics.SOP
16import Generics.SOP
17+import Prelude hiding (id, (.))
18+
19+import qualified Database.PostgreSQL.LibPQ as LibPQ
15
20
16import Squeal.PostgreSQL.PQ
21import Squeal.PostgreSQL.PQ
17import Squeal.PostgreSQL.Transaction
22import Squeal.PostgreSQL.Transaction
@@ -34,10 +39,13 @@ up
34 -> IO (K MigrationResult schema1)
39 -> IO (K MigrationResult schema1)
35up (Migration mUp _) = runPQ $
40up (Migration mUp _) = runPQ $
36 begin (TransactionMode RepeatableRead ReadWrite)
41 begin (TransactionMode RepeatableRead ReadWrite)
37− & pqThen mUp
42+ & pqThen (restorably mUp)
38− & pqBind ( \ result -> do
43+ & pqBind ( \ result ->
39 commit >> return result
44 commit >> return result
40 )
45 )
46+ where
47+ restorably u = PQ $ \ conn -> mask $ \ restore ->
48+ restore (runPQ u conn) `onException` LibPQ.exec (unK conn) "ROLLBACK"
41
49
42data MigrationResult
50data MigrationResult
43 = MigrationSuccess
51 = MigrationSuccess
squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+4−4
@@ -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− (result, _ :: K Connection schema) <- flip runPQ conn $
51+ (K result :: K Result 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 Connection schema) <- flip runPQ conn $
56+ (result :: K Result 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 Connection schema) <- flip runPQ conn $
61+ (_ :: K Result 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 Connection schema) <- flip runPQ conn $
66+ (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/Schema.hs+2
@@ -41,6 +41,7 @@ module Squeal.PostgreSQL.Schema
41 , ColumnType
41 , ColumnType
42 , ColumnsType
42 , ColumnsType
43 , RelationType
43 , RelationType
44+ , NilRelation
44 , RelationsType
45 , RelationsType
45 , TableType
46 , TableType
46 , TablesType
47 , TablesType
@@ -281,6 +282,7 @@ type TablesType = [(Symbol,TableType)]
281-- >>> :kind Relation
282-- >>> :kind Relation
282-- Relation :: [(Symbol, NullityType)]
283-- Relation :: [(Symbol, NullityType)]
283type RelationType = [(Symbol,NullityType)]
284type RelationType = [(Symbol,NullityType)]
285+type family NilRelation :: RelationType where NilRelation = '[]
284
286
285-- | `RelationsType` is a row of `RelationType`s, thought of as a product.
287-- | `RelationsType` is a row of `RelationType`s, thought of as a product.
286type RelationsType = [(Symbol,RelationType)]
288type RelationsType = [(Symbol,RelationType)]
squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs−2
@@ -47,8 +47,6 @@ transactionally_
47 => tx x -> tx x
47 => tx x -> tx x
48transactionally_ = transactionally (TransactionMode ReadCommitted ReadWrite)
48transactionally_ = transactionally (TransactionMode ReadCommitted ReadWrite)
49
49
50−type family NilRelation :: RelationType where NilRelation = '[]
51−
52begin :: MonadPQ schema tx => TransactionMode -> tx (K Result NilRelation)
50begin :: MonadPQ schema tx => TransactionMode -> tx (K Result NilRelation)
53begin mode = manipulate . UnsafeManipulation $
51begin mode = manipulate . UnsafeManipulation $
54 "BEGIN" <+> renderTransactionMode mode <> ";"
52 "BEGIN" <+> renderTransactionMode mode <> ";"