{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Some functionality is useful enough to be provided across backends, but is
-- not standardized. For example, many RDBMS systems provide ways of fetching
-- auto-incrementing or defaulting fields on INSERT or UPDATE.
--
-- Beam provides type classes that some backends instantiate that provide this
-- support. This uses direct means on sufficiently advanced backends and is
-- emulated on others.
module Database.Beam.Backend.SQL.BeamExtensions
  ( MonadBeamInsertReturning(..)
  , MonadBeamUpdateReturning(..)
  , MonadBeamDeleteReturning(..)
  , BeamHasInsertOnConflict(..)

  , SqlSerial(..)
  , onConflictUpdateInstead
  , onConflictUpdateAll
  ) where

import           Database.Beam.Backend
import           Database.Beam.Query
import           Database.Beam.Query.Internal
import           Database.Beam.Schema
import           Database.Beam.Schema.Tables

import           Control.Monad.Cont
import           Control.Monad.Except
import           Control.Monad.Identity
import qualified Control.Monad.RWS.Lazy as Lazy
import qualified Control.Monad.RWS.Strict as Strict
import           Control.Monad.Reader
import qualified Control.Monad.State.Lazy as Lazy
import qualified Control.Monad.State.Strict as Strict
import qualified Control.Monad.Writer.Lazy as Lazy
import qualified Control.Monad.Writer.Strict as Strict
import           Data.Functor.Const
import           Data.Kind (Type)
import           Data.Proxy
import           Data.Semigroup

--import GHC.Generics

-- | 'MonadBeam's that support returning the newly created rows of an @INSERT@ statement.
--   Useful for discovering the real value of a defaulted value.
class MonadBeam be m =>
  MonadBeamInsertReturning be m | m -> be where
  runInsertReturningList
    :: ( Beamable table
       , Projectible be (table (QExpr be ()))
       , FromBackendRow be (table Identity) )
    => SqlInsert be table
    -> m [table Identity]

instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (ExceptT e m) where
    runInsertReturningList :: SqlInsert be table -> ExceptT e m [table Identity]
runInsertReturningList = m [table Identity] -> ExceptT e m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> ExceptT e m [table Identity])
-> (SqlInsert be table -> m [table Identity])
-> SqlInsert be table
-> ExceptT e m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamInsertReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlInsert be table -> m [table Identity]
runInsertReturningList
instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (ContT r m) where
    runInsertReturningList :: SqlInsert be table -> ContT r m [table Identity]
runInsertReturningList = m [table Identity] -> ContT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> ContT r m [table Identity])
-> (SqlInsert be table -> m [table Identity])
-> SqlInsert be table
-> ContT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamInsertReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlInsert be table -> m [table Identity]
runInsertReturningList
instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (ReaderT r m) where
    runInsertReturningList :: SqlInsert be table -> ReaderT r m [table Identity]
runInsertReturningList = m [table Identity] -> ReaderT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> ReaderT r m [table Identity])
-> (SqlInsert be table -> m [table Identity])
-> SqlInsert be table
-> ReaderT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamInsertReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlInsert be table -> m [table Identity]
runInsertReturningList
instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (Lazy.StateT r m) where
    runInsertReturningList :: SqlInsert be table -> StateT r m [table Identity]
runInsertReturningList = m [table Identity] -> StateT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> StateT r m [table Identity])
-> (SqlInsert be table -> m [table Identity])
-> SqlInsert be table
-> StateT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamInsertReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlInsert be table -> m [table Identity]
runInsertReturningList
instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (Strict.StateT r m) where
    runInsertReturningList :: SqlInsert be table -> StateT r m [table Identity]
runInsertReturningList = m [table Identity] -> StateT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> StateT r m [table Identity])
-> (SqlInsert be table -> m [table Identity])
-> SqlInsert be table
-> StateT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamInsertReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlInsert be table -> m [table Identity]
runInsertReturningList
instance (MonadBeamInsertReturning be m, Monoid r)
    => MonadBeamInsertReturning be (Lazy.WriterT r m) where
    runInsertReturningList :: SqlInsert be table -> WriterT r m [table Identity]
