{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}

module Opaleye.Trans
    ( OpaleyeT (..)
    , runOpaleyeT

    , -- * Transactions
      Transaction
    , transaction
    , run

    , -- * Queries
      query
    , queryFirst

    , -- * Inserts
      insert
    , insertMany
    , insertReturning
    , insertReturningFirst
    , insertManyReturning

    , -- * Updates
      update
    , updateReturning
    , updateReturningFirst

    , -- * Deletes
      delete

    , -- * Utilities
      withConn

    , -- * Reexports
      liftIO
    , MonadIO
    , ask
    , Int64
    ) where

import           Control.Monad.IO.Class          (MonadIO, liftIO)
import           Control.Monad.Reader            (MonadReader, ReaderT (..),
                                                  ask)
import           Control.Monad.Trans             (MonadTrans (..))
import           Control.Monad.Catch             (MonadCatch, MonadThrow)

import           Data.Maybe                      (listToMaybe)
import           Data.Profunctor.Product.Default (Default)

import           Database.PostgreSQL.Simple      (Connection, withTransaction)
import qualified Database.PostgreSQL.Simple      as PSQL

import           GHC.Int                         (Int64)

import           Opaleye


-- | The 'Opaleye' monad transformer
newtype OpaleyeT m a = OpaleyeT { OpaleyeT m a -> ReaderT Connection m a
unOpaleyeT :: ReaderT Connection m a }
    deriving ( a -> OpaleyeT m b -> OpaleyeT m a
(a -> b) -> OpaleyeT m a -> OpaleyeT m b
(forall a b. (a -> b) -> OpaleyeT m a -> OpaleyeT m b)
-> (forall a b. a -> OpaleyeT m b -> OpaleyeT m a)
-> Functor (OpaleyeT m)
forall a b. a -> OpaleyeT m b -> OpaleyeT m a
forall a b. (a -> b) -> OpaleyeT m a -> OpaleyeT m b
forall (m :: * -> *) a b.
Functor m =>
a -> OpaleyeT m b -> OpaleyeT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> OpaleyeT m a -> OpaleyeT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OpaleyeT m b -> OpaleyeT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> OpaleyeT m b -> OpaleyeT m a
fmap :: (a -> b) -> OpaleyeT m a -> OpaleyeT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> OpaleyeT m a -> OpaleyeT m b
Functor, Functor (OpaleyeT m)
a -> OpaleyeT m a
Functor (OpaleyeT m)
-> (forall a. a -> OpaleyeT m a)
-> (forall a b.
    OpaleyeT m (a -> b) -> OpaleyeT m a -> OpaleyeT m b)
-> (forall a b c.
    (a -> b -> c) -> OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m c)
-> (forall a b. OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b)
-> (forall a b. OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m a)
-> Applicative (OpaleyeT m)
OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m a
OpaleyeT m (a -> b) -> OpaleyeT m a -> OpaleyeT m b
(a -> b -> c) -> OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m c
forall a. a -> OpaleyeT m a
forall a b. OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m a
forall a b. OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
forall a b. OpaleyeT m (a -> b) -> OpaleyeT m a -> OpaleyeT m b
forall a b c.
(a -> b -> c) -> OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (OpaleyeT m)
forall (m :: * -> *) a. Applicative m => a -> OpaleyeT m a
forall (m :: * -> *) a b.
Applicative m =>
OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m a
forall (m :: * -> *) a b.
Applicative m =>
OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
forall (m :: * -> *) a b.
Applicative m =>
OpaleyeT m (a -> b) -> OpaleyeT m a -> OpaleyeT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m c
<* :: OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m a
*> :: OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
liftA2 :: (a -> b -> c) -> OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m c
<*> :: OpaleyeT m (a -> b) -> OpaleyeT m a -> OpaleyeT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
OpaleyeT m (a -> b) -> OpaleyeT m a -> OpaleyeT m b
pure :: a -> OpaleyeT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> OpaleyeT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (OpaleyeT m)
Applicative, Applicative (OpaleyeT m)
a -> OpaleyeT m a
Applicative (OpaleyeT m)
-> (forall a b.
    OpaleyeT m a -> (a -> OpaleyeT m b) -> OpaleyeT m b)
-> (forall a b. OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b)
-> (forall a. a -> OpaleyeT m a)
-> Monad (OpaleyeT m)
OpaleyeT m a -> (a -> OpaleyeT m b) -> OpaleyeT m b
OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
forall a. a -> OpaleyeT m a
forall a b. OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
forall a b. OpaleyeT m a -> (a -> OpaleyeT m b) -> OpaleyeT m b
forall (m :: * -> *). Monad m => Applicative (OpaleyeT m)
forall (m :: * -> *) a. Monad m => a -> OpaleyeT m a
forall (m :: * -> *) a b.
Monad m =>
OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
forall (m :: * -> *) a b.
Monad m =>
OpaleyeT m a -> (a -> OpaleyeT m b) -> OpaleyeT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> OpaleyeT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> OpaleyeT m a
>> :: OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
OpaleyeT m a -> OpaleyeT m b -> OpaleyeT m b
>>= :: OpaleyeT m a -> (a -> OpaleyeT m b) -> OpaleyeT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
OpaleyeT m a -> (a -> OpaleyeT m b) -> OpaleyeT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (OpaleyeT m)
Monad, m a -> OpaleyeT m a
(forall (m :: * -> *) a. Monad m => m a -> OpaleyeT m a)
-> MonadTrans OpaleyeT
forall (m :: * -> *) a. Monad m => m a -> OpaleyeT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> OpaleyeT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> OpaleyeT m a
MonadTrans, Monad (OpaleyeT m)
Monad (OpaleyeT m)
-> (forall a. IO a -> OpaleyeT m a) -> MonadIO (OpaleyeT m)
IO a -> OpaleyeT m a
forall a. IO a -> OpaleyeT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (OpaleyeT m)
forall (m :: * -> *) a. MonadIO m => IO a -> OpaleyeT m a
liftIO :: IO a -> OpaleyeT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> OpaleyeT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (OpaleyeT m)
MonadIO
             , MonadReader Connection, MonadThrow (OpaleyeT m)
MonadThrow (OpaleyeT m)
-> (forall e a.
    Exception e =>
    OpaleyeT m a -> (e -> OpaleyeT m a) -> OpaleyeT m a)
-> MonadCatch (OpaleyeT m)
OpaleyeT m a -> (e -> OpaleyeT m a) -> OpaleyeT m a
forall e a.
Exception e =>
OpaleyeT m a -> (e -> OpaleyeT m a) -> OpaleyeT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (OpaleyeT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
OpaleyeT m a -> (e -> OpaleyeT m a) -> OpaleyeT m a
catch :: OpaleyeT m a -> (e -> OpaleyeT m a) -> OpaleyeT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
OpaleyeT m a -> (e -> OpaleyeT m a) -> OpaleyeT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (OpaleyeT m)
MonadCatch, Monad (OpaleyeT m)
e -> OpaleyeT m a
Monad (OpaleyeT m)
-> (forall e a. Exception e => e -> OpaleyeT m a)
-> MonadThrow (OpaleyeT m)
forall e a. Exception e => e -> OpaleyeT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (OpaleyeT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> OpaleyeT m a
throwM :: e -> OpaleyeT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> OpaleyeT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (OpaleyeT m)
MonadThrow
             )


-- | Given a 'Connection', run an 'OpaleyeT'
runOpaleyeT :: PSQL.Connection -> OpaleyeT m a -> m a
runOpaleyeT :: Connection -> OpaleyeT m a -> m a
runOpaleyeT Connection
c = (ReaderT Connection m a -> Connection -> m a)
-> Connection -> ReaderT Connection m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Connection m a -> Connection -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Connection
c (ReaderT Connection m a -> m a)
-> (OpaleyeT m a -> ReaderT Connection m a) -> OpaleyeT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpaleyeT m a -> ReaderT Connection m a
forall (m :: * -> *) a. OpaleyeT m a -> ReaderT Connection m a
unOpaleyeT


withConn :: MonadIO m => (Connection -> IO a) -> OpaleyeT m a
withConn :: (Connection -> IO a) -> OpaleyeT m a
withConn Connection -> IO a
f = OpaleyeT m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask OpaleyeT m Connection
-> (Connection -> OpaleyeT m a) -> OpaleyeT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> OpaleyeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> OpaleyeT m a)
-> (Connection -> IO a) -> Connection -> OpaleyeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO a
f


newtype Transaction a = Transaction { Transaction a -> ReaderT Connection IO a
unTransaction :: ReaderT Connection IO a }
    deriving (a -> Transaction b -> Transaction a
(a -> b) -> Transaction a -> Transaction b
(forall a b. (a -> b) -> Transaction a -> Transaction b)
-> (forall a b. a -> Transaction b -> Transaction a)
-> Functor Transaction
forall a b. a -> Transaction b -> Transaction a
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Transaction b -> Transaction a
$c<$ :: forall a b. a -> Transaction b -> Transaction a
fmap :: (a -> b) -> Transaction a -> Transaction b
$cfmap :: forall a b. (a -> b) -> Transaction a -> Transaction b
Functor, Functor Transaction
a -> Transaction a
Functor Transaction
-> (forall a. a -> Transaction a)
-> (forall a b.
    Transaction (a -> b) -> Transaction a -> Transaction b)
-> (forall a b c.
    (a -> b -> c) -> Transaction a -> Transaction b -> Transaction c)
-> (forall a b. Transaction a -> Transaction b -> Transaction b)
-> (forall a b. Transaction a -> Transaction b -> Transaction a)
-> Applicative Transaction
Transaction a -> Transaction b -> Transaction b
Transaction a -> Transaction b -> Transaction a
Transaction (a -> b) -> Transaction a -> Transaction b
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
forall a. a -> Transaction a
forall a b. Transaction a -> Transaction b -> Transaction a
forall a b. Transaction a -> Transaction b -> Transaction b
forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
forall a b c.
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Transaction a -> Transaction b -> Transaction a
$c<* :: forall a b. Transaction a -> Transaction b -> Transaction a
*> :: Transaction a -> Transaction b -> Transaction b
$c*> :: forall a b. Transaction a -> Transaction b -> Transaction b
liftA2 :: (a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Transaction a -> Transaction b -> Transaction c
<*> :: Transaction (a -> b) -> Transaction a -> Transaction b
$c<*> :: forall a b. Transaction (a -> b) -> Transaction a -> Transaction b
pure :: a -> Transaction a
$cpure :: forall a. a -> Transaction a
$cp1Applicative :: Functor Transaction
Applicative, Applicative Transaction
a -> Transaction a
Applicative Transaction
-> (forall a b.
    Transaction a -> (a -> Transaction b) -> Transaction b)
-> (forall a b. Transaction a -> Transaction b -> Transaction b)
-> (forall a. a -> Transaction a)
-> Monad Transaction
Transaction a -> (a -> Transaction b) -> Transaction b
Transaction a -> Transaction b -> Transaction b
forall a. a -> Transaction a
forall a b. Transaction a -> Transaction b -> Transaction b
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Transaction a
$creturn :: forall a. a -> Transaction a
>> :: Transaction a -> Transaction b -> Transaction b
$c>> :: forall a b. Transaction a -> Transaction b -> Transaction b
>>= :: Transaction a -> (a -> Transaction b) -> Transaction b
$c>>= :: forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
$cp1Monad :: Applicative Transaction
Monad, MonadReader Connection)


-- | Run a postgresql transaction in the 'OpaleyeT' monad
transaction :: MonadIO m => Transaction a -> OpaleyeT m a
transaction :: Transaction a -> OpaleyeT m a
transaction (Transaction ReaderT Connection IO a
t) = (Connection -> IO a) -> OpaleyeT m a
forall (m :: * -> *) a.
MonadIO m =>
(Connection -> IO a) -> OpaleyeT m a
withConn ((Connection -> IO a) -> OpaleyeT m a)
-> (Connection -> IO a) -> OpaleyeT m a
forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
    Connection -> IO a -> IO a
forall a. Connection -> IO a -> IO a
withTransaction Connection
conn (ReaderT Connection IO a -> Connection -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Connection IO a
t Connection
conn)


-- | Execute a query without a literal transaction
run :: MonadIO m => Transaction a -> OpaleyeT m a
run :: Transaction a -> OpaleyeT m a
run = (Connection -> IO a) -> OpaleyeT m a
forall (m :: * -> *) a.
MonadIO m =>
(Connection -> IO a) -> OpaleyeT m a
withConn ((Connection -> IO a) -> OpaleyeT m a)
-> (Transaction a -> Connection -> IO a)
-> Transaction a
-> OpaleyeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Connection IO a -> Connection -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT Connection IO a -> Connection -> IO a)
-> (Transaction a -> ReaderT Connection IO a)
-> Transaction a
-> Connection
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction a -> ReaderT Connection IO a
forall a. Transaction a -> ReaderT Connection IO a
unTransaction


-- | With a 'Connection' in a 'Transaction'
-- This isn't exposed so that users can't just drop down to IO
-- in a transaction
withConnIO :: (Connection -> IO a) -> Transaction a
withConnIO :: (Connection -> IO a) -> Transaction a
withConnIO = ReaderT Connection IO a -> Transaction a
forall a. ReaderT Connection IO a -> Transaction a
Transaction (ReaderT Connection IO a -> Transaction a)
-> ((Connection -> IO a) -> ReaderT Connection IO a)
-> (Connection -> IO a)
-> Transaction a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> IO a) -> ReaderT Connection IO a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT


