{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, OverloadedStrings #-}
-- | API for running Selda operations over databases.
module Database.Selda.Frontend
  ( Result, Res, MonadIO (..), MonadSelda (..), SeldaT, OnError (..)
  , query, queryInto
  , insert, insert_, insertWithPK, tryInsert, insertWhen, insertUnless
  , update, update_, upsert
  , deleteFrom, deleteFrom_
  , createTable, tryCreateTable, createTableWithoutIndexes, createTableIndexes
  , dropTable, tryDropTable
  , transaction, withoutForeignKeyEnforcement
  ) where
import Database.Selda.Backend.Internal
    ( SqlValue,
      Param,
      SeldaT,
      MonadSelda(..),
      SeldaBackend(runStmtWithPK, disableForeignKeys, ppConfig, runStmt),
      QueryRunner,
      SeldaError(SqlError),
      withBackend )
import Database.Selda.Column ( Row, Col )
import Database.Selda.Compile
    ( Result,
      Res,
      compileWith,
      compileInsert,
      compileUpdate,
      compileDelete,
      buildResult )
import Database.Selda.Generic ( Relational )
import Database.Selda.Query.Type ( Query )
import Database.Selda.SqlType (ID, invalidId, toId)
import Database.Selda.Table.Type
    ( Table(tableName, tableHasAutoPK) )
import Database.Selda.Table.Compile
    ( OnError(..),
      compileCreateTable,
      compileCreateIndexes,
      compileDropTable )
import Database.Selda.Types (fromTableName)
import Data.Proxy ( Proxy(..) )
import Data.Text (Text)
import Control.Monad ( void )
import Control.Monad.Catch
    ( bracket_,
      onException,
      try,
      MonadCatch,
      MonadMask(mask),
      MonadThrow(throwM) )
import Control.Monad.IO.Class ( MonadIO(..) )

-- | Run a query within a Selda monad. In practice, this is often a 'SeldaT'
--   transformer on top of some other monad.
--   Selda transformers are entered using backend-specific @withX@ functions,
--   such as 'withSQLite' from the SQLite backend.
query :: (MonadSelda m, Result a) => Query (Backend m) a -> m [Res a]
query :: forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
query Query (Backend m) a
q = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
QueryRunner (Int, [[SqlValue]]) -> Query (Backend m) a -> m [Res a]
queryWith Query (Backend m) a
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. SeldaBackend b -> QueryRunner (Int, [[SqlValue]])
runStmt)

-- | Perform the given query, and insert the result into the given table.
--   Returns the number of inserted rows.
queryInto :: (MonadSelda m, Relational a)
          => Table a
          -> Query (Backend m) (Row (Backend m) a)
          -> m Int
queryInto :: forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> Query (Backend m) (Row (Backend m) a) -> m Int
queryInto Table a
tbl Query (Backend m) (Row (Backend m) a)
q = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> do
    let (Text
qry, [Param]
ps) = forall a s. Result a => PPConfig -> Query s a -> (Text, [Param])
compileWith (forall b. SeldaBackend b -> PPConfig
ppConfig SeldaBackend (Backend m)
b) Query (Backend m) (Row (Backend m) a)
q
        qry' :: Text
qry' = forall a. Monoid a => [a] -> a
mconcat [Text
"INSERT INTO ", Text
tblName, Text
" ", Text
qry]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b. SeldaBackend b -> QueryRunner (Int, [[SqlValue]])
runStmt SeldaBackend (Backend m)
b Text
qry' [Param]
ps
  where
    tblName :: Text
tblName = TableName -> Text
fromTableName (forall a. Table a -> TableName
tableName Table a
tbl)

