hpqtypes-1.12.0.0: src/Database/PostgreSQL/PQTypes/Utils.hs

module Database.PostgreSQL.PQTypes.Utils
  ( throwDB
  , raw
  , runQuery_
  , runQuery01
  , runQuery01_
  , runSQL
  , runSQL_
  , runSQL01
  , runSQL01_
  , runPreparedQuery_
  , runPreparedQuery01
  , runPreparedQuery01_
  , runPreparedSQL
  , runPreparedSQL_
  , runPreparedSQL01
  , runPreparedSQL01_
  -- Internal.Utils
  , hpqTypesError
  ) where

import Control.Monad
import Control.Monad.Catch
import GHC.Stack

import Database.PostgreSQL.PQTypes.Class
import Database.PostgreSQL.PQTypes.Internal.Error
import Database.PostgreSQL.PQTypes.Internal.Exception
import Database.PostgreSQL.PQTypes.Internal.Utils
import Database.PostgreSQL.PQTypes.SQL
import Database.PostgreSQL.PQTypes.SQL.Class
import Database.PostgreSQL.PQTypes.SQL.Raw

-- | When given 'DBException', throw it immediately. Otherwise
-- wrap it in 'DBException' with the current query context first.
throwDB :: (HasCallStack, Exception e, MonadDB m, MonadThrow m) => e -> m a
throwDB e = case fromException $ toException e of
  Just (dbe :: DBException) -> throwM dbe
  Nothing -> do
    SomeSQL sql <- getLastQuery
    pid <- getBackendPid
    throwM
      DBException
        { dbeQueryContext = sql
        , dbeBackendPid = pid
        , dbeError = e
        , dbeCallStack = callStack
        }

----------------------------------------

-- | Convert 'RawSQL' () to 'SQL'.
raw :: RawSQL () -> SQL
raw = mkSQL . unRawSQL

----------------------------------------

-- | Specialization of 'runQuery' that discards the result.
runQuery_ :: (HasCallStack, IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ = withFrozenCallStack $ void . runQuery

-- | Specialization of 'runQuery' that checks whether affected/returned
-- number of rows is in range [0, 1] and returns appropriate 'Bool' value.
-- Otherwise, 'AffectedRowsMismatch' exception is thrown.
runQuery01 :: (HasCallStack, IsSQL sql, MonadDB m, MonadThrow m) => sql -> m Bool
runQuery01 sql = withFrozenCallStack $ do
  n <- runQuery sql
  when (n > 1) $
    throwDB
      AffectedRowsMismatch
        { rowsExpected = [(0, 1)]
        , rowsDelivered = n
        }
  pure $ n == 1

-- | Specialization of 'runQuery01' that discards the result.
runQuery01_ :: (HasCallStack, IsSQL sql, MonadDB m, MonadThrow m) => sql -> m ()
runQuery01_ = withFrozenCallStack $ void . runQuery01

----------------------------------------

-- | Specialization of 'runQuery' to 'SQL' type.
runSQL :: (HasCallStack, MonadDB m) => SQL -> m Int
runSQL = withFrozenCallStack runQuery

-- | Specialization of 'runQuery_' to 'SQL' type.
runSQL_ :: (HasCallStack, MonadDB m) => SQL -> m ()
runSQL_ = withFrozenCallStack runQuery_

-- | Specialization of 'runQuery01' to 'SQL' type.
runSQL01 :: (HasCallStack, MonadDB m, MonadThrow m) => SQL -> m Bool
runSQL01 = withFrozenCallStack runQuery01

-- | Specialization of 'runQuery01_' to 'SQL' type.
runSQL01_ :: (HasCallStack, MonadDB m, MonadThrow m) => SQL -> m ()
runSQL01_ = withFrozenCallStack runQuery01_

----------------------------------------

-- | Specialization of 'runPreparedQuery' that discards the result.
runPreparedQuery_ :: (HasCallStack, IsSQL sql, MonadDB m) => QueryName -> sql -> m ()
runPreparedQuery_ name = withFrozenCallStack $ void . runPreparedQuery name

-- | Specialization of 'runPreparedQuery' that checks whether affected/returned
-- number of rows is in range [0, 1] and returns appropriate 'Bool' value.
-- Otherwise, 'AffectedRowsMismatch' exception is thrown.
runPreparedQuery01
  :: (HasCallStack, IsSQL sql, MonadDB m, MonadThrow m)
  => QueryName
  -> sql
  -> m Bool
runPreparedQuery01 name sql = withFrozenCallStack $ do
  n <- runPreparedQuery name sql
  when (n > 1) $
    throwDB
      AffectedRowsMismatch
        { rowsExpected = [(0, 1)]
        , rowsDelivered = n
        }
  pure $ n == 1

-- | Specialization of 'runPreparedQuery01' that discards the result.
runPreparedQuery01_
  :: (HasCallStack, IsSQL sql, MonadDB m, MonadThrow m)
  => QueryName
  -> sql
  -> m ()
runPreparedQuery01_ name = withFrozenCallStack $ void . runPreparedQuery01 name

----------------------------------------

-- | Specialization of 'runPreparedQuery' to 'SQL' type.
runPreparedSQL :: (HasCallStack, MonadDB m) => QueryName -> SQL -> m Int
runPreparedSQL = withFrozenCallStack runPreparedQuery

-- | Specialization of 'runPreparedQuery_' to 'SQL' type.
runPreparedSQL_ :: (HasCallStack, MonadDB m) => QueryName -> SQL -> m ()
runPreparedSQL_ = withFrozenCallStack runPreparedQuery_

-- | Specialization of 'runPreparedQuery01' to 'SQL' type.
runPreparedSQL01 :: (HasCallStack, MonadDB m, MonadThrow m) => QueryName -> SQL -> m Bool
runPreparedSQL01 = withFrozenCallStack runPreparedQuery01

-- | Specialization of 'runPreparedQuery01_' to 'SQL' type.
runPreparedSQL01_ :: (HasCallStack, MonadDB m, MonadThrow m) => QueryName -> SQL -> m ()
runPreparedSQL01_ = withFrozenCallStack runPreparedQuery01_