@@ -1,76 +1,95 @@
11{-# LANGUAGE GeneralizedNewtypeDeriving #-}
22module ProjectM36.Client.Simple (
33 simpleConnectProjectM36,
4+ simpleConnectProjectM36At,
45 withTransaction,
6+ withTransactionUsing,
57 execute,
8+ executeOrErr,
69 query,
10+ queryOrErr,
11+ cancelTransaction,
12+ orCancelTransaction,
713 rollback,
814 close,
915 Atom(..),
1016 AtomType(..),
17+ Db,
18+ DbConn,
1119 DbError(..),
20+ RelationalError(..),
1221 Attribute(..),
22+ C.Atomable(toAtom, fromAtom),
1323 C.ConnectionInfo(..),
1424 C.PersistenceStrategy(..),
1525 C.NotificationCallback,
1626 C.emptyNotificationCallback,
1727 C.DatabaseContextExpr(..),
18− C.RelationalExprBase(..)
28+ C.RelationalExprBase(..)
1929 ) where
2030-- | A simplified client interface for Project:M36 database access.
21−import ProjectM36.Error
31+
32+import Control.Exception.Base
33+import Control.Monad ((<=<))
34+import Control.Monad.Reader
2235import ProjectM36.Base
2336import qualified ProjectM36.Client as C
24−import Control.Monad.Reader
25−import Control.Exception.Base
37+import ProjectM36.Error
2638
2739type DbConn = (C.SessionId, C.Connection)
2840
29−newtype Db a = Db {runDB :: ReaderT DbConn IO a}
41+newtype Db a = Db {runDb :: ReaderT DbConn IO a}
3042 deriving (Functor, Applicative, Monad, MonadIO)
31−
43+
44+-- This exception type should never be observable by the API users.
45+-- It merely carries errors which end up as RelError at the end of a transaction.
3246newtype TransactionCancelled = TransactionCancelled DbError deriving Show
3347instance Exception TransactionCancelled
3448
35−-- | A simple alternative to 'connectProjectM36' which includes simple session management
36−simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DbError DbConn)
37−simpleConnectProjectM36 connInfo = do
49+-- | A simple alternative to 'connectProjectM36' which includes simple session management.
50+simpleConnectProjectM36At :: HeadName -> C.ConnectionInfo -> IO (Either DbError DbConn)
51+simpleConnectProjectM36At headName connInfo = do
3852 eConn <- C.connectProjectM36 connInfo
3953 case eConn of
4054 Left err -> pure (Left (ConnError err))
4155 Right conn -> do
42− eSess <- C.createSessionAtHead conn "master"
56+ eSess <- C.createSessionAtHead conn headName
4357 case eSess of
4458 Left err -> do
4559 C.close conn
4660 pure (Left (RelError err))
4761 Right sess -> pure (Right (sess, conn))
48−
49−close :: DbConn -> IO ()
62+
63+-- | Same as 'simpleConnectProjectM36At' but always connects to the @master@ branch.
64+simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DbError DbConn)
65+simpleConnectProjectM36 = simpleConnectProjectM36At "master"
66+
67+-- | Closes the database connection.
68+close :: DbConn -> IO ()
5069close (_ , conn) = C.close conn
5170
5271-- | 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.
5372withTransaction :: DbConn -> Db a -> IO (Either DbError a)
54−withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
73+withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
5574
5675-- | Same a 'withTransaction' except that the merge strategy can be specified.
5776withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
5877withTransactionUsing (sess, conn) strat dbm = do
5978 eHeadName <- C.headName sess conn
60− case eHeadName of
79+ case eHeadName of
6180 Left err -> pure (Left (RelError err))
6281 Right headName -> do
6382 let successFunc = C.autoMergeToHead sess conn strat headName
64− block = runReaderT (runDB dbm) (sess, conn)
83+ block = runReaderT (runDb dbm) (sess, conn)
6584 handler :: TransactionCancelled -> IO (Either DbError a)
6685 handler (TransactionCancelled err) = pure (Left err)
6786 handle handler $ do
6887 ret <- C.withTransaction sess conn (block >>= pure . Right) successFunc
69− case ret of
70− Left err -> pure (Left (RelError err))
88+ case ret of
89+ Left err -> pure (Left (RelError err))
7190 Right val -> pure (Right val)
7291
73−-- | A union of connection and other errors that can be returned from 'withDBConnection'.
92+-- | A union of connection and other errors that can be returned from 'withTransaction'.
7493data DbError = ConnError C.ConnectionError |
7594 RelError RelationalError |
7695 TransactionRolledBack
@@ -78,26 +97,18 @@ data DbError = ConnError C.ConnectionError |
7897
7998-- | 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.
8099execute :: C.DatabaseContextExpr -> Db ()
81−execute expr = do
82− ret <- executeOrErr expr
83− case ret of
84− Left err -> liftIO $ cancelTransaction (RelError err)
85− Right _ -> pure ()
86−
100+execute = orCancelTransaction <=< executeOrErr
101+
87102-- | Run a 'RelationalExpr' query in the 'DB' monad. Relational expressions perform read-only queries against the current database state.
88103query :: C.RelationalExpr -> Db Relation
89−query expr = do
90− ret <- queryOrErr expr
91− case ret of
92− Left err -> liftIO $ cancelTransaction (RelError err)
93− Right rel -> pure rel
94−
104+query = orCancelTransaction <=< queryOrErr
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
@@ -106,7 +117,12 @@ queryOrErr expr = Db $ do
106117
107118-- | Unconditionally roll back the current transaction and throw an exception to terminate the execution of the Db monad.
108119rollback :: Db ()
109−rollback = Db $ lift $ cancelTransaction TransactionRolledBack
120+rollback = cancelTransaction TransactionRolledBack
121+
122+-- | Cancel a transaction and carry some error information with it.
123+cancelTransaction :: DbError -> Db a
124+cancelTransaction err = liftIO $ throwIO (TransactionCancelled err)
110125
111−cancelTransaction :: DbError -> IO a
112−cancelTransaction err = throwIO (TransactionCancelled err)
126+-- | Converts the 'Either' result from a 'Db' action into an immediate cancel in the case of error.
127+orCancelTransaction :: Either RelationalError a -> Db a
128+orCancelTransaction = either (cancelTransaction . RelError) pure