{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, OverloadedStrings #-}
module Database.Selda.Frontend
( Result, Res, MonadIO (..), MonadSelda (..), SeldaT
, query, queryInto
, insert, insert_, insertWithPK, tryInsert, insertWhen, insertUnless
, update, update_, upsert
, deleteFrom, deleteFrom_
, createTable, tryCreateTable
, dropTable, tryDropTable
, transaction, setLocalCache, withoutForeignKeyEnforcement
) where
import Database.Selda.Backend.Internal
import Database.Selda.Caching
import Database.Selda.Column
import Database.Selda.Compile
import Database.Selda.Generic
import Database.Selda.Query.Type
import Database.Selda.SqlType (ID, invalidId, toId)
import Database.Selda.Table
import Database.Selda.Table.Compile
import Database.Selda.Types (fromTableName)
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
queryInto :: (MonadSelda m, Relational a)
=> Table a
-> Query s (Row s a)
-> m Int
queryInto tbl q = do
backend <- seldaBackend
let (qry, ps) = compileWith (ppConfig backend) q
qry' = mconcat ["INSERT INTO ", tblName, " ", qry]
fmap fst . liftIO $ runStmt backend qry' ps
where
tblName = fromTableName (tableName tbl)
insert :: (MonadSelda m, Relational a) => Table a -> [a] -> m Int
insert _ [] = do
return 0
insert t cs = do
cfg <- ppConfig <$> seldaBackend
res <- mapM (uncurry exec) $ compileInsert cfg t cs
invalidateTable t
return (sum res)
tryInsert :: (MonadSelda m, MonadCatch m, Relational 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 :: ( MonadSelda m
, Relational a
)
=> Table a
-> (Row s a -> Col s Bool)
-> (Row s a -> Row s a)
-> [a]
-> m (Maybe (ID a))
upsert tbl check upd rows = transaction $ do
updated <- update tbl check upd
if updated == 0
then Just <$> insertWithPK tbl rows
else pure Nothing
insertUnless :: ( MonadSelda m
, Relational a
)
=> Table a
-> (Row s a -> Col s Bool)
-> [a]
-> m (Maybe (ID a))
insertUnless tbl check rows = upsert tbl check id rows
insertWhen :: ( MonadSelda m
, Relational a
)
=> Table a
-> (Row s a -> Col s Bool)
-> [a]
-> m (Maybe (ID a))
insertWhen tbl check rows = transaction $ do
matches <- update tbl check id
if matches > 0
then Just <$> insertWithPK tbl rows
else pure Nothing
insert_ :: (MonadSelda m, Relational a) => Table a -> [a] -> m ()
insert_ t cs = void $ insert t cs
insertWithPK :: (MonadSelda m, Relational a) => Table a -> [a] -> m (ID a)
insertWithPK t cs = do
b <- seldaBackend
if tableHasAutoPK t
then do
res <- liftIO $ do
mapM (uncurry (runStmtWithPK b)) $ compileInsert (ppConfig b) t cs
invalidateTable t
return $ toId (last res)
else do
insert_ t cs
return invalidId
update :: (MonadSelda m, Relational a)
=> Table a
-> (Row s a -> Col s Bool)
-> (Row s a -> Row 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, Relational a)
=> Table a
-> (Row s a -> Col s Bool)
-> (Row s a -> Row s a)
-> m ()
update_ tbl check upd = void $ update tbl check upd
deleteFrom :: (MonadSelda m, Relational a)
=> Table a
-> (Row 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, Relational a)
=> Table a
-> (Row 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
mapM_ (flip exec []) $ compileCreateTable cfg Fail tbl
tryCreateTable :: MonadSelda m => Table a -> m ()
tryCreateTable tbl = do
cfg <- ppConfig <$> seldaBackend
mapM_ (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 => m a -> m a
transaction m = do
wrapTransaction (void $ exec "COMMIT" []) (void $ exec "ROLLBACK" []) $ do
exec "BEGIN TRANSACTION" [] *> m
withoutForeignKeyEnforcement :: (MonadSelda m, MonadMask m) => m a -> m a
withoutForeignKeyEnforcement m = do
b <- seldaBackend
bracket_ (liftIO $ disableForeignKeys b True)
(liftIO $ disableForeignKeys b False)
m
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 (buildResult 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
liftIO $ execIO backend q ps
execIO :: SeldaBackend -> Text -> [Param] -> IO Int
execIO backend q ps = fmap fst $ runStmt backend q ps