runInsertReturningList = m [table Identity] -> WriterT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> WriterT r m [table Identity])
-> (SqlInsert be table -> m [table Identity])
-> SqlInsert be table
-> WriterT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamInsertReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlInsert be table -> m [table Identity]
runInsertReturningList
instance (MonadBeamInsertReturning be m, Monoid r)
    => MonadBeamInsertReturning be (Strict.WriterT r m) where
    runInsertReturningList :: SqlInsert be table -> WriterT r m [table Identity]
runInsertReturningList = m [table Identity] -> WriterT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> WriterT r m [table Identity])
-> (SqlInsert be table -> m [table Identity])
-> SqlInsert be table
-> WriterT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamInsertReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlInsert be table -> m [table Identity]
runInsertReturningList
instance (MonadBeamInsertReturning be m, Monoid w)
    => MonadBeamInsertReturning be (Lazy.RWST r w s m) where
    runInsertReturningList :: SqlInsert be table -> RWST r w s m [table Identity]
runInsertReturningList = m [table Identity] -> RWST r w s m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> RWST r w s m [table Identity])
-> (SqlInsert be table -> m [table Identity])
-> SqlInsert be table
-> RWST r w s m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamInsertReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlInsert be table -> m [table Identity]
runInsertReturningList
instance (MonadBeamInsertReturning be m, Monoid w)
    => MonadBeamInsertReturning be (Strict.RWST r w s m) where
    runInsertReturningList :: SqlInsert be table -> RWST r w s m [table Identity]
runInsertReturningList = m [table Identity] -> RWST r w s m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> RWST r w s m [table Identity])
-> (SqlInsert be table -> m [table Identity])
-> SqlInsert be table
-> RWST r w s m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamInsertReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlInsert be table -> m [table Identity]
runInsertReturningList

-- | 'MonadBeam's that support returning the updated rows of an @UPDATE@ statement.
--   Useful for discovering the new values of the updated rows.
class MonadBeam be m =>
  MonadBeamUpdateReturning be m | m -> be where
  runUpdateReturningList
    :: ( Beamable table
       , Projectible be (table (QExpr be ()))
       , FromBackendRow be (table Identity) )
    => SqlUpdate be table
    -> m [table Identity]

instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (ExceptT e m) where
    runUpdateReturningList :: SqlUpdate be table -> ExceptT e m [table Identity]
runUpdateReturningList = m [table Identity] -> ExceptT e m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> ExceptT e m [table Identity])
-> (SqlUpdate be table -> m [table Identity])
-> SqlUpdate be table
-> ExceptT e m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamUpdateReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlUpdate be table -> m [table Identity]
runUpdateReturningList
instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (ContT r m) where
    runUpdateReturningList :: SqlUpdate be table -> ContT r m [table Identity]
runUpdateReturningList = m [table Identity] -> ContT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> ContT r m [table Identity])
-> (SqlUpdate be table -> m [table Identity])
-> SqlUpdate be table
-> ContT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamUpdateReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlUpdate be table -> m [table Identity]
runUpdateReturningList
instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (ReaderT r m) where
    runUpdateReturningList :: SqlUpdate be table -> ReaderT r m [table Identity]
runUpdateReturningList = m [table Identity] -> ReaderT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> ReaderT r m [table Identity])
-> (SqlUpdate be table -> m [table Identity])
-> SqlUpdate be table
-> ReaderT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamUpdateReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlUpdate be table -> m [table Identity]
runUpdateReturningList
instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (Lazy.StateT r m) where
    runUpdateReturningList :: SqlUpdate be table -> StateT r m [table Identity]
