{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Opaleye.Internal.Manipulation where

import qualified Control.Applicative as A

import           Opaleye.Internal.Column (Column(Column))
import qualified Opaleye.Internal.HaskellDB.Sql  as HSql
import qualified Opaleye.Internal.HaskellDB.Sql.Default  as SD
import qualified Opaleye.Internal.HaskellDB.Sql.Generate as SG
import qualified Opaleye.Internal.HaskellDB.Sql.Print    as HPrint
import           Opaleye.Internal.Helpers        ((.:), (.:.), (.::.), (.::))
import qualified Opaleye.Internal.PrimQuery      as PQ
import qualified Opaleye.Internal.Print          as Print
import qualified Opaleye.Internal.RunQuery       as IRQ
import qualified Opaleye.RunSelect               as RS
import qualified Opaleye.Internal.Sql            as Sql
import qualified Opaleye.Internal.Table          as TI
import qualified Opaleye.Internal.Unpackspec     as U
import qualified Opaleye.Table                   as T
import           Opaleye.SqlTypes (SqlBool)

import           Data.Int                       (Int64)
import qualified Data.List.NonEmpty              as NEL
import           Data.Profunctor                 (Profunctor, dimap)
import qualified Data.Profunctor.Product         as PP
import qualified Data.Profunctor.Product.Default as D
import           Data.String                     (fromString)

import qualified Database.PostgreSQL.Simple as PGS

-- | Don't use this internal datatype.  Instead you probably want
-- 'Opaleye.Manipulation.rCount' or 'Opaleye.Manipulation.rReturning'.
data Returning a b where
  Count
    :: Returning a Int64
  ReturningExplicit
    :: RS.FromFields b c -> (a -> b) -> Returning a [c]

arrangeInsertMany :: T.Table columns a
                  -> NEL.NonEmpty columns
                  -> Maybe HSql.OnConflict
                  -> HSql.SqlInsert
arrangeInsertMany :: Table columns a
-> NonEmpty columns -> Maybe OnConflict -> SqlInsert
arrangeInsertMany Table columns a
table NonEmpty columns
columns Maybe OnConflict
onConflict = SqlInsert
insert
  where writer :: Writer columns a
writer = TableFields columns a -> Writer columns a
forall writeColumns viewColumns.
TableFields writeColumns viewColumns
-> Writer writeColumns viewColumns
TI.tableColumnsWriter (Table columns a -> TableFields columns a
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
TI.tableColumns Table columns a
table)
        (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
-> SqlTable
-> [String]
-> NonEmpty [PrimExpr]
-> Maybe OnConflict
-> SqlInsert
SG.sqlInsert SqlGenerator
SD.defaultSqlGenerator
                      (TableIdentifier -> SqlTable
PQ.tiToSqlTable (Table columns a -> TableIdentifier
forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
TI.tableIdentifier Table columns a
table))
                      [String]
columnNames NonEmpty [PrimExpr]
columnExprs
                      Maybe OnConflict
onConflict

arrangeInsertManyReturning :: U.Unpackspec columnsReturned ignored
                           -> T.Table columnsW columnsR
                           -> NEL.NonEmpty columnsW
                           -> (columnsR -> columnsReturned)
                           -> Maybe HSql.OnConflict
                           -> Sql.Returning HSql.SqlInsert
arrangeInsertManyReturning :: Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> Returning SqlInsert
arrangeInsertManyReturning Unpackspec columnsReturned ignored
unpackspec Table columnsW columnsR
table NonEmpty columnsW
columns columnsR -> columnsReturned
returningf Maybe OnConflict
onConflict =
  SqlInsert -> NonEmpty SqlExpr -> Returning SqlInsert
forall a. a -> NonEmpty SqlExpr -> Returning a
Sql.Returning SqlInsert
insert NonEmpty SqlExpr
returningSEs
  where insert :: SqlInsert
insert = Table columnsW columnsR
-> NonEmpty columnsW -> Maybe OnConflict -> SqlInsert
forall columns a.
Table columns a
-> NonEmpty columns -> Maybe OnConflict -> SqlInsert
arrangeInsertMany Table columnsW columnsR
table NonEmpty columnsW
columns Maybe OnConflict
onConflict
        TI.View columnsR
columnsR = TableFields columnsW columnsR -> View columnsR
forall writeColumns viewColumns.
TableFields writeColumns viewColumns -> View viewColumns
TI.tableColumnsView (Table columnsW columnsR -> TableFields columnsW columnsR
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
TI.tableColumns Table columnsW columnsR
table)
        returningPEs :: [PrimExpr]
returningPEs = Unpackspec columnsReturned ignored -> columnsReturned -> [PrimExpr]
forall s t. Unpackspec s t -> s -> [PrimExpr]
U.collectPEs Unpackspec columnsReturned ignored
unpackspec (columnsR -> columnsReturned
returningf columnsR
columnsR)
        returningSEs :: NonEmpty SqlExpr
returningSEs = (SqlExpr -> SqlExpr) -> [SqlExpr] -> NonEmpty SqlExpr
forall a. (SqlExpr -> a) -> [a] -> NonEmpty a
Sql.ensureColumnsGen SqlExpr -> SqlExpr
forall a. a -> a
id ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
Sql.sqlExpr [PrimExpr]
returningPEs)

arrangeInsertManyReturningSql :: U.Unpackspec columnsReturned ignored
                              -> T.Table columnsW columnsR
                              -> NEL.NonEmpty columnsW
                              -> (columnsR -> columnsReturned)
                              -> Maybe HSql.OnConflict
                              -> String
arrangeInsertManyReturningSql :: Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> String
arrangeInsertManyReturningSql =
  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 columnsReturned ignored
    -> Table columnsW columnsR
    -> NonEmpty columnsW
    -> (columnsR -> columnsReturned)
    -> Maybe OnConflict
    -> Returning SqlInsert)
-> Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> String
forall r z a b c d e.
(r -> z)
-> (a -> b -> c -> d -> e -> r) -> a -> b -> c -> d -> e -> z
.::. Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> Returning SqlInsert
forall columnsReturned ignored columnsW columnsR.
Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> Returning SqlInsert
arrangeInsertManyReturning

arrangeInsertManySql :: T.Table columnsW columnsR
                     -> NEL.NonEmpty columnsW
                     -> Maybe HSql.OnConflict
                     -> String
arrangeInsertManySql :: Table columnsW columnsR
-> NonEmpty columnsW -> Maybe OnConflict -> 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 columnsW columnsR
    -> NonEmpty columnsW -> Maybe OnConflict -> SqlInsert)
-> Table columnsW columnsR
-> NonEmpty columnsW
-> Maybe OnConflict
-> String
forall r z a b c.
(r -> z) -> (a -> b -> c -> r) -> a -> b -> c -> z
.:. Table columnsW columnsR
-> NonEmpty columnsW -> Maybe OnConflict -> SqlInsert
forall columns a.
Table columns a
-> NonEmpty columns -> Maybe OnConflict -> SqlInsert
arrangeInsertMany

runInsertManyReturningExplicit
  :: RS.FromFields columnsReturned haskells
  -> PGS.Connection
  -> T.Table columnsW columnsR
  -> [columnsW]
  -> (columnsR -> columnsReturned)
  -> Maybe HSql.OnConflict
  -> IO [haskells]
runInsertManyReturningExplicit :: FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> IO [haskells]
runInsertManyReturningExplicit
  FromFields columnsReturned haskells
qr Connection
conn Table columnsW columnsR
t [columnsW]
columns columnsR -> columnsReturned
r Maybe OnConflict
onConflict =
  case [columnsW] -> Maybe (NonEmpty columnsW)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [columnsW]
columns of
    Maybe (NonEmpty columnsW)
Nothing       -> [haskells] -> IO [haskells]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just NonEmpty columnsW
columns' -> RowParser haskells -> Connection -> Query -> IO [haskells]
forall r. RowParser r -> Connection -> Query -> IO [r]
PGS.queryWith_ RowParser haskells
parser Connection
conn
                       (String -> Query
forall a. IsString a => String -> a
fromString
                        (Unpackspec columnsReturned ()
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> String
forall columnsReturned ignored columnsW columnsR.
Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> String
arrangeInsertManyReturningSql Unpackspec columnsReturned ()
u Table columnsW columnsR
t NonEmpty columnsW
columns' columnsR -> columnsReturned
r
                                                       Maybe OnConflict
onConflict))
  where IRQ.QueryRunner Unpackspec columnsReturned ()
u columnsReturned -> RowParser haskells
_ columnsReturned -> Int
_ = FromFields columnsReturned haskells
qr
        parser :: RowParser haskells
