-- | This module is the primary entry point if you're working with @persistent@
-- on a SQL database.
--
-- = Getting Started
--
-- First, you'll want to define your database entities. You can do that with
-- "Database.Persist.Quasi."
--
-- Then, you'll use the operations
module Database.Persist.Sql
    ( -- * 'RawSql' and 'PersistFieldSql'
      module Database.Persist.Sql.Class

      -- * Running actions

      -- | Run actions in a transaction with 'runSqlPool'.
    , module Database.Persist.Sql.Run

      -- * Migrations
    , module Database.Persist.Sql.Migration

      -- * @persistent@ combinators

      -- | We re-export "Database.Persist" here, to make it easier to use query
      -- and update combinators. Check out that module for documentation.
    , module Database.Persist
    , module Database.Persist.Sql.Orphan.PersistStore

      -- * The Escape Hatch

      -- | @persistent@ offers a set of functions that are useful for operating
      -- directly on the underlying SQL database. This can allow you to use
      -- whatever SQL features you want.
      --
      -- Consider going to <https://hackage.haskell.org/package/esqueleto
      -- esqueleto> for a more powerful SQL query library built on @persistent@.
    , rawQuery
    , rawQueryRes
    , rawExecute
    , rawExecuteCount
    , rawSql

      -- * SQL helpers
    , deleteWhereCount
    , updateWhereCount
    , filterClause
    , filterClauseWithVals
    , orderClause
    , FilterTablePrefix (..)

      -- * Transactions
    , transactionSave
    , transactionSaveWithIsolation
    , transactionUndo
    , transactionUndoWithIsolation

      -- * Other utilities
    , getStmtConn
    , mkColumns
    , BackendSpecificOverrides
    , emptyBackendSpecificOverrides
    , getBackendSpecificForeignKeyName
    , setBackendSpecificForeignKeyName
    , defaultAttribute

      -- * Internal
    , IsolationLevel (..)
    , decorateSQLWithLimitOffset
    , module Database.Persist.Sql.Types
    ) where

import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT, ask)

import Database.Persist
import Database.Persist.Sql.Class
import Database.Persist.Sql.Internal
import Database.Persist.Sql.Migration
import Database.Persist.Sql.Raw
import Database.Persist.Sql.Run hiding (rawAcquireSqlConn, rawRunSqlPool)
import Database.Persist.Sql.Types
import Database.Persist.Sql.Types.Internal
    ( IsolationLevel (..)
    , SqlBackend (..)
    )

import Database.Persist.Sql.Orphan.PersistQuery
import Database.Persist.Sql.Orphan.PersistStore
import Database.Persist.Sql.Orphan.PersistUnique ()

-- | Commit the current transaction and begin a new one.
-- This is used when a transaction commit is required within the context of 'runSqlConn'
-- (which brackets its provided action with a transaction begin/commit pair).
--
-- @since 1.2.0
transactionSave :: (MonadIO m) => ReaderT SqlBackend m ()
transactionSave :: forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave = do
    SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let
        getter :: Text -> IO Statement
getter = SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
conn
    IO () -> ReaderT SqlBackend m ()
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ SqlBackend -> (Text -> IO Statement) -> IO ()
connCommit SqlBackend
conn Text -> IO Statement
getter IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlBackend
-> (Text -> IO Statement) -> Maybe IsolationLevel -> IO ()
connBegin SqlBackend
conn Text -> IO Statement
getter Maybe IsolationLevel
forall a. Maybe a
Nothing

-- | Commit the current transaction and begin a new one with the specified isolation level.
--
-- @since 2.9.0
transactionSaveWithIsolation
    :: (MonadIO m) => IsolationLevel -> ReaderT SqlBackend m ()
transactionSaveWithIsolation :: forall (m :: * -> *).
MonadIO m =>
IsolationLevel -> ReaderT SqlBackend m ()
transactionSaveWithIsolation IsolationLevel
isolation = do
    SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let
        getter :: Text -> IO Statement
getter = SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
conn
    IO () -> ReaderT SqlBackend m ()
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ SqlBackend -> (Text -> IO Statement) -> IO ()
connCommit SqlBackend
conn Text -> IO Statement
getter IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlBackend
-> (Text -> IO Statement) -> Maybe IsolationLevel -> IO ()
connBegin SqlBackend
conn Text -> IO Statement
getter (IsolationLevel -> Maybe IsolationLevel
forall a. a -> Maybe a
Just IsolationLevel
isolation)

-- | Roll back the current transaction and begin a new one.
-- This rolls back to the state of the last call to 'transactionSave' or the enclosing
-- 'runSqlConn' call.
--
-- @since 1.2.0
transactionUndo :: (MonadIO m) => ReaderT SqlBackend m ()
transactionUndo :: forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionUndo = do
    SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let
        getter :: Text -> IO Statement
getter = SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
conn
    IO () -> ReaderT SqlBackend m ()
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ SqlBackend -> (Text -> IO Statement) -> IO ()
connRollback SqlBackend
conn Text -> IO Statement
getter IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlBackend
-> (Text -> IO Statement) -> Maybe IsolationLevel -> IO ()
connBegin SqlBackend
conn Text -> IO Statement
getter Maybe IsolationLevel
forall a. Maybe a
Nothing

-- | Roll back the current transaction and begin a new one with the specified isolation level.
--
-- @since 2.9.0
transactionUndoWithIsolation
    :: (MonadIO m) => IsolationLevel -> ReaderT SqlBackend m ()
transactionUndoWithIsolation :: forall (m :: * -> *).
MonadIO m =>
IsolationLevel -> ReaderT SqlBackend m ()
transactionUndoWithIsolation IsolationLevel
isolation = do
    SqlBackend
conn <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    let
        getter :: Text -> IO Statement
getter = SqlBackend -> Text -> IO Statement
getStmtConn SqlBackend
conn
    IO () -> ReaderT SqlBackend m ()
forall a. IO a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ SqlBackend -> (Text -> IO Statement) -> IO ()
connRollback SqlBackend
conn Text -> IO Statement
getter IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlBackend
-> (Text -> IO Statement) -> Maybe IsolationLevel -> IO ()
connBegin SqlBackend
conn Text -> IO Statement
getter (IsolationLevel -> Maybe IsolationLevel
forall a. a -> Maybe a
Just IsolationLevel
isolation)