{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Opaleye.Manipulation (
runInsert,
Insert(..),
runUpdate,
Update(..),
updateEasy,
runDelete,
Delete(..),
MI.Returning,
rCount,
rReturning,
rReturningI,
rReturningExplicit,
HSql.OnConflict,
doNothing,
runInsert_,
runUpdate_,
runDelete_,
HSql.OnConflict(HSql.DoNothing),
) where
import qualified Opaleye.Field as F
import qualified Opaleye.RunSelect as RS
import qualified Opaleye.Internal.RunQuery as IRQ
import qualified Opaleye.Table as T
import qualified Opaleye.Internal.Table as TI
import Opaleye.Internal.Column (Column)
import Opaleye.Internal.Helpers ((.:.))
import Opaleye.Internal.Inferrable (Inferrable, runInferrable)
import Opaleye.Internal.Manipulation (Updater(Updater))
import qualified Opaleye.Internal.Manipulation as MI
import Opaleye.SqlTypes (SqlBool)
import qualified Opaleye.Internal.HaskellDB.Sql as HSql
import qualified Database.PostgreSQL.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
runInsert :: PGS.Connection
-> Insert haskells
-> IO haskells
runInsert :: forall haskells. Connection -> Insert haskells -> IO haskells
runInsert Connection
conn Insert haskells
i = case Insert haskells
i of
Insert Table fieldsW fieldsR
table_ [fieldsW]
rows_ Returning fieldsR haskells
returning_ Maybe OnConflict
onConflict_ ->
let insert :: Connection -> Table fieldsW fieldsR -> [fieldsW] -> IO haskells
insert = case Returning fieldsR haskells
returning_ of
Returning fieldsR haskells
MI.Count ->
forall columnsW columnsR.
Maybe OnConflict
-> Connection -> Table columnsW columnsR -> [columnsW] -> IO Int64
runInsertMany' Maybe OnConflict
onConflict_
MI.ReturningExplicit FromFields b c
qr fieldsR -> b
f ->
\Connection
c Table fieldsW fieldsR
t [fieldsW]
r -> forall columnsReturned haskells columnsW columnsR.
FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> IO [haskells]
MI.runInsertManyReturningExplicit FromFields b c
qr Connection
c Table fieldsW fieldsR
t [fieldsW]
r fieldsR -> b
f Maybe OnConflict
onConflict_
in Connection -> Table fieldsW fieldsR -> [fieldsW] -> IO haskells
insert Connection
conn Table fieldsW fieldsR
table_ [fieldsW]
rows_
{-# DEPRECATED runInsert_ "Use 'runInsert' instead. Will be removed in 0.11." #-}
runInsert_ :: PGS.Connection
-> Insert haskells
-> IO haskells
runInsert_ :: forall haskells. Connection -> Insert haskells -> IO haskells
runInsert_ = forall haskells. Connection -> Insert haskells -> IO haskells
runInsert
runUpdate :: PGS.Connection
-> Update haskells
-> IO haskells
runUpdate :: forall haskells. Connection -> Update haskells -> IO haskells
runUpdate Connection
conn Update haskells
i = case Update haskells
i of
Update Table fieldsW fieldsR
table_ fieldsR -> fieldsW
updateWith_ fieldsR -> Field SqlBool
where_ Returning fieldsR haskells
returning_ -> case Returning fieldsR haskells
returning_ of
Returning fieldsR haskells
MI.Count ->
Connection -> Query -> IO Int64
PGS.execute_ Connection
conn (forall a. IsString a => String -> a
fromString (forall columnsW columnsR.
Table columnsW columnsR
-> (columnsR -> columnsW) -> (columnsR -> Field SqlBool) -> String
MI.arrangeUpdateSql Table fieldsW fieldsR
table_ fieldsR -> fieldsW
updateWith_ fieldsR -> Field SqlBool
where_))
MI.ReturningExplicit FromFields b c
qr fieldsR -> b
f ->
forall columnsReturned haskells columnsW columnsR.
FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
runUpdateReturningExplicit FromFields b c
qr Connection
conn Table fieldsW fieldsR
table_ fieldsR -> fieldsW
updateWith_ fieldsR -> Field SqlBool
where_ fieldsR -> b
f
{-# DEPRECATED runUpdate_ "Use 'runUpdate' instead. Will be removed in 0.11." #-}
runUpdate_ :: PGS.Connection
-> Update haskells
-> IO haskells
runUpdate_ :: forall haskells. Connection -> Update haskells -> IO haskells
runUpdate_ = forall haskells. Connection -> Update haskells -> IO haskells
runUpdate
runDelete :: PGS.Connection
-> Delete haskells
-> IO haskells
runDelete :: forall haskells. Connection -> Delete haskells -> IO haskells
runDelete Connection
conn Delete haskells
i = case Delete haskells
i of
Delete Table fieldsW fieldsR
table_ fieldsR -> Field SqlBool
where_ Returning fieldsR haskells
returning_ -> case Returning fieldsR haskells
returning_ of
Returning fieldsR haskells
MI.Count ->
Connection -> Query -> IO Int64
PGS.execute_ Connection
conn (forall a. IsString a => String -> a
fromString (forall a columnsR.
Table a columnsR -> (columnsR -> Field SqlBool) -> String
MI.arrangeDeleteSql Table fieldsW fieldsR
table_ fieldsR -> Field SqlBool
where_))
MI.ReturningExplicit FromFields b c
qr fieldsR -> b
f ->
forall columnsReturned haskells a columnsR.
FromFields columnsReturned haskells
-> Connection
-> Table a columnsR
-> (columnsR -> Field SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
MI.runDeleteReturningExplicit FromFields b c
qr Connection
conn Table fieldsW fieldsR
table_ fieldsR -> Field SqlBool
where_ fieldsR -> b
f
{-# DEPRECATED runDelete_ "Use 'runDelete' instead. Will be removed in 0.11." #-}
runDelete_ :: PGS.Connection
-> Delete haskells
-> IO haskells
runDelete_ :: forall haskells. Connection -> Delete haskells -> IO haskells
runDelete_ = forall haskells. Connection -> Delete haskells -> IO haskells
runDelete
data Insert haskells = forall fieldsW fieldsR. Insert
{ ()
iTable :: T.Table fieldsW fieldsR
, ()
iRows :: [fieldsW]
, ()
iReturning :: MI.Returning fieldsR haskells
, forall haskells. Insert haskells -> Maybe OnConflict
iOnConflict :: Maybe HSql.OnConflict
}
data Update haskells = forall fieldsW fieldsR. Update
{ ()
uTable :: T.Table fieldsW fieldsR
, ()
uUpdateWith :: fieldsR -> fieldsW
, ()
uWhere :: fieldsR -> F.Field SqlBool
, ()
uReturning :: MI.Returning fieldsR haskells
}
updateEasy :: D.Default Updater fieldsR fieldsW
=> (fieldsR -> fieldsR)
-> (fieldsR -> fieldsW)
updateEasy :: forall fieldsR fieldsW.
Default Updater fieldsR fieldsW =>
(fieldsR -> fieldsR) -> fieldsR -> fieldsW
updateEasy fieldsR -> fieldsR
u = fieldsR -> fieldsW
u' forall b c a. (b -> c) -> (a -> b) -> a -> c
. fieldsR -> fieldsR
u
where Updater fieldsR -> fieldsW
u' = forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
data Delete haskells = forall fieldsW fieldsR. Delete
{ ()
dTable :: T.Table fieldsW fieldsR
, ()
dWhere :: fieldsR -> F.Field SqlBool
, ()
dReturning :: MI.Returning fieldsR haskells
}
rCount :: MI.Returning fieldsR Int64
rCount :: forall fieldsR. Returning fieldsR Int64
rCount = forall fieldsR. Returning fieldsR Int64
MI.Count
rReturning :: D.Default RS.FromFields fields haskells
=> (fieldsR -> fields)
-> MI.Returning fieldsR [haskells]
rReturning :: forall fields haskells fieldsR.
Default FromFields fields haskells =>
(fieldsR -> fields) -> Returning fieldsR [haskells]
rReturning = forall fields haskells fieldsR.
FromFields fields haskells
-> (fieldsR -> fields) -> Returning fieldsR [haskells]
rReturningExplicit forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
rReturningI :: D.Default (Inferrable RS.FromFields) fields haskells
=> (fieldsR -> fields)
-> MI.Returning fieldsR [haskells]
rReturningI :: forall fields haskells fieldsR.
Default (Inferrable FromFields) fields haskells =>
(fieldsR -> fields) -> Returning fieldsR [haskells]
rReturningI = forall fields haskells fieldsR.
FromFields fields haskells
-> (fieldsR -> fields) -> Returning fieldsR [haskells]
rReturningExplicit (forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def)
rReturningExplicit :: RS.FromFields fields haskells
-> (fieldsR -> fields)
-> MI.Returning fieldsR [haskells]
rReturningExplicit :: forall fields haskells fieldsR.
FromFields fields haskells
-> (fieldsR -> fields) -> Returning fieldsR [haskells]
rReturningExplicit = forall fields haskells fieldsR.
FromFields fields haskells
-> (fieldsR -> fields) -> Returning fieldsR [haskells]
MI.ReturningExplicit
runInsertMany' :: Maybe HSql.OnConflict
-> PGS.Connection
-> TI.Table columnsW columnsR
-> [columnsW]
-> IO Int64
runInsertMany' :: forall columnsW columnsR.
Maybe OnConflict
-> Connection -> Table columnsW columnsR -> [columnsW] -> IO Int64
runInsertMany' Maybe OnConflict
oc Connection
conn Table columnsW columnsR
t [columnsW]
columns =
case forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [columnsW]
columns of
Maybe (NonEmpty columnsW)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0
Just NonEmpty columnsW
columns' -> (Connection -> Query -> IO Int64
PGS.execute_ Connection
conn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall r z a b c.
(r -> z) -> (a -> b -> c -> r) -> a -> b -> c -> z
.:. forall columnsW columnsR.
Table columnsW columnsR
-> NonEmpty columnsW -> Maybe OnConflict -> String
MI.arrangeInsertManySql)
Table columnsW columnsR
t NonEmpty columnsW
columns' Maybe OnConflict
oc
runUpdateReturningExplicit :: RS.FromFields columnsReturned haskells
-> PGS.Connection
-> T.Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
runUpdateReturningExplicit :: forall columnsReturned haskells columnsW columnsR.
FromFields columnsReturned haskells
-> Connection
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
runUpdateReturningExplicit FromFields columnsReturned haskells
qr Connection
conn Table columnsW columnsR
t columnsR -> columnsW
update columnsR -> Column SqlBool
cond columnsR -> columnsReturned
r =
forall r. RowParser r -> Connection -> Query -> IO [r]
PGS.queryWith_ RowParser haskells
parser Connection
conn
(forall a. IsString a => String -> a
fromString (forall columnsReturned ignored columnsW columnsR.
Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Field SqlBool)
-> (columnsR -> columnsReturned)
-> String
MI.arrangeUpdateReturningSql Unpackspec columnsReturned ()
u Table columnsW columnsR
t columnsR -> columnsW
update columnsR -> Column SqlBool
cond columnsR -> columnsReturned
r))
where IRQ.FromFields Unpackspec columnsReturned ()
u columnsReturned -> RowParser haskells
_ columnsReturned -> Int
_ = FromFields columnsReturned haskells
qr
parser :: RowParser haskells
parser = forall columns haskells.
FromFields columns haskells -> columns -> RowParser haskells
IRQ.prepareRowParser FromFields columnsReturned haskells
qr (columnsR -> columnsReturned
r columnsR
v)
TI.View columnsR
v = forall writeColumns viewColumns.
TableFields writeColumns viewColumns -> View viewColumns
TI.tableColumnsView (forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
TI.tableColumns Table columnsW columnsR
t)
doNothing :: HSql.OnConflict
doNothing :: OnConflict
doNothing = OnConflict
HSql.DoNothing