parser = FromFields columnsReturned haskells
-> columnsReturned -> RowParser haskells
forall columns haskells.
FromFields columns haskells -> columns -> RowParser haskells
IRQ.prepareRowParser FromFields columnsReturned haskells
qr (columnsR -> columnsReturned
r columnsR
v)
        TI.View columnsR
v = TableFields columnsW columnsR -> View columnsR
forall writeColumns viewColumns.
TableFields writeColumns viewColumns -> View viewColumns
TI.tableColumnsView (Table columnsW columnsR -> TableFields columnsW columnsR
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
TI.tableColumns Table columnsW columnsR
t)
        -- This method of getting hold of the return type feels a bit
        -- suspect.  I haven't checked it for validity.

newtype Updater a b = Updater (a -> b)

-- { Boilerplate instances

instance Functor (Updater a) where
  fmap :: (a -> b) -> Updater a a -> Updater a b
fmap a -> b
f (Updater a -> a
g) = (a -> b) -> Updater a b
forall a b. (a -> b) -> Updater a b
Updater ((a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a -> a
g)

instance A.Applicative (Updater a) where
  pure :: a -> Updater a a
pure = (a -> a) -> Updater a a
forall a b. (a -> b) -> Updater a b
Updater ((a -> a) -> Updater a a) -> (a -> a -> a) -> a -> Updater a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall (f :: * -> *) a. Applicative f => a -> f a
A.pure
  Updater a -> a -> b
f <*> :: Updater a (a -> b) -> Updater a a -> Updater a b
<*> Updater a -> a
x = (a -> b) -> Updater a b
forall a b. (a -> b) -> Updater a b
Updater (a -> a -> b
f (a -> a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
A.<*> a -> a
x)

instance Profunctor Updater where
  dimap :: (a -> b) -> (c -> d) -> Updater b c -> Updater a d
dimap a -> b
f c -> d
g (Updater b -> c
h) = (a -> d) -> Updater a d
forall a b. (a -> b) -> Updater a b
Updater ((a -> b) -> (c -> d) -> (b -> c) -> a -> d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f c -> d
g b -> c
h)

instance PP.ProductProfunctor Updater where
  purePP :: b -> Updater a b
purePP = b -> Updater a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: Updater a (b -> c) -> Updater a b -> Updater a c
(****) = Updater a (b -> c) -> Updater a b -> Updater a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

--

instance D.Default Updater (Column a) (Column a) where
  def :: Updater (Column a) (Column a)
def = (Column a -> Column a) -> Updater (Column a) (Column a)
forall a b. (a -> b) -> Updater a b
Updater Column a -> Column a
forall a. a -> a
id

instance D.Default Updater (Column a) (Maybe (Column a)) where
  def :: Updater (Column a) (Maybe (Column a))
def = (Column a -> Maybe (Column a))
-> Updater (Column a) (Maybe (Column a))
forall a b. (a -> b) -> Updater a b
Updater Column a -> Maybe (Column a)
forall a. a -> Maybe a
Just

arrangeDeleteReturning :: U.Unpackspec columnsReturned ignored
                       -> T.Table columnsW columnsR
                       -> (columnsR -> Column SqlBool)
                       -> (columnsR -> columnsReturned)
                       -> Sql.Returning HSql.SqlDelete
  -- this implementation was copied, it does not make sense yet
arrangeDeleteReturning :: Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> Returning SqlDelete
arrangeDeleteReturning Unpackspec columnsReturned ignored
unpackspec Table columnsW columnsR
t columnsR -> Column SqlBool
cond columnsR -> columnsReturned
returningf =
  SqlDelete -> NonEmpty SqlExpr -> Returning SqlDelete
forall a. a -> NonEmpty SqlExpr -> Returning a
Sql.Returning SqlDelete
delete NonEmpty SqlExpr
returningSEs
  where delete :: SqlDelete
delete = Table columnsW columnsR
-> (columnsR -> Column SqlBool) -> SqlDelete
forall a columnsR.
Table a columnsR -> (columnsR -> Column SqlBool) -> SqlDelete
arrangeDelete Table columnsW columnsR
t columnsR -> Column SqlBool
cond
        TI.View columnsR
columnsR = TableFields columnsW columnsR -> View columnsR
forall writeColumns viewColumns.
TableFields writeColumns viewColumns -> View viewColumns
TI.tableColumnsView (Table columnsW columnsR -> TableFields columnsW columnsR
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
TI.tableColumns Table columnsW columnsR
t)
        returningPEs :: [PrimExpr]
returningPEs = Unpackspec columnsReturned ignored -> columnsReturned -> [PrimExpr]
forall s t. Unpackspec s t -> s -> [PrimExpr]
U.collectPEs Unpackspec columnsReturned ignored
unpackspec (columnsR -> columnsReturned
returningf columnsR
columnsR)
        returningSEs :: NonEmpty SqlExpr
returningSEs = (SqlExpr -> SqlExpr) -> [SqlExpr] -> NonEmpty SqlExpr
forall a. (SqlExpr -> a) -> [a] -> NonEmpty a
Sql.ensureColumnsGen SqlExpr -> SqlExpr
forall a. a -> a
id ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
Sql.sqlExpr [PrimExpr]
returningPEs)

arrangeDeleteReturningSql :: U.Unpackspec columnsReturned ignored
                          -> T.Table columnsW columnsR
                          -> (columnsR -> Column SqlBool)
                          -> (columnsR -> columnsReturned)
                          -> String
arrangeDeleteReturningSql :: Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> String
arrangeDeleteReturningSql =
  Doc -> String
forall a. Show a => a -> String
show (Doc -> String)
-> (Returning SqlDelete -> Doc) -> Returning SqlDelete -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Returning SqlDelete -> Doc
Print.ppDeleteReturning (Returning SqlDelete -> String)
-> (Unpackspec columnsReturned ignored
    -> Table columnsW columnsR
    -> (columnsR -> Column SqlBool)
    -> (columnsR -> columnsReturned)
    -> Returning SqlDelete)
-> Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> String
forall r z a b c d.
(r -> z) -> (a -> b -> c -> d -> r) -> a -> b -> c -> d -> z
.:: Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> Returning SqlDelete
forall columnsReturned ignored columnsW columnsR.
Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> Returning SqlDelete
arrangeDeleteReturning


runDeleteReturning :: (D.Default RS.FromFields columnsReturned haskells)
                   => PGS.Connection
                   -- ^
                   -> T.Table a columnsR
                   -- ^ Table to delete rows from
                   -> (columnsR -> Column SqlBool)
                   -- ^ Predicate function @f@ to choose which rows to delete.
                   -- 'runDeleteReturning' will delete rows for which @f@ returns @TRUE@
                   -- and leave unchanged rows for
                   -- which @f@ returns @FALSE@.
                   -> (columnsR -> columnsReturned)
                   -> IO [haskells]
                   -- ^ Returned rows which have been deleted
runDeleteReturning :: Connection
-> Table a columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
runDeleteReturning = FromFields columnsReturned haskells
-> Connection
-> Table a columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
forall columnsReturned haskells a columnsR.
FromFields columnsReturned haskells
-> Connection
-> Table a columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
runDeleteReturningExplicit FromFields columnsReturned haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

runDeleteReturningExplicit :: RS.FromFields columnsReturned haskells
                           -> PGS.Connection
                           -> T.Table a columnsR
                           -> (columnsR -> Column SqlBool)
                           -> (columnsR -> columnsReturned)
                           -> IO [haskells]
runDeleteReturningExplicit :: FromFields columnsReturned haskells
-> Connection
-> Table a columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
runDeleteReturningExplicit FromFields columnsReturned haskells
qr Connection
conn Table a columnsR
t columnsR -> Column SqlBool
cond columnsR -> columnsReturned
r =
  RowParser haskells -> Connection -> Query -> IO [haskells]
forall r. RowParser r -> Connection -> Query -> IO [r]
PGS.queryWith_ RowParser haskells
parser Connection
conn
                 (String -> Query
forall a. IsString a => String -> a
fromString (Unpackspec columnsReturned ()
-> Table a columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> String
forall columnsReturned ignored columnsW columnsR.
Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> String
arrangeDeleteReturningSql Unpackspec columnsReturned ()
u Table a columnsR
t columnsR -> Column SqlBool
cond columnsR -> columnsReturned
r))
  where IRQ.QueryRunner Unpackspec columnsReturned ()
u columnsReturned -> RowParser haskells
_ columnsReturned -> Int
_ = FromFields columnsReturned haskells
qr
        parser :: RowParser haskells
parser = FromFields columnsReturned haskells
-> columnsReturned -> RowParser haskells
forall columns haskells.
FromFields columns haskells -> columns -> RowParser haskells
IRQ.prepareRowParser FromFields columnsReturned haskells
qr (columnsR -> columnsReturned
r columnsR
v)
        TI.View columnsR
v = TableFields a columnsR -> View columnsR
forall writeColumns viewColumns.
TableFields writeColumns viewColumns -> View viewColumns
TI.tableColumnsView (Table a columnsR -> TableFields a columnsR
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
TI.tableColumns Table a columnsR
t)

arrangeDelete :: T.Table a columnsR -> (columnsR -> Column SqlBool) -> HSql.SqlDelete
arrangeDelete :: Table a columnsR -> (columnsR -> Column SqlBool) -> SqlDelete
arrangeDelete Table a columnsR
t columnsR -> Column SqlBool
cond =
  SqlGenerator -> SqlTable -> [PrimExpr] -> SqlDelete
SG.sqlDelete SqlGenerator
SD.defaultSqlGenerator (TableIdentifier -> SqlTable
PQ.tiToSqlTable (Table a columnsR -> TableIdentifier
forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
TI.tableIdentifier Table a columnsR
t)) [PrimExpr
condExpr]
  where Column PrimExpr
condExpr = columnsR -> Column SqlBool
cond columnsR
tableCols
        TI.View columnsR
tableCols = TableFields a columnsR -> View columnsR
forall writeColumns viewColumns.
TableFields writeColumns viewColumns -> View viewColumns
TI.tableColumnsView (Table a columnsR -> TableFields a columnsR
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
TI.tableColumns Table a columnsR
t)

runInsert :: PGS.Connection -> T.Table fields fields' -> fields -> IO Int64
runInsert :: Connection -> Table fields fields' -> fields -> 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 fields fields' -> fields -> String)
-> Table fields fields'
-> fields
-> IO Int64
forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: Table fields fields' -> fields -> String
forall columns a. Table columns a -> columns -> String
arrangeInsertSql

runInsertReturning :: (D.Default RS.FromFields fieldsReturned haskells)
                   => PGS.Connection
                   -> T.Table fieldsW fieldsR
                   -> fieldsW
                   -> (fieldsR -> fieldsReturned)
                   -> IO [haskells]
runInsertReturning :: Connection
-> Table fieldsW fieldsR
-> fieldsW
-> (fieldsR -> fieldsReturned)
-> IO [haskells]
runInsertReturning = FromFields fieldsReturned haskells
-> Connection
-> Table fieldsW fieldsR
-> fieldsW
-> (fieldsR -> fieldsReturned)
-> IO [haskells]
forall columnsReturned haskells columnsW columnsR.
FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertReturningExplicit FromFields fieldsReturned haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

runInsertReturningExplicit :: RS.FromFields columnsReturned haskells
                           -> PGS.Connection
                           -> T.Table columnsW columnsR
                           -> columnsW
                           -> (columnsR -> columnsReturned)
                           -> IO [haskells]
runInsertReturningExplicit :: FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> columnsW
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertReturningExplicit FromFields columnsReturned haskells
qr Connection
conn Table columnsW columnsR
t =
  FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> IO [haskells]
forall columnsReturned haskells columnsW columnsR.
FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertManyReturningExplicitI FromFields columnsReturned haskells
qr Connection
conn Table columnsW columnsR
t ([columnsW] -> (columnsR -> columnsReturned) -> IO [haskells])
-> (columnsW -> [columnsW])
-> columnsW
-> (columnsR -> columnsReturned)
-> IO [haskells]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. columnsW -> [columnsW]
forall (m :: * -> *) a. Monad m => a -> m a
return

runInsertManyReturningExplicitI :: RS.FromFields columnsReturned haskells
                                -> PGS.Connection
                                -> T.Table columnsW columnsR
                                -> [columnsW]
                                -> (columnsR -> columnsReturned)
                                -> IO [haskells]
runInsertManyReturningExplicitI :: FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertManyReturningExplicitI FromFields columnsReturned haskells
qr Connection
conn Table columnsW columnsR
t [columnsW]
columns columnsR -> columnsReturned
f =
  FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> IO [haskells]
forall columnsReturned haskells columnsW columnsR.
FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> IO [haskells]
runInsertManyReturningExplicit FromFields columnsReturned haskells
qr Connection
conn Table columnsW columnsR
t [columnsW]
columns columnsR -> columnsReturned
f Maybe OnConflict
forall a. Maybe a
Nothing

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
arrangeInsertManyI 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

arrangeInsertManyI :: T.Table columns a -> NEL.NonEmpty columns -> HSql.SqlInsert
arrangeInsertManyI :: Table columns a -> NonEmpty columns -> SqlInsert
arrangeInsertManyI Table columns a
t NonEmpty columns
columns = Table columns a
-> NonEmpty columns -> Maybe OnConflict -> SqlInsert
forall columns a.
Table columns a
-> NonEmpty columns -> Maybe OnConflict -> SqlInsert
arrangeInsertMany Table columns a
t NonEmpty columns
columns Maybe OnConflict
forall a. Maybe a
Nothing

arrangeInsertManySqlI :: T.Table columns a -> NEL.NonEmpty columns -> String
arrangeInsertManySqlI :: Table columns a -> NonEmpty columns -> String
arrangeInsertManySqlI Table columns a
t NonEmpty columns
c  = Table columns a -> NonEmpty columns -> Maybe OnConflict -> String
forall columnsW columnsR.
Table columnsW columnsR
-> NonEmpty columnsW -> Maybe OnConflict -> String
arrangeInsertManySql Table columns a
t NonEmpty columns
c Maybe OnConflict
forall a. Maybe a
Nothing

arrangeUpdate :: T.Table columnsW columnsR
              -> (columnsR -> columnsW) -> (columnsR -> Column SqlBool)
              -> HSql.SqlUpdate
arrangeUpdate :: Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> SqlUpdate
arrangeUpdate Table columnsW columnsR
t columnsR -> columnsW
update columnsR -> Column SqlBool
cond =
  SqlGenerator -> SqlTable -> [PrimExpr] -> Assoc -> SqlUpdate
SG.sqlUpdate SqlGenerator
SD.defaultSqlGenerator
               (TableIdentifier -> SqlTable
PQ.tiToSqlTable (Table columnsW columnsR -> TableIdentifier
forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
TI.tableIdentifier Table columnsW columnsR
t))
               [PrimExpr
condExpr] (columnsR -> Assoc
update' columnsR
tableCols)
  where TI.TableFields Writer columnsW columnsR
writer (TI.View columnsR
tableCols) = Table columnsW columnsR -> TableFields columnsW columnsR
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
TI.tableColumns Table columnsW columnsR
t
        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 SqlBool
cond columnsR
tableCols

arrangeUpdateSql :: T.Table columnsW columnsR
              -> (columnsR -> columnsW) -> (columnsR -> Column SqlBool)
              -> String
arrangeUpdateSql :: Table columnsW columnsR
-> (columnsR -> columnsW) -> (columnsR -> Column SqlBool) -> 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 SqlBool)
    -> SqlUpdate)
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> String
forall r z a b c.
(r -> z) -> (a -> b -> c -> r) -> a -> b -> c -> z
.:. Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> SqlUpdate
forall columnsW columnsR.
Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> SqlUpdate
arrangeUpdate

