{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-partial-type-signatures #-}

{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Database.Beam.Postgres.Connection
  ( Pg(..), PgF(..)

  , liftIOWithHandle

  , runBeamPostgres, runBeamPostgresDebug

  , pgRenderSyntax, runPgRowReader, getFields

  , withPgDebug

  , postgresUriSyntax ) where

import           Control.Exception (SomeException(..), throwIO)
import           Control.Monad.Base (MonadBase(..))
import           Control.Monad.Free.Church
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Control (MonadBaseControl(..))

import           Database.Beam hiding (runDelete, runUpdate, runInsert, insert)
import           Database.Beam.Backend.SQL.BeamExtensions
import           Database.Beam.Backend.SQL.Row ( FromBackendRowF(..), FromBackendRowM(..)
                                               , BeamRowReadError(..), ColumnParseError(..) )
import           Database.Beam.Backend.URI
import           Database.Beam.Schema.Tables

import           Database.Beam.Postgres.Syntax
import           Database.Beam.Postgres.Full
import           Database.Beam.Postgres.Types

import qualified Database.PostgreSQL.LibPQ as Pg hiding
  (Connection, escapeStringConn, escapeIdentifier, escapeByteaConn, exec)
import qualified Database.PostgreSQL.Simple as Pg
import qualified Database.PostgreSQL.Simple.FromField as Pg
import qualified Database.PostgreSQL.Simple.Internal as Pg
  ( Field(..), RowParser(..)
  , escapeStringConn, escapeIdentifier, escapeByteaConn
  , exec, throwResultError )
import qualified Database.PostgreSQL.Simple.Internal as PgI
import qualified Database.PostgreSQL.Simple.Ok as Pg
import qualified Database.PostgreSQL.Simple.Types as Pg (Query(..))

import           Control.Monad.Reader
import           Control.Monad.State
import qualified Control.Monad.Fail as Fail

import           Data.ByteString (ByteString)
import           Data.ByteString.Builder (toLazyByteString, byteString)
import qualified Data.ByteString.Lazy as BL
import           Data.Maybe (listToMaybe, fromMaybe)
import           Data.Proxy
import           Data.String
import qualified Data.Text as T
import           Data.Text.Encoding (decodeUtf8)
import           Data.Typeable (cast)
#if !MIN_VERSION_base(4, 11, 0)
import           Data.Semigroup
#endif

import           Foreign.C.Types

import           Network.URI (uriToString)

data PgStream a = PgStreamDone     (Either BeamRowReadError a)
                | PgStreamContinue (Maybe PgI.Row -> IO (PgStream a))

-- | 'BeamURIOpeners' for the standard @postgresql:@ URI scheme. See the
-- postgres documentation for more details on the formatting. See documentation
-- for 'BeamURIOpeners' for more information on how to use this with beam
postgresUriSyntax :: c Postgres Pg.Connection Pg
                  -> BeamURIOpeners c
postgresUriSyntax :: c Postgres Connection Pg -> BeamURIOpeners c
postgresUriSyntax =
    (forall a. Connection -> Pg a -> IO a)
-> String
-> (URI -> IO (Connection, IO ()))
-> c Postgres Connection Pg
-> BeamURIOpeners c
forall hdl (m :: * -> *) (c :: * -> * -> (* -> *) -> *) be.
(forall a. hdl -> m a -> IO a)
-> String
-> (URI -> IO (hdl, IO ()))
-> c be hdl m
-> BeamURIOpeners c
mkUriOpener forall a. Connection -> Pg a -> IO a
runBeamPostgres String
"postgresql:"
        (\URI
uri -> do
            let pgConnStr :: ByteString
pgConnStr = String -> ByteString
forall a. IsString a => String -> a
fromString ((String -> String) -> URI -> String -> String
uriToString String -> String
forall a. a -> a
id URI
uri String
"")
            Connection
hdl <- ByteString -> IO Connection
Pg.connectPostgreSQL ByteString
pgConnStr
            (Connection, IO ()) -> IO (Connection, IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Connection
hdl, Connection -> IO ()
Pg.close Connection
hdl))

-- * Syntax rendering

pgRenderSyntax ::
  Pg.Connection -> PgSyntax -> IO ByteString
pgRenderSyntax :: Connection -> PgSyntax -> IO ByteString
pgRenderSyntax Connection
conn (PgSyntax PgSyntaxM ()
mkQuery) =
  Builder -> ByteString
renderBuilder (Builder -> ByteString) -> IO Builder -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PgSyntaxM ()
-> (() -> Builder -> IO Builder)
-> (PgSyntaxF (Builder -> IO Builder) -> Builder -> IO Builder)
-> Builder
-> IO Builder
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF PgSyntaxM ()
mkQuery () -> Builder -> IO Builder
forall (f :: * -> *) p a. Applicative f => p -> a -> f a
finish PgSyntaxF (Builder -> IO Builder) -> Builder -> IO Builder
step Builder
forall a. Monoid a => a
mempty
  where
    renderBuilder :: Builder -> ByteString
renderBuilder = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString

    step :: PgSyntaxF (Builder -> IO Builder) -> Builder -> IO Builder
step (EmitBuilder Builder
b Builder -> IO Builder
next) Builder
a = Builder -> IO Builder
next (Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)
    step (EmitByteString ByteString
b Builder -> IO Builder
next) Builder
a = Builder -> IO Builder
next (Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
b)
    step (EscapeString ByteString
b Builder -> IO Builder
next) Builder
a = do
      ByteString
res <- String -> IO (Either ByteString ByteString) -> IO ByteString
forall (m :: * -> *) a b.
(MonadFail m, Show a) =>
String -> m (Either a b) -> m b
wrapError String
"EscapeString" (Connection -> ByteString -> IO (Either ByteString ByteString)
Pg.escapeStringConn Connection
conn ByteString
b)
      Builder -> IO Builder
next (Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
res)
    step (EscapeBytea ByteString
b Builder -> IO Builder
next) Builder
a = do
      ByteString
res <- String -> IO (Either ByteString ByteString) -> IO ByteString
forall (m :: * -> *) a b.
(MonadFail m, Show a) =>
String -> m (Either a b) -> m b
wrapError String
"EscapeBytea" (Connection -> ByteString -> IO (Either ByteString ByteString)
Pg.escapeByteaConn Connection
conn ByteString
b)
      Builder -> IO Builder
next (Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
res)
    step (EscapeIdentifier ByteString
b Builder -> IO Builder
next) Builder
a = do
      ByteString
res <- String -> IO (Either ByteString ByteString) -> IO ByteString
forall (m :: * -> *) a b.
(MonadFail m, Show a) =>
String -> m (Either a b) -> m b
wrapError String
"EscapeIdentifier" (Connection -> ByteString -> IO (Either ByteString ByteString)
Pg.escapeIdentifier Connection
conn ByteString
b)
      Builder -> IO Builder
next (Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
res)

    finish :: p -> a -> f a
finish p
_ = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    wrapError :: String -> m (Either a b) -> m b
wrapError String
step' m (Either a b)
go = do
      Either a b
res <- m (Either a b)
go
      case Either a b
res of
        Right b
res' -> b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
res'
        Left a
res' -> String -> m b
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
step' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
res')

-- * Run row readers

getFields :: Pg.Result -> IO [Pg.Field]
getFields :: Result -> IO [Field]
getFields Result
res = do
  Pg.Col CInt
colCount <- Result -> IO Column
Pg.nfields Result
res

  let getField :: CInt -> IO Field
getField CInt
col =
        Result -> Column -> Oid -> Field
Pg.Field Result
res (CInt -> Column
Pg.Col CInt
col) (Oid -> Field) -> IO Oid -> IO Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> Column -> IO Oid
Pg.ftype Result
res (CInt -> Column
Pg.Col CInt
col)

  (CInt -> IO Field) -> [CInt] -> IO [Field]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CInt -> IO Field
getField [CInt
0..CInt
colCount CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1]

runPgRowReader ::
  Pg.Connection -> Pg.Row -> Pg.Result -> [Pg.Field] -> FromBackendRowM Postgres a -> IO (Either BeamRowReadError a)
runPgRowReader :: Connection
-> Row
-> Result
-> [Field]
-> FromBackendRowM Postgres a
-> IO (Either BeamRowReadError a)
runPgRowReader Connection
conn Row
rowIdx Result
res [Field]
fields (FromBackendRowM F (FromBackendRowF Postgres) a
readRow) =
  Result -> IO Column
Pg.nfields Result
res IO Column
-> (Column -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Pg.Col CInt
colCount) ->
  F (FromBackendRowF Postgres) a
-> (a -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError a))
-> (FromBackendRowF
      Postgres
      (CInt -> CInt -> [Field] -> IO (Either BeamRowReadError a))
    -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError a))