runUpdateReturningList = m [table Identity] -> StateT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> StateT r m [table Identity])
-> (SqlUpdate be table -> m [table Identity])
-> SqlUpdate be table
-> StateT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamUpdateReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlUpdate be table -> m [table Identity]
runUpdateReturningList
instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (Strict.StateT r m) where
    runUpdateReturningList :: SqlUpdate be table -> StateT r m [table Identity]
runUpdateReturningList = m [table Identity] -> StateT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> StateT r m [table Identity])
-> (SqlUpdate be table -> m [table Identity])
-> SqlUpdate be table
-> StateT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamUpdateReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlUpdate be table -> m [table Identity]
runUpdateReturningList
instance (MonadBeamUpdateReturning be m, Monoid r)
    => MonadBeamUpdateReturning be (Lazy.WriterT r m) where
    runUpdateReturningList :: SqlUpdate be table -> WriterT r m [table Identity]
runUpdateReturningList = m [table Identity] -> WriterT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> WriterT r m [table Identity])
-> (SqlUpdate be table -> m [table Identity])
-> SqlUpdate be table
-> WriterT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamUpdateReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlUpdate be table -> m [table Identity]
runUpdateReturningList
instance (MonadBeamUpdateReturning be m, Monoid r)
    => MonadBeamUpdateReturning be (Strict.WriterT r m) where
    runUpdateReturningList :: SqlUpdate be table -> WriterT r m [table Identity]
runUpdateReturningList = m [table Identity] -> WriterT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> WriterT r m [table Identity])
-> (SqlUpdate be table -> m [table Identity])
-> SqlUpdate be table
-> WriterT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamUpdateReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlUpdate be table -> m [table Identity]
runUpdateReturningList
instance (MonadBeamUpdateReturning be m, Monoid w)
    => MonadBeamUpdateReturning be (Lazy.RWST r w s m) where
    runUpdateReturningList :: SqlUpdate be table -> RWST r w s m [table Identity]
runUpdateReturningList = m [table Identity] -> RWST r w s m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> RWST r w s m [table Identity])
-> (SqlUpdate be table -> m [table Identity])
-> SqlUpdate be table
-> RWST r w s m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamUpdateReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlUpdate be table -> m [table Identity]
runUpdateReturningList
instance (MonadBeamUpdateReturning be m, Monoid w)
    => MonadBeamUpdateReturning be (Strict.RWST r w s m) where
    runUpdateReturningList :: SqlUpdate be table -> RWST r w s m [table Identity]
runUpdateReturningList = m [table Identity] -> RWST r w s m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> RWST r w s m [table Identity])
-> (SqlUpdate be table -> m [table Identity])
-> SqlUpdate be table
-> RWST r w s m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamUpdateReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlUpdate be table -> m [table Identity]
runUpdateReturningList

-- | 'MonadBeam's that suppert returning rows that will be deleted by the given
-- @DELETE@ statement. Useful for deallocating resources based on the value of
-- deleted rows.
class MonadBeam be m =>
  MonadBeamDeleteReturning be m | m -> be where
  runDeleteReturningList
    :: ( Beamable table
       , Projectible be (table (QExpr be ()))
       , FromBackendRow be (table Identity) )
    => SqlDelete be table
    -> m [table Identity]

instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (ExceptT e m) where
    runDeleteReturningList :: SqlDelete be table -> ExceptT e m [table Identity]
runDeleteReturningList = m [table Identity] -> ExceptT e m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> ExceptT e m [table Identity])
-> (SqlDelete be table -> m [table Identity])
-> SqlDelete be table
-> ExceptT e m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamDeleteReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlDelete be table -> m [table Identity]
runDeleteReturningList
instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (ContT r m) where
    runDeleteReturningList :: SqlDelete be table -> ContT r m [table Identity]
