module Database.Selda.Frontend
( Result, Res, MonadIO (..), MonadSelda (..), SeldaT
, query
, insert, insert_, insertWithPK, tryInsert, insertUnless
, update, update_, upsert
, deleteFrom, deleteFrom_
, createTable, tryCreateTable
, dropTable, tryDropTable
, transaction, setLocalCache
) where
import Database.Selda.Backend
import Database.Selda.Caching
import Database.Selda.Column
import Database.Selda.Compile
import Database.Selda.Query.Type
import Database.Selda.SQL
import Database.Selda.SqlType (RowID, invalidRowId, unsafeRowId)
import Database.Selda.Table
import Database.Selda.Table.Compile
import Data.Proxy
import Data.Text (Text)
import Control.Monad
import Control.Monad.Catch
query :: (MonadSelda m, Result a) => Query s a -> m [Res a]
query q = do
backend <- seldaBackend
queryWith (runStmt backend) q
insert :: (MonadSelda m, Insert a) => Table a -> [a] -> m Int
insert _ [] = do
return 0
insert t cs = do
kw <- defaultKeyword <$> seldaBackend
res <- uncurry exec $ compileInsert kw t cs
invalidateTable t
return res
tryInsert :: (MonadCatch m, MonadSelda m, Insert a) => Table a -> [a] -> m Bool
tryInsert tbl row = do
mres <- try $ insert tbl row
case mres of
Right _ -> return True
Left (SqlError _) -> return False
Left e -> throwM e
upsert :: ( MonadCatch m
, MonadSelda m
, Insert a
, Columns (Cols s a)
, Result (Cols s a)
)
=> Table a
-> (Cols s a -> Col s Bool)
-> (Cols s a -> Cols s a)
-> [a]
-> m (Maybe RowID)
upsert tbl check upd rows = transaction $ do
updated <- update tbl check upd
if updated == 0
then Just <$> insertWithPK tbl rows
else pure Nothing
insertUnless :: ( MonadCatch m
, MonadSelda m
, Insert a
, Columns (Cols s a)
, Result (Cols s a)
)
=> Table a
-> (Cols s a -> Col s Bool)
-> [a]
-> m (Maybe RowID)
insertUnless tbl check rows = upsert tbl check id rows
insert_ :: (MonadSelda m, Insert a) => Table a -> [a] -> m ()
insert_ t cs = void $ insert t cs
insertWithPK :: (MonadSelda m, Insert a) => Table a -> [a] -> m RowID
insertWithPK t cs = do
b <- seldaBackend
if tableHasAutoPK t
then do
res <- liftIO $ do
uncurry (runStmtWithPK b) $ compileInsert (defaultKeyword b) t cs
invalidateTable t
return $ unsafeRowId res
else do
insert_ t cs
return invalidRowId
update :: (MonadSelda m, Columns (Cols s a), Result (Cols s a))
=> Table a
-> (Cols s a -> Col s Bool)
-> (Cols s a -> Cols s a)
-> m Int
update tbl check upd = do
tt <- typeTrans <$> seldaBackend
res <- uncurry exec $ compileUpdate tt tbl upd check
invalidateTable tbl
return res
update_ :: (MonadSelda m, Columns (Cols s a), Result (Cols s a))
=> Table a
-> (Cols s a -> Col s Bool)
-> (Cols s a -> Cols s a)
-> m ()
update_ tbl check upd = void $ update tbl check upd
deleteFrom :: (MonadSelda m, Columns (Cols s a))
=> Table a -> (Cols s a -> Col s Bool) -> m Int
deleteFrom tbl f = do
res <- uncurry exec $ compileDelete tbl f
invalidateTable tbl
return res
deleteFrom_ :: (MonadSelda m, Columns (Cols s a))
=> Table a -> (Cols s a -> Col s Bool) -> m ()
deleteFrom_ tbl f = void $ deleteFrom tbl f
createTable :: MonadSelda m => Table a -> m ()
createTable tbl = do
cct <- customColType <$> seldaBackend
void . flip exec [] $ compileCreateTable cct Fail tbl
tryCreateTable :: MonadSelda m => Table a -> m ()
tryCreateTable tbl = do
cct <- customColType <$> seldaBackend
void . flip exec [] $ compileCreateTable cct Ignore tbl
dropTable :: MonadSelda m => Table a -> m ()
dropTable = withInval $ void . flip exec [] . compileDropTable Fail
tryDropTable :: MonadSelda m => Table a -> m ()
tryDropTable = withInval $ void . flip exec [] . compileDropTable Ignore
transaction :: (MonadSelda m, MonadThrow m, MonadCatch m) => m a -> m a
transaction m = do
beginTransaction
void $ exec "BEGIN TRANSACTION" []
res <- try m
case res of
Left (SomeException e) -> do
void $ exec "ROLLBACK" []
endTransaction False
throwM e
Right x -> do
void $ exec "COMMIT" []
endTransaction True
return x
setLocalCache :: MonadIO m => Int -> m ()
setLocalCache = liftIO . setMaxItems
queryWith :: forall s m a. (MonadSelda m, Result a)
=> QueryRunner (Int, [[SqlValue]]) -> Query s a -> m [Res a]
queryWith qr q = do
backend <- seldaBackend
let db = dbIdentifier backend
cacheKey = (db, qs, ps)
(tables, qry@(qs, ps)) = compileWithTables (typeTrans backend) q
mres <- liftIO $ cached cacheKey
case mres of
Just res -> do
return res
_ -> do
res <- fmap snd . liftIO $ uncurry qr qry
let res' = mkResults (Proxy :: Proxy a) res
liftIO $ cache tables cacheKey res'
return res'
typeTrans :: SeldaBackend -> Text -> Text
typeTrans backend t = maybe t id (customColType backend t [])
mkResults :: Result a => Proxy a -> [[SqlValue]] -> [Res a]
mkResults p = map (toRes p)
withInval :: MonadSelda m => (Table a -> m b) -> Table a -> m b
withInval f t = do
res <- f t
invalidateTable t
return res
exec :: MonadSelda m => Text -> [Param] -> m Int
exec q ps = do
backend <- seldaBackend
fmap fst . liftIO $ runStmt backend q ps