-- | Execute a 'Query'. See 'runQuery'.
query :: Default QueryRunner a b => Query a -> Transaction [b]
query :: Query a -> Transaction [b]
query Query a
q = (Connection -> IO [b]) -> Transaction [b]
forall a. (Connection -> IO a) -> Transaction a
withConnIO (Connection -> Query a -> IO [b]
forall fields haskells.
Default FromFields fields haskells =>
Connection -> Select fields -> IO [haskells]
`runQuery` Query a
q)


-- | Retrieve the first result from a 'Query'. Similar to @listToMaybe <$> runQuery@.
queryFirst :: Default QueryRunner a b => Query a -> Transaction (Maybe b)
queryFirst :: Query a -> Transaction (Maybe b)
queryFirst Query a
q = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> Transaction [b] -> Transaction (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query a -> Transaction [b]
forall a b. Default FromFields a b => Query a -> Transaction [b]
query Query a
q


-- | Insert into a 'Table'. See 'runInsert'.
insert :: Table w r -> w -> Transaction Int64
insert :: Table w r -> w -> Transaction Int64
insert Table w r
t w
w = (Connection -> IO Int64) -> Transaction Int64
forall a. (Connection -> IO a) -> Transaction a
withConnIO (\Connection
c -> Connection -> Table w r -> [w] -> IO Int64
forall columns columns'.
Connection -> Table columns columns' -> [columns] -> IO Int64
runInsertMany Connection
c Table w r
t [w
w])


-- | Insert many records into a 'Table'. See 'runInsertMany'.
insertMany :: Table w r -> [w] -> Transaction Int64
insertMany :: Table w r -> [w] -> Transaction Int64
insertMany Table w r
t [w]
ws = (Connection -> IO Int64) -> Transaction Int64
forall a. (Connection -> IO a) -> Transaction a
withConnIO (\Connection
c -> Connection -> Table w r -> [w] -> IO Int64
forall columns columns'.
Connection -> Table columns columns' -> [columns] -> IO Int64
runInsertMany Connection
c Table w r
t [w]
ws)


-- | Insert a record into a 'Table' with a return value. See 'runInsertReturning'.
insertReturning :: Default QueryRunner a b => Table w r -> (r -> a) -> w -> Transaction [b]
insertReturning :: Table w r -> (r -> a) -> w -> Transaction [b]
insertReturning Table w r
t r -> a
ret w
w = (Connection -> IO [b]) -> Transaction [b]
forall a. (Connection -> IO a) -> Transaction a
withConnIO (\Connection
c -> Connection -> Table w r -> [w] -> (r -> a) -> IO [b]
forall columnsReturned haskells columnsW columnsR.
Default FromFields columnsReturned haskells =>
Connection
-> Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertManyReturning Connection
c Table w r
t [w
w] r -> a
ret)


-- | Insert a record into a 'Table' with a return value. Retrieve only the first result.
-- Similar to @'listToMaybe' '<$>' 'insertReturning'@
insertReturningFirst :: Default QueryRunner a b => Table w r -> (r -> a) -> w -> Transaction (Maybe b)
insertReturningFirst :: Table w r -> (r -> a) -> w -> Transaction (Maybe b)
insertReturningFirst Table w r
t r -> a
ret w
w = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> Transaction [b] -> Transaction (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Table w r -> (r -> a) -> w -> Transaction [b]
forall a b w r.
Default FromFields a b =>
Table w r -> (r -> a) -> w -> Transaction [b]
insertReturning Table w r
t r -> a
ret w
w


-- | Insert many records into a 'Table' with a return value for each record.
--
-- Maybe not worth defining. This almost certainly does the wrong thing.
insertManyReturning :: Default QueryRunner a b => Table w r -> [w] -> (r -> a) -> Transaction [b]
insertManyReturning :: Table w r -> [w] -> (r -> a) -> Transaction [b]
insertManyReturning Table w r
t [w]
ws r -> a
ret = (Connection -> IO [b]) -> Transaction [b]
forall a. (Connection -> IO a) -> Transaction a
withConnIO (\Connection
c -> Connection -> Table w r -> [w] -> (r -> a) -> IO [b]
forall columnsReturned haskells columnsW columnsR.
Default FromFields columnsReturned haskells =>
Connection
-> Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertManyReturning Connection
c Table w r
t [w]
ws r -> a
ret)


-- | Update items in a 'Table' where the predicate is true. See 'runUpdate'.
update :: Table w r -> (r -> w) -> (r -> Column PGBool) -> Transaction Int64
update :: Table w r -> (r -> w) -> (r -> Column PGBool) -> Transaction Int64
update Table w r
t r -> w
r2w r -> Column PGBool
predicate = (Connection -> IO Int64) -> Transaction Int64
forall a. (Connection -> IO a) -> Transaction a
withConnIO (\Connection
c -> Connection
-> Table w r -> (r -> w) -> (r -> Column PGBool) -> IO Int64
forall columnsW columnsR.
Connection
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> IO Int64
runUpdate Connection
c Table w r
t r -> w
r2w r -> Column PGBool
predicate)


-- | Update items in a 'Table' with a return value. See 'runUpdateReturning'.
updateReturning :: Default QueryRunner a b
                => Table w r
                -> (r -> w)
                -> (r -> Column PGBool)
                -> (r -> a)
                -> Transaction [b]
updateReturning :: Table w r
-> (r -> w) -> (r -> Column PGBool) -> (r -> a) -> Transaction [b]
updateReturning Table w r
table r -> w
r2w r -> Column PGBool
predicate r -> a
r2returned = (Connection -> IO [b]) -> Transaction [b]
forall a. (Connection -> IO a) -> Transaction a
withConnIO (\Connection
c -> Connection
-> Table w r
-> (r -> w)
-> (r -> Column PGBool)
-> (r -> a)
-> IO [b]
forall columnsReturned haskells columnsW columnsR.
Default FromFields columnsReturned haskells =>
Connection
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
runUpdateReturning Connection
c Table w r
table r -> w
r2w r -> Column PGBool
predicate r -> a
r2returned)


-- | Update items in a 'Table' with a return value. Similar to @'listToMaybe' '<$>' 'updateReturning'@.
updateReturningFirst :: Default QueryRunner a b
                     => Table w r
                     -> (r -> w)
                     -> (r -> Column PGBool)
                     -> (r -> a)
                     -> Transaction (Maybe b)
updateReturningFirst :: Table w r
-> (r -> w)
-> (r -> Column PGBool)
-> (r -> a)
-> Transaction (Maybe b)
updateReturningFirst Table w r
table r -> w
r2w r -> Column PGBool
predicate r -> a
r2returned = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> Transaction [b] -> Transaction (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Table w r
-> (r -> w) -> (r -> Column PGBool) -> (r -> a) -> Transaction [b]
forall a b w r.
Default FromFields a b =>
Table w r
-> (r -> w) -> (r -> Column PGBool) -> (r -> a) -> Transaction [b]
updateReturning Table w r
table r -> w
r2w r -> Column PGBool
predicate r -> a
r2returned


-- | Delete items in a 'Table' that satisfy some boolean predicate. See 'runDelete'.
delete :: Table a b -> (b -> Column PGBool) -> Transaction Int64
delete :: Table a b -> (b -> Column PGBool) -> Transaction Int64
delete Table a b
table b -> Column PGBool
r2b = (Connection -> IO Int64) -> Transaction Int64
forall a. (Connection -> IO a) -> Transaction a
withConnIO (\Connection
c -> Connection -> Table a b -> (b -> Column PGBool) -> IO Int64
forall a columnsR.
Connection
-> Table a columnsR -> (columnsR -> Column PGBool) -> IO Int64
runDelete Connection
c Table a b
table b -> Column PGBool
r2b)