arrangeDeleteSql :: T.Table a columnsR -> (columnsR -> Column SqlBool) -> String
arrangeDeleteSql :: Table a columnsR -> (columnsR -> Column SqlBool) -> 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 SqlBool) -> SqlDelete)
-> Table a columnsR
-> (columnsR -> Column SqlBool)
-> String
forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: Table a columnsR -> (columnsR -> Column SqlBool) -> SqlDelete
forall a columnsR.
Table a columnsR -> (columnsR -> Column SqlBool) -> SqlDelete
arrangeDelete

arrangeInsertManyReturningI :: U.Unpackspec columnsReturned ignored
                            -> T.Table columnsW columnsR
                            -> NEL.NonEmpty columnsW
                            -> (columnsR -> columnsReturned)
                            -> Sql.Returning HSql.SqlInsert
arrangeInsertManyReturningI :: Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Returning SqlInsert
arrangeInsertManyReturningI Unpackspec columnsReturned ignored
unpackspec Table columnsW columnsR
t NonEmpty columnsW
columns columnsR -> columnsReturned
returningf =
  Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> Returning SqlInsert
forall columnsReturned ignored columnsW columnsR.
Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> Returning SqlInsert
arrangeInsertManyReturning Unpackspec columnsReturned ignored
unpackspec Table columnsW columnsR
t NonEmpty columnsW
columns columnsR -> columnsReturned
returningf Maybe OnConflict
forall a. Maybe a
Nothing

