git.iko.soy/squeal
on dev help sign in
up
commitd8cece918af8c8ef5653c23ffab9a3528dd5c53f authorEitan Chatav <eitan.chatav@gmail.com> dateMon 5 Mar 2018, 21:45 (9 years ago) parent9300568
2 files changed+26−14
compare with dev
unifiedsplit
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+17−11 squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+9−3
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+17−11
@@ -1,15 +1,20 @@
1+{-# LANGUAGE
2+ ScopedTypeVariables
3+#-}
4+
15module Squeal.PostgreSQL.Migration
26 ( Migration
3−-- , up
7+ , up
48 , MigrationResult
59 ) where
610
711import Control.Category
812-- import Control.Exception.Lifted
913import Data.Function ((&))
14+import Generics.SOP
1015
1116import Squeal.PostgreSQL.PQ
12−-- import Squeal.PostgreSQL.Transaction
17+import Squeal.PostgreSQL.Transaction
1318
1419data Migration schema0 schema1 = Migration
1520 { migrateUp :: PQ schema0 schema1 IO MigrationResult
@@ -23,15 +28,16 @@ instance Category Migration where
2328 , migrateDown = migrateDown migration1 & pqThen (migrateDown migration0)
2429 }
2530
26−-- up
27−-- :: Migration schema0 schema1
28−-- -> Connection schema0
29−-- -> IO (MigrationResult, Connection schema1)
30−-- up (Migration mUp _) conn0 = do
31−-- (begin _conn0) <- runPQ (begin (TransactionMode ReadCommitted ReadWrite)) conn0
32−-- & pqThen (Prelude.id mUp `onException` rollback)
33−-- & pqBind (\ result ->
34−-- commit & pqThen (return result))
31+up
32+ :: Migration schema0 schema1
33+ -> K Connection schema0
34+ -> IO (K MigrationResult schema1)
35+up (Migration mUp _) = runPQ $
36+ begin (TransactionMode RepeatableRead ReadWrite)
37+ & pqThen mUp
38+ & pqBind ( \ result -> do
39+ commit >> return result
40+ )
3541
3642data MigrationResult
3743 = MigrationSuccess
squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+9−3
@@ -6,6 +6,8 @@
66 , LambdaCase
77 , OverloadedStrings
88 , MultiParamTypeClasses
9+ , TypeFamilies
10+ , TypeInType
911#-}
1012
1113module Squeal.PostgreSQL.Transaction
@@ -23,10 +25,12 @@ import Control.Exception.Lifted
2325import Control.Monad.Trans.Control
2426import Data.ByteString
2527import Data.Monoid
28+import Generics.SOP
2629
2730import Squeal.PostgreSQL.Manipulation
2831import Squeal.PostgreSQL.Prettyprint
2932import Squeal.PostgreSQL.PQ
33+import Squeal.PostgreSQL.Schema
3034
3135transactionally
3236 :: (MonadBaseControl IO tx, MonadPQ schema tx)
@@ -43,14 +47,16 @@ transactionally_
4347 => tx x -> tx x
4448transactionally_ = transactionally (TransactionMode ReadCommitted ReadWrite)
4549
46−begin :: MonadPQ schema tx => TransactionMode -> tx (Result '[])
50+type family NilRelation :: RelationType where NilRelation = '[]
51+
52+begin :: MonadPQ schema tx => TransactionMode -> tx (K Result NilRelation)
4753begin mode = manipulate . UnsafeManipulation $
4854 "BEGIN" <+> renderTransactionMode mode <> ";"
4955
50−commit :: MonadPQ schema tx => tx (Result '[])
56+commit :: MonadPQ schema tx => tx (K Result NilRelation)
5157commit = manipulate $ UnsafeManipulation "COMMIT;"
5258
53−rollback :: MonadPQ schema tx => tx (Result '[])
59+rollback :: MonadPQ schema tx => tx (K Result NilRelation)
5460rollback = manipulate $ UnsafeManipulation "ROLLBACK;"
5561
5662data TransactionMode = TransactionMode