{-# language GADTs #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}

module Rel8.Statement.Insert
  ( Insert(..)
  , OnConflict(..)
  , insert
  )
where

-- base
import Control.Exception ( throwIO )
import Data.List.NonEmpty ( NonEmpty( (:|) ) )
import Prelude

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

-- opaleye
import qualified Opaleye.Internal.Manipulation as Opaleye
import qualified Opaleye.Manipulation as Opaleye

-- rel8
import Rel8.Schema.Insert ( Insert(..), OnConflict(..) )
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 )

-- text
import qualified Data.Text as Text ( pack )
import Data.Text.Encoding ( encodeUtf8 )


-- | Run an @INSERT@ statement
insert :: Connection -> Insert a -> IO a
insert :: Connection -> Insert a -> IO a
insert Connection
c Insert {TableSchema names
$sel:into:Insert :: ()
into :: TableSchema names
into, [inserts]
$sel:rows:Insert :: ()
rows :: [inserts]
rows, OnConflict
$sel:onConflict:Insert :: forall a. Insert a -> OnConflict
onConflict :: OnConflict
onConflict, Returning names a
$sel:returning:Insert :: ()
returning :: Returning names a
returning} =
  case ([inserts]
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 []

    (inserts
x:[inserts]
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 inserts (Col Insert)) (Columns inserts (Col Expr))
-> NonEmpty (Columns inserts (Col Insert))
-> Maybe OnConflict
-> String
forall columnsW columnsR.
Table columnsW columnsR
-> NonEmpty columnsW -> Maybe OnConflict -> String
Opaleye.arrangeInsertManySql Table (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
into' NonEmpty (Columns inserts (Col Insert))
rows' Maybe OnConflict
onConflict'
          where
            into' :: Table (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
into' = TableSchema (Columns inserts (Col Name))
-> Table
     (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
forall names exprs inserts.
(Selects names exprs, Inserts exprs inserts) =>
TableSchema names -> Table inserts exprs
table (TableSchema (Columns inserts (Col Name))
 -> Table
      (Columns inserts (Col Insert)) (Columns inserts (Col Expr)))
-> TableSchema (Columns inserts (Col Name))
-> Table
     (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
forall a b. (a -> b) -> a -> b
$ names -> Columns inserts (Col Name)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (names -> Columns inserts (Col Name))
-> TableSchema names -> TableSchema (Columns inserts (Col Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableSchema names
into
            rows' :: NonEmpty (Columns inserts (Col Insert))
rows' = inserts -> Columns inserts (Col Insert)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (inserts -> Columns inserts (Col Insert))
-> NonEmpty inserts -> NonEmpty (Columns inserts (Col Insert))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> inserts
x inserts -> [inserts] -> NonEmpty inserts
forall a. a -> [a] -> NonEmpty a
:| [inserts]
xs

    (inserts
x:[inserts]
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 inserts (Col Insert)) (Columns inserts (Col Expr))
-> NonEmpty (Columns inserts (Col Insert))
-> (Columns inserts (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 inserts (Col Insert)) (Columns inserts (Col Expr))
into'
            NonEmpty (Columns inserts (Col Insert))
rows'
            Columns inserts (Col Expr) -> Columns projection (Col Expr)
project'
            Maybe OnConflict
onConflict'
          where
            into' :: Table (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
into' = TableSchema (Columns inserts (Col Name))
-> Table
     (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
forall names exprs inserts.
(Selects names exprs, Inserts exprs inserts) =>
TableSchema names -> Table inserts exprs
table (TableSchema (Columns inserts (Col Name))
 -> Table
      (Columns inserts (Col Insert)) (Columns inserts (Col Expr)))
-> TableSchema (Columns inserts (Col Name))
-> Table
     (Columns inserts (Col Insert)) (Columns inserts (Col Expr))
forall a b. (a -> b) -> a -> b
$ names -> Columns inserts (Col Name)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (names -> Columns inserts (Col Name))
-> TableSchema names -> TableSchema (Columns inserts (Col Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableSchema names
into
            rows' :: NonEmpty (Columns inserts (Col Insert))
rows' = inserts -> Columns inserts (Col Insert)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (inserts -> Columns inserts (Col Insert))
-> NonEmpty inserts -> NonEmpty (Columns inserts (Col Insert))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> inserts
x inserts -> [inserts] -> NonEmpty inserts
forall a. a -> [a] -> NonEmpty a
:| [inserts]
xs
            project' :: Columns inserts (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 inserts (Col Expr) -> Columns projection (Col Expr))
-> Columns inserts (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 inserts (Col Expr) -> projection)
-> Columns inserts (Col Expr)
-> Columns projection (Col Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. exprs -> projection
project (exprs -> projection)
-> (Columns inserts (Col Expr) -> exprs)
-> Columns inserts (Col Expr)
-> projection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Columns inserts (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)