arrangeInsertManyReturningSqlI :: U.Unpackspec columnsReturned ignored
                               -> T.Table columnsW columnsR
                               -> NEL.NonEmpty columnsW
                               -> (columnsR -> columnsReturned)
                               -> String
arrangeInsertManyReturningSqlI :: Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> String
arrangeInsertManyReturningSqlI Unpackspec columnsReturned ignored
u Table columnsW columnsR
t NonEmpty columnsW
c columnsR -> columnsReturned
r =
  Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> String
forall columnsReturned ignored columnsW columnsR.
Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> String
arrangeInsertManyReturningSql Unpackspec columnsReturned ignored
u Table columnsW columnsR
t NonEmpty columnsW
c columnsR -> columnsReturned
r Maybe OnConflict
forall a. Maybe a
Nothing

arrangeUpdateReturning :: U.Unpackspec columnsReturned ignored
                       -> T.Table columnsW columnsR
                       -> (columnsR -> columnsW)
                       -> (columnsR -> Column SqlBool)
                       -> (columnsR -> columnsReturned)
                       -> Sql.Returning HSql.SqlUpdate
arrangeUpdateReturning :: Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> Returning SqlUpdate
arrangeUpdateReturning Unpackspec columnsReturned ignored
unpackspec Table columnsW columnsR
t columnsR -> columnsW
updatef columnsR -> Column SqlBool
cond columnsR -> columnsReturned
returningf =
  SqlUpdate -> NonEmpty SqlExpr -> Returning SqlUpdate
