module Database.Selda.Backend
( MonadIO (..)
, QueryRunner, SeldaBackend (..), MonadSelda (..), SeldaT (..), SeldaM
, SeldaError (..)
, Param (..), Lit (..), SqlValue (..), ColAttr (..)
, compileColAttr
, sqlDateTimeFormat, sqlDateFormat, sqlTimeFormat
, runSeldaT
) where
import Database.Selda.Caching (invalidate)
import Database.Selda.SQL (Param (..))
import Database.Selda.SqlType
import Database.Selda.Table (Table, ColAttr (..), tableName)
import Database.Selda.Table.Compile (compileColAttr)
import Database.Selda.Types (TableName)
import Control.Exception (throwIO)
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.State
import Data.Text (Text)
import Data.Typeable
data SeldaError
= DbError String
| SqlError String
deriving (Show, Eq, Typeable)
instance Exception SeldaError
type QueryRunner a = Text -> [Param] -> IO a
data SeldaBackend = SeldaBackend
{
runStmt :: QueryRunner (Int, [[SqlValue]])
, runStmtWithPK :: QueryRunner Int
, customColType :: Text -> [ColAttr] -> Maybe Text
, defaultKeyword :: Text
}
data SeldaState = SeldaState
{
stBackend :: !SeldaBackend
, stTouchedTables :: !(Maybe [TableName])
}
class MonadIO m => MonadSelda m where
seldaBackend :: m SeldaBackend
invalidateTable :: Table a -> m ()
beginTransaction :: m ()
endTransaction :: Bool
-> m ()
newtype SeldaT m a = S {unS :: StateT SeldaState m a}
deriving ( Functor, Applicative, Monad, MonadIO
, MonadThrow, MonadCatch, MonadMask, MonadTrans
)
instance MonadIO m => MonadSelda (SeldaT m) where
seldaBackend = S $ fmap stBackend get
invalidateTable tbl = S $ do
st <- get
case stTouchedTables st of
Nothing -> liftIO $ invalidate [tableName tbl]
Just ts -> put $ st {stTouchedTables = Just (tableName tbl : ts)}
beginTransaction = S $ do
st <- get
case stTouchedTables st of
Nothing -> put $ st {stTouchedTables = Just []}
Just _ -> liftIO $ throwIO $ SqlError "attempted to nest transactions"
endTransaction committed = S $ do
st <- get
case stTouchedTables st of
Just ts | committed -> liftIO $ invalidate ts
_ -> return ()
put $ st {stTouchedTables = Nothing}
type SeldaM = SeldaT IO
runSeldaT :: MonadIO m => SeldaT m a -> SeldaBackend -> m a
runSeldaT m b = fst <$> runStateT (unS m) (SeldaState b Nothing)