git.iko.soy/squeal
on dev help sign in
transactions
621a3e8Eitan Chatav
squeal-postgresql/squeal-postgresql.cabal+1
compare with dev
unifiedsplit
@@ -30,6 +30,7 @@ library
30 Squeal.PostgreSQL.Prettyprint
30 Squeal.PostgreSQL.Prettyprint
31 Squeal.PostgreSQL.Query
31 Squeal.PostgreSQL.Query
32 Squeal.PostgreSQL.Schema
32 Squeal.PostgreSQL.Schema
33+ Squeal.PostgreSQL.Transaction
33 default-language: Haskell2010
34 default-language: Haskell2010
34 ghc-options: -Wall -fprint-explicit-kinds
35 ghc-options: -Wall -fprint-explicit-kinds
35 build-depends:
36 build-depends:
squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hsnew file+85
@@ -0,0 +1,85 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , EmptyCase
4+ , FlexibleContexts
5+ , FlexibleInstances
6+ , LambdaCase
7+ , OverloadedStrings
8+ , MultiParamTypeClasses
9+#-}
10+
11+module Squeal.PostgreSQL.Transaction
12+ ( transactionally
13+ , transactionally_
14+ , begin
15+ , commit
16+ , rollback
17+ , TransactionMode (..)
18+ ) where
19+
20+import Control.Exception.Lifted
21+import Control.Monad.Trans.Control
22+import Data.ByteString
23+import Data.Monoid
24+
25+import Squeal.PostgreSQL.Manipulation
26+import Squeal.PostgreSQL.Prettyprint
27+import Squeal.PostgreSQL.PQ
28+
29+transactionally
30+ :: (MonadBaseControl IO tx, MonadPQ schema tx)
31+ => TransactionMode
32+ -> tx x -> tx x
33+transactionally mode tx = mask $ \restore -> do
34+ _ <- begin mode
35+ result <- restore tx `onException` rollback
36+ _ <- commit
37+ return result
38+
39+transactionally_
40+ :: (MonadBaseControl IO tx, MonadPQ schema tx)
41+ => tx x -> tx x
42+transactionally_ = transactionally (TransactionMode ReadCommitted ReadWrite)
43+
44+begin :: MonadPQ schema tx => TransactionMode -> tx (Result '[])
45+begin mode = manipulate . UnsafeManipulation $
46+ "BEGIN" <+> renderTransactionMode mode <> ";"
47+
48+commit :: MonadPQ schema tx => tx (Result '[])
49+commit = manipulate $ UnsafeManipulation "COMMIT;"
50+
51+rollback :: MonadPQ schema tx => tx (Result '[])
52+rollback = manipulate $ UnsafeManipulation "ROLLBACK;"
53+
54+data TransactionMode = TransactionMode
55+ { isolationLevel :: IsolationLevel
56+ , readWriteMode :: ReadWriteMode
57+ } deriving (Show, Eq)
58+
59+renderTransactionMode :: TransactionMode -> ByteString
60+renderTransactionMode mode =
61+ "ISOLATION LEVEL"
62+ <+> renderIsolationLevel (isolationLevel mode)
63+ <+> renderReadWriteMode (readWriteMode mode)
64+
65+data IsolationLevel
66+ = Serializable
67+ | RepeatableRead
68+ | ReadCommitted
69+ deriving (Show, Eq)
70+
71+renderIsolationLevel :: IsolationLevel -> ByteString
72+renderIsolationLevel = \case
73+ Serializable -> "SERIALIZABLE"
74+ ReadCommitted -> "READ COMMITTED"
75+ RepeatableRead -> "REPEATABLE READ"
76+
77+data ReadWriteMode
78+ = ReadWrite
79+ | ReadOnly
80+ deriving (Show, Eq)
81+
82+renderReadWriteMode :: ReadWriteMode -> ByteString
83+renderReadWriteMode = \case
84+ ReadWrite -> "READ WRITE"
85+ ReadOnly -> "READ ONLY"