{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module ProjectM36.Client.Simple (
simpleConnectProjectM36,
simpleConnectProjectM36At,
withTransaction,
withTransactionUsing,
execute,
executeOrErr,
query,
queryOrErr,
cancelTransaction,
orCancelTransaction,
rollback,
close,
Atom(..),
AtomType(..),
Db,
DbConn,
DbError(..),
RelationalError(..),
Attribute(..),
C.Atomable(toAtom, fromAtom),
C.ConnectionInfo(..),
C.PersistenceStrategy(..),
C.NotificationCallback,
C.emptyNotificationCallback,
C.DatabaseContextExprBase(..),
C.DatabaseContextExpr,
C.RelationalExprBase(..)
) where
import Control.Exception.Base
import Control.Monad.Reader
import ProjectM36.Base
import qualified ProjectM36.Client as C
import ProjectM36.Error
type DbConn = (C.SessionId, C.Connection)
newtype Db a = Db {Db a -> ReaderT DbConn IO a
runDb :: ReaderT DbConn IO a}
deriving (a -> Db b -> Db a
(a -> b) -> Db a -> Db b
(forall a b. (a -> b) -> Db a -> Db b)
-> (forall a b. a -> Db b -> Db a) -> Functor Db
forall a b. a -> Db b -> Db a
forall a b. (a -> b) -> Db a -> Db b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Db b -> Db a
$c<$ :: forall a b. a -> Db b -> Db a
fmap :: (a -> b) -> Db a -> Db b
$cfmap :: forall a b. (a -> b) -> Db a -> Db b
Functor, Functor Db
a -> Db a
Functor Db
-> (forall a. a -> Db a)
-> (forall a b. Db (a -> b) -> Db a -> Db b)
-> (forall a b c. (a -> b -> c) -> Db a -> Db b -> Db c)
-> (forall a b. Db a -> Db b -> Db b)
-> (forall a b. Db a -> Db b -> Db a)
-> Applicative Db
Db a -> Db b -> Db b
Db a -> Db b -> Db a
Db (a -> b) -> Db a -> Db b
(a -> b -> c) -> Db a -> Db b -> Db c
forall a. a -> Db a
forall a b. Db a -> Db b -> Db a
forall a b. Db a -> Db b -> Db b
forall a b. Db (a -> b) -> Db a -> Db b
forall a b c. (a -> b -> c) -> Db a -> Db b -> Db c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Db a -> Db b -> Db a
$c<* :: forall a b. Db a -> Db b -> Db a
*> :: Db a -> Db b -> Db b
$c*> :: forall a b. Db a -> Db b -> Db b
liftA2 :: (a -> b -> c) -> Db a -> Db b -> Db c
$cliftA2 :: forall a b c. (a -> b -> c) -> Db a -> Db b -> Db c
<*> :: Db (a -> b) -> Db a -> Db b
$c<*> :: forall a b. Db (a -> b) -> Db a -> Db b
pure :: a -> Db a
$cpure :: forall a. a -> Db a
$cp1Applicative :: Functor Db
Applicative, Applicative Db
a -> Db a
Applicative Db
-> (forall a b. Db a -> (a -> Db b) -> Db b)
-> (forall a b. Db a -> Db b -> Db b)
-> (forall a. a -> Db a)
-> Monad Db
Db a -> (a -> Db b) -> Db b
Db a -> Db b -> Db b
forall a. a -> Db a
forall a b. Db a -> Db b -> Db b
forall a b. Db a -> (a -> Db b) -> Db b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Db a
$creturn :: forall a. a -> Db a
>> :: Db a -> Db b -> Db b
$c>> :: forall a b. Db a -> Db b -> Db b
>>= :: Db a -> (a -> Db b) -> Db b
$c>>= :: forall a b. Db a -> (a -> Db b) -> Db b
$cp1Monad :: Applicative Db
Monad, Monad Db
Monad Db -> (forall a. IO a -> Db a) -> MonadIO Db
IO a -> Db a
forall a. IO a -> Db a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Db a
$cliftIO :: forall a. IO a -> Db a
$cp1MonadIO :: Monad Db
MonadIO)
newtype TransactionCancelled = TransactionCancelled DbError deriving Int -> TransactionCancelled -> ShowS
[TransactionCancelled] -> ShowS
TransactionCancelled -> String
(Int -> TransactionCancelled -> ShowS)
-> (TransactionCancelled -> String)
-> ([TransactionCancelled] -> ShowS)
-> Show TransactionCancelled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactionCancelled] -> ShowS
$cshowList :: [TransactionCancelled] -> ShowS
show :: TransactionCancelled -> String
$cshow :: TransactionCancelled -> String
showsPrec :: Int -> TransactionCancelled -> ShowS
$cshowsPrec :: Int -> TransactionCancelled -> ShowS
Show
instance Exception TransactionCancelled
simpleConnectProjectM36At :: HeadName -> C.ConnectionInfo -> IO (Either DbError DbConn)
simpleConnectProjectM36At :: HeadName -> ConnectionInfo -> IO (Either DbError DbConn)
simpleConnectProjectM36At HeadName
headName ConnectionInfo
connInfo = do
Either ConnectionError Connection
eConn <- ConnectionInfo -> IO (Either ConnectionError Connection)
C.connectProjectM36 ConnectionInfo
connInfo
case Either ConnectionError Connection
eConn of
Left ConnectionError
err -> Either DbError DbConn -> IO (Either DbError DbConn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbError -> Either DbError DbConn
forall a b. a -> Either a b
Left (ConnectionError -> DbError
ConnError ConnectionError
err))
Right Connection
conn -> do
Either RelationalError SessionId
eSess <- Connection -> HeadName -> IO (Either RelationalError SessionId)
C.createSessionAtHead Connection
conn HeadName
headName
case Either RelationalError SessionId
eSess of
Left RelationalError
err -> do
Connection -> IO ()
C.close Connection
conn
Either DbError DbConn -> IO (Either DbError DbConn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbError -> Either DbError DbConn
forall a b. a -> Either a b
Left (RelationalError -> DbError
RelError RelationalError
err))
Right SessionId
sess -> Either DbError DbConn -> IO (Either DbError DbConn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbConn -> Either DbError DbConn
forall a b. b -> Either a b
Right (SessionId
sess, Connection
conn))
simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DbError DbConn)
simpleConnectProjectM36 :: ConnectionInfo -> IO (Either DbError DbConn)
simpleConnectProjectM36 = HeadName -> ConnectionInfo -> IO (Either DbError DbConn)
simpleConnectProjectM36At HeadName
"master"
close :: DbConn -> IO ()
close :: DbConn -> IO ()
close (SessionId
_ , Connection
conn) = Connection -> IO ()
C.close Connection
conn
withTransaction :: DbConn -> Db a -> IO (Either DbError a)
withTransaction :: DbConn -> Db a -> IO (Either DbError a)
withTransaction DbConn
sessconn = DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
forall a. DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
withTransactionUsing DbConn
sessconn MergeStrategy
UnionMergeStrategy
withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
withTransactionUsing (SessionId
sess, Connection
conn) MergeStrategy
strat Db a
dbm = do
Either RelationalError HeadName
eHeadName <- SessionId -> Connection -> IO (Either RelationalError HeadName)
C.headName SessionId
sess Connection
conn
case Either RelationalError HeadName
eHeadName of
Left RelationalError
err -> Either DbError a -> IO (Either DbError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbError -> Either DbError a
forall a b. a -> Either a b
Left (RelationalError -> DbError
RelError RelationalError
err))
Right HeadName
headName -> do
let successFunc :: IO (Either RelationalError ())
successFunc = SessionId
-> Connection
-> MergeStrategy
-> HeadName
-> IO (Either RelationalError ())
C.autoMergeToHead SessionId
sess Connection
conn MergeStrategy
strat HeadName
headName
block :: IO a
block = ReaderT DbConn IO a -> DbConn -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Db a -> ReaderT DbConn IO a
forall a. Db a -> ReaderT DbConn IO a
runDb Db a
dbm) (SessionId
sess, Connection
conn)
handler :: TransactionCancelled -> IO (Either DbError a)
handler :: TransactionCancelled -> IO (Either DbError a)
handler (TransactionCancelled DbError
err) = Either DbError a -> IO (Either DbError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbError -> Either DbError a
forall a b. a -> Either a b
Left DbError
err)
(TransactionCancelled -> IO (Either DbError a))
-> IO (Either DbError a) -> IO (Either DbError a)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle TransactionCancelled -> IO (Either DbError a)
forall a. TransactionCancelled -> IO (Either DbError a)
handler (IO (Either DbError a) -> IO (Either DbError a))
-> IO (Either DbError a) -> IO (Either DbError a)
forall a b. (a -> b) -> a -> b
$ do
Either RelationalError a
ret <- SessionId
-> Connection
-> IO (Either RelationalError a)
-> IO (Either RelationalError ())
-> IO (Either RelationalError a)
forall a.
SessionId
-> Connection
-> IO (Either RelationalError a)
-> IO (Either RelationalError ())
-> IO (Either RelationalError a)
C.withTransaction SessionId
sess Connection
conn (a -> Either RelationalError a
forall a b. b -> Either a b
Right (a -> Either RelationalError a)
-> IO a -> IO (Either RelationalError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
block) IO (Either RelationalError ())
successFunc
case Either RelationalError a
ret of
Left RelationalError
err -> Either DbError a -> IO (Either DbError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbError -> Either DbError a
forall a b. a -> Either a b
Left (RelationalError -> DbError
RelError RelationalError
err))
Right a
val -> Either DbError a -> IO (Either DbError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either DbError a
forall a b. b -> Either a b
Right a
val)
data DbError = ConnError C.ConnectionError |
RelError RelationalError |
TransactionRolledBack
deriving (DbError -> DbError -> Bool
(DbError -> DbError -> Bool)
-> (DbError -> DbError -> Bool) -> Eq DbError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DbError -> DbError -> Bool
$c/= :: DbError -> DbError -> Bool
== :: DbError -> DbError -> Bool
$c== :: DbError -> DbError -> Bool
Eq, Int -> DbError -> ShowS
[DbError] -> ShowS
DbError -> String
(Int -> DbError -> ShowS)
-> (DbError -> String) -> ([DbError] -> ShowS) -> Show DbError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DbError] -> ShowS
$cshowList :: [DbError] -> ShowS
show :: DbError -> String
$cshow :: DbError -> String
showsPrec :: Int -> DbError -> ShowS
$cshowsPrec :: Int -> DbError -> ShowS
Show)
execute :: C.DatabaseContextExpr -> Db ()
execute :: DatabaseContextExpr -> Db ()
execute = Either RelationalError () -> Db ()
forall a. Either RelationalError a -> Db a
orCancelTransaction (Either RelationalError () -> Db ())
-> (DatabaseContextExpr -> Db (Either RelationalError ()))
-> DatabaseContextExpr
-> Db ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DatabaseContextExpr -> Db (Either RelationalError ())
executeOrErr
query :: C.RelationalExpr -> Db Relation
query :: RelationalExpr -> Db Relation
query = Either RelationalError Relation -> Db Relation
forall a. Either RelationalError a -> Db a
orCancelTransaction (Either RelationalError Relation -> Db Relation)
-> (RelationalExpr -> Db (Either RelationalError Relation))
-> RelationalExpr
-> Db Relation
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< RelationalExpr -> Db (Either RelationalError Relation)
queryOrErr
executeOrErr :: C.DatabaseContextExpr -> Db (Either RelationalError ())
executeOrErr :: DatabaseContextExpr -> Db (Either RelationalError ())
executeOrErr DatabaseContextExpr
expr = ReaderT DbConn IO (Either RelationalError ())
-> Db (Either RelationalError ())
forall a. ReaderT DbConn IO a -> Db a
Db (ReaderT DbConn IO (Either RelationalError ())
-> Db (Either RelationalError ()))
-> ReaderT DbConn IO (Either RelationalError ())
-> Db (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ do
(SessionId
sess, Connection
conn) <- ReaderT DbConn IO DbConn
forall r (m :: * -> *). MonadReader r m => m r
ask
IO (Either RelationalError ())
-> ReaderT DbConn IO (Either RelationalError ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either RelationalError ())
-> ReaderT DbConn IO (Either RelationalError ()))
-> IO (Either RelationalError ())
-> ReaderT DbConn IO (Either RelationalError ())
forall a b. (a -> b) -> a -> b
$ SessionId
-> Connection
-> DatabaseContextExpr
-> IO (Either RelationalError ())
C.executeDatabaseContextExpr SessionId
sess Connection
conn DatabaseContextExpr
expr
queryOrErr :: C.RelationalExpr -> Db (Either RelationalError Relation)
queryOrErr :: RelationalExpr -> Db (Either RelationalError Relation)
queryOrErr RelationalExpr
expr = ReaderT DbConn IO (Either RelationalError Relation)
-> Db (Either RelationalError Relation)
forall a. ReaderT DbConn IO a -> Db a
Db (ReaderT DbConn IO (Either RelationalError Relation)
-> Db (Either RelationalError Relation))
-> ReaderT DbConn IO (Either RelationalError Relation)
-> Db (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ do
(SessionId
sess, Connection
conn) <- ReaderT DbConn IO DbConn
forall r (m :: * -> *). MonadReader r m => m r
ask
IO (Either RelationalError Relation)
-> ReaderT DbConn IO (Either RelationalError Relation)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either RelationalError Relation)
-> ReaderT DbConn IO (Either RelationalError Relation))
-> IO (Either RelationalError Relation)
-> ReaderT DbConn IO (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ SessionId
-> Connection
-> RelationalExpr
-> IO (Either RelationalError Relation)
C.executeRelationalExpr SessionId
sess Connection
conn RelationalExpr
expr
rollback :: Db ()
rollback :: Db ()
rollback = DbError -> Db ()
forall a. DbError -> Db a
cancelTransaction DbError
TransactionRolledBack
cancelTransaction :: DbError -> Db a
cancelTransaction :: DbError -> Db a
cancelTransaction DbError
err = IO a -> Db a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Db a) -> IO a -> Db a
forall a b. (a -> b) -> a -> b
$ TransactionCancelled -> IO a
forall e a. Exception e => e -> IO a
throwIO (DbError -> TransactionCancelled
TransactionCancelled DbError
err)
orCancelTransaction :: Either RelationalError a -> Db a
orCancelTransaction :: Either RelationalError a -> Db a
orCancelTransaction = (RelationalError -> Db a)
-> (a -> Db a) -> Either RelationalError a -> Db a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (DbError -> Db a
forall a. DbError -> Db a
cancelTransaction (DbError -> Db a)
-> (RelationalError -> DbError) -> RelationalError -> Db a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalError -> DbError
RelError) a -> Db a
forall (f :: * -> *) a. Applicative f => a -> f a
pure