-- | Insert the given values into the given table. All columns of the table
--   must be present. If your table has an auto-incrementing primary key,
--   use the special value 'def' for that column to get the auto-incrementing
--   behavior.
--   Returns the number of rows that were inserted.
--
--   To insert a list of tuples into a table with auto-incrementing primary key:
--
-- > data Person = Person
-- >   { id :: ID Person
-- >   , name :: Text
-- >   , age :: Int
-- >   , pet :: Maybe Text
-- >   } deriving Generic
-- > instance SqlResult Person
-- >
-- > people :: Table Person
-- > people = table "people" [autoPrimary :- id]
-- >
-- > main = withSQLite "my_database.sqlite" $ do
-- >   insert_ people
-- >     [ Person def "Link" 125 (Just "horse")
-- >     , Person def "Zelda" 119 Nothing
-- >     , ...
-- >     ]
--
--   Note that if one or more of the inserted rows would cause a constraint
--   violation, NO rows will be inserted; the whole insertion fails atomically.
insert :: (MonadSelda m, Relational a) => Table a -> [a] -> m Int
insert :: forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m Int
insert Table a
_ [] = do
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
insert Table a
t [a]
cs = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> do
  forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec) (forall a.
Relational a =>
PPConfig -> Table a -> [a] -> [(Text, [Param])]
compileInsert (forall b. SeldaBackend b -> PPConfig
ppConfig SeldaBackend (Backend m)
b) Table a
t [a]
cs)

-- | Attempt to insert a list of rows into a table, but don't raise an error
--   if the insertion fails. Returns @True@ if the insertion succeeded, otherwise
--   @False@.
--
--   Like 'insert', if even one of the inserted rows would cause a constraint
--   violation, the whole insert operation fails.
tryInsert :: (MonadSelda m, MonadCatch m, Relational a) => Table a -> [a] -> m Bool
tryInsert :: forall (m :: * -> *) a.
(MonadSelda m, MonadCatch m, Relational a) =>
Table a -> [a] -> m Bool
tryInsert Table a
tbl [a]
row = do
  Either SeldaError Int
mres <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m Int
insert Table a
tbl [a]
row
  case Either SeldaError Int
mres of
    Right Int
