@@ -8,7 +8,7 @@ module ProjectM36.Client.Simple (
10 AtomType(..),
10 AtomType(..),
11− DBError(..),
11+ DbError(..),
12 Attribute(..),
12 Attribute(..),
13 C.ConnectionInfo(..),
13 C.ConnectionInfo(..),
14 C.PersistenceStrategy(..),
14 C.PersistenceStrategy(..),
@@ -24,16 +24,16 @@ import qualified ProjectM36.Client as C
24import Control.Monad.Reader
24import Control.Monad.Reader
25import Control.Exception.Base
25import Control.Exception.Base
27−type DBConn = (C.SessionId, C.Connection)
27+type DbConn = (C.SessionId, C.Connection)
29−newtype DB a = DB {runDB :: ReaderT (C.SessionId, C.Connection) IO a}
29+newtype Db a = Db {runDB :: ReaderT DbConn IO a}
30− deriving (Functor, Applicative, Monad)
30+ deriving (Functor, Applicative, Monad, MonadIO)
32−newtype TransactionCancelled = TransactionCancelled DBError deriving Show
32+newtype TransactionCancelled = TransactionCancelled DbError deriving Show
33instance Exception TransactionCancelled
33instance Exception TransactionCancelled
35-- | A simple alternative to 'connectProjectM36' which includes simple session management
35-- | 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)
37simpleConnectProjectM36 connInfo = do
37simpleConnectProjectM36 connInfo = do
38 eConn <- C.connectProjectM36 connInfo
38 eConn <- C.connectProjectM36 connInfo
39 case eConn of
39 case eConn of
@@ -46,19 +46,23 @@ simpleConnectProjectM36 connInfo = do
46 pure (Left (RelError err))
46 pure (Left (RelError err))
47 Right sess -> pure (Right (sess, conn))
47 Right sess -> pure (Right (sess, conn))
49−close :: DBConn -> IO ()
49+close :: DbConn -> IO ()
50close (_ , conn) = C.close conn
50close (_ , conn) = C.close conn
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.
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)
53+withTransaction :: DbConn -> Db a -> IO (Either DbError a)
54−withTransaction (sess, conn) dbm = do
54+withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
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
55 eHeadName <- C.headName sess conn
59 eHeadName <- C.headName sess conn
56 case eHeadName of
60 case eHeadName of
57 Left err -> pure (Left (RelError err))
61 Left err -> pure (Left (RelError err))
58 Right headName -> do
62 Right headName -> do
59− let successFunc = C.autoMergeToHead sess conn UnionMergeStrategy headName
63+ let successFunc = C.autoMergeToHead sess conn strat headName
60 block = runReaderT (runDB dbm) (sess, conn)
64 block = runReaderT (runDB dbm) (sess, conn)
61− handler :: TransactionCancelled -> IO (Either DBError a)
65+ handler :: TransactionCancelled -> IO (Either DbError a)
62 handler (TransactionCancelled err) = pure (Left err)
66 handler (TransactionCancelled err) = pure (Left err)
63 handle handler $ do
67 handle handler $ do
64 ret <- C.withTransaction sess conn (block >>= pure . Right) successFunc
68 ret <- C.withTransaction sess conn (block >>= pure . Right) successFunc
@@ -67,32 +71,42 @@ withTransaction (sess, conn) dbm = do
67 Right val -> pure (Right val)
71 Right val -> pure (Right val)
69-- | A union of connection and other errors that can be returned from 'withDBConnection'.
73-- | 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 |
71 RelError RelationalError |
75 RelError RelationalError |
72 TransactionRolledBack
76 TransactionRolledBack
73 deriving (Eq, Show)
77 deriving (Eq, Show)
75-- | 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.
79-- | 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 ()
80+execute :: C.DatabaseContextExpr -> Db ()
77−execute expr = DB $ do
81+execute expr = do
78− (sess, conn) <- ask
82+ ret <- executeOrErr expr
79− ret <- liftIO $ C.executeDatabaseContextExpr sess conn expr
80 case ret of
83 case ret of
81 Left err -> liftIO $ cancelTransaction (RelError err)
84 Left err -> liftIO $ cancelTransaction (RelError err)
82 Right _ -> pure ()
85 Right _ -> pure ()
84-- | Run a 'RelationalExpr' query in the 'DB' monad. Relational expressions perform read-only queries against the current database state.
87-- | 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
88+query :: C.RelationalExpr -> Db Relation
86−query expr = DB $ do
89+query expr = do
87− (sess, conn) <- ask
90+ ret <- queryOrErr expr
88− ret <- lift $ C.executeRelationalExpr sess conn expr
89 case ret of
91 case ret of
90− Left err -> liftIO $ cancelTransaction (RelError err) >> error "impossible"
92+ Left err -> liftIO $ cancelTransaction (RelError err)
91 Right rel -> pure rel
93 Right rel -> pure rel
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
99+ lift $ C.executeDatabaseContextExpr sess conn expr
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
105+ lift $ C.executeRelationalExpr sess conn expr
93−-- | Unconditionally roll back the current transaction and throw an exception to terminate the execution of the DB monad.
107+-- | Unconditionally roll back the current transaction and throw an exception to terminate the execution of the Db monad.
94−rollback :: DB ()
108+rollback :: Db ()
95−rollback = DB $ lift $ cancelTransaction TransactionRolledBack
109+rollback = Db $ lift $ cancelTransaction TransactionRolledBack
97−cancelTransaction :: DBError -> IO ()
111+cancelTransaction :: DbError -> IO a
98cancelTransaction err = throwIO (TransactionCancelled err)
112cancelTransaction err = throwIO (TransactionCancelled err)