@@ -2,15 +2,16 @@
2module ProjectM36.Client.Simple (
2module ProjectM36.Client.Simple (
3 withDBConnection,
3 withDBConnection,
4 withTransaction,
4 withTransaction,
5− executeDatabaseContextExpr,
5+ execute,
6− executeRelationalExpr,
6+ query,
8 AtomType(..),
9 AtomType(..),
9 DBError(..),
10 DBError(..),
10 Attribute(..),
11 Attribute(..),
11 C.ConnectionInfo(..),
12 C.ConnectionInfo(..),
12 C.PersistenceStrategy(..),
13 C.PersistenceStrategy(..),
13− C.NotificationCallback(..),
14+ C.NotificationCallback,
14 C.emptyNotificationCallback,
15 C.emptyNotificationCallback,
15 C.DatabaseContextExpr(..),
16 C.DatabaseContextExpr(..),
16 C.RelationalExprBase(..)
17 C.RelationalExprBase(..)
@@ -28,12 +29,12 @@ data DBError = ConnError C.ConnectionError |
28 deriving (Eq, Show)
29 deriving (Eq, Show)
30newtype DB a = DB {runDB :: ReaderT (C.SessionId, C.Connection) IO a}
31newtype DB a = DB {runDB :: ReaderT (C.SessionId, C.Connection) IO a}
31− deriving (Functor, Applicative, Monad, MonadIO)
32+ deriving (Functor, Applicative, Monad)
33-- | Opens a connection in the 'DB' monad and closes it after running the monad.
34-- | Opens a connection in the 'DB' monad and closes it after running the monad.
34withDBConnection :: C.ConnectionInfo -> DB (Either DBError a) -> IO (Either DBError a)
35withDBConnection :: C.ConnectionInfo -> DB (Either DBError a) -> IO (Either DBError a)
35withDBConnection connInfo block = bracket (C.connectProjectM36 connInfo) (\eConn -> case eConn of
36withDBConnection connInfo block = bracket (C.connectProjectM36 connInfo) (\eConn -> case eConn of
36− Left err -> pure (Right ())
37+ Left _ -> pure (Right ())
37 Right conn -> C.close conn >> pure (Right ())) $ \eConn -> do
38 Right conn -> C.close conn >> pure (Right ())) $ \eConn -> do
38 case eConn of
39 case eConn of
39 Left err -> pure (Left (ConnError err))
40 Left err -> pure (Left (ConnError err))
@@ -52,28 +53,34 @@ wrapClientIO func = DB $ do
52 Left err -> pure (Left (RelError err))
53 Left err -> pure (Left (RelError err))
53 Right val -> pure (Right val)
54 Right val -> pure (Right val)
55−-- | Atomically commits the result of the database context expression to disk on the server or restores the initial state.
56+-- | Atomically commits the result of the database context expressions to disk on the server or restores the initial state.
56−withTransaction :: C.DatabaseContextExpr -> DB (Either DBError ())
57+withTransaction :: [C.DatabaseContextExpr] -> DB (Either DBError ())
57−withTransaction expr = do
58+withTransaction exprs = do
58− ret <- executeDatabaseContextExpr expr
59+ ret <- execute (MultipleExpr exprs)
59 case ret of
60 case ret of
60 Left err -> pure (Left err)
61 Left err -> pure (Left err)
61 Right _ -> do
62 Right _ -> do
62 eCurrentHead <- wrapClientIO C.headName
63 eCurrentHead <- wrapClientIO C.headName
63 case eCurrentHead of
64 case eCurrentHead of
64 Left err -> pure (Left err)
65 Left err -> pure (Left err)
65− Right currentHead ->
66+ Right currentHead -> do
67+ --only add a commit if something actually changed
68+ eIsDirty <- wrapClientIO C.disconnectedTransactionIsDirty
70+ Left err -> pure (Left err)
66− wrapClientIO (\sess conn -> C.autoMergeToHead sess conn C.UnionMergeStrategy currentHead)
73+ wrapClientIO (\sess conn -> C.autoMergeToHead sess conn C.UnionMergeStrategy currentHead)
68-- | Execute a 'DatabaseContextExpr' in the 'DB' monad. Database context expressions manipulate the state of the database.
77-- | Execute a 'DatabaseContextExpr' in the 'DB' monad. Database context expressions manipulate the state of the database.
69−executeDatabaseContextExpr :: C.DatabaseContextExpr -> DB (Either DBError ())
78+execute :: C.DatabaseContextExpr -> DB (Either DBError ())
70−executeDatabaseContextExpr expr = DB $ do
72− eErr <- liftIO $ C.executeDatabaseContextExpr sess conn expr
79+execute expr = wrapClientIO (\sess conn -> C.executeDatabaseContextExpr sess conn expr)
74− Left err -> pure (Left (RelError err))
75− Right () -> pure (Right ())
77−-- | Execute a 'RelationalExpr' in the 'DB' monad. Relational expressions perform read-only queries against the current database state.
81+-- | Run a 'RelationalExpr' query in the 'DB' monad. Relational expressions perform read-only queries against the current database state.
78−executeRelationalExpr :: C.RelationalExpr -> DB (Either DBError Relation)
82+query :: C.RelationalExpr -> DB (Either DBError Relation)
79−executeRelationalExpr expr = wrapClientIO (\sess conn -> C.executeRelationalExpr sess conn expr)
83+query expr = wrapClientIO (\sess conn -> C.executeRelationalExpr sess conn expr)
85+rollback :: DB (Either DBError ())
86+rollback = wrapClientIO C.rollback