{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Opaleye.Manipulation (module Opaleye.Manipulation,
HSql.OnConflict(..)) 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.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_ conn i = case i of
Insert table_ rows_ returning_ onConflict_ ->
let insert = case (returning_, onConflict_) of
(MI.Count, Nothing) ->
runInsertMany
(MI.Count, Just HSql.DoNothing) ->
runInsertManyOnConflictDoNothing
(MI.ReturningExplicit qr f, oc) ->
\c t r -> MI.runInsertManyReturningExplicit qr c t r f oc
in insert conn table_ rows_
runUpdate_ :: PGS.Connection
-> Update haskells
-> IO haskells
runUpdate_ conn i = case i of
Update table_ updateWith_ where_ returning_ ->
let update = case returning_ of
MI.Count ->
runUpdate
MI.ReturningExplicit qr f ->
\c t u w -> runUpdateReturningExplicit qr c t u w f
in update conn table_ updateWith_ where_
runDelete_ :: PGS.Connection
-> Delete haskells
-> IO haskells
runDelete_ conn i = case i of
Delete table_ where_ returning_ ->
let delete = case returning_ of
MI.Count ->
runDelete
MI.ReturningExplicit qr f ->
\c t w -> MI.runDeleteReturningExplicit qr c t w f
in delete conn table_ where_
data Insert haskells = forall fieldsW fieldsR. Insert
{ iTable :: T.Table fieldsW fieldsR
, iRows :: [fieldsW]
, iReturning :: MI.Returning fieldsR haskells
, 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 u = u' . u
where Updater u' = 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 = MI.Count
rReturning :: D.Default RS.FromFields fields haskells
=> (fieldsR -> fields)
-> MI.Returning fieldsR [haskells]
rReturning = rReturningExplicit D.def
rReturningExplicit :: RS.FromFields fields haskells
-> (fieldsR -> fields)
-> MI.Returning fieldsR [haskells]
rReturningExplicit = MI.ReturningExplicit
{-# DEPRECATED runInsertManyOnConflictDoNothing "Use 'runInsert_'. Will be removed in version 0.8." #-}
runInsertManyOnConflictDoNothing :: PGS.Connection
-> T.Table columns columns'
-> [columns]
-> IO Int64
runInsertManyOnConflictDoNothing conn table_ columns =
case NEL.nonEmpty columns of
Nothing -> return 0
Just columns' -> (PGS.execute_ conn . fromString .:. MI.arrangeInsertManySql)
table_ columns' (Just HSql.DoNothing)
{-# DEPRECATED runInsertManyReturningOnConflictDoNothing "Use 'runInsert_'. Will be removed in version 0.8." #-}
runInsertManyReturningOnConflictDoNothing
:: (D.Default RS.FromFields columnsReturned haskells)
=> PGS.Connection
-> T.Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertManyReturningOnConflictDoNothing =
runInsertManyReturningOnConflictDoNothingExplicit D.def
{-# DEPRECATED runInsertMany "Use 'runInsert_' instead. Will be removed in version 0.8." #-}
runInsertMany :: PGS.Connection
-> T.Table columns columns'
-> [columns]
-> IO Int64
runInsertMany conn t columns = case NEL.nonEmpty columns of
Nothing -> return 0
Just columns' -> (PGS.execute_ conn . fromString .: MI.arrangeInsertManySqlI) t columns'
{-# DEPRECATED runInsertManyReturning "Use 'runInsert_' instead. Will be removed in version 0.8." #-}
runInsertManyReturning :: (D.Default RS.FromFields columnsReturned haskells)
=> PGS.Connection
-> T.Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertManyReturning = runInsertManyReturningExplicit D.def
{-# DEPRECATED runInsertReturningExplicit "Use 'runInsert_' instead. Will be removed in version 0.8." #-}
runInsertReturningExplicit :: RS.FromFields columnsReturned haskells
-> PGS.Connection
-> T.Table columnsW columnsR
-> columnsW
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertReturningExplicit = MI.runInsertReturningExplicit
{-# DEPRECATED runInsertManyReturningExplicit "Use 'runInsert_' instead. Will be removed in version 0.8." #-}
runInsertManyReturningExplicit :: RS.FromFields columnsReturned haskells
-> PGS.Connection
-> T.Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertManyReturningExplicit = MI.runInsertManyReturningExplicitI
{-# DEPRECATED runInsertManyReturningOnConflictDoNothingExplicit "Use 'runInsert_' instead. Will be removed in version 0.8." #-}
runInsertManyReturningOnConflictDoNothingExplicit
:: RS.FromFields columnsReturned haskells
-> PGS.Connection
-> T.Table columnsW columnsR
-> [columnsW]
-> (columnsR -> columnsReturned)
-> IO [haskells]
runInsertManyReturningOnConflictDoNothingExplicit qr conn t columns f =
MI.runInsertManyReturningExplicit qr conn t columns f (Just HSql.DoNothing)
{-# DEPRECATED runUpdateEasy "Use 'runUpdate_' instead. Will be removed in version 0.8." #-}
runUpdateEasy :: D.Default Updater columnsR columnsW
=> PGS.Connection
-> T.Table columnsW columnsR
-> (columnsR -> columnsR)
-> (columnsR -> Column SqlBool)
-> IO Int64
runUpdateEasy conn table_ u = runUpdate conn table_ (u' . u)
where Updater u' = D.def
{-# DEPRECATED runUpdate "Use 'runUpdate_' instead. Will be removed in version 0.8." #-}
runUpdate :: PGS.Connection
-> T.Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> IO Int64
runUpdate conn = PGS.execute_ conn . fromString .:. MI.arrangeUpdateSql
{-# DEPRECATED runUpdateReturning "Use 'runUpdate_' instead. Will be removed in version 0.8." #-}
runUpdateReturning :: (D.Default RS.FromFields columnsReturned haskells)
=> PGS.Connection
-> T.Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
runUpdateReturning = runUpdateReturningExplicit D.def
{-# DEPRECATED runUpdateReturningExplicit "Use 'runUpdate_' instead. Will be removed in version 0.8." #-}
runUpdateReturningExplicit :: RS.FromFields columnsReturned haskells
-> PGS.Connection
-> T.Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Column SqlBool)
-> (columnsR -> columnsReturned)
-> IO [haskells]
runUpdateReturningExplicit qr conn t update cond r =
PGS.queryWith_ parser conn
(fromString (MI.arrangeUpdateReturningSql u t update cond r))
where IRQ.QueryRunner u _ _ = qr
parser = IRQ.prepareRowParser qr (r v)
TI.View v = TI.tableColumnsView (TI.tableColumns t)
{-# DEPRECATED runDelete "Use 'runDelete_' instead. Will be removed in version 0.8." #-}
runDelete :: PGS.Connection
-> T.Table a columnsR
-> (columnsR -> Column SqlBool)
-> IO Int64
runDelete conn = PGS.execute_ conn . fromString .: MI.arrangeDeleteSql