git.iko.soy/squeal
on dev help sign in
up
d8cece9Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+17−11
compare with dev
unifiedsplit
@@ -1,15 +1,20 @@
1+{-# LANGUAGE
2+ ScopedTypeVariables
3+#-}
4+
1module Squeal.PostgreSQL.Migration
5module Squeal.PostgreSQL.Migration
2 ( Migration
6 ( Migration
3−-- , up
7+ , up
4 , MigrationResult
8 , MigrationResult
5 ) where
9 ) where
6
10
7import Control.Category
11import Control.Category
8-- import Control.Exception.Lifted
12-- import Control.Exception.Lifted
9import Data.Function ((&))
13import Data.Function ((&))
14+import Generics.SOP
10
15
11import Squeal.PostgreSQL.PQ
16import Squeal.PostgreSQL.PQ
12−-- import Squeal.PostgreSQL.Transaction
17+import Squeal.PostgreSQL.Transaction
13
18
14data Migration schema0 schema1 = Migration
19data Migration schema0 schema1 = Migration
15 { migrateUp :: PQ schema0 schema1 IO MigrationResult
20 { migrateUp :: PQ schema0 schema1 IO MigrationResult
@@ -23,15 +28,16 @@ instance Category Migration where
23 , migrateDown = migrateDown migration1 & pqThen (migrateDown migration0)
28 , migrateDown = migrateDown migration1 & pqThen (migrateDown migration0)
24 }
29 }
25
30
26−-- up
31+up
27−-- :: Migration schema0 schema1
32+ :: Migration schema0 schema1
28−-- -> Connection schema0
33+ -> K Connection schema0
29−-- -> IO (MigrationResult, Connection schema1)
34+ -> IO (K MigrationResult schema1)
30−-- up (Migration mUp _) conn0 = do
35+up (Migration mUp _) = runPQ $
31−-- (begin _conn0) <- runPQ (begin (TransactionMode ReadCommitted ReadWrite)) conn0
36+ begin (TransactionMode RepeatableRead ReadWrite)
32−-- & pqThen (Prelude.id mUp `onException` rollback)
37+ & pqThen mUp
33−-- & pqBind (\ result ->
38+ & pqBind ( \ result -> do
34−-- commit & pqThen (return result))
39+ commit >> return result
40+ )
35
41
36data MigrationResult
42data MigrationResult
37 = MigrationSuccess
43 = MigrationSuccess
squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+9−3
@@ -6,6 +6,8 @@
6 , LambdaCase
6 , LambdaCase
7 , OverloadedStrings
7 , OverloadedStrings
8 , MultiParamTypeClasses
8 , MultiParamTypeClasses
9+ , TypeFamilies
10+ , TypeInType
9#-}
11#-}
10
12
11module Squeal.PostgreSQL.Transaction
13module Squeal.PostgreSQL.Transaction
@@ -23,10 +25,12 @@ import Control.Exception.Lifted
23import Control.Monad.Trans.Control
25import Control.Monad.Trans.Control
24import Data.ByteString
26import Data.ByteString
25import Data.Monoid
27import Data.Monoid
28+import Generics.SOP
26
29
27import Squeal.PostgreSQL.Manipulation
30import Squeal.PostgreSQL.Manipulation
28import Squeal.PostgreSQL.Prettyprint
31import Squeal.PostgreSQL.Prettyprint
29import Squeal.PostgreSQL.PQ
32import Squeal.PostgreSQL.PQ
33+import Squeal.PostgreSQL.Schema
30
34
31transactionally
35transactionally
32 :: (MonadBaseControl IO tx, MonadPQ schema tx)
36 :: (MonadBaseControl IO tx, MonadPQ schema tx)
@@ -43,14 +47,16 @@ transactionally_
43 => tx x -> tx x
47 => tx x -> tx x
44transactionally_ = transactionally (TransactionMode ReadCommitted ReadWrite)
48transactionally_ = transactionally (TransactionMode ReadCommitted ReadWrite)
45
49
50+type family NilRelation :: RelationType where NilRelation = '[]
51+
46−begin :: MonadPQ schema tx => TransactionMode -> tx (Result '[])
52+begin :: MonadPQ schema tx => TransactionMode -> tx (K Result NilRelation)
47begin mode = manipulate . UnsafeManipulation $
53begin mode = manipulate . UnsafeManipulation $
48 "BEGIN" <+> renderTransactionMode mode <> ";"
54 "BEGIN" <+> renderTransactionMode mode <> ";"
49
55
50−commit :: MonadPQ schema tx => tx (Result '[])
56+commit :: MonadPQ schema tx => tx (K Result NilRelation)
51commit = manipulate $ UnsafeManipulation "COMMIT;"
57commit = manipulate $ UnsafeManipulation "COMMIT;"
52
58
53−rollback :: MonadPQ schema tx => tx (Result '[])
59+rollback :: MonadPQ schema tx => tx (K Result NilRelation)
54rollback = manipulate $ UnsafeManipulation "ROLLBACK;"
60rollback = manipulate $ UnsafeManipulation "ROLLBACK;"
55
61
56data TransactionMode = TransactionMode
62data TransactionMode = TransactionMode