runDeleteReturningList = m [table Identity] -> ContT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> ContT r m [table Identity])
-> (SqlDelete be table -> m [table Identity])
-> SqlDelete be table
-> ContT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamDeleteReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlDelete be table -> m [table Identity]
runDeleteReturningList
instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (ReaderT r m) where
    runDeleteReturningList :: SqlDelete be table -> ReaderT r m [table Identity]
runDeleteReturningList = m [table Identity] -> ReaderT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> ReaderT r m [table Identity])
-> (SqlDelete be table -> m [table Identity])
-> SqlDelete be table
-> ReaderT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamDeleteReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlDelete be table -> m [table Identity]
runDeleteReturningList
instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (Lazy.StateT r m) where
    runDeleteReturningList :: SqlDelete be table -> StateT r m [table Identity]
runDeleteReturningList = m [table Identity] -> StateT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> StateT r m [table Identity])
-> (SqlDelete be table -> m [table Identity])
-> SqlDelete be table
-> StateT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamDeleteReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlDelete be table -> m [table Identity]
runDeleteReturningList
instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (Strict.StateT r m) where
    runDeleteReturningList :: SqlDelete be table -> StateT r m [table Identity]
runDeleteReturningList = m [table Identity] -> StateT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> StateT r m [table Identity])
-> (SqlDelete be table -> m [table Identity])
-> SqlDelete be table
-> StateT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamDeleteReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlDelete be table -> m [table Identity]
runDeleteReturningList
instance (MonadBeamDeleteReturning be m, Monoid r)
    => MonadBeamDeleteReturning be (Lazy.WriterT r m) where
    runDeleteReturningList :: SqlDelete be table -> WriterT r m [table Identity]
runDeleteReturningList = m [table Identity] -> WriterT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> WriterT r m [table Identity])
-> (SqlDelete be table -> m [table Identity])
-> SqlDelete be table
-> WriterT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamDeleteReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlDelete be table -> m [table Identity]
runDeleteReturningList
instance (MonadBeamDeleteReturning be m, Monoid r)
    => MonadBeamDeleteReturning be (Strict.WriterT r m) where
    runDeleteReturningList :: SqlDelete be table -> WriterT r m [table Identity]
runDeleteReturningList = m [table Identity] -> WriterT r m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> WriterT r m [table Identity])
-> (SqlDelete be table -> m [table Identity])
-> SqlDelete be table
-> WriterT r m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamDeleteReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlDelete be table -> m [table Identity]
runDeleteReturningList
instance (MonadBeamDeleteReturning be m, Monoid w)
    => MonadBeamDeleteReturning be (Lazy.RWST r w s m) where
    runDeleteReturningList :: SqlDelete be table -> RWST r w s m [table Identity]
runDeleteReturningList = m [table Identity] -> RWST r w s m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> RWST r w s m [table Identity])
-> (SqlDelete be table -> m [table Identity])
-> SqlDelete be table
-> RWST r w s m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamDeleteReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlDelete be table -> m [table Identity]
runDeleteReturningList
instance (MonadBeamDeleteReturning be m, Monoid w)
    => MonadBeamDeleteReturning be (Strict.RWST r w s m) where
    runDeleteReturningList :: SqlDelete be table -> RWST r w s m [table Identity]