-> CInt
-> CInt
-> [Field]
-> IO (Either BeamRowReadError a)
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F (FromBackendRowF Postgres) a
readRow a -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError a)
forall (f :: * -> *) b p p p a.
Applicative f =>
b -> p -> p -> p -> f (Either a b)
finish FromBackendRowF
  Postgres
  (CInt -> CInt -> [Field] -> IO (Either BeamRowReadError a))
-> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError a)
forall x.
FromBackendRowF
  Postgres
  (CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x))
-> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
step CInt
0 CInt
colCount [Field]
fields
  where

    step :: forall x. FromBackendRowF Postgres (CInt -> CInt -> [PgI.Field] -> IO (Either BeamRowReadError x))
         -> CInt -> CInt -> [PgI.Field] -> IO (Either BeamRowReadError x)
    step :: FromBackendRowF
  Postgres
  (CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x))
-> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
step (ParseOneField a -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
_) CInt
curCol CInt
colCount [] = Either BeamRowReadError x -> IO (Either BeamRowReadError x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError x
forall a b. a -> Either a b
Left (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError (Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
curCol)) (Int -> ColumnParseError
ColumnNotEnoughColumns (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
colCount))))
    step (ParseOneField a -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
_) CInt
curCol CInt
colCount [Field]
_
      | CInt
curCol CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
colCount = Either BeamRowReadError x -> IO (Either BeamRowReadError x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError x
forall a b. a -> Either a b
Left (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError (Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
curCol)) (Int -> ColumnParseError
ColumnNotEnoughColumns (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
colCount))))
    step (ParseOneField (a -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
next' :: next -> _)) CInt
curCol CInt
colCount (Field
field:[Field]
remainingFields) =
      do Maybe ByteString
fieldValue <- Result -> Row -> Column -> IO (Maybe ByteString)
Pg.getvalue' Result
res Row
rowIdx (CInt -> Column
Pg.Col CInt
curCol)
         Ok a
res' <- Conversion a -> Connection -> IO (Ok a)
forall a. Conversion a -> Connection -> IO (Ok a)
Pg.runConversion (FieldParser a
forall a. FromField a => FieldParser a
Pg.fromField Field
field Maybe ByteString
fieldValue) Connection
conn
         case Ok a
res' of
           Pg.Errors [SomeException]
errs ->
             let err :: ColumnParseError
err = ColumnParseError -> Maybe ColumnParseError -> ColumnParseError
forall a. a -> Maybe a -> a
fromMaybe (String -> ColumnParseError
ColumnErrorInternal String
"Column parse failed with unknown exception") (Maybe ColumnParseError -> ColumnParseError)
-> Maybe ColumnParseError -> ColumnParseError
forall a b. (a -> b) -> a -> b
$
                       [ColumnParseError] -> Maybe ColumnParseError
forall a. [a] -> Maybe a
listToMaybe ([ColumnParseError] -> Maybe ColumnParseError)
-> [ColumnParseError] -> Maybe ColumnParseError
forall a b. (a -> b) -> a -> b
$
                       do SomeException e
e <- [SomeException]
errs
                          Just ResultError
pgErr <- Maybe ResultError -> [Maybe ResultError]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Maybe ResultError
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e)
                          case ResultError
pgErr of
                            Pg.ConversionFailed { errSQLType :: ResultError -> String
Pg.errSQLType = String
sql
                                                , errHaskellType :: ResultError -> String
Pg.errHaskellType = String
hs
                                                , errMessage :: ResultError -> String
Pg.errMessage = String
msg } ->
                              ColumnParseError -> [ColumnParseError]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> String -> String -> ColumnParseError
ColumnTypeMismatch String
hs String
sql String
msg)
                            Pg.Incompatible { errSQLType :: ResultError -> String
Pg.errSQLType = String
sql
                                            , errHaskellType :: ResultError -> String
Pg.errHaskellType = String
hs
                                            , errMessage :: ResultError -> String
Pg.errMessage = String
msg } ->
                              ColumnParseError -> [ColumnParseError]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> String -> String -> ColumnParseError
ColumnTypeMismatch String
hs String
sql String
msg)
                            Pg.UnexpectedNull {} ->
                              ColumnParseError -> [ColumnParseError]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnParseError
ColumnUnexpectedNull
             in Either BeamRowReadError x -> IO (Either BeamRowReadError x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError x
forall a b. a -> Either a b
Left (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError (Int -> Maybe Int
forall a. a -> Maybe a
Just (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
curCol)) ColumnParseError
err))
           Pg.Ok a
x -> a -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
next' a
x (CInt
curCol CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1) CInt
colCount [Field]
remainingFields

    step (Alt (FromBackendRowM F (FromBackendRowF Postgres) a
a) (FromBackendRowM F (FromBackendRowF Postgres) a
b) a -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
next) CInt
curCol CInt
colCount [Field]
cols =
      do Either BeamRowReadError (IO (Either BeamRowReadError x))
aRes <- F (FromBackendRowF Postgres) a
-> (a
    -> CInt
    -> CInt
    -> [Field]
    -> IO (Either BeamRowReadError (IO (Either BeamRowReadError x))))
-> (FromBackendRowF
      Postgres
      (CInt
       -> CInt
       -> [Field]
       -> IO (Either BeamRowReadError (IO (Either BeamRowReadError x))))
    -> CInt
    -> CInt
    -> [Field]
    -> IO (Either BeamRowReadError (IO (Either BeamRowReadError x))))