_           -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Left (SqlError String
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Left SeldaError
e            -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SeldaError
e

-- | Attempt to perform the given update. If no rows were updated, insert the
--   given row.
--   Returns the primary key of the inserted row, if the insert was performed.
--   Calling this function on a table which does not have a primary key will
--   return @Just id@ on a successful insert, where @id@ is a row identifier
--   guaranteed to not match any row in any table.
--
--   Note that this may perform two separate queries: one update, potentially
--   followed by one insert.
upsert :: (MonadSelda m, MonadMask m, Relational a)
       => Table a
       -> (Row (Backend m) a -> Col (Backend m) Bool)
       -> (Row (Backend m) a -> Row (Backend m) a)
       -> [a]
       -> m (Maybe (ID a))
upsert :: forall (m :: * -> *) a.
(MonadSelda m, MonadMask m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> [a]
-> m (Maybe (ID a))
upsert Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
check Row (Backend m) a -> Row (Backend m) a
upd [a]
rows = forall (m :: * -> *) a. (MonadSelda m, MonadMask m) => m a -> m a
transaction forall a b. (a -> b) -> a -> b
$ do
  Int
updated <- forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m Int
update Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
check Row (Backend m) a -> Row (Backend m) a
upd
  if Int
updated forall a. Eq a => a -> a -> Bool
== Int
0
    then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
insertWithPK Table a
tbl [a]
rows
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- | Perform the given insert, if no rows already present in the table match
--   the given predicate.
--   Returns the primary key of the last inserted row,
--   if the insert was performed.
--   If called on a table which doesn't have an auto-incrementing primary key,
--   @Just id@ is always returned on successful insert, where @id@ is a row
--   identifier guaranteed to not match any row in any table.
insertUnless :: (MonadSelda m, MonadMask m, Relational a)
             => Table a
             -> (Row (Backend m) a -> Col (Backend m) Bool)
             -> [a]
             -> m (Maybe (ID a))
insertUnless :: forall (m :: * -> *) a.
(MonadSelda m, MonadMask m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> [a]
-> m (Maybe (ID a))
insertUnless Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
check [a]
rows = forall (m :: * -> *) a.
(MonadSelda m, MonadMask m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> [a]
-> m (Maybe (ID a))
upsert Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
check forall a. a -> a
id [a]
rows

-- | Like 'insertUnless', but performs the insert when at least one row matches
--   the predicate.
insertWhen :: (MonadSelda m, MonadMask m, Relational a)
           => Table a
           -> (Row (Backend m) a -> Col (Backend m) Bool)
           -> [a]
           -> m (Maybe (ID a))
insertWhen :: forall (m :: * -> *) a.
(MonadSelda m, MonadMask m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> [a]
-> m (Maybe (ID a))
insertWhen Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
check [a]
rows = forall (m :: * -> *) a. (MonadSelda m, MonadMask m) => m a -> m a
transaction forall a b. (a -> b) -> a -> b
$ do
  Int
matches <- forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m Int
update Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
check forall a. a -> a
id
  if Int
matches forall a. Ord a => a -> a -> Bool
> Int
0
    then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
insertWithPK Table a
tbl [a]
rows
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- | Like 'insert', but does not return anything.
--   Use this when you really don't care about how many rows were inserted.
insert_ :: (MonadSelda m, Relational a) => Table a -> [a] -> m ()
insert_ :: forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m ()
insert_ Table a
t [a]
cs = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m Int
insert Table a
t [a]
cs

-- | Like 'insert', but returns the primary key of the last inserted row.
--   Attempting to run this operation on a table without an auto-incrementing
--   primary key will always return a row identifier that is guaranteed to not
--   match any row in any table.
insertWithPK :: (MonadSelda m, Relational a) => Table a -> [a] -> m (ID a)
insertWithPK :: forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m (ID a)
insertWithPK Table a
t [a]
cs = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> do
  if forall a. Table a -> Bool
tableHasAutoPK Table a
t
    then do
      [Int64]
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall b. SeldaBackend b -> Text -> [Param] -> IO Int64
runStmtWithPK SeldaBackend (Backend m)
b)) forall a b. (a -> b) -> a -> b
$ forall a.
Relational a =>
PPConfig -> Table a -> [a] -> [(Text, [Param])]
compileInsert (forall b. SeldaBackend b -> PPConfig
ppConfig SeldaBackend (Backend m)
b) Table a
t [a]
cs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int64 -> ID a
toId (forall a. [a] -> a
last [Int64]
res)
    else do
      forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> [a] -> m ()
insert_ Table a
t [a]
cs
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. ID a
invalidId

-- | Update the given table using the given update function, for all rows
--   matching the given predicate. Returns the number of updated rows.
update :: (MonadSelda m, Relational a)
       => Table a                                     -- ^ Table to update.
       -> (Row (Backend m) a -> Col (Backend m) Bool) -- ^ Predicate.
       -> (Row (Backend m) a -> Row (Backend m) a)    -- ^ Update function.
       -> m Int
update :: forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m Int
update Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
check Row (Backend m) a -> Row (Backend m) a
upd = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> do
  Int
res <- forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec forall a b. (a -> b) -> a -> b
$ forall s a.
(Relational a, SqlRow a) =>
PPConfig
-> Table a
-> (Row s a -> Row s a)
-> (Row s a -> Col s Bool)
-> (Text, [Param])
compileUpdate (forall b. SeldaBackend b -> PPConfig
ppConfig SeldaBackend (Backend m)
b) Table a
tbl Row (Backend m) a -> Row (Backend m) a
upd Row (Backend m) a -> Col (Backend m) Bool
check
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
res

-- | Like 'update', but doesn't return the number of updated rows.
update_ :: (MonadSelda m, Relational a)
       => Table a
       -> (Row (Backend m) a -> Col (Backend m) Bool)
       -> (Row (Backend m) a -> Row (Backend m) a)
       -> m ()
update_ :: forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m ()
update_ Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
check Row (Backend m) a -> Row (Backend m) a
upd = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a
-> (Row (Backend m) a -> Col (Backend m) Bool)
-> (Row (Backend m) a -> Row (Backend m) a)
-> m Int
update Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
check Row (Backend m) a -> Row (Backend m) a
upd

-- | From the given table, delete all rows matching the given predicate.
--   Returns the number of deleted rows.
deleteFrom :: (MonadSelda m, Relational a)
           => Table a
           -> (Row (Backend m) a -> Col (Backend m) Bool)
           -> m Int
deleteFrom :: forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m Int
deleteFrom Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
f = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> do
  Int
res <- forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec forall a b. (a -> b) -> a -> b
$ forall a s.
Relational a =>
PPConfig -> Table a -> (Row s a -> Col s Bool) -> (Text, [Param])
compileDelete (forall b. SeldaBackend b -> PPConfig
ppConfig SeldaBackend (Backend m)
b) Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
f
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
res

-- | Like 'deleteFrom', but does not return the number of deleted rows.
deleteFrom_ :: (MonadSelda m, Relational a)
            => Table a
            -> (Row (Backend m) a -> Col (Backend m) Bool)
            -> m ()
deleteFrom_ :: forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m ()
deleteFrom_ Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
f = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadSelda m, Relational a) =>
Table a -> (Row (Backend m) a -> Col (Backend m) Bool) -> m Int
deleteFrom Table a
tbl Row (Backend m) a -> Col (Backend m) Bool
f

-- | Create a table from the given schema.
createTable :: MonadSelda m => Table a -> m ()
createTable :: forall (m :: * -> *) a. MonadSelda m => Table a -> m ()
createTable Table a
tbl = do
  forall (m :: * -> *) a. MonadSelda m => OnError -> Table a -> m ()
createTableWithoutIndexes OnError
Fail Table a
tbl
  forall (m :: * -> *) a. MonadSelda m => OnError -> Table a -> m ()
createTableIndexes OnError
Fail Table a
tbl

-- | Create a table from the given schema, but don't create any indexes.
createTableWithoutIndexes :: MonadSelda m => OnError -> Table a -> m ()
createTableWithoutIndexes :: forall (m :: * -> *) a. MonadSelda m => OnError -> Table a -> m ()
createTableWithoutIndexes OnError
onerror Table a
tbl = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec (forall a. PPConfig -> OnError -> Table a -> Text
compileCreateTable (forall b. SeldaBackend b -> PPConfig
ppConfig SeldaBackend (Backend m)
b) OnError
onerror Table a
tbl) []

-- | Create all indexes for the given table. Fails if any of the table's indexes
--   already exists.
createTableIndexes :: MonadSelda m => OnError -> Table a -> m ()
createTableIndexes :: forall (m :: * -> *) a. MonadSelda m => OnError -> Table a -> m ()
createTableIndexes OnError
ifex Table a
tbl = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec []) forall a b. (a -> b) -> a -> b
$ forall a. PPConfig -> OnError -> Table a -> [Text]
compileCreateIndexes (forall b. SeldaBackend b -> PPConfig
ppConfig SeldaBackend (Backend m)
b) OnError
ifex Table a
tbl

-- | Create a table from the given schema, unless it already exists.
tryCreateTable :: MonadSelda m => Table a -> m ()
tryCreateTable :: forall (m :: * -> *) a. MonadSelda m => Table a -> m ()
tryCreateTable Table a
tbl = do
  forall (m :: * -> *) a. MonadSelda m => OnError -> Table a -> m ()
createTableWithoutIndexes OnError
Ignore Table a
tbl
  forall (m :: * -> *) a. MonadSelda m => OnError -> Table a -> m ()
createTableIndexes OnError
Ignore Table a
tbl

-- | Drop the given table.
dropTable :: MonadSelda m => Table a -> m ()
dropTable :: forall (m :: * -> *) a. MonadSelda m => Table a -> m ()
dropTable = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. OnError -> Table a -> Text
compileDropTable OnError
Fail

-- | Drop the given table, if it exists.
tryDropTable :: MonadSelda m => Table a -> m ()
tryDropTable :: forall (m :: * -> *) a. MonadSelda m => Table a -> m ()
tryDropTable = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. OnError -> Table a -> Text
compileDropTable OnError
Ignore

-- | Perform the given computation atomically.
--   If an exception is raised during its execution, the entire transaction
--   will be rolled back and the exception re-thrown, even if the exception
--   is caught and handled within the transaction.
transaction :: (MonadSelda m, MonadMask m) => m a -> m a
transaction :: forall (m :: * -> *) a. (MonadSelda m, MonadMask m) => m a -> m a
transaction m a
m = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> forall (m :: * -> *) a. MonadSelda m => m a -> m a
transact forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec Text
"BEGIN TRANSACTION" []
  a
x <- forall a. m a -> m a
restore m a
m forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException` forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec Text
"ROLLBACK" [])
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec Text
"COMMIT" []
  forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Run the given computation as a transaction without enforcing foreign key
--   constraints.
--
--   If the computation finishes with the database in an inconsistent state
--   with regards to foreign keys, the resulting behavior is undefined.
--   Use with extreme caution, preferably only for migrations.
--
--   On the PostgreSQL backend, at least PostgreSQL 9.6 is required.
--
--   Using this should be avoided in favor of deferred foreign key
--   constraints. See SQL backend documentation for deferred constraints.
withoutForeignKeyEnforcement :: (MonadSelda m, MonadMask m) => m a -> m a
withoutForeignKeyEnforcement :: forall (m :: * -> *) a. (MonadSelda m, MonadMask m) => m a -> m a
withoutForeignKeyEnforcement m a
m = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> do
  forall (m :: * -> *) a c b. MonadMask m => m a -> m c -> m b -> m b
bracket_ (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b. SeldaBackend b -> Bool -> IO ()
disableForeignKeys SeldaBackend (Backend m)
b Bool
True)
           (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b. SeldaBackend b -> Bool -> IO ()
disableForeignKeys SeldaBackend (Backend m)
b Bool
False)
           m a
m

-- | Build the final result from a list of result columns.
queryWith :: forall m a. (MonadSelda m, Result a)
          => QueryRunner (Int, [[SqlValue]]) -> Query (Backend m) a -> m [Res a]
queryWith :: forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
QueryRunner (Int, [[SqlValue]]) -> Query (Backend m) a -> m [Res a]
queryWith QueryRunner (Int, [[SqlValue]])
run Query (Backend m) a
q = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> do
  [[SqlValue]]
res <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry QueryRunner (Int, [[SqlValue]])
run forall a b. (a -> b) -> a -> b
$ forall a s. Result a => PPConfig -> Query s a -> (Text, [Param])
compileWith (forall b. SeldaBackend b -> PPConfig
ppConfig SeldaBackend (Backend m)
b) Query (Backend m) a
q
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Result a => Proxy a -> [[SqlValue]] -> [Res a]
mkResults (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) [[SqlValue]]
res

-- | Generate the final result of a query from a list of untyped result rows.
mkResults :: Result a => Proxy a -> [[SqlValue]] -> [Res a]
mkResults :: forall a. Result a => Proxy a -> [[SqlValue]] -> [Res a]
mkResults Proxy a
p = forall a b. (a -> b) -> [a] -> [b]
map (forall r. Result r => Proxy r -> [SqlValue] -> Res r
buildResult Proxy a
p)

{-# INLINE exec #-}
-- | Execute a statement without a result.
exec :: MonadSelda m => Text -> [Param] -> m Int
exec :: forall (m :: * -> *). MonadSelda m => Text -> [Param] -> m Int
exec Text
q [Param]
ps = forall (m :: * -> *) a.
MonadSelda m =>
(SeldaBackend (Backend m) -> m a) -> m a
withBackend forall a b. (a -> b) -> a -> b
$ \SeldaBackend (Backend m)
b -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b. SeldaBackend b -> Text -> [Param] -> IO Int
execIO SeldaBackend (Backend m)
b Text
q [Param]
ps

{-# INLINE execIO #-}
-- | Like 'exec', but in 'IO'.
execIO :: SeldaBackend b -> Text -> [Param] -> IO Int
execIO :: forall b. SeldaBackend b -> Text -> [Param] -> IO Int
execIO SeldaBackend b
backend Text
q [Param]
ps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall b. SeldaBackend b -> QueryRunner (Int, [[SqlValue]])
runStmt SeldaBackend b
backend Text
q [Param]
ps