git.iko.soy/project-m36
on cfa7253 help sign in
project-m36/src/lib/ProjectM36/Client/Simple.hs
129 lines 5.2 kB history raw
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2-- | A simplified client interface for Project:M36 database access.
3module ProjectM36.Client.Simple (
4 simpleConnectProjectM36,
5 simpleConnectProjectM36At,
6 withTransaction,
7 withTransactionUsing,
8 execute,
9 executeOrErr,
10 query,
11 queryOrErr,
12 cancelTransaction,
13 orCancelTransaction,
14 rollback,
15 close,
16 Atom(..),
17 AtomType(..),
18 Db,
19 DbConn,
20 DbError(..),
21 RelationalError(..),
22 Attribute(..),
23 C.Atomable(toAtom, fromAtom),
24 C.ConnectionInfo(..),
25 C.PersistenceStrategy(..),
26 C.NotificationCallback,
27 C.emptyNotificationCallback,
28 C.DatabaseContextExprBase(..),
29 C.DatabaseContextExpr,
30 C.RelationalExprBase(..)
31 ) where
33import Control.Exception.Base
34import Control.Monad ((<=<))
35import Control.Monad.Reader
36import ProjectM36.Base
37import qualified ProjectM36.Client as C
38import ProjectM36.Error
40type DbConn = (C.SessionId, C.Connection)
42newtype Db a = Db {runDb :: ReaderT DbConn IO a}
43 deriving (Functor, Applicative, Monad, MonadIO)
45-- This exception type should never be observable by the API users.
46-- It merely carries errors which end up as RelError at the end of a transaction.
47newtype TransactionCancelled = TransactionCancelled DbError deriving Show
48instance Exception TransactionCancelled
50-- | A simple alternative to 'connectProjectM36' which includes simple session management.
51simpleConnectProjectM36At :: HeadName -> C.ConnectionInfo -> IO (Either DbError DbConn)
52simpleConnectProjectM36At headName connInfo = do
53 eConn <- C.connectProjectM36 connInfo
54 case eConn of
55 Left err -> pure (Left (ConnError err))
56 Right conn -> do
57 eSess <- C.createSessionAtHead conn headName
58 case eSess of
59 Left err -> do
60 C.close conn
61 pure (Left (RelError err))
62 Right sess -> pure (Right (sess, conn))
64-- | Same as 'simpleConnectProjectM36At' but always connects to the @master@ branch.
65simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DbError DbConn)
66simpleConnectProjectM36 = simpleConnectProjectM36At "master"
68-- | Closes the database connection.
69close :: DbConn -> IO ()
70close (_ , conn) = C.close conn
72-- | 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.
73withTransaction :: DbConn -> Db a -> IO (Either DbError a)
74withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
76-- | Same as 'withTransaction' except that the merge strategy can be specified.
77withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
78withTransactionUsing (sess, conn) strat dbm = do
79 eHeadName <- C.headName sess conn
80 case eHeadName of
81 Left err -> pure (Left (RelError err))
82 Right headName -> do
83 let successFunc = C.autoMergeToHead sess conn strat headName
84 block = runReaderT (runDb dbm) (sess, conn)
85 handler :: TransactionCancelled -> IO (Either DbError a)
86 handler (TransactionCancelled err) = pure (Left err)
87 handle handler $ do
88 ret <- C.withTransaction sess conn (Right <$> block) successFunc
89 case ret of
90 Left err -> pure (Left (RelError err))
91 Right val -> pure (Right val)
93-- | A union of connection and other errors that can be returned from 'withTransaction'.
94data DbError = ConnError C.ConnectionError |
95 RelError RelationalError |
96 TransactionRolledBack
97 deriving (Eq, Show)
99-- | 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.
100execute :: C.DatabaseContextExpr -> Db ()
101execute = orCancelTransaction <=< executeOrErr
103-- | Run a 'RelationalExpr' query in the 'DB' monad. Relational expressions perform read-only queries against the current database state.
104query :: C.RelationalExpr -> Db Relation
105query = orCancelTransaction <=< queryOrErr
107-- | Run a 'DatabaseContextExpr' update expression. If there is an error, just return it without cancelling the current transaction.
108executeOrErr :: C.DatabaseContextExpr -> Db (Either RelationalError ())
109executeOrErr expr = Db $ do
110 (sess, conn) <- ask
111 lift $ C.executeDatabaseContextExpr sess conn expr
113-- | Run a 'RelationalExpr' query expression. If there is an error, just return it without cancelling the transaction.
114queryOrErr :: C.RelationalExpr -> Db (Either RelationalError Relation)
115queryOrErr expr = Db $ do
116 (sess, conn) <- ask
117 lift $ C.executeRelationalExpr sess conn expr
119-- | Unconditionally roll back the current transaction and throw an exception to terminate the execution of the Db monad.
120rollback :: Db ()
121rollback = cancelTransaction TransactionRolledBack
123-- | Cancel a transaction and carry some error information with it.
124cancelTransaction :: DbError -> Db a
125cancelTransaction err = liftIO $ throwIO (TransactionCancelled err)
127-- | Converts the 'Either' result from a 'Db' action into an immediate cancel in the case of error.
128orCancelTransaction :: Either RelationalError a -> Db a
129orCancelTransaction = either (cancelTransaction . RelError) pure