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.Internal
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
import Control.Monad.IO.Class
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
cfg <- ppConfig <$> seldaBackend
res <- uncurry exec $ compileInsert cfg 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 (ppConfig 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
cfg <- ppConfig <$> seldaBackend
res <- uncurry exec $ compileUpdate cfg 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
cfg <- ppConfig <$> seldaBackend
res <- uncurry exec $ compileDelete cfg 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
cfg <- ppConfig <$> seldaBackend
void . flip exec [] $ compileCreateTable cfg Fail tbl
tryCreateTable :: MonadSelda m => Table a -> m ()
tryCreateTable tbl = do
cfg <- ppConfig <$> seldaBackend
void . flip exec [] $ compileCreateTable cfg 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
conn <- seldaConnection
let backend = connBackend conn
db = connDbId conn
cacheKey = (db, qs, ps)
(tables, qry@(qs, ps)) = compileWithTables (ppConfig 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'
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