{-# LANGUAGE FlexibleContexts #-}

module Opaleye.SQLite.Manipulation (module Opaleye.SQLite.Manipulation,
                             U.Unpackspec) where

import qualified Opaleye.SQLite.Internal.Sql as Sql
import qualified Opaleye.SQLite.Internal.Print as Print
import qualified Opaleye.SQLite.RunQuery as RQ
import qualified Opaleye.SQLite.Internal.RunQuery as IRQ
import qualified Opaleye.SQLite.Table as T
import qualified Opaleye.SQLite.Internal.Table as TI
import           Opaleye.SQLite.Internal.Column (Column(Column))
import           Opaleye.SQLite.Internal.Helpers ((.:), (.:.), (.::), (.::.))
import qualified Opaleye.SQLite.Internal.Unpackspec as U
import           Opaleye.SQLite.PGTypes (PGBool)

import qualified Opaleye.SQLite.Internal.HaskellDB.Sql as HSql
import qualified Opaleye.SQLite.Internal.HaskellDB.Sql.Print as HPrint
import qualified Opaleye.SQLite.Internal.HaskellDB.Sql.Default as SD
import qualified Opaleye.SQLite.Internal.HaskellDB.Sql.Generate as SG

import qualified Database.SQLite.Simple as PGS

import qualified Data.Profunctor.Product.Default as D

--import           Data.Int (Int64)
import           Data.String (fromString)
import qualified Data.List.NonEmpty as NEL

type Int64 = ()

arrangeInsert :: T.Table columns a -> columns -> HSql.SqlInsert
arrangeInsert :: Table columns a -> columns -> SqlInsert
arrangeInsert Table columns a
t columns
c = Table columns a -> NonEmpty columns -> SqlInsert
forall columns a. Table columns a -> NonEmpty columns -> SqlInsert
arrangeInsertMany Table columns a
t (columns -> NonEmpty columns
forall (m :: * -> *) a. Monad m => a -> m a
return columns
c)

arrangeInsertSql :: T.Table columns a -> columns -> String
arrangeInsertSql :: Table columns a -> columns -> String
arrangeInsertSql = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (SqlInsert -> Doc) -> SqlInsert -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert -> Doc
HPrint.ppInsert (SqlInsert -> String)
-> (Table columns a -> columns -> SqlInsert)
-> Table columns a
-> columns
-> String
forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: Table columns a -> columns -> SqlInsert
forall columns a. Table columns a -> columns -> SqlInsert
arrangeInsert

runInsert :: PGS.Connection -> T.Table columns columns' -> columns -> IO Int64
runInsert :: Connection -> Table columns columns' -> columns -> IO Int64
runInsert Connection
conn = Connection -> Query -> IO Int64
PGS.execute_ Connection
conn (Query -> IO Int64) -> (String -> Query) -> String -> IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Query
forall a. IsString a => String -> a
fromString (String -> IO Int64)
-> (Table columns columns' -> columns -> String)
-> Table columns columns'
-> columns
-> IO Int64
forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: Table columns columns' -> columns -> String
forall columns a. Table columns a -> columns -> String
arrangeInsertSql

arrangeInsertMany :: T.Table columns a -> NEL.NonEmpty columns -> HSql.SqlInsert
arrangeInsertMany :: Table columns a -> NonEmpty columns -> SqlInsert
arrangeInsertMany (T.Table String
tableName (TI.TableProperties Writer columns a
writer View a
_)) NonEmpty columns
columns = SqlInsert
insert
  where (NonEmpty [PrimExpr]
columnExprs, [String]
columnNames) = Writer columns a
-> NonEmpty columns -> (NonEmpty [PrimExpr], [String])
forall columns columns'.
Writer columns columns'
-> NonEmpty columns -> (NonEmpty [PrimExpr], [String])
TI.runWriter' Writer columns a
writer NonEmpty columns
columns
        insert :: SqlInsert
insert = SqlGenerator
-> String -> [String] -> NonEmpty [PrimExpr] -> SqlInsert
SG.sqlInsert SqlGenerator
SD.defaultSqlGenerator
                      String
tableName [String]
columnNames NonEmpty [PrimExpr]
columnExprs

arrangeInsertManySql :: T.Table columns a -> NEL.NonEmpty columns -> String
arrangeInsertManySql :: Table columns a -> NonEmpty columns -> String
arrangeInsertManySql = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (SqlInsert -> Doc) -> SqlInsert -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlInsert -> Doc
HPrint.ppInsert (SqlInsert -> String)
-> (Table columns a -> NonEmpty columns -> SqlInsert)
-> Table columns a
-> NonEmpty columns
-> String
forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: Table columns a -> NonEmpty columns -> SqlInsert
forall columns a. Table columns a -> NonEmpty columns -> SqlInsert
arrangeInsertMany

runInsertMany :: PGS.Connection
              -> T.Table columns columns'
              -> [columns]
              -> IO Int64
runInsertMany :: Connection -> Table columns columns' -> [columns] -> IO Int64
runInsertMany Connection
conn Table columns columns'
table [columns]
columns = case [columns] -> Maybe (NonEmpty columns)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [columns]
columns of
  -- Inserting the empty list is just the same as returning 0
  Maybe (NonEmpty columns)
Nothing       -> Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return () --return 0
  Just NonEmpty columns
columns' -> (Connection -> Query -> IO Int64
PGS.execute_ Connection
conn (Query -> IO Int64) -> (String -> Query) -> String -> IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Query
forall a. IsString a => String -> a
fromString (String -> IO Int64)
-> (Table columns columns' -> NonEmpty columns -> String)
-> Table columns columns'
-> NonEmpty columns
-> IO Int64
forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: Table columns columns' -> NonEmpty columns -> String
forall columns a. Table columns a -> NonEmpty columns -> String
arrangeInsertManySql) Table columns columns'
table NonEmpty columns
columns'

arrangeUpdate :: T.Table columnsW columnsR
              -> (columnsR -> columnsW) -> (columnsR -> Column PGBool)
              -> HSql.SqlUpdate
arrangeUpdate :: Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> SqlUpdate
arrangeUpdate (TI.Table String
tableName (TI.TableProperties Writer columnsW columnsR
writer (TI.View columnsR
tableCols)))
              columnsR -> columnsW
update columnsR -> Column PGBool
cond =
  SqlGenerator -> String -> [PrimExpr] -> Assoc -> SqlUpdate
SG.sqlUpdate SqlGenerator
SD.defaultSqlGenerator String
tableName [PrimExpr
condExpr] (columnsR -> Assoc
update' columnsR
tableCols)
  where update' :: columnsR -> Assoc
update' = ((PrimExpr, String) -> (String, PrimExpr))
-> [(PrimExpr, String)] -> Assoc
forall a b. (a -> b) -> [a] -> [b]
map (\(PrimExpr
x, String
y) -> (String
y, PrimExpr
x))
                   ([(PrimExpr, String)] -> Assoc)
-> (columnsR -> [(PrimExpr, String)]) -> columnsR -> Assoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer columnsW columnsR -> columnsW -> [(PrimExpr, String)]
forall columns columns'.
Writer columns columns' -> columns -> [(PrimExpr, String)]
TI.runWriter Writer columnsW columnsR
writer
                   (columnsW -> [(PrimExpr, String)])
-> (columnsR -> columnsW) -> columnsR -> [(PrimExpr, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. columnsR -> columnsW
update
        Column PrimExpr
condExpr = columnsR -> Column PGBool
cond columnsR
tableCols

arrangeUpdateSql :: T.Table columnsW columnsR
              -> (columnsR -> columnsW) -> (columnsR -> Column PGBool)
              -> String
arrangeUpdateSql :: Table columnsW columnsR
-> (columnsR -> columnsW) -> (columnsR -> Column PGBool) -> String
arrangeUpdateSql = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (SqlUpdate -> Doc) -> SqlUpdate -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlUpdate -> Doc
HPrint.ppUpdate (SqlUpdate -> String)
-> (Table columnsW columnsR
    -> (columnsR -> columnsW)
    -> (columnsR -> Column PGBool)
    -> SqlUpdate)
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> String
forall r z a b c.
(r -> z) -> (a -> b -> c -> r) -> a -> b -> c -> z
.:. Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> SqlUpdate
forall columnsW columnsR.
Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> SqlUpdate
arrangeUpdate

runUpdate :: PGS.Connection -> T.Table columnsW columnsR
          -> (columnsR -> columnsW) -> (columnsR -> Column PGBool)
          -> IO Int64
runUpdate :: Connection
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> IO Int64
runUpdate Connection
conn = Connection -> Query -> IO Int64
PGS.execute_ Connection
conn (Query -> IO Int64) -> (String -> Query) -> String -> IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Query
forall a. IsString a => String -> a
fromString (String -> IO Int64)
-> (Table columnsW columnsR
    -> (columnsR -> columnsW) -> (columnsR -> Column PGBool) -> String)
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> IO Int64
forall r z a b c.
(r -> z) -> (a -> b -> c -> r) -> a -> b -> c -> z
.:. Table columnsW columnsR
-> (columnsR -> columnsW) -> (columnsR -> Column PGBool) -> String
forall columnsW columnsR.
Table columnsW columnsR
-> (columnsR -> columnsW) -> (columnsR -> Column PGBool) -> String
arrangeUpdateSql

arrangeDelete :: T.Table a columnsR -> (columnsR -> Column PGBool) -> HSql.SqlDelete
arrangeDelete :: Table a columnsR -> (columnsR -> Column PGBool) -> SqlDelete
arrangeDelete (TI.Table String
tableName (TI.TableProperties Writer a columnsR
_ (TI.View columnsR
tableCols)))
              columnsR -> Column PGBool
cond =
  SqlGenerator -> String -> [PrimExpr] -> SqlDelete
SG.sqlDelete SqlGenerator
SD.defaultSqlGenerator String
tableName [PrimExpr
condExpr]
  where Column PrimExpr
condExpr = columnsR -> Column PGBool
cond columnsR
tableCols

arrangeDeleteSql :: T.Table a columnsR -> (columnsR -> Column PGBool) -> String
arrangeDeleteSql :: Table a columnsR -> (columnsR -> Column PGBool) -> String
arrangeDeleteSql = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (SqlDelete -> Doc) -> SqlDelete -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlDelete -> Doc
HPrint.ppDelete (SqlDelete -> String)
-> (Table a columnsR -> (columnsR -> Column PGBool) -> SqlDelete)
-> Table a columnsR
-> (columnsR -> Column PGBool)
-> String
forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: Table a columnsR -> (columnsR -> Column PGBool) -> SqlDelete
forall a columnsR.
Table a columnsR -> (columnsR -> Column PGBool) -> SqlDelete
arrangeDelete

runDelete :: PGS.Connection -> T.Table a columnsR -> (columnsR -> Column PGBool)
          -> IO Int64
runDelete :: Connection
-> Table a columnsR -> (columnsR -> Column PGBool) -> IO Int64
runDelete Connection
conn = Connection -> Query -> IO Int64
PGS.execute_ Connection
conn (Query -> IO Int64) -> (String -> Query) -> String -> IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Query
forall a. IsString a => String -> a
fromString (String -> IO Int64)
-> (Table a columnsR -> (columnsR -> Column PGBool) -> String)
-> Table a columnsR
-> (columnsR -> Column PGBool)
-> IO Int64
forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: Table a columnsR -> (columnsR -> Column PGBool) -> String
forall a columnsR.
Table a columnsR -> (columnsR -> Column PGBool) -> String
arrangeDeleteSql

arrangeInsertReturning :: U.Unpackspec returned ignored
                       -> T.Table columnsW columnsR
                       -> columnsW
                       -> (columnsR -> returned)
                       -> Sql.Returning HSql.SqlInsert
arrangeInsertReturning :: Unpackspec returned ignored
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> Returning SqlInsert
arrangeInsertReturning Unpackspec returned ignored
unpackspec Table columnsW columnsR
table columnsW
columns columnsR -> returned
returningf =
  SqlInsert -> [SqlExpr] -> Returning SqlInsert
forall a. a -> [SqlExpr] -> Returning a
Sql.Returning SqlInsert
insert [SqlExpr]
returningSEs
  where insert :: SqlInsert
insert = Table columnsW columnsR -> columnsW -> SqlInsert
forall columns a. Table columns a -> columns -> SqlInsert
arrangeInsert Table columnsW columnsR
table columnsW
columns
        TI.Table String
_ (TI.TableProperties Writer columnsW columnsR
_ (TI.View columnsR
columnsR)) = Table columnsW columnsR
table
        returningPEs :: [PrimExpr]
returningPEs = Unpackspec returned ignored -> returned -> [PrimExpr]
forall s t. Unpackspec s t -> s -> [PrimExpr]
U.collectPEs Unpackspec returned ignored
unpackspec (columnsR -> returned
returningf columnsR
columnsR)
        returningSEs :: [SqlExpr]
returningSEs = (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
Sql.sqlExpr [PrimExpr]
returningPEs

arrangeInsertReturningSql :: U.Unpackspec returned ignored
                          -> T.Table columnsW columnsR
                          -> columnsW
                          -> (columnsR -> returned)
                          -> String
arrangeInsertReturningSql :: Unpackspec returned ignored
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> String
arrangeInsertReturningSql = Doc -> String
forall a. Show a => a -> String
show
                            (Doc -> String)
-> (Returning SqlInsert -> Doc) -> Returning SqlInsert -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Returning SqlInsert -> Doc
Print.ppInsertReturning
                            (Returning SqlInsert -> String)
-> (Unpackspec returned ignored
    -> Table columnsW columnsR
    -> columnsW
    -> (columnsR -> returned)
    -> Returning SqlInsert)
-> Unpackspec returned ignored
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> String
forall r z a b c d.
(r -> z) -> (a -> b -> c -> d -> r) -> a -> b -> c -> d -> z
.:: Unpackspec returned ignored
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> Returning SqlInsert
forall returned ignored columnsW columnsR.
Unpackspec returned ignored
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> Returning SqlInsert
arrangeInsertReturning

runInsertReturningExplicit :: RQ.QueryRunner returned haskells
                            -> PGS.Connection
                            -> T.Table columnsW columnsR
                            -> columnsW
                            -> (columnsR -> returned)
                            -> IO [haskells]
runInsertReturningExplicit :: QueryRunner returned haskells
-> Connection
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> IO [haskells]
runInsertReturningExplicit QueryRunner returned haskells
qr Connection
conn Table columnsW columnsR
t columnsW
w columnsR -> returned
r = RowParser haskells -> Connection -> Query -> IO [haskells]
forall r. RowParser r -> Connection -> Query -> IO [r]
PGS.queryWith_ (returned -> RowParser haskells
rowParser (columnsR -> returned
r columnsR
v)) Connection
conn
                                             (String -> Query
forall a. IsString a => String -> a
fromString
                                             (Unpackspec returned Int64
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> String
forall returned ignored columnsW columnsR.
Unpackspec returned ignored
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> String
arrangeInsertReturningSql Unpackspec returned Int64
u Table columnsW columnsR
t columnsW
w columnsR -> returned
r))
  where IRQ.QueryRunner Unpackspec returned Int64
u returned -> RowParser haskells
rowParser returned -> Bool
_ = QueryRunner returned haskells
qr
        --- ^^ TODO: need to make sure we're not trying to read zero rows
        TI.Table String
_ (TI.TableProperties Writer columnsW columnsR
_ (TI.View columnsR
v)) = Table columnsW columnsR
t
        -- This method of getting hold of the return type feels a bit
        -- suspect.  I haven't checked it for validity.

-- | @runInsertReturning@'s use of the 'D.Default' typeclass means that the
-- compiler will have trouble inferring types.  It is strongly
-- recommended that you provide full type signatures when using
-- @runInsertReturning@.
runInsertReturning :: (D.Default RQ.QueryRunner returned haskells)
                      => PGS.Connection
                      -> T.Table columnsW columnsR
                      -> columnsW
                      -> (columnsR -> returned)
                      -> IO [haskells]
runInsertReturning :: Connection
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> IO [haskells]
runInsertReturning = QueryRunner returned haskells
-> Connection
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> IO [haskells]
forall returned haskells columnsW columnsR.
QueryRunner returned haskells
-> Connection
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> returned)
-> IO [haskells]
runInsertReturningExplicit QueryRunner returned haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

arrangeUpdateReturning :: U.Unpackspec returned ignored
                       -> T.Table columnsW columnsR
                       -> (columnsR -> columnsW)
                       -> (columnsR -> Column PGBool)
                       -> (columnsR -> returned)
                       -> Sql.Returning HSql.SqlUpdate
arrangeUpdateReturning :: Unpackspec returned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> Returning SqlUpdate
arrangeUpdateReturning Unpackspec returned ignored
unpackspec Table columnsW columnsR
table columnsR -> columnsW
updatef columnsR -> Column PGBool
cond columnsR -> returned
returningf =
  SqlUpdate -> [SqlExpr] -> Returning SqlUpdate
forall a. a -> [SqlExpr] -> Returning a
Sql.Returning SqlUpdate
update [SqlExpr]
returningSEs
  where update :: SqlUpdate
update = Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> SqlUpdate
forall columnsW columnsR.
Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> SqlUpdate
arrangeUpdate Table columnsW columnsR
table columnsR -> columnsW
updatef columnsR -> Column PGBool
cond
        TI.Table String
_ (TI.TableProperties Writer columnsW columnsR
_ (TI.View columnsR
columnsR)) = Table columnsW columnsR
table
        returningPEs :: [PrimExpr]
returningPEs = Unpackspec returned ignored -> returned -> [PrimExpr]
forall s t. Unpackspec s t -> s -> [PrimExpr]
U.collectPEs Unpackspec returned ignored
unpackspec (columnsR -> returned
returningf columnsR
columnsR)
        returningSEs :: [SqlExpr]
returningSEs = (PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
Sql.sqlExpr [PrimExpr]
returningPEs

arrangeUpdateReturningSql :: U.Unpackspec returned ignored
                       -> T.Table columnsW columnsR
                       -> (columnsR -> columnsW)
                       -> (columnsR -> Column PGBool)
                       -> (columnsR -> returned)
                       -> String
arrangeUpdateReturningSql :: Unpackspec returned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> String
arrangeUpdateReturningSql = Doc -> String
forall a. Show a => a -> String
show
                            (Doc -> String)
-> (Returning SqlUpdate -> Doc) -> Returning SqlUpdate -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Returning SqlUpdate -> Doc
Print.ppUpdateReturning
                            (Returning SqlUpdate -> String)
-> (Unpackspec returned ignored
    -> Table columnsW columnsR
    -> (columnsR -> columnsW)
    -> (columnsR -> Column PGBool)
    -> (columnsR -> returned)
    -> Returning SqlUpdate)
-> Unpackspec returned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> String
forall r z a b c d e.
(r -> z)
-> (a -> b -> c -> d -> e -> r) -> a -> b -> c -> d -> e -> z
.::. Unpackspec returned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> Returning SqlUpdate
forall returned ignored columnsW columnsR.
Unpackspec returned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> Returning SqlUpdate
arrangeUpdateReturning

runUpdateReturningExplicit :: RQ.QueryRunner returned haskells
                           -> PGS.Connection
                           -> T.Table columnsW columnsR
                           -> (columnsR -> columnsW)
                           -> (columnsR -> Column PGBool)
                           -> (columnsR -> returned)
                           -> IO [haskells]
runUpdateReturningExplicit :: QueryRunner returned haskells
-> Connection
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> IO [haskells]
runUpdateReturningExplicit QueryRunner returned haskells
qr Connection
conn Table columnsW columnsR
t columnsR -> columnsW
update columnsR -> Column PGBool
cond columnsR -> returned
r =
  RowParser haskells -> Connection -> Query -> IO [haskells]
forall r. RowParser r -> Connection -> Query -> IO [r]
PGS.queryWith_ (returned -> RowParser haskells
rowParser (columnsR -> returned
r columnsR
v)) Connection
conn
                 (String -> Query
forall a. IsString a => String -> a
fromString (Unpackspec returned Int64
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> String
forall returned ignored columnsW columnsR.
Unpackspec returned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> String
arrangeUpdateReturningSql Unpackspec returned Int64
u Table columnsW columnsR
t columnsR -> columnsW
update columnsR -> Column PGBool
cond columnsR -> returned
r))
  where IRQ.QueryRunner Unpackspec returned Int64
u returned -> RowParser haskells
rowParser returned -> Bool
_ = QueryRunner returned haskells
qr
        --- ^^ TODO: need to make sure we're not trying to read zero rows
        TI.Table String
_ (TI.TableProperties Writer columnsW columnsR
_ (TI.View columnsR
v)) = Table columnsW columnsR
t

runUpdateReturning :: (D.Default RQ.QueryRunner returned haskells)
                      => PGS.Connection
                      -> T.Table columnsW columnsR
                      -> (columnsR -> columnsW)
                      -> (columnsR -> Column PGBool)
                      -> (columnsR -> returned)
                      -> IO [haskells]
runUpdateReturning :: Connection
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> IO [haskells]
runUpdateReturning = QueryRunner returned haskells
-> Connection
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> IO [haskells]
forall returned haskells columnsW columnsR.
QueryRunner returned haskells
-> Connection
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column PGBool)
-> (columnsR -> returned)
-> IO [haskells]
runUpdateReturningExplicit QueryRunner returned haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def