{-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-}
-- | A simplified client interface for Project:M36 database access.
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
#if MIN_VERSION_base(4,18,0)
import Control.Monad ((<=<))
#endif
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 {forall a. Db a -> ReaderT DbConn IO a
runDb :: ReaderT DbConn IO a}
  deriving (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
<$ :: forall a b. a -> Db b -> Db a
$c<$ :: forall a b. a -> Db b -> Db a
fmap :: forall a b. (a -> b) -> Db a -> Db b
$cfmap :: forall a b. (a -> b) -> Db a -> Db b
Functor, Functor Db
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
<* :: forall a b. Db a -> Db b -> Db a
$c<* :: forall a b. Db a -> Db b -> Db a
*> :: forall a b. Db a -> Db b -> Db b
$c*> :: forall a b. Db a -> Db b -> Db b
liftA2 :: forall a b c. (a -> b -> c) -> Db a -> Db b -> Db c
$cliftA2 :: forall a b c. (a -> b -> c) -> Db a -> Db b -> Db c
<*> :: forall a b. Db (a -> b) -> Db a -> Db b
$c<*> :: forall a b. Db (a -> b) -> Db a -> Db b
pure :: forall a. a -> Db a
$cpure :: forall a. a -> Db a
Applicative, Applicative Db
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 :: forall a. a -> Db a
$creturn :: forall a. a -> Db a
>> :: forall a b. Db a -> Db b -> Db b
$c>> :: forall a b. Db a -> Db b -> Db b
>>= :: forall a b. Db a -> (a -> Db b) -> Db b
$c>>= :: forall a b. Db a -> (a -> Db b) -> Db b
Monad, Monad Db
forall a. IO a -> Db a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Db a
$cliftIO :: forall a. IO a -> Db a
MonadIO)

-- This exception type should never be observable by the API users.
-- It merely carries errors which end up as RelError at the end of a transaction.
newtype TransactionCancelled = TransactionCancelled DbError deriving Int -> TransactionCancelled -> ShowS
[TransactionCancelled] -> ShowS
TransactionCancelled -> String
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

-- | A simple alternative to 'connectProjectM36' which includes simple session management.
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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (RelationalError -> DbError
RelError RelationalError
err))
        Right SessionId
sess -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (SessionId
sess, Connection
conn))

-- | Same as 'simpleConnectProjectM36At' but always connects to the @master@ branch.
simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DbError DbConn)
simpleConnectProjectM36 :: ConnectionInfo -> IO (Either DbError DbConn)
simpleConnectProjectM36 = HeadName -> ConnectionInfo -> IO (Either DbError DbConn)
simpleConnectProjectM36At HeadName
"master"

-- | Closes the database connection.
close :: DbConn -> IO ()
close :: DbConn -> IO ()
close (SessionId
_ , Connection
conn) = Connection -> IO ()
C.close Connection
conn

-- | 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.
withTransaction :: DbConn -> Db a -> IO (Either DbError a)
withTransaction :: forall a. DbConn -> Db a -> IO (Either DbError a)
withTransaction DbConn
sessconn = forall a. DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
withTransactionUsing DbConn
sessconn MergeStrategy
UnionMergeStrategy

-- | Same as 'withTransaction' except that the merge strategy can be specified.
withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
withTransactionUsing :: forall a. 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall a. Db a -> ReaderT DbConn IO a
runDb Db a
dbm) (SessionId
sess, Connection
conn)
          handler :: TransactionCancelled -> IO (Either DbError a)
          handler :: forall a. TransactionCancelled -> IO (Either DbError a)
handler (TransactionCancelled DbError
err) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left DbError
err)
      forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a. TransactionCancelled -> IO (Either DbError a)
handler forall a b. (a -> b) -> a -> b
$ do
        Either RelationalError a
ret <- forall a.
SessionId
-> Connection
-> IO (Either RelationalError a)
-> IO (Either RelationalError ())
-> IO (Either RelationalError a)
C.withTransaction SessionId
sess Connection
conn (forall a b. b -> Either a b
Right 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  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (RelationalError -> DbError
RelError RelationalError
err))
          Right a
val -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right a
val)

-- | A union of connection and other errors that can be returned from 'withTransaction'.
data DbError = ConnError C.ConnectionError |
               RelError RelationalError |
               TransactionRolledBack
               deriving (DbError -> DbError -> Bool
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
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 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.
execute :: C.DatabaseContextExpr -> Db ()
execute :: DatabaseContextExpr -> Db ()
execute = forall a. Either RelationalError a -> Db a
orCancelTransaction forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DatabaseContextExpr -> Db (Either RelationalError ())
executeOrErr

-- | Run a 'RelationalExpr' query in the 'DB' monad. Relational expressions perform read-only queries against the current database state.
query :: C.RelationalExpr -> Db Relation
query :: RelationalExpr -> Db Relation
query = forall a. Either RelationalError a -> Db a
orCancelTransaction forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< RelationalExpr -> Db (Either RelationalError Relation)
queryOrErr

-- | Run a 'DatabaseContextExpr' update expression. If there is an error, just return it without cancelling the current transaction.
executeOrErr :: C.DatabaseContextExpr -> Db (Either RelationalError ())
executeOrErr :: DatabaseContextExpr -> Db (Either RelationalError ())
executeOrErr DatabaseContextExpr
expr = forall a. ReaderT DbConn IO a -> Db a
Db forall a b. (a -> b) -> a -> b
$ do
  (SessionId
sess, Connection
conn) <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ SessionId
-> Connection
-> DatabaseContextExpr
-> IO (Either RelationalError ())
C.executeDatabaseContextExpr SessionId
sess Connection
conn DatabaseContextExpr
expr

-- | Run a 'RelationalExpr' query expression. If there is an error, just return it without cancelling the transaction.
queryOrErr :: C.RelationalExpr -> Db (Either RelationalError Relation)
queryOrErr :: RelationalExpr -> Db (Either RelationalError Relation)
queryOrErr RelationalExpr
expr = forall a. ReaderT DbConn IO a -> Db a
Db forall a b. (a -> b) -> a -> b
$ do
  (SessionId
sess, Connection
conn) <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ SessionId
-> Connection
-> RelationalExpr
-> IO (Either RelationalError Relation)
C.executeRelationalExpr SessionId
sess Connection
conn RelationalExpr
expr

-- | Unconditionally roll back the current transaction and throw an exception to terminate the execution of the Db monad.
rollback :: Db ()
rollback :: Db ()
rollback = forall a. DbError -> Db a
cancelTransaction DbError
TransactionRolledBack

-- | Cancel a transaction and carry some error information with it.
cancelTransaction :: DbError -> Db a
cancelTransaction :: forall a. DbError -> Db a
cancelTransaction DbError
err = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO (DbError -> TransactionCancelled
TransactionCancelled DbError
err)

-- | Converts the 'Either' result from a 'Db' action into an immediate cancel in the case of error.
orCancelTransaction :: Either RelationalError a -> Db a
orCancelTransaction :: forall a. Either RelationalError a -> Db a
orCancelTransaction = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. DbError -> Db a
cancelTransaction forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationalError -> DbError
RelError) forall (f :: * -> *) a. Applicative f => a -> f a
pure