forall a. a -> NonEmpty SqlExpr -> Returning a
Sql.Returning SqlUpdate
update NonEmpty SqlExpr
returningSEs
  where update :: SqlUpdate
update = Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> SqlUpdate
forall columnsW columnsR.
Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> SqlUpdate
arrangeUpdate Table columnsW columnsR
t columnsR -> columnsW
updatef columnsR -> Column SqlBool
cond
        TI.View columnsR
columnsR = TableFields columnsW columnsR -> View columnsR
forall writeColumns viewColumns.
TableFields writeColumns viewColumns -> View viewColumns
TI.tableColumnsView (Table columnsW columnsR -> TableFields columnsW columnsR
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
TI.tableColumns Table columnsW columnsR
t)
        returningPEs :: [PrimExpr]
returningPEs = Unpackspec columnsReturned ignored -> columnsReturned -> [PrimExpr]
forall s t. Unpackspec s t -> s -> [PrimExpr]
U.collectPEs Unpackspec columnsReturned ignored
unpackspec (columnsR -> columnsReturned
returningf columnsR
columnsR)
        returningSEs :: NonEmpty SqlExpr
returningSEs = (SqlExpr -> SqlExpr) -> [SqlExpr] -> NonEmpty SqlExpr
forall a. (SqlExpr -> a) -> [a] -> NonEmpty a
Sql.ensureColumnsGen SqlExpr -> SqlExpr
forall a. a -> a
id ((PrimExpr -> SqlExpr) -> [PrimExpr] -> [SqlExpr]
forall a b. (a -> b) -> [a] -> [b]
map PrimExpr -> SqlExpr
Sql.sqlExpr [PrimExpr]
returningPEs)

arrangeUpdateReturningSql :: U.Unpackspec columnsReturned ignored
                          -> T.Table columnsW columnsR
                          -> (columnsR -> columnsW)
                          -> (columnsR -> Column SqlBool)
                          -> (columnsR -> columnsReturned)
                          -> String
arrangeUpdateReturningSql :: Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> 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 columnsReturned ignored
    -> Table columnsW columnsR
    -> (columnsR -> columnsW)
    -> (columnsR -> Column SqlBool)
    -> (columnsR -> columnsReturned)
    -> Returning SqlUpdate)
-> Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> String
forall r z a b c d e.
(r -> z)
-> (a -> b -> c -> d -> e -> r) -> a -> b -> c -> d -> e -> z
.::. Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> Returning SqlUpdate
forall columnsReturned ignored columnsW columnsR.
Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> Returning SqlUpdate
arrangeUpdateReturning