@@ -1,13 +1,19 @@
11{-# LANGUAGE GeneralizedNewtypeDeriving #-}
22module ProjectM36.Client.Simple (
33 simpleConnectProjectM36,
4+ simpleConnectProjectM36At,
45 withTransaction,
6+ withTransactionUsing,
57 execute,
8+ executeOrErr,
69 query,
10+ queryOrErr,
711 rollback,
812 close,
913 Atom(..),
1014 AtomType(..),
15+ Db,
16+ DbConn,
1117 DbError(..),
1218 Attribute(..),
1319 C.ConnectionInfo(..),
@@ -15,62 +21,67 @@ module ProjectM36.Client.Simple (
1521 C.NotificationCallback,
1622 C.emptyNotificationCallback,
1723 C.DatabaseContextExpr(..),
18− C.RelationalExprBase(..)
24+ C.RelationalExprBase(..)
1925 ) where
2026-- | A simplified client interface for Project:M36 database access.
21−import ProjectM36.Error
27+import Control.Exception.Base
28+import Control.Monad.Reader
2229import ProjectM36.Base
2330import qualified ProjectM36.Client as C
24−import Control.Monad.Reader
25−import Control.Exception.Base
31+import ProjectM36.Error
2632
2733type DbConn = (C.SessionId, C.Connection)
2834
29−newtype Db a = Db {runDB :: ReaderT DbConn IO a}
35+newtype Db a = Db {runDb :: ReaderT DbConn IO a}
3036 deriving (Functor, Applicative, Monad, MonadIO)
31−
37+
3238newtype TransactionCancelled = TransactionCancelled DbError deriving Show
3339instance Exception TransactionCancelled
3440
35−-- | A simple alternative to 'connectProjectM36' which includes simple session management
36−simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DbError DbConn)
37−simpleConnectProjectM36 connInfo = do
41+-- | A simple alternative to 'connectProjectM36' which includes simple session management.
42+simpleConnectProjectM36At :: HeadName -> C.ConnectionInfo -> IO (Either DbError DbConn)
43+simpleConnectProjectM36At headName connInfo = do
3844 eConn <- C.connectProjectM36 connInfo
3945 case eConn of
4046 Left err -> pure (Left (ConnError err))
4147 Right conn -> do
42− eSess <- C.createSessionAtHead conn "master"
48+ eSess <- C.createSessionAtHead conn headName
4349 case eSess of
4450 Left err -> do
4551 C.close conn
4652 pure (Left (RelError err))
4753 Right sess -> pure (Right (sess, conn))
48−
49−close :: DbConn -> IO ()
54+
55+-- | Same as 'simpleConnectProjectM36At' but always connects to the @master@ branch.
56+simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DbError DbConn)
57+simpleConnectProjectM36 = simpleConnectProjectM36At "master"
58+
59+-- | Closes the database connection.
60+close :: DbConn -> IO ()
5061close (_ , conn) = C.close conn
5162
5263-- | 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.
5364withTransaction :: DbConn -> Db a -> IO (Either DbError a)
54−withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
65+withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
5566
5667-- | Same a 'withTransaction' except that the merge strategy can be specified.
5768withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
5869withTransactionUsing (sess, conn) strat dbm = do
5970 eHeadName <- C.headName sess conn
60− case eHeadName of
71+ case eHeadName of
6172 Left err -> pure (Left (RelError err))
6273 Right headName -> do
6374 let successFunc = C.autoMergeToHead sess conn strat headName
64− block = runReaderT (runDB dbm) (sess, conn)
75+ block = runReaderT (runDb dbm) (sess, conn)
6576 handler :: TransactionCancelled -> IO (Either DbError a)
6677 handler (TransactionCancelled err) = pure (Left err)
6778 handle handler $ do
6879 ret <- C.withTransaction sess conn (block >>= pure . Right) successFunc
69− case ret of
70− Left err -> pure (Left (RelError err))
80+ case ret of
81+ Left err -> pure (Left (RelError err))
7182 Right val -> pure (Right val)
7283
73−-- | A union of connection and other errors that can be returned from 'withDBConnection'.
84+-- | A union of connection and other errors that can be returned from 'withTransaction'.
7485data DbError = ConnError C.ConnectionError |
7586 RelError RelationalError |
7687 TransactionRolledBack
@@ -82,22 +93,22 @@ execute expr = do
8293 ret <- executeOrErr expr
8394 case ret of
8495 Left err -> liftIO $ cancelTransaction (RelError err)
85− Right _ -> pure ()
86−
96+ Right _ -> pure ()
97+
8798-- | Run a 'RelationalExpr' query in the 'DB' monad. Relational expressions perform read-only queries against the current database state.
8899query :: C.RelationalExpr -> Db Relation
89100query expr = do
90101 ret <- queryOrErr expr
91102 case ret of
92− Left err -> liftIO $ cancelTransaction (RelError err)
103+ Left err -> liftIO $ cancelTransaction (RelError err)
93104 Right rel -> pure rel
94−
105+
95106-- | Run a 'DatabaseContextExpr' update expression. If there is an error, just return it without cancelling the current transaction.
96107executeOrErr :: C.DatabaseContextExpr -> Db (Either RelationalError ())
97108executeOrErr expr = Db $ do
98− (sess, conn) <- ask
109+ (sess, conn) <- ask
99110 lift $ C.executeDatabaseContextExpr sess conn expr
100−
111+
101112-- | Run a 'RelationalExpr' query expression. If there is an error, just return it without cancelling the transaction.
102113queryOrErr :: C.RelationalExpr -> Db (Either RelationalError Relation)
103114queryOrErr expr = Db $ do