runDeleteReturningList = m [table Identity] -> RWST r w s m [table Identity]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [table Identity] -> RWST r w s m [table Identity])
-> (SqlDelete be table -> m [table Identity])
-> SqlDelete be table
-> RWST r w s m [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete be table -> m [table Identity]
forall be (m :: * -> *) (table :: (* -> *) -> *).
(MonadBeamDeleteReturning be m, Beamable table,
 Projectible be (table (QExpr be ())),
 FromBackendRow be (table Identity)) =>
SqlDelete be table -> m [table Identity]
runDeleteReturningList

class BeamSqlBackend be => BeamHasInsertOnConflict be where
  -- | Specifies the kind of constraint that must be violated for the action to occur
  data SqlConflictTarget be (table :: (Type -> Type) -> Type) :: Type
  -- | What to do when an @INSERT@ statement inserts a row into the table @tbl@
  -- that violates a constraint.
  data SqlConflictAction be (table :: (Type -> Type) -> Type) :: Type

  insertOnConflict
    :: Beamable table
    => DatabaseEntity be db (TableEntity table)
    -> SqlInsertValues be (table (QExpr be s))
    -> SqlConflictTarget be table
    -> SqlConflictAction be table
    -> SqlInsert be table

  anyConflict :: SqlConflictTarget be table
  conflictingFields
    :: Projectible be proj
    => (table (QExpr be QInternal) -> proj)
    -> SqlConflictTarget be table
  conflictingFieldsWhere
    :: Projectible be proj
    => (table (QExpr be QInternal) -> proj)
    -> (forall s. table (QExpr be s) -> QExpr be s Bool)
    -> SqlConflictTarget be table

  onConflictDoNothing :: SqlConflictAction be table
  onConflictUpdateSet
    :: Beamable table
    => (forall s. table (QField s) -> table (QExpr be s) -> QAssignment be s)
    -> SqlConflictAction be table
  onConflictUpdateSetWhere
    :: Beamable table
    => (forall s. table (QField s) -> table (QExpr be s) -> QAssignment be s)
    -> (forall s. table (QField s) -> table (QExpr be s) -> QExpr be s Bool)
    -> SqlConflictAction be table

newtype InaccessibleQAssignment be = InaccessibleQAssignment
  { InaccessibleQAssignment be
-> [(BeamSqlBackendFieldNameSyntax be,
     BeamSqlBackendExpressionSyntax be)]
unInaccessibleQAssignment :: [(BeamSqlBackendFieldNameSyntax be, BeamSqlBackendExpressionSyntax be)]
  } deriving (b -> InaccessibleQAssignment be -> InaccessibleQAssignment be
NonEmpty (InaccessibleQAssignment be) -> InaccessibleQAssignment be
InaccessibleQAssignment be
-> InaccessibleQAssignment be -> InaccessibleQAssignment be
(InaccessibleQAssignment be
 -> InaccessibleQAssignment be -> InaccessibleQAssignment be)
-> (NonEmpty (InaccessibleQAssignment be)
    -> InaccessibleQAssignment be)
-> (forall b.
    Integral b =>
    b -> InaccessibleQAssignment be -> InaccessibleQAssignment be)
-> Semigroup (InaccessibleQAssignment be)
forall b.
Integral b =>
b -> InaccessibleQAssignment be -> InaccessibleQAssignment be
forall be.
NonEmpty (InaccessibleQAssignment be) -> InaccessibleQAssignment be
forall be.
InaccessibleQAssignment be
-> InaccessibleQAssignment be -> InaccessibleQAssignment be
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall be b.
Integral b =>
b -> InaccessibleQAssignment be -> InaccessibleQAssignment be
stimes :: b -> InaccessibleQAssignment be -> InaccessibleQAssignment be
$cstimes :: forall be b.
Integral b =>
b -> InaccessibleQAssignment be -> InaccessibleQAssignment be
sconcat :: NonEmpty (InaccessibleQAssignment be) -> InaccessibleQAssignment be
$csconcat :: forall be.
NonEmpty (InaccessibleQAssignment be) -> InaccessibleQAssignment be
<> :: InaccessibleQAssignment be
-> InaccessibleQAssignment be -> InaccessibleQAssignment be
$c<> :: forall be.
InaccessibleQAssignment be
-> InaccessibleQAssignment be -> InaccessibleQAssignment be
Data.Semigroup.Semigroup, Semigroup (InaccessibleQAssignment be)
InaccessibleQAssignment be
Semigroup (InaccessibleQAssignment be)
-> InaccessibleQAssignment be
-> (InaccessibleQAssignment be
    -> InaccessibleQAssignment be -> InaccessibleQAssignment be)
-> ([InaccessibleQAssignment be] -> InaccessibleQAssignment be)
-> Monoid (InaccessibleQAssignment be)
[InaccessibleQAssignment be] -> InaccessibleQAssignment be
InaccessibleQAssignment be
-> InaccessibleQAssignment be -> InaccessibleQAssignment be
forall be. Semigroup (InaccessibleQAssignment be)
forall be. InaccessibleQAssignment be
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall be.
[InaccessibleQAssignment be] -> InaccessibleQAssignment be
forall be.
InaccessibleQAssignment be
-> InaccessibleQAssignment be -> InaccessibleQAssignment be
mconcat :: [InaccessibleQAssignment be] -> InaccessibleQAssignment be
$cmconcat :: forall be.
[InaccessibleQAssignment be] -> InaccessibleQAssignment be
mappend :: InaccessibleQAssignment be
-> InaccessibleQAssignment be -> InaccessibleQAssignment be
$cmappend :: forall be.
InaccessibleQAssignment be
-> InaccessibleQAssignment be -> InaccessibleQAssignment be
mempty :: InaccessibleQAssignment be
$cmempty :: forall be. InaccessibleQAssignment be
$cp1Monoid :: forall be. Semigroup (InaccessibleQAssignment be)
Monoid)

onConflictUpdateInstead
  :: forall be table proj
  .  ( BeamHasInsertOnConflict be
     , Beamable table
     , ProjectibleWithPredicate AnyType () (InaccessibleQAssignment be) proj
     )
  => (table (Const (InaccessibleQAssignment be)) -> proj)
  -> SqlConflictAction be table
onConflictUpdateInstead :: (table (Const (InaccessibleQAssignment be)) -> proj)
-> SqlConflictAction be table
onConflictUpdateInstead table (Const (InaccessibleQAssignment be)) -> proj
mkProj = (forall s.
 table (QField s) -> table (QExpr be s) -> QAssignment be s)
-> SqlConflictAction be table
forall be (table :: (* -> *) -> *).
(BeamHasInsertOnConflict be, Beamable table) =>
(forall s.
 table (QField s) -> table (QExpr be s) -> QAssignment be s)
-> SqlConflictAction be table
onConflictUpdateSet forall s.
table (QField s) -> table (QExpr be s) -> QAssignment be s
mkAssignments
  where
    mkAssignments
      :: forall s
      .  table (QField s)
      -> table (QExpr be s)
      -> QAssignment be s
    mkAssignments :: table (QField s) -> table (QExpr be s) -> QAssignment be s
mkAssignments table (QField s)
table table (QExpr be s)
excluded = [(BeamSqlBackendFieldNameSyntax be,
  BeamSqlBackendExpressionSyntax be)]
-> QAssignment be s
forall be s.
[(BeamSqlBackendFieldNameSyntax be,
  BeamSqlBackendExpressionSyntax be)]
-> QAssignment be s
QAssignment ([(BeamSqlBackendFieldNameSyntax be,
   BeamSqlBackendExpressionSyntax be)]
 -> QAssignment be s)
-> [(BeamSqlBackendFieldNameSyntax be,
     BeamSqlBackendExpressionSyntax be)]
-> QAssignment be s
forall a b. (a -> b) -> a -> b
$ InaccessibleQAssignment be
-> [(BeamSqlBackendFieldNameSyntax be,
     BeamSqlBackendExpressionSyntax be)]
forall be.
InaccessibleQAssignment be
-> [(BeamSqlBackendFieldNameSyntax be,
     BeamSqlBackendExpressionSyntax be)]
unInaccessibleQAssignment (InaccessibleQAssignment be
 -> [(BeamSqlBackendFieldNameSyntax be,
      BeamSqlBackendExpressionSyntax be)])
-> InaccessibleQAssignment be
-> [(BeamSqlBackendFieldNameSyntax be,
     BeamSqlBackendExpressionSyntax be)]
forall a b. (a -> b) -> a -> b
$
      Writer (InaccessibleQAssignment be) proj
-> InaccessibleQAssignment be
forall w a. Writer w a -> w
Strict.execWriter (Writer (InaccessibleQAssignment be) proj
 -> InaccessibleQAssignment be)
-> Writer (InaccessibleQAssignment be) proj
-> InaccessibleQAssignment be
forall a b. (a -> b) -> a -> b
$ Proxy AnyType
-> Proxy ((), InaccessibleQAssignment be)
-> (forall context.
    AnyType context =>
    Proxy context
    -> Proxy ()
    -> InaccessibleQAssignment be
    -> WriterT
         (InaccessibleQAssignment be) Identity (InaccessibleQAssignment be))
-> proj
-> Writer (InaccessibleQAssignment be) proj
forall (contextPredicate :: * -> Constraint) be res a
       (m :: * -> *).
(ProjectibleWithPredicate contextPredicate be res a, Monad m) =>
Proxy contextPredicate
-> Proxy (be, res)
-> (forall context.
    contextPredicate context =>
    Proxy context -> Proxy be -> res -> m res)
-> a
-> m a
project'
        (Proxy AnyType
forall k (t :: k). Proxy t
Proxy @AnyType)
        (Proxy ((), InaccessibleQAssignment be)
forall k (t :: k). Proxy t
Proxy @((), InaccessibleQAssignment be))
        (\Proxy context
_ Proxy ()
_ InaccessibleQAssignment be
a -> InaccessibleQAssignment be
-> WriterT (InaccessibleQAssignment be) Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
Strict.tell InaccessibleQAssignment be
a WriterT (InaccessibleQAssignment be) Identity ()
-> WriterT
     (InaccessibleQAssignment be) Identity (InaccessibleQAssignment be)
-> WriterT
     (InaccessibleQAssignment be) Identity (InaccessibleQAssignment be)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InaccessibleQAssignment be
-> WriterT
     (InaccessibleQAssignment be) Identity (InaccessibleQAssignment be)
forall (m :: * -> *) a. Monad m => a -> m a
return InaccessibleQAssignment be
a)
        (table (Const (InaccessibleQAssignment be)) -> proj
mkProj (table (Const (InaccessibleQAssignment be)) -> proj)
-> table (Const (InaccessibleQAssignment be)) -> proj
forall a b. (a -> b) -> a -> b
$ Identity (table (Const (InaccessibleQAssignment be)))
-> table (Const (InaccessibleQAssignment be))
forall a. Identity a -> a
runIdentity (Identity (table (Const (InaccessibleQAssignment be)))
 -> table (Const (InaccessibleQAssignment be)))
-> Identity (table (Const (InaccessibleQAssignment be)))
-> table (Const (InaccessibleQAssignment be))
forall a b. (a -> b) -> a -> b
$ (forall a.
 Columnar' (QField s) a
 -> Columnar' (QExpr be s) a
 -> Identity (Columnar' (Const (InaccessibleQAssignment be)) a))
-> table (QField s)
-> table (QExpr be s)
-> Identity (table (Const (InaccessibleQAssignment be)))
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM forall a.
Columnar' (QField s) a
-> Columnar' (QExpr be s) a
-> Identity (Columnar' (Const (InaccessibleQAssignment be)) a)
forall s a.
Columnar' (QField s) a
-> Columnar' (QExpr be s) a
-> Identity (Columnar' (Const (InaccessibleQAssignment be)) a)
mkAssignment table (QField s)
table table (QExpr be s)
excluded)
    mkAssignment
      :: forall s a
      .  Columnar' (QField s) a
      -> Columnar' (QExpr be s) a
      -> Identity (Columnar' (Const (InaccessibleQAssignment be)) a)
    mkAssignment :: Columnar' (QField s) a
-> Columnar' (QExpr be s) a
-> Identity (Columnar' (Const (InaccessibleQAssignment be)) a)
mkAssignment (Columnar' Columnar (QField s) a
field) (Columnar' Columnar (QExpr be s) a
value) =
      Columnar' (Const (InaccessibleQAssignment be)) a
-> Identity (Columnar' (Const (InaccessibleQAssignment be)) a)
forall a. a -> Identity a
Identity (Columnar' (Const (InaccessibleQAssignment be)) a
 -> Identity (Columnar' (Const (InaccessibleQAssignment be)) a))
-> Columnar' (Const (InaccessibleQAssignment be)) a
-> Identity (Columnar' (Const (InaccessibleQAssignment be)) a)
forall a b. (a -> b) -> a -> b
$ Columnar (Const (InaccessibleQAssignment be)) a
-> Columnar' (Const (InaccessibleQAssignment be)) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Columnar (Const (InaccessibleQAssignment be)) a
 -> Columnar' (Const (InaccessibleQAssignment be)) a)
-> Columnar (Const (InaccessibleQAssignment be)) a
-> Columnar' (Const (InaccessibleQAssignment be)) a
forall a b. (a -> b) -> a -> b
$ InaccessibleQAssignment be -> Const (InaccessibleQAssignment be) a
forall k a (b :: k). a -> Const a b
Const (InaccessibleQAssignment be
 -> Const (InaccessibleQAssignment be) a)
-> InaccessibleQAssignment be
-> Const (InaccessibleQAssignment be) a
forall a b. (a -> b) -> a -> b
$
        [(BeamSqlBackendFieldNameSyntax be,
  BeamSqlBackendExpressionSyntax be)]
-> InaccessibleQAssignment be
forall be.
[(BeamSqlBackendFieldNameSyntax be,
  BeamSqlBackendExpressionSyntax be)]
-> InaccessibleQAssignment be
InaccessibleQAssignment ([(BeamSqlBackendFieldNameSyntax be,
   BeamSqlBackendExpressionSyntax be)]
 -> InaccessibleQAssignment be)
-> [(BeamSqlBackendFieldNameSyntax be,
     BeamSqlBackendExpressionSyntax be)]
-> InaccessibleQAssignment be
forall a b. (a -> b) -> a -> b
$ QAssignment be s
-> [(BeamSqlBackendFieldNameSyntax be,
     BeamSqlBackendExpressionSyntax be)]
forall be s.
QAssignment be s
-> [(BeamSqlBackendFieldNameSyntax be,
     BeamSqlBackendExpressionSyntax be)]
unQAssignment (QAssignment be s
 -> [(BeamSqlBackendFieldNameSyntax be,
      BeamSqlBackendExpressionSyntax be)])
-> QAssignment be s
-> [(BeamSqlBackendFieldNameSyntax be,
     BeamSqlBackendExpressionSyntax be)]
forall a b. (a -> b) -> a -> b
$ Columnar (QField s) a
QField s a
field QField s a -> QGenExpr QValueContext be s a -> QAssignment be s
forall be s lhs rhs.
SqlUpdatable be s lhs rhs =>
lhs -> rhs -> QAssignment be s
<-. Columnar (QExpr be s) a
QGenExpr QValueContext be s a
value

onConflictUpdateAll
  :: forall be table
  .  ( BeamHasInsertOnConflict be
     , Beamable table
     )
  => SqlConflictAction be table
onConflictUpdateAll :: SqlConflictAction be table
onConflictUpdateAll = (table (Const (InaccessibleQAssignment be))
 -> table (Const (InaccessibleQAssignment be)))
-> SqlConflictAction be table
forall be (table :: (* -> *) -> *) proj.
(BeamHasInsertOnConflict be, Beamable table,
 ProjectibleWithPredicate
   AnyType () (InaccessibleQAssignment be) proj) =>
(table (Const (InaccessibleQAssignment be)) -> proj)
-> SqlConflictAction be table
onConflictUpdateInstead table (Const (InaccessibleQAssignment be))
-> table (Const (InaccessibleQAssignment be))
forall a. a -> a
id