{-# language DuplicateRecordFields #-}
{-# language GADTs #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
module Rel8.Statement.Insert
( Insert(..)
, OnConflict(..)
, insert
)
where
import Control.Exception ( throwIO )
import Data.List.NonEmpty ( NonEmpty( (:|) ) )
import Data.Kind ( Type )
import Prelude
import Hasql.Connection ( Connection )
import qualified Hasql.Decoders as Hasql
import qualified Hasql.Encoders as Hasql
import qualified Hasql.Session as Hasql
import qualified Hasql.Statement as Hasql
import qualified Opaleye.Internal.Manipulation as Opaleye
import qualified Opaleye.Manipulation as Opaleye
import Rel8.Schema.Name ( Selects )
import Rel8.Schema.Table ( TableSchema )
import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
import Rel8.Table ( fromColumns, toColumns )
import Rel8.Table.Opaleye ( castTable, table, unpackspec )
import Rel8.Table.Serialize ( Serializable, parse )
import qualified Data.Text as Text ( pack )
import Data.Text.Encoding ( encodeUtf8 )
type OnConflict :: Type
data OnConflict
= Abort
| DoNothing
type Insert :: Type -> Type
data Insert a where
Insert :: Selects names exprs =>
{ ()
into :: TableSchema names
, ()
rows :: [exprs]
, Insert a -> OnConflict
onConflict :: OnConflict
, ()
returning :: Returning names a
}
-> Insert a
insert :: Connection -> Insert a -> IO a
insert :: Connection -> Insert a -> IO a
insert Connection
c Insert {TableSchema names
into :: TableSchema names
$sel:into:Insert :: ()
into, [exprs]
rows :: [exprs]
$sel:rows:Insert :: ()
rows, OnConflict
onConflict :: OnConflict
$sel:onConflict:Insert :: forall a. Insert a -> OnConflict
onConflict, Returning names a
returning :: Returning names a
$sel:returning:Insert :: ()
returning} =
case ([exprs]
rows, Returning names a
returning) of
([], Returning names a
NumberOfRowsAffected) -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
0
([], Projection exprs -> projection
_) -> [a] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
(exprs
x:[exprs]
xs, Returning names a
NumberOfRowsAffected) -> Session Int64 -> Connection -> IO (Either QueryError Int64)
forall a. Session a -> Connection -> IO (Either QueryError a)
Hasql.run Session Int64
session Connection
c IO (Either QueryError Int64)
-> (Either QueryError Int64 -> IO Int64) -> IO Int64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QueryError -> IO Int64)
-> (Int64 -> IO Int64) -> Either QueryError Int64 -> IO Int64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either QueryError -> IO Int64
forall e a. Exception e => e -> IO a
throwIO Int64 -> IO Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure
where
session :: Session Int64
session = () -> Statement () Int64 -> Session Int64
forall params result.
params -> Statement params result -> Session result
Hasql.statement () Statement () Int64
statement
statement :: Statement () Int64
statement = ByteString
-> Params () -> Result Int64 -> Bool -> Statement () Int64
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Hasql.Statement ByteString
bytes Params ()
params Result Int64
decode Bool
prepare
bytes :: ByteString
bytes = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
sql
params :: Params ()
params = Params ()
Hasql.noParams
decode :: Result Int64
decode = Result Int64
Hasql.rowsAffected
prepare :: Bool
prepare = Bool
False
sql :: String
sql = Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
-> NonEmpty (Columns exprs (Col Expr))
-> Maybe OnConflict
-> String
forall columnsW columnsR.
Table columnsW columnsR
-> NonEmpty columnsW -> Maybe OnConflict -> String
Opaleye.arrangeInsertManySql Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
into' NonEmpty (Columns exprs (Col Expr))
rows' Maybe OnConflict
onConflict'
where
into' :: Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
into' = TableSchema (Columns exprs (Col Name))
-> Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
forall names exprs.
Selects names exprs =>
TableSchema names -> Table exprs exprs
table (TableSchema (Columns exprs (Col Name))
-> Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr)))
-> TableSchema (Columns exprs (Col Name))
-> Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
forall a b. (a -> b) -> a -> b
$ names -> Columns exprs (Col Name)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (names -> Columns exprs (Col Name))
-> TableSchema names -> TableSchema (Columns exprs (Col Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableSchema names
into
rows' :: NonEmpty (Columns exprs (Col Expr))
rows' = exprs -> Columns exprs (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (exprs -> Columns exprs (Col Expr))
-> NonEmpty exprs -> NonEmpty (Columns exprs (Col Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> exprs
x exprs -> [exprs] -> NonEmpty exprs
forall a. a -> [a] -> NonEmpty a
:| [exprs]
xs
(exprs
x:[exprs]
xs, Projection exprs -> projection
project) -> Session [a] -> Connection -> IO (Either QueryError [a])
forall a. Session a -> Connection -> IO (Either QueryError a)
Hasql.run Session [a]
session Connection
c IO (Either QueryError [a])
-> (Either QueryError [a] -> IO [a]) -> IO [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QueryError -> IO [a])
-> ([a] -> IO [a]) -> Either QueryError [a] -> IO [a]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either QueryError -> IO [a]
forall e a. Exception e => e -> IO a
throwIO [a] -> IO [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
where
session :: Session [a]
session = () -> Statement () [a] -> Session [a]
forall params result.
params -> Statement params result -> Session result
Hasql.statement () Statement () [a]
statement
statement :: Statement () [a]
statement = ByteString -> Params () -> Result [a] -> Bool -> Statement () [a]
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Hasql.Statement ByteString
bytes Params ()
params Result [a]
decode Bool
prepare
bytes :: ByteString
bytes = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
sql
params :: Params ()
params = Params ()
Hasql.noParams
decode :: Result [a]
decode = (exprs -> projection) -> Result [a]
forall exprs projection a.
Serializable projection a =>
(exprs -> projection) -> Result [a]
decoder exprs -> projection
project
prepare :: Bool
prepare = Bool
False
sql :: String
sql =
Unpackspec
(Columns projection (Col Expr)) (Columns projection (Col Expr))
-> Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
-> NonEmpty (Columns exprs (Col Expr))
-> (Columns exprs (Col Expr) -> Columns projection (Col Expr))
-> Maybe OnConflict
-> String
forall columnsReturned ignored columnsW columnsR.
Unpackspec columnsReturned ignored
-> Table columnsW columnsR
-> NonEmpty columnsW
-> (columnsR -> columnsReturned)
-> Maybe OnConflict
-> String
Opaleye.arrangeInsertManyReturningSql
Unpackspec
(Columns projection (Col Expr)) (Columns projection (Col Expr))
forall a. Table Expr a => Unpackspec a a
unpackspec
Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
into'
NonEmpty (Columns exprs (Col Expr))
rows'
Columns exprs (Col Expr) -> Columns projection (Col Expr)
project'
Maybe OnConflict
onConflict'
where
into' :: Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
into' = TableSchema (Columns exprs (Col Name))
-> Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
forall names exprs.
Selects names exprs =>
TableSchema names -> Table exprs exprs
table (TableSchema (Columns exprs (Col Name))
-> Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr)))
-> TableSchema (Columns exprs (Col Name))
-> Table (Columns exprs (Col Expr)) (Columns exprs (Col Expr))
forall a b. (a -> b) -> a -> b
$ names -> Columns exprs (Col Name)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (names -> Columns exprs (Col Name))
-> TableSchema names -> TableSchema (Columns exprs (Col Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableSchema names
into
rows' :: NonEmpty (Columns exprs (Col Expr))
rows' = exprs -> Columns exprs (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (exprs -> Columns exprs (Col Expr))
-> NonEmpty exprs -> NonEmpty (Columns exprs (Col Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> exprs
x exprs -> [exprs] -> NonEmpty exprs
forall a. a -> [a] -> NonEmpty a
:| [exprs]
xs
project' :: Columns exprs (Col Expr) -> Columns projection (Col Expr)
project' = Columns projection (Col Expr) -> Columns projection (Col Expr)
forall a. Table Expr a => a -> a
castTable (Columns projection (Col Expr) -> Columns projection (Col Expr))
-> (Columns exprs (Col Expr) -> Columns projection (Col Expr))
-> Columns exprs (Col Expr)
-> Columns projection (Col Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. projection -> Columns projection (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (projection -> Columns projection (Col Expr))
-> (Columns exprs (Col Expr) -> projection)
-> Columns exprs (Col Expr)
-> Columns projection (Col Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. exprs -> projection
project (exprs -> projection)
-> (Columns exprs (Col Expr) -> exprs)
-> Columns exprs (Col Expr)
-> projection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Columns exprs (Col Expr) -> exprs
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns
where
onConflict' :: Maybe OnConflict
onConflict' =
case OnConflict
onConflict of
OnConflict
DoNothing -> OnConflict -> Maybe OnConflict
forall a. a -> Maybe a
Just OnConflict
Opaleye.DoNothing
OnConflict
Abort -> Maybe OnConflict
forall a. Maybe a
Nothing
decoder :: forall exprs projection a. Serializable projection a
=> (exprs -> projection) -> Hasql.Result [a]
decoder :: (exprs -> projection) -> Result [a]
decoder exprs -> projection
_ = Row a -> Result [a]
forall a. Row a -> Result [a]
Hasql.rowList (Serializable projection a => Row a
forall exprs a. Serializable exprs a => Row a
parse @projection @a)