@@ -8,7 +8,7 @@ module ProjectM36.Client.Simple (
88 close,
99 Atom(..),
1010 AtomType(..),
11− DBError(..),
11+ DbError(..),
1212 Attribute(..),
1313 C.ConnectionInfo(..),
1414 C.PersistenceStrategy(..),
@@ -24,16 +24,16 @@ import qualified ProjectM36.Client as C
2424import Control.Monad.Reader
2525import Control.Exception.Base
2626
27−type DBConn = (C.SessionId, C.Connection)
27+type DbConn = (C.SessionId, C.Connection)
2828
29−newtype DB a = DB {runDB :: ReaderT (C.SessionId, C.Connection) IO a}
30− deriving (Functor, Applicative, Monad)
29+newtype Db a = Db {runDB :: ReaderT DbConn IO a}
30+ deriving (Functor, Applicative, Monad, MonadIO)
3131
32−newtype TransactionCancelled = TransactionCancelled DBError deriving Show
32+newtype TransactionCancelled = TransactionCancelled DbError deriving Show
3333instance Exception TransactionCancelled
3434
3535-- | A simple alternative to 'connectProjectM36' which includes simple session management
36−simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DBError DBConn)
36+simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DbError DbConn)
3737simpleConnectProjectM36 connInfo = do
3838 eConn <- C.connectProjectM36 connInfo
3939 case eConn of
@@ -46,19 +46,23 @@ simpleConnectProjectM36 connInfo = do
4646 pure (Left (RelError err))
4747 Right sess -> pure (Right (sess, conn))
4848
49−close :: DBConn -> IO ()
49+close :: DbConn -> IO ()
5050close (_ , conn) = C.close conn
5151
52−-- | Runs an IO monad which may include some database updates. If an exception or error occurs, the transaction is rolled back. Otherwise, the transaction is committed.
53−withTransaction :: DBConn -> DB a -> IO (Either DBError a)
54−withTransaction (sess, conn) dbm = do
52+-- | Runs a Db monad which may include some database updates. If an exception or error occurs, the transaction is rolled back. Otherwise, the transaction is committed to the head of the current branch.
53+withTransaction :: DbConn -> Db a -> IO (Either DbError a)
54+withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
55+
56+-- | Same a 'withTransaction' except that the merge strategy can be specified.
57+withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
58+withTransactionUsing (sess, conn) strat dbm = do
5559 eHeadName <- C.headName sess conn
5660 case eHeadName of
5761 Left err -> pure (Left (RelError err))
5862 Right headName -> do
59− let successFunc = C.autoMergeToHead sess conn UnionMergeStrategy headName
63+ let successFunc = C.autoMergeToHead sess conn strat headName
6064 block = runReaderT (runDB dbm) (sess, conn)
61− handler :: TransactionCancelled -> IO (Either DBError a)
65+ handler :: TransactionCancelled -> IO (Either DbError a)
6266 handler (TransactionCancelled err) = pure (Left err)
6367 handle handler $ do
6468 ret <- C.withTransaction sess conn (block >>= pure . Right) successFunc
@@ -67,32 +71,42 @@ withTransaction (sess, conn) dbm = do
6771 Right val -> pure (Right val)
6872
6973-- | A union of connection and other errors that can be returned from 'withDBConnection'.
70−data DBError = ConnError C.ConnectionError |
74+data DbError = ConnError C.ConnectionError |
7175 RelError RelationalError |
7276 TransactionRolledBack
7377 deriving (Eq, Show)
7478
7579-- | Execute a 'DatabaseContextExpr' in the 'DB' monad. Database context expressions manipulate the state of the database. In case of an error, the transaction is terminated and the connection's session is rolled back.
76−execute :: C.DatabaseContextExpr -> DB ()
77−execute expr = DB $ do
78− (sess, conn) <- ask
79− ret <- liftIO $ C.executeDatabaseContextExpr sess conn expr
80+execute :: C.DatabaseContextExpr -> Db ()
81+execute expr = do
82+ ret <- executeOrErr expr
8083 case ret of
8184 Left err -> liftIO $ cancelTransaction (RelError err)
8285 Right _ -> pure ()
8386
8487-- | Run a 'RelationalExpr' query in the 'DB' monad. Relational expressions perform read-only queries against the current database state.
85−query :: C.RelationalExpr -> DB Relation
86−query expr = DB $ do
87− (sess, conn) <- ask
88− ret <- lift $ C.executeRelationalExpr sess conn expr
88+query :: C.RelationalExpr -> Db Relation
89+query expr = do
90+ ret <- queryOrErr expr
8991 case ret of
90− Left err -> liftIO $ cancelTransaction (RelError err) >> error "impossible"
92+ Left err -> liftIO $ cancelTransaction (RelError err)
9193 Right rel -> pure rel
94+
95+-- | Run a 'DatabaseContextExpr' update expression. If there is an error, just return it without cancelling the current transaction.
96+executeOrErr :: C.DatabaseContextExpr -> Db (Either RelationalError ())
97+executeOrErr expr = Db $ do
98+ (sess, conn) <- ask
99+ lift $ C.executeDatabaseContextExpr sess conn expr
100+
101+-- | Run a 'RelationalExpr' query expression. If there is an error, just return it without cancelling the transaction.
102+queryOrErr :: C.RelationalExpr -> Db (Either RelationalError Relation)
103+queryOrErr expr = Db $ do
104+ (sess, conn) <- ask
105+ lift $ C.executeRelationalExpr sess conn expr
92106
93−-- | Unconditionally roll back the current transaction and throw an exception to terminate the execution of the DB monad.
94−rollback :: DB ()
95−rollback = DB $ lift $ cancelTransaction TransactionRolledBack
107+-- | Unconditionally roll back the current transaction and throw an exception to terminate the execution of the Db monad.
108+rollback :: Db ()
109+rollback = Db $ lift $ cancelTransaction TransactionRolledBack
96110
97−cancelTransaction :: DBError -> IO ()
111+cancelTransaction :: DbError -> IO a
98112cancelTransaction err = throwIO (TransactionCancelled err)