-> CInt
-> CInt
-> [Field]
-> IO (Either BeamRowReadError (IO (Either BeamRowReadError x)))
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F (FromBackendRowF Postgres) a
a (\a
x CInt
curCol' CInt
colCount' [Field]
cols' -> Either BeamRowReadError (IO (Either BeamRowReadError x))
-> IO (Either BeamRowReadError (IO (Either BeamRowReadError x)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO (Either BeamRowReadError x)
-> Either BeamRowReadError (IO (Either BeamRowReadError x))
forall a b. b -> Either a b
Right (a -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
next a
x CInt
curCol' CInt
colCount' [Field]
cols'))) FromBackendRowF
  Postgres
  (CInt
   -> CInt
   -> [Field]
   -> IO (Either BeamRowReadError (IO (Either BeamRowReadError x))))
-> CInt
-> CInt
-> [Field]
-> IO (Either BeamRowReadError (IO (Either BeamRowReadError x)))
forall x.
FromBackendRowF
  Postgres
  (CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x))
-> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
step CInt
curCol CInt
colCount [Field]
cols
         case Either BeamRowReadError (IO (Either BeamRowReadError x))
aRes of
           Right IO (Either BeamRowReadError x)
next' -> IO (Either BeamRowReadError x)
next'
           Left BeamRowReadError
aErr -> do
             Either BeamRowReadError (IO (Either BeamRowReadError x))
bRes <- F (FromBackendRowF Postgres) a
-> (a
    -> CInt
    -> CInt
    -> [Field]
    -> IO (Either BeamRowReadError (IO (Either BeamRowReadError x))))
-> (FromBackendRowF
      Postgres
      (CInt
       -> CInt
       -> [Field]
       -> IO (Either BeamRowReadError (IO (Either BeamRowReadError x))))
    -> CInt
    -> CInt
    -> [Field]
    -> IO (Either BeamRowReadError (IO (Either BeamRowReadError x))))
-> CInt
-> CInt
-> [Field]
-> IO (Either BeamRowReadError (IO (Either BeamRowReadError x)))
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F (FromBackendRowF Postgres) a
b (\a
x CInt
curCol' CInt
colCount' [Field]
cols' -> Either BeamRowReadError (IO (Either BeamRowReadError x))
-> IO (Either BeamRowReadError (IO (Either BeamRowReadError x)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO (Either BeamRowReadError x)
-> Either BeamRowReadError (IO (Either BeamRowReadError x))
forall a b. b -> Either a b
Right (a -> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
next a
x CInt
curCol' CInt
colCount' [Field]
cols'))) FromBackendRowF
  Postgres
  (CInt
   -> CInt
   -> [Field]
   -> IO (Either BeamRowReadError (IO (Either BeamRowReadError x))))
-> CInt
-> CInt
-> [Field]
-> IO (Either BeamRowReadError (IO (Either BeamRowReadError x)))
forall x.
FromBackendRowF
  Postgres
  (CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x))
-> CInt -> CInt -> [Field] -> IO (Either BeamRowReadError x)
step CInt
curCol CInt
colCount [Field]
cols
             case Either BeamRowReadError (IO (Either BeamRowReadError x))
bRes of
               Right IO (Either BeamRowReadError x)
next' -> IO (Either BeamRowReadError x)
next'
               Left {} -> Either BeamRowReadError x -> IO (Either BeamRowReadError x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError x
forall a b. a -> Either a b
Left BeamRowReadError
aErr)

    step (FailParseWith BeamRowReadError
err) CInt
_ CInt
_ [Field]
_ =
      Either BeamRowReadError x -> IO (Either BeamRowReadError x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError x
forall a b. a -> Either a b
Left BeamRowReadError
err)

    finish :: b -> p -> p -> p -> f (Either a b)
finish b
x p
_ p
_ p
_ = Either a b -> f (Either a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Either a b
forall a b. b -> Either a b
Right b
x)

withPgDebug :: (String -> IO ()) -> Pg.Connection -> Pg a -> IO (Either BeamRowReadError a)
withPgDebug :: (String -> IO ())
-> Connection -> Pg a -> IO (Either BeamRowReadError a)
withPgDebug String -> IO ()
dbg Connection
conn (Pg F PgF a
action) =
  let finish :: b -> f (Either a b)
finish b
x = Either a b -> f (Either a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Either a b
forall a b. b -> Either a b
Right b
x)
      step :: PgF (IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
step (PgLiftIO IO a
io a -> IO (Either BeamRowReadError a)
next) = IO a
io IO a
-> (a -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO (Either BeamRowReadError a)
next
      step (PgLiftWithHandle (String -> IO ()) -> Connection -> IO a
withConn a -> IO (Either BeamRowReadError a)
next) = (String -> IO ()) -> Connection -> IO a
withConn String -> IO ()
dbg Connection
conn IO a
-> (a -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO (Either BeamRowReadError a)
next
      step (PgFetchNext Maybe x -> IO (Either BeamRowReadError a)
next) = Maybe x -> IO (Either BeamRowReadError a)
next Maybe x
forall a. Maybe a
Nothing
      step (PgRunReturning FetchMode
CursorBatching
                           (PgCommandSyntax PgCommandType
PgCommandTypeQuery PgSyntax
syntax)
                           (Pg (Maybe x) -> Pg a
mkProcess :: Pg (Maybe x) -> Pg a')
                           a -> IO (Either BeamRowReadError a)
next) =
        do ByteString
query <- Connection -> PgSyntax -> IO ByteString
pgRenderSyntax Connection
conn PgSyntax
syntax
           let Pg F PgF a
process = Pg (Maybe x) -> Pg a
mkProcess (F PgF (Maybe x) -> Pg (Maybe x)
forall a. F PgF a -> Pg a
Pg (PgF (Maybe x) -> F PgF (Maybe x)
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((Maybe x -> Maybe x) -> PgF (Maybe x)
forall x next.
FromBackendRow Postgres x =>
(Maybe x -> next) -> PgF next
PgFetchNext Maybe x -> Maybe x
forall a. a -> a
id)))
           String -> IO ()
dbg (Text -> String
T.unpack (ByteString -> Text
decodeUtf8 ByteString
query))
           PgStream a
action' <- F PgF a
-> (a -> Maybe Row -> IO (PgStream a))
-> (PgF (Maybe Row -> IO (PgStream a))
    -> Maybe Row -> IO (PgStream a))
-> Maybe Row
-> IO (PgStream a)
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F PgF a
process a -> Maybe Row -> IO (PgStream a)
forall a. a -> Maybe Row -> IO (PgStream a)
finishProcess PgF (Maybe Row -> IO (PgStream a)) -> Maybe Row -> IO (PgStream a)
forall a.
PgF (Maybe Row -> IO (PgStream a)) -> Maybe Row -> IO (PgStream a)
stepProcess Maybe Row
forall a. Maybe a
Nothing
           case PgStream a
action' of
             PgStreamDone (Right a
x) -> Connection -> Query -> IO Int64
Pg.execute_ Connection
conn (ByteString -> Query
Pg.Query ByteString
query) IO Int64
-> IO (Either BeamRowReadError a) -> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO (Either BeamRowReadError a)
next a
x
             PgStreamDone (Left BeamRowReadError
err) -> Either BeamRowReadError a -> IO (Either BeamRowReadError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left BeamRowReadError
err)
             PgStreamContinue Maybe Row -> IO (PgStream a)
nextStream ->
               let finishUp :: PgStream a -> IO (Either BeamRowReadError a)
finishUp (PgStreamDone (Right a
x)) = a -> IO (Either BeamRowReadError a)
next a
x
                   finishUp (PgStreamDone (Left BeamRowReadError
err)) = Either BeamRowReadError a -> IO (Either BeamRowReadError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left BeamRowReadError
err)
                   finishUp (PgStreamContinue Maybe Row -> IO (PgStream a)
next') = Maybe Row -> IO (PgStream a)
next' Maybe Row
forall a. Maybe a
Nothing IO (PgStream a)
-> (PgStream a -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PgStream a -> IO (Either BeamRowReadError a)
finishUp

                   columnCount :: Column
columnCount = Int -> Column
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Column) -> Int -> Column
forall a b. (a -> b) -> a -> b
$ Proxy Postgres -> Proxy x -> Int
forall be a. FromBackendRow be a => Proxy be -> Proxy a -> Int
valuesNeeded (Proxy Postgres
forall k (t :: k). Proxy t
Proxy @Postgres) (Proxy x
forall k (t :: k). Proxy t
Proxy @x)
               in RowParser Row
-> Connection
-> Query
-> PgStream a
-> (PgStream a -> Row -> IO (PgStream a))
-> IO (PgStream a)
forall r a.
RowParser r -> Connection -> Query -> a -> (a -> r -> IO a) -> IO a
Pg.foldWith_ (ReaderT Row (StateT Column Conversion) Row -> RowParser Row
forall a. ReaderT Row (StateT Column Conversion) a -> RowParser a
Pg.RP (Column -> ReaderT Row (StateT Column Conversion) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Column
columnCount ReaderT Row (StateT Column Conversion) ()
-> ReaderT Row (StateT Column Conversion) Row
-> ReaderT Row (StateT Column Conversion) Row
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT Row (StateT Column Conversion) Row
forall r (m :: * -> *). MonadReader r m => m r
ask)) Connection
conn (ByteString -> Query
Pg.Query ByteString
query) ((Maybe Row -> IO (PgStream a)) -> PgStream a
forall a. (Maybe Row -> IO (PgStream a)) -> PgStream a
PgStreamContinue Maybe Row -> IO (PgStream a)
nextStream) PgStream a -> Row -> IO (PgStream a)
forall a. PgStream a -> Row -> IO (PgStream a)
runConsumer IO (PgStream a)
-> (PgStream a -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PgStream a -> IO (Either BeamRowReadError a)
finishUp
      step (PgRunReturning FetchMode
AtOnce
                           (PgCommandSyntax PgCommandType
PgCommandTypeQuery PgSyntax
syntax)
                           (Pg (Maybe x) -> Pg a
mkProcess :: Pg (Maybe x) -> Pg a')
                           a -> IO (Either BeamRowReadError a)
next) =
        ByteString
-> PgSyntax
-> (Pg (Maybe x) -> Pg a)
-> (a -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall x a' a.
FromBackendRow Postgres x =>
ByteString
-> PgSyntax
-> (Pg (Maybe x) -> Pg a')
-> (a' -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
renderExecReturningList ByteString
"No tuples returned to Postgres query" PgSyntax
syntax Pg (Maybe x) -> Pg a
mkProcess a -> IO (Either BeamRowReadError a)
next
      step (PgRunReturning FetchMode
_ (PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
syntax) Pg (Maybe x) -> Pg a
mkProcess a -> IO (Either BeamRowReadError a)
next) =
        ByteString
-> PgSyntax
-> (Pg (Maybe x) -> Pg a)
-> (a -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall x a' a.
FromBackendRow Postgres x =>
ByteString
-> PgSyntax
-> (Pg (Maybe x) -> Pg a')
-> (a' -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
renderExecReturningList ByteString
"No tuples returned to Postgres update/insert returning" PgSyntax
syntax Pg (Maybe x) -> Pg a
mkProcess a -> IO (Either BeamRowReadError a)
next
      step (PgRunReturning FetchMode
_ (PgCommandSyntax PgCommandType
_ PgSyntax
syntax) Pg (Maybe x) -> Pg a
mkProcess a -> IO (Either BeamRowReadError a)
next) =
        do ByteString
query <- Connection -> PgSyntax -> IO ByteString
pgRenderSyntax Connection
conn PgSyntax
syntax
           String -> IO ()
dbg (Text -> String
T.unpack (ByteString -> Text
decodeUtf8 ByteString
query))
           Int64
_ <- Connection -> Query -> IO Int64
Pg.execute_ Connection
conn (ByteString -> Query
Pg.Query ByteString
query)

           let Pg F PgF a
process = Pg (Maybe x) -> Pg a
mkProcess (F PgF (Maybe x) -> Pg (Maybe x)
forall a. F PgF a -> Pg a
Pg (PgF (Maybe x) -> F PgF (Maybe x)
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((Maybe x -> Maybe x) -> PgF (Maybe x)
forall x next.
FromBackendRow Postgres x =>
(Maybe x -> next) -> PgF next
PgFetchNext Maybe x -> Maybe x
forall a. a -> a
id)))
           F PgF a
-> (a -> IO (Either BeamRowReadError a))
-> (PgF (IO (Either BeamRowReadError a))
    -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F PgF a
process a -> IO (Either BeamRowReadError a)
next PgF (IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall a.
PgF (IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
stepReturningNone

      renderExecReturningList :: (FromBackendRow Postgres x) => _ -> PgSyntax -> (Pg (Maybe x) -> Pg a') -> _ -> _
      renderExecReturningList :: ByteString
-> PgSyntax
-> (Pg (Maybe x) -> Pg a')
-> (a' -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
renderExecReturningList ByteString
errMsg PgSyntax
syntax Pg (Maybe x) -> Pg a'
mkProcess a' -> IO (Either BeamRowReadError a)
next =
        do ByteString
query <- Connection -> PgSyntax -> IO ByteString
pgRenderSyntax Connection
conn PgSyntax
syntax
           String -> IO ()
dbg (Text -> String
T.unpack (ByteString -> Text
decodeUtf8 ByteString
query))

           Result
res <- Connection -> ByteString -> IO Result
Pg.exec Connection
conn ByteString
query
           ExecStatus
sts <- Result -> IO ExecStatus
Pg.resultStatus Result
res
           case ExecStatus
sts of
             ExecStatus
Pg.TuplesOk -> do
               let Pg F PgF a'
process = Pg (Maybe x) -> Pg a'
mkProcess (F PgF (Maybe x) -> Pg (Maybe x)
forall a. F PgF a -> Pg a
Pg (PgF (Maybe x) -> F PgF (Maybe x)
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((Maybe x -> Maybe x) -> PgF (Maybe x)
forall x next.
FromBackendRow Postgres x =>
(Maybe x -> next) -> PgF next
PgFetchNext Maybe x -> Maybe x
forall a. a -> a
id)))
               F PgF a'
-> (a' -> CInt -> IO (Either BeamRowReadError a))
-> (PgF (CInt -> IO (Either BeamRowReadError a))
    -> CInt -> IO (Either BeamRowReadError a))
-> CInt
-> IO (Either BeamRowReadError a)
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F PgF a'
process (\a'
x CInt
_ -> Result -> IO ()
Pg.unsafeFreeResult Result
res IO ()
-> IO (Either BeamRowReadError a) -> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a' -> IO (Either BeamRowReadError a)
next a'
x) (Result
-> PgF (CInt -> IO (Either BeamRowReadError a))
-> CInt
-> IO (Either BeamRowReadError a)
forall a.
Result
-> PgF (CInt -> IO (Either BeamRowReadError a))
-> CInt
-> IO (Either BeamRowReadError a)
stepReturningList Result
res) CInt
0
             ExecStatus
_ -> ByteString
-> Result -> ExecStatus -> IO (Either BeamRowReadError a)
forall a. ByteString -> Result -> ExecStatus -> IO a
Pg.throwResultError ByteString
errMsg Result
res ExecStatus
sts

      stepReturningNone :: forall a. PgF (IO (Either BeamRowReadError a)) -> IO (Either BeamRowReadError a)
      stepReturningNone :: PgF (IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
stepReturningNone (PgLiftIO IO a
action' a -> IO (Either BeamRowReadError a)
next) = IO a
action' IO a
-> (a -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO (Either BeamRowReadError a)
next
      stepReturningNone (PgLiftWithHandle (String -> IO ()) -> Connection -> IO a
withConn a -> IO (Either BeamRowReadError a)
next) = (String -> IO ()) -> Connection -> IO a
withConn String -> IO ()
dbg Connection
conn IO a
-> (a -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO (Either BeamRowReadError a)
next
      stepReturningNone (PgFetchNext Maybe x -> IO (Either BeamRowReadError a)
next) = Maybe x -> IO (Either BeamRowReadError a)
next Maybe x
forall a. Maybe a
Nothing
      stepReturningNone (PgRunReturning {}) = Either BeamRowReadError a -> IO (Either BeamRowReadError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError Maybe Int
forall a. Maybe a
Nothing (String -> ColumnParseError
ColumnErrorInternal  String
"Nested queries not allowed")))

      stepReturningList :: forall a. Pg.Result -> PgF (CInt -> IO (Either BeamRowReadError a)) -> CInt -> IO (Either BeamRowReadError a)
      stepReturningList :: Result
-> PgF (CInt -> IO (Either BeamRowReadError a))
-> CInt
-> IO (Either BeamRowReadError a)
stepReturningList Result
_   (PgLiftIO IO a
action' a -> CInt -> IO (Either BeamRowReadError a)
next) CInt
rowIdx = IO a
action' IO a
-> (a -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> a -> CInt -> IO (Either BeamRowReadError a)
next a
x CInt
rowIdx
      stepReturningList Result
res (PgFetchNext Maybe x -> CInt -> IO (Either BeamRowReadError a)
next) CInt
rowIdx =
        do [Field]
fields <- Result -> IO [Field]
getFields Result
res
           Pg.Row CInt
rowCount <- Result -> IO Row
Pg.ntuples Result
res
           if CInt
rowIdx CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
rowCount
             then Maybe x -> CInt -> IO (Either BeamRowReadError a)
next Maybe x
forall a. Maybe a
Nothing CInt
rowIdx
             else Connection
-> Row
-> Result
-> [Field]
-> FromBackendRowM Postgres x
-> IO (Either BeamRowReadError x)
forall a.
Connection
-> Row
-> Result
-> [Field]
-> FromBackendRowM Postgres a
-> IO (Either BeamRowReadError a)
runPgRowReader Connection
conn (CInt -> Row
Pg.Row CInt
rowIdx) Result
res [Field]
fields FromBackendRowM Postgres x
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow IO (Either BeamRowReadError x)
-> (Either BeamRowReadError x -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Left BeamRowReadError
err -> Either BeamRowReadError a -> IO (Either BeamRowReadError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left BeamRowReadError
err)
                    Right x
r -> Maybe x -> CInt -> IO (Either BeamRowReadError a)
next (x -> Maybe x
forall a. a -> Maybe a
Just x
r) (CInt
rowIdx CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+ CInt
1)
      stepReturningList Result
_   (PgRunReturning {}) CInt
_ = Either BeamRowReadError a -> IO (Either BeamRowReadError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError Maybe Int
forall a. Maybe a
Nothing (String -> ColumnParseError
ColumnErrorInternal String
"Nested queries not allowed")))
      stepReturningList Result
_   (PgLiftWithHandle {}) CInt
_ = Either BeamRowReadError a -> IO (Either BeamRowReadError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError Maybe Int
forall a. Maybe a
Nothing (String -> ColumnParseError
ColumnErrorInternal String
"Nested queries not allowed")))

      finishProcess :: forall a. a -> Maybe PgI.Row -> IO (PgStream a)
      finishProcess :: a -> Maybe Row -> IO (PgStream a)
finishProcess a
x Maybe Row
_ = PgStream a -> IO (PgStream a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BeamRowReadError a -> PgStream a
forall a. Either BeamRowReadError a -> PgStream a
PgStreamDone (a -> Either BeamRowReadError a
forall a b. b -> Either a b
Right a
x))

      stepProcess :: forall a. PgF (Maybe PgI.Row -> IO (PgStream a)) -> Maybe PgI.Row -> IO (PgStream a)
      stepProcess :: PgF (Maybe Row -> IO (PgStream a)) -> Maybe Row -> IO (PgStream a)
stepProcess (PgLiftIO IO a
action' a -> Maybe Row -> IO (PgStream a)
next) Maybe Row
row = IO a
action' IO a -> (a -> IO (PgStream a)) -> IO (PgStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Maybe Row -> IO (PgStream a))
-> Maybe Row -> a -> IO (PgStream a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Maybe Row -> IO (PgStream a)
next Maybe Row
row
      stepProcess (PgFetchNext Maybe x -> Maybe Row -> IO (PgStream a)
next) Maybe Row
Nothing =
        PgStream a -> IO (PgStream a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PgStream a -> IO (PgStream a))
-> ((Maybe Row -> IO (PgStream a)) -> PgStream a)
-> (Maybe Row -> IO (PgStream a))
-> IO (PgStream a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Row -> IO (PgStream a)) -> PgStream a
forall a. (Maybe Row -> IO (PgStream a)) -> PgStream a
PgStreamContinue ((Maybe Row -> IO (PgStream a)) -> IO (PgStream a))
-> (Maybe Row -> IO (PgStream a)) -> IO (PgStream a)
forall a b. (a -> b) -> a -> b
$ \Maybe Row
res ->
        case Maybe Row
res of
          Maybe Row
Nothing -> Maybe x -> Maybe Row -> IO (PgStream a)
next Maybe x
forall a. Maybe a
Nothing Maybe Row
forall a. Maybe a
Nothing
          Just (PgI.Row Row
rowIdx Result
res') ->
            Result -> IO [Field]
getFields Result
res' IO [Field] -> ([Field] -> IO (PgStream a)) -> IO (PgStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Field]
fields ->
            Connection
-> Row
-> Result
-> [Field]
-> FromBackendRowM Postgres x
-> IO (Either BeamRowReadError x)
forall a.
Connection
-> Row
-> Result
-> [Field]
-> FromBackendRowM Postgres a
-> IO (Either BeamRowReadError a)
runPgRowReader Connection
conn Row
rowIdx Result
res' [Field]
fields FromBackendRowM Postgres x
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow IO (Either BeamRowReadError x)
-> (Either BeamRowReadError x -> IO (PgStream a))
-> IO (PgStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Left BeamRowReadError
err -> PgStream a -> IO (PgStream a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BeamRowReadError a -> PgStream a
forall a. Either BeamRowReadError a -> PgStream a
PgStreamDone (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left BeamRowReadError
err))
              Right x
r -> Maybe x -> Maybe Row -> IO (PgStream a)
next (x -> Maybe x
forall a. a -> Maybe a
Just x
r) Maybe Row
forall a. Maybe a
Nothing
      stepProcess (PgFetchNext Maybe x -> Maybe Row -> IO (PgStream a)
next) (Just (PgI.Row Row
rowIdx Result
res)) =
        Result -> IO [Field]
getFields Result
res IO [Field] -> ([Field] -> IO (PgStream a)) -> IO (PgStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Field]
fields ->
        Connection
-> Row
-> Result
-> [Field]
-> FromBackendRowM Postgres x
-> IO (Either BeamRowReadError x)
forall a.
Connection
-> Row
-> Result
-> [Field]
-> FromBackendRowM Postgres a
-> IO (Either BeamRowReadError a)
runPgRowReader Connection
conn Row
rowIdx Result
res [Field]
fields FromBackendRowM Postgres x
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow IO (Either BeamRowReadError x)
-> (Either BeamRowReadError x -> IO (PgStream a))
-> IO (PgStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left BeamRowReadError
err -> PgStream a -> IO (PgStream a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BeamRowReadError a -> PgStream a
forall a. Either BeamRowReadError a -> PgStream a
PgStreamDone (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left BeamRowReadError
err))
          Right x
r -> PgStream a -> IO (PgStream a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe Row -> IO (PgStream a)) -> PgStream a
forall a. (Maybe Row -> IO (PgStream a)) -> PgStream a
PgStreamContinue (Maybe x -> Maybe Row -> IO (PgStream a)
next (x -> Maybe x
forall a. a -> Maybe a
Just x
r)))
      stepProcess (PgRunReturning {}) Maybe Row
_ = PgStream a -> IO (PgStream a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BeamRowReadError a -> PgStream a
forall a. Either BeamRowReadError a -> PgStream a
PgStreamDone (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError Maybe Int
forall a. Maybe a
Nothing (String -> ColumnParseError
ColumnErrorInternal String
"Nested queries not allowed"))))
      stepProcess (PgLiftWithHandle (String -> IO ()) -> Connection -> IO a
_ a -> Maybe Row -> IO (PgStream a)
_) Maybe Row
_ = PgStream a -> IO (PgStream a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BeamRowReadError a -> PgStream a
forall a. Either BeamRowReadError a -> PgStream a
PgStreamDone (BeamRowReadError -> Either BeamRowReadError a
forall a b. a -> Either a b
Left (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError Maybe Int
forall a. Maybe a
Nothing (String -> ColumnParseError
ColumnErrorInternal String
"Nested queries not allowed"))))

      runConsumer :: forall a. PgStream a -> PgI.Row -> IO (PgStream a)
      runConsumer :: PgStream a -> Row -> IO (PgStream a)
runConsumer s :: PgStream a
s@(PgStreamDone {}) Row
_ = PgStream a -> IO (PgStream a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PgStream a
s
      runConsumer (PgStreamContinue Maybe Row -> IO (PgStream a)
next) Row
row = Maybe Row -> IO (PgStream a)
next (Row -> Maybe Row
forall a. a -> Maybe a
Just Row
row)
  in F PgF a
-> (a -> IO (Either BeamRowReadError a))
-> (PgF (IO (Either BeamRowReadError a))
    -> IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F PgF a
action a -> IO (Either BeamRowReadError a)
forall (f :: * -> *) b a. Applicative f => b -> f (Either a b)
finish PgF (IO (Either BeamRowReadError a))
-> IO (Either BeamRowReadError a)
step

-- * Beam Monad class

data PgF next where
    PgLiftIO :: IO a -> (a -> next) -> PgF next
    PgRunReturning ::
        FromBackendRow Postgres x =>
        FetchMode -> PgCommandSyntax -> (Pg (Maybe x) -> Pg a) -> (a -> next) -> PgF next
    PgFetchNext ::
        FromBackendRow Postgres x =>
        (Maybe x -> next) -> PgF next
    PgLiftWithHandle :: ((String -> IO ()) -> Pg.Connection -> IO a) -> (a -> next) -> PgF next
instance Functor PgF where
  fmap :: (a -> b) -> PgF a -> PgF b
fmap a -> b
f = \case
    PgLiftIO IO a
io a -> a
n -> IO a -> (a -> b) -> PgF b
forall a next. IO a -> (a -> next) -> PgF next
PgLiftIO IO a
io ((a -> b) -> PgF b) -> (a -> b) -> PgF b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
n
    PgRunReturning FetchMode
mode PgCommandSyntax
cmd Pg (Maybe x) -> Pg a
consume a -> a
n -> FetchMode
-> PgCommandSyntax -> (Pg (Maybe x) -> Pg a) -> (a -> b) -> PgF b
forall x a next.
FromBackendRow Postgres x =>
FetchMode
-> PgCommandSyntax
-> (Pg (Maybe x) -> Pg a)
-> (a -> next)
-> PgF next
PgRunReturning FetchMode
mode PgCommandSyntax
cmd Pg (Maybe x) -> Pg a
consume ((a -> b) -> PgF b) -> (a -> b) -> PgF b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
n
    PgFetchNext Maybe x -> a
n -> (Maybe x -> b) -> PgF b
forall x next.
FromBackendRow Postgres x =>
(Maybe x -> next) -> PgF next
PgFetchNext ((Maybe x -> b) -> PgF b) -> (Maybe x -> b) -> PgF b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (Maybe x -> a) -> Maybe x -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe x -> a
n
    PgLiftWithHandle (String -> IO ()) -> Connection -> IO a
withConn a -> a
n -> ((String -> IO ()) -> Connection -> IO a) -> (a -> b) -> PgF b
forall a next.
((String -> IO ()) -> Connection -> IO a)
-> (a -> next) -> PgF next
PgLiftWithHandle (String -> IO ()) -> Connection -> IO a
withConn ((a -> b) -> PgF b) -> (a -> b) -> PgF b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
n

-- | How to fetch results.
data FetchMode
    = CursorBatching -- ^ Fetch in batches of ~256 rows via cursor for SELECT.
    | AtOnce         -- ^ Fetch all rows at once.

-- | 'MonadBeam' in which we can run Postgres commands. See the documentation
-- for 'MonadBeam' on examples of how to use.
--
-- @beam-postgres@ also provides functions that let you run queries without
-- 'MonadBeam'. These functions may be more efficient and offer a conduit
-- API. See "Database.Beam.Postgres.Conduit" for more information.
newtype Pg a = Pg { Pg a -> F PgF a
runPg :: F PgF a }
    deriving (Applicative Pg
a -> Pg a
Applicative Pg
-> (forall a b. Pg a -> (a -> Pg b) -> Pg b)
-> (forall a b. Pg a -> Pg b -> Pg b)
-> (forall a. a -> Pg a)
-> Monad Pg
Pg a -> (a -> Pg b) -> Pg b
Pg a -> Pg b -> Pg b
forall a. a -> Pg a
forall a b. Pg a -> Pg b -> Pg b
forall a b. Pg a -> (a -> Pg b) -> Pg b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Pg a
$creturn :: forall a. a -> Pg a
>> :: Pg a -> Pg b -> Pg b
$c>> :: forall a b. Pg a -> Pg b -> Pg b
>>= :: Pg a -> (a -> Pg b) -> Pg b
$c>>= :: forall a b. Pg a -> (a -> Pg b) -> Pg b
$cp1Monad :: Applicative Pg
Monad, Functor Pg
a -> Pg a
Functor Pg
-> (forall a. a -> Pg a)
-> (forall a b. Pg (a -> b) -> Pg a -> Pg b)
-> (forall a b c. (a -> b -> c) -> Pg a -> Pg b -> Pg c)
-> (forall a b. Pg a -> Pg b -> Pg b)
-> (forall a b. Pg a -> Pg b -> Pg a)
-> Applicative Pg
Pg a -> Pg b -> Pg b
Pg a -> Pg b -> Pg a
Pg (a -> b) -> Pg a -> Pg b
(a -> b -> c) -> Pg a -> Pg b -> Pg c
forall a. a -> Pg a
forall a b. Pg a -> Pg b -> Pg a
forall a b. Pg a -> Pg b -> Pg b
forall a b. Pg (a -> b) -> Pg a -> Pg b
forall a b c. (a -> b -> c) -> Pg a -> Pg b -> Pg c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Pg a -> Pg b -> Pg a
$c<* :: forall a b. Pg a -> Pg b -> Pg a
*> :: Pg a -> Pg b -> Pg b
$c*> :: forall a b. Pg a -> Pg b -> Pg b
liftA2 :: (a -> b -> c) -> Pg a -> Pg b -> Pg c
$cliftA2 :: forall a b c. (a -> b -> c) -> Pg a -> Pg b -> Pg c
<*> :: Pg (a -> b) -> Pg a -> Pg b
$c<*> :: forall a b. Pg (a -> b) -> Pg a -> Pg b
pure :: a -> Pg a
$cpure :: forall a. a -> Pg a
$cp1Applicative :: Functor Pg
Applicative, a -> Pg b -> Pg a
(a -> b) -> Pg a -> Pg b
(forall a b. (a -> b) -> Pg a -> Pg b)
-> (forall a b. a -> Pg b -> Pg a) -> Functor Pg
forall a b. a -> Pg b -> Pg a
forall a b. (a -> b) -> Pg a -> Pg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Pg b -> Pg a
$c<$ :: forall a b. a -> Pg b -> Pg a
fmap :: (a -> b) -> Pg a -> Pg b
$cfmap :: forall a b. (a -> b) -> Pg a -> Pg b
Functor, MonadFree PgF)

instance Fail.MonadFail Pg where
    fail :: String -> Pg a
fail String
e =  IO a -> Pg a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"Internal Error with: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
e)

instance MonadIO Pg where
    liftIO :: IO a -> Pg a
liftIO IO a
x = PgF a -> Pg a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (IO a -> (a -> a) -> PgF a
forall a next. IO a -> (a -> next) -> PgF next
PgLiftIO IO a
x a -> a
forall a. a -> a
id)

instance MonadBase IO Pg where
    liftBase :: IO α -> Pg α
liftBase = IO α -> Pg α
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadBaseControl IO Pg where
    type StM Pg a = a

    liftBaseWith :: (RunInBase Pg IO -> IO a) -> Pg a
liftBaseWith RunInBase Pg IO -> IO a
action =
      PgF a -> Pg a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (((String -> IO ()) -> Connection -> IO a) -> (a -> a) -> PgF a
forall a next.
((String -> IO ()) -> Connection -> IO a)
-> (a -> next) -> PgF next
PgLiftWithHandle (\String -> IO ()
dbg Connection
conn -> RunInBase Pg IO -> IO a
action ((String -> IO ()) -> Connection -> Pg a -> IO a
forall a. (String -> IO ()) -> Connection -> Pg a -> IO a
runBeamPostgresDebug String -> IO ()
dbg Connection
conn)) a -> a
forall a. a -> a
id)

    restoreM :: StM Pg a -> Pg a
restoreM = StM Pg a -> Pg a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

liftIOWithHandle :: (Pg.Connection -> IO a) -> Pg a
liftIOWithHandle :: (Connection -> IO a) -> Pg a
liftIOWithHandle Connection -> IO a
f = PgF a -> Pg a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (((String -> IO ()) -> Connection -> IO a) -> (a -> a) -> PgF a
forall a next.
((String -> IO ()) -> Connection -> IO a)
-> (a -> next) -> PgF next
PgLiftWithHandle (\String -> IO ()
_ -> Connection -> IO a
f) a -> a
forall a. a -> a
id)

runBeamPostgresDebug :: (String -> IO ()) -> Pg.Connection -> Pg a -> IO a
runBeamPostgresDebug :: (String -> IO ()) -> Connection -> Pg a -> IO a
runBeamPostgresDebug String -> IO ()
dbg Connection
conn Pg a
action =
    (String -> IO ())
-> Connection -> Pg a -> IO (Either BeamRowReadError a)
forall a.
(String -> IO ())
-> Connection -> Pg a -> IO (Either BeamRowReadError a)
withPgDebug String -> IO ()
dbg Connection
conn Pg a
action IO (Either BeamRowReadError a)
-> (Either BeamRowReadError a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (BeamRowReadError -> IO a)
-> (a -> IO a) -> Either BeamRowReadError a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either BeamRowReadError -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

runBeamPostgres :: Pg.Connection -> Pg a -> IO a
runBeamPostgres :: Connection -> Pg a -> IO a
runBeamPostgres = (String -> IO ()) -> Connection -> Pg a -> IO a
forall a. (String -> IO ()) -> Connection -> Pg a -> IO a
runBeamPostgresDebug (\String
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance MonadBeam Postgres Pg where
    runReturningMany :: BeamSqlBackendSyntax Postgres -> (Pg (Maybe x) -> Pg a) -> Pg a
runReturningMany BeamSqlBackendSyntax Postgres
cmd Pg (Maybe x) -> Pg a
consume =
        PgF a -> Pg a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (FetchMode
-> PgCommandSyntax -> (Pg (Maybe x) -> Pg a) -> (a -> a) -> PgF a
forall x a next.
FromBackendRow Postgres x =>
FetchMode
-> PgCommandSyntax
-> (Pg (Maybe x) -> Pg a)
-> (a -> next)
-> PgF next
PgRunReturning FetchMode
CursorBatching BeamSqlBackendSyntax Postgres
PgCommandSyntax
cmd Pg (Maybe x) -> Pg a
consume a -> a
forall a. a -> a
id)

    runReturningOne :: BeamSqlBackendSyntax Postgres -> Pg (Maybe x)
runReturningOne BeamSqlBackendSyntax Postgres
cmd =
        PgF (Maybe x) -> Pg (Maybe x)
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (FetchMode
-> PgCommandSyntax
-> (Pg (Maybe x) -> Pg (Maybe x))
-> (Maybe x -> Maybe x)
-> PgF (Maybe x)
forall x a next.
FromBackendRow Postgres x =>
FetchMode
-> PgCommandSyntax
-> (Pg (Maybe x) -> Pg a)
-> (a -> next)
-> PgF next
PgRunReturning FetchMode
AtOnce BeamSqlBackendSyntax Postgres
PgCommandSyntax
cmd Pg (Maybe x) -> Pg (Maybe x)
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m (Maybe a)
consume Maybe x -> Maybe x
forall a. a -> a
id)
      where
        consume :: m (Maybe a) -> m (Maybe a)
consume m (Maybe a)
next = do
          Maybe a
a <- m (Maybe a)
next
          case Maybe a
a of
            Maybe a
Nothing -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
            Just a
x -> do
              Maybe a
a' <- m (Maybe a)
next
              case Maybe a
a' of
                Maybe a
Nothing -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
                Just a
_ -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

    runReturningList :: BeamSqlBackendSyntax Postgres -> Pg [x]
runReturningList BeamSqlBackendSyntax Postgres
cmd =
        PgF [x] -> Pg [x]
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (FetchMode
-> PgCommandSyntax
-> (Pg (Maybe x) -> Pg [x])
-> ([x] -> [x])
-> PgF [x]
forall x a next.
FromBackendRow Postgres x =>
FetchMode
-> PgCommandSyntax
-> (Pg (Maybe x) -> Pg a)
-> (a -> next)
-> PgF next
PgRunReturning FetchMode
AtOnce BeamSqlBackendSyntax Postgres
PgCommandSyntax
cmd Pg (Maybe x) -> Pg [x]
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
consume [x] -> [x]
forall a. a -> a
id)
      where
        consume :: m (Maybe a) -> m [a]
consume m (Maybe a)
next =
          let collectM :: ([a] -> [a]) -> m [a]
collectM [a] -> [a]
acc = do
                Maybe a
a <- m (Maybe a)
next
                case Maybe a
a of
                  Maybe a
Nothing -> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> [a]
acc [])
                  Just a
x -> ([a] -> [a]) -> m [a]
collectM ([a] -> [a]
acc ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:))
          in ([a] -> [a]) -> m [a]
collectM [a] -> [a]
forall a. a -> a
id

instance MonadBeamInsertReturning Postgres Pg where
    runInsertReturningList :: SqlInsert Postgres table -> Pg [table Identity]
runInsertReturningList SqlInsert Postgres table
i = do
        let insertReturningCmd' :: PgReturningType
  SqlInsert (QExprToIdentity (table (QExpr Postgres ())))
insertReturningCmd' = SqlInsert Postgres table
i SqlInsert Postgres table
-> (table (QExpr Postgres PostgresInaccessible)
    -> table (QExpr Postgres ()))
-> PgReturningType
     SqlInsert (QExprToIdentity (table (QExpr Postgres ())))
forall (cmd :: * -> ((* -> *) -> *) -> *) (tbl :: (* -> *) -> *) a.
(PgReturning cmd, Beamable tbl, Projectible Postgres a) =>
cmd Postgres tbl
-> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType cmd (QExprToIdentity a)
`returning`
              (forall a.
 Columnar' (QExpr Postgres PostgresInaccessible) a
 -> Columnar' (QExpr Postgres ()) a)
-> table (QExpr Postgres PostgresInaccessible)
-> table (QExpr Postgres ())
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QExpr s) :: Columnar' (QExpr Postgres PostgresInaccessible) ty) ->
                Columnar (QExpr Postgres ()) a -> Columnar' (QExpr Postgres ()) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((Text -> BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres () a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr Text -> BeamSqlBackendExpressionSyntax Postgres
s) :: Columnar' (QExpr Postgres ()) ty)

        -- Make savepoint
        case PgReturningType
  SqlInsert (QExprToIdentity (table (QExpr Postgres ())))
insertReturningCmd' of
          PgReturningType
  SqlInsert (QExprToIdentity (table (QExpr Postgres ())))
PgInsertReturningEmpty ->
            [table Identity] -> Pg [table Identity]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          PgInsertReturning insertReturningCmd ->
            BeamSqlBackendSyntax Postgres -> Pg [table Identity]
forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList (PgCommandType -> PgSyntax -> PgCommandSyntax
PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
insertReturningCmd)

instance MonadBeamUpdateReturning Postgres Pg where
    runUpdateReturningList :: SqlUpdate Postgres table -> Pg [table Identity]
runUpdateReturningList SqlUpdate Postgres table
u = do
        let updateReturningCmd' :: PgReturningType
  SqlUpdate (QExprToIdentity (table (QExpr Postgres ())))
updateReturningCmd' = SqlUpdate Postgres table
u SqlUpdate Postgres table
-> (table (QExpr Postgres PostgresInaccessible)
    -> table (QExpr Postgres ()))
-> PgReturningType
     SqlUpdate (QExprToIdentity (table (QExpr Postgres ())))
forall (cmd :: * -> ((* -> *) -> *) -> *) (tbl :: (* -> *) -> *) a.
(PgReturning cmd, Beamable tbl, Projectible Postgres a) =>
cmd Postgres tbl
-> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType cmd (QExprToIdentity a)
`returning`
              (forall a.
 Columnar' (QExpr Postgres PostgresInaccessible) a
 -> Columnar' (QExpr Postgres ()) a)
-> table (QExpr Postgres PostgresInaccessible)
-> table (QExpr Postgres ())
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QExpr s) :: Columnar' (QExpr Postgres PostgresInaccessible) ty) ->
                Columnar (QExpr Postgres ()) a -> Columnar' (QExpr Postgres ()) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((Text -> BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres () a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr Text -> BeamSqlBackendExpressionSyntax Postgres
s) :: Columnar' (QExpr Postgres ()) ty)

        case PgReturningType
  SqlUpdate (QExprToIdentity (table (QExpr Postgres ())))
updateReturningCmd' of
          PgReturningType
  SqlUpdate (QExprToIdentity (table (QExpr Postgres ())))
PgUpdateReturningEmpty ->
            [table Identity] -> Pg [table Identity]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          PgUpdateReturning updateReturningCmd ->
            BeamSqlBackendSyntax Postgres -> Pg [table Identity]
forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList (PgCommandType -> PgSyntax -> PgCommandSyntax
PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
updateReturningCmd)

instance MonadBeamDeleteReturning Postgres Pg where
    runDeleteReturningList :: SqlDelete Postgres table -> Pg [table Identity]
runDeleteReturningList SqlDelete Postgres table
d = do
        let PgDeleteReturning PgSyntax
deleteReturningCmd = SqlDelete Postgres table
d SqlDelete Postgres table
-> (table (QExpr Postgres PostgresInaccessible)
    -> table (QExpr Postgres ()))
-> PgReturningType
     SqlDelete (QExprToIdentity (table (QExpr Postgres ())))
forall (cmd :: * -> ((* -> *) -> *) -> *) (tbl :: (* -> *) -> *) a.
(PgReturning cmd, Beamable tbl, Projectible Postgres a) =>
cmd Postgres tbl
-> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType cmd (QExprToIdentity a)
`returning`
              (forall a.
 Columnar' (QExpr Postgres PostgresInaccessible) a
 -> Columnar' (QExpr Postgres ()) a)
-> table (QExpr Postgres PostgresInaccessible)
-> table (QExpr Postgres ())
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QExpr s) :: Columnar' (QExpr Postgres PostgresInaccessible) ty) ->
                Columnar (QExpr Postgres ()) a -> Columnar' (QExpr Postgres ()) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((Text -> BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres () a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr Text -> BeamSqlBackendExpressionSyntax Postgres
s) :: Columnar' (QExpr Postgres ()) ty)

        BeamSqlBackendSyntax Postgres -> Pg [table Identity]
forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList (PgCommandType -> PgSyntax -> PgCommandSyntax
PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
deleteReturningCmd)