{-# LANGUAGE OverloadedStrings #-}

module Hasql.Private.CursorTransactionIO where

-- bytestring
import Data.ByteString (ByteString)

-- bytestring-tree-builder
import ByteString.TreeBuilder

-- transformers
import Control.Monad.Error.Class

-- mtl
import Control.Monad.Reader
import Control.Monad.State

-- unliftio-core
import Control.Monad.IO.Unlift

-- resourcet
import Control.Monad.Trans.Resource

-- hasql
import Hasql.Encoders (noParams)
import Hasql.Decoders (Result, noResult)
import Hasql.Session hiding (statement)
import Hasql.Statement

-- hasql-streaming
import Hasql.Private.Session.UnliftIO
import Hasql.TransactionIO hiding (statement)
import qualified Hasql.TransactionIO as TransactionIO

-- | A PostgresSQL cursor that produces results of type @a@ when fetched
data Cursor s a = Cursor 
  { forall s a. Cursor s a -> ByteString
cursorVar :: ByteString
  , forall s a. Cursor s a -> Result a
decoder :: Result a
  }
  deriving (forall a b. a -> Cursor s b -> Cursor s a
forall a b. (a -> b) -> Cursor s a -> Cursor s b
forall s a b. a -> Cursor s b -> Cursor s a
forall s a b. (a -> b) -> Cursor s a -> Cursor s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Cursor s b -> Cursor s a
$c<$ :: forall s a b. a -> Cursor s b -> Cursor s a
fmap :: forall a b. (a -> b) -> Cursor s a -> Cursor s b
$cfmap :: forall s a b. (a -> b) -> Cursor s a -> Cursor s b
Functor)

-- | A `TransactionIO` that also manages creation and deletion of `Cursor`s
newtype CursorTransactionIO s a = CursorTransactionIO
  ( StateT Int (ResourceT TransactionIO) a )
  deriving (forall a b. a -> CursorTransactionIO s b -> CursorTransactionIO s a
forall a b.
(a -> b) -> CursorTransactionIO s a -> CursorTransactionIO s b
forall s a b.
a -> CursorTransactionIO s b -> CursorTransactionIO s a
forall s a b.
(a -> b) -> CursorTransactionIO s a -> CursorTransactionIO s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CursorTransactionIO s b -> CursorTransactionIO s a
$c<$ :: forall s a b.
a -> CursorTransactionIO s b -> CursorTransactionIO s a
fmap :: forall a b.
(a -> b) -> CursorTransactionIO s a -> CursorTransactionIO s b
$cfmap :: forall s a b.
(a -> b) -> CursorTransactionIO s a -> CursorTransactionIO s b
Functor, forall s. Functor (CursorTransactionIO s)
forall a. a -> CursorTransactionIO s a
forall s a. a -> CursorTransactionIO s a
forall a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s a
forall a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
forall a b.
CursorTransactionIO s (a -> b)
-> CursorTransactionIO s a -> CursorTransactionIO s b
forall s a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s a
forall s a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
forall s a b.
CursorTransactionIO s (a -> b)
-> CursorTransactionIO s a -> CursorTransactionIO s b
forall a b c.
(a -> b -> c)
-> CursorTransactionIO s a
-> CursorTransactionIO s b
-> CursorTransactionIO s c
forall s a b c.
(a -> b -> c)
-> CursorTransactionIO s a
-> CursorTransactionIO s b
-> CursorTransactionIO s 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
<* :: forall a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s a
$c<* :: forall s a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s a
*> :: forall a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
$c*> :: forall s a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
liftA2 :: forall a b c.
(a -> b -> c)
-> CursorTransactionIO s a
-> CursorTransactionIO s b
-> CursorTransactionIO s c
$cliftA2 :: forall s a b c.
(a -> b -> c)
-> CursorTransactionIO s a
-> CursorTransactionIO s b
-> CursorTransactionIO s c
<*> :: forall a b.
CursorTransactionIO s (a -> b)
-> CursorTransactionIO s a -> CursorTransactionIO s b
$c<*> :: forall s a b.
CursorTransactionIO s (a -> b)
-> CursorTransactionIO s a -> CursorTransactionIO s b
pure :: forall a. a -> CursorTransactionIO s a
$cpure :: forall s a. a -> CursorTransactionIO s a
Applicative, forall s. Applicative (CursorTransactionIO s)
forall a. a -> CursorTransactionIO s a
forall s a. a -> CursorTransactionIO s a
forall a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
forall a b.
CursorTransactionIO s a
-> (a -> CursorTransactionIO s b) -> CursorTransactionIO s b
forall s a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
forall s a b.
CursorTransactionIO s a
-> (a -> CursorTransactionIO s b) -> CursorTransactionIO s 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 :: forall a. a -> CursorTransactionIO s a
$creturn :: forall s a. a -> CursorTransactionIO s a
>> :: forall a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
$c>> :: forall s a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
>>= :: forall a b.
CursorTransactionIO s a
-> (a -> CursorTransactionIO s b) -> CursorTransactionIO s b
$c>>= :: forall s a b.
CursorTransactionIO s a
-> (a -> CursorTransactionIO s b) -> CursorTransactionIO s b
Monad, forall s. Monad (CursorTransactionIO s)
forall a. IO a -> CursorTransactionIO s a
forall s a. IO a -> CursorTransactionIO s a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> CursorTransactionIO s a
$cliftIO :: forall s a. IO a -> CursorTransactionIO s a
MonadIO, forall s. MonadIO (CursorTransactionIO s)
forall a. ResourceT IO a -> CursorTransactionIO s a
forall s a. ResourceT IO a -> CursorTransactionIO s a
forall (m :: * -> *).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
liftResourceT :: forall a. ResourceT IO a -> CursorTransactionIO s a
$cliftResourceT :: forall s a. ResourceT IO a -> CursorTransactionIO s a
MonadResource, MonadState Int)

run :: (forall s. CursorTransactionIO s a) -> TransactionIO a
run :: forall a. (forall s. CursorTransactionIO s a) -> TransactionIO a
run (CursorTransactionIO StateT Int (ResourceT TransactionIO) a
ctxio) = forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Int
0 forall a b. (a -> b) -> a -> b
$ StateT Int (ResourceT TransactionIO) a
ctxio

-- | Like `Session.sql` but in a `CursorTransactionIO`. It should not attempt any statements that cannot be safely run inside a transaction.
sql :: ByteString -> CursorTransactionIO s ()
sql :: forall s. ByteString -> CursorTransactionIO s ()
sql = forall s a.
StateT Int (ResourceT TransactionIO) a -> CursorTransactionIO s a
CursorTransactionIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> TransactionIO ()
TransactionIO.sql

-- | Like `Session.statement` but in a `CursorTransactionIO`. It should not any statements that cannot be safely run inside a transaction.
statement :: params -> Statement params result -> CursorTransactionIO s result
statement :: forall params result s.
params -> Statement params result -> CursorTransactionIO s result
statement params
params Statement params result
stmt = forall s a.
StateT Int (ResourceT TransactionIO) a -> CursorTransactionIO s a
CursorTransactionIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall params result.
params -> Statement params result -> TransactionIO result
TransactionIO.statement params
params Statement params result
stmt

ignoreFailedTransactionError :: MonadError QueryError m => m () -> m ()
ignoreFailedTransactionError :: forall (m :: * -> *). MonadError QueryError m => m () -> m ()
ignoreFailedTransactionError m ()
sess =
  forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m ()
sess forall a b. (a -> b) -> a -> b
$ \QueryError
qe -> case QueryError
qe of
    QueryError ByteString
_ [Text]
_ (ResultError (ServerError ByteString
"25P02" ByteString
_ Maybe ByteString
_ Maybe ByteString
_ Maybe Int
_)) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    QueryError
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QueryError
qe

-- | Run a `Statement` using a cursor
declareCursorFor :: params -> Statement params result -> CursorTransactionIO s (Cursor s result)
declareCursorFor :: forall params result s.
params
-> Statement params result
-> CursorTransactionIO s (Cursor s result)
declareCursorFor params
params Statement params result
stmt = do
  UnliftIO forall a. TransactionIO a -> IO a
runInIO <- forall s a.
StateT Int (ResourceT TransactionIO) a -> CursorTransactionIO s a
CursorTransactionIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
  Int
cursorIx <- forall s (m :: * -> *). MonadState s m => m s
get
  let cursorVar :: ByteString
cursorVar = Builder -> ByteString
toByteString forall a b. (a -> b) -> a -> b
$ Builder
"Hasql_CursorTransactionIO_" forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
asciiIntegral Int
cursorIx
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (forall a. Num a => a -> a -> a
+Int
1)
  (ReleaseKey
_, Cursor s result
cursor) <- forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate
    (forall a. TransactionIO a -> IO a
runInIO forall a b. (a -> b) -> a -> b
$ forall params result s.
ByteString
-> params
-> Statement params result
-> TransactionIO (Cursor s result)
newCursor ByteString
cursorVar params
params Statement params result
stmt)
    (forall a. TransactionIO a -> IO a
runInIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadError QueryError m => m () -> m ()
ignoreFailedTransactionError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. Cursor s a -> TransactionIO ()
closeCursor)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Cursor s result
cursor

newCursor :: ByteString -> params -> Statement params result -> TransactionIO (Cursor s result)
newCursor :: forall params result s.
ByteString
-> params
-> Statement params result
-> TransactionIO (Cursor s result)
newCursor ByteString
cursorVar params
params (Statement ByteString
query Params params
encoder Result result
decoder Bool
prepare) = do
  let cursorQuery :: ByteString
cursorQuery = 
        ByteString
"DECLARE " forall a. Semigroup a => a -> a -> a
<> ByteString
cursorVar forall a. Semigroup a => a -> a -> a
<> ByteString
" NO SCROLL CURSOR FOR " forall a. Semigroup a => a -> a -> a
<> ByteString
query
  forall params result.
params -> Statement params result -> TransactionIO result
TransactionIO.statement params
params (forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement ByteString
cursorQuery Params params
encoder Result ()
noResult Bool
prepare)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s a. ByteString -> Result a -> Cursor s a
Cursor ByteString
cursorVar Result result
decoder

closeCursor :: Cursor s a -> TransactionIO ()
closeCursor :: forall s a. Cursor s a -> TransactionIO ()
closeCursor (Cursor ByteString
cursorVar Result a
_) = do
  let closeQuery :: ByteString
closeQuery = ByteString
"CLOSE " forall a. Semigroup a => a -> a -> a
<> ByteString
cursorVar
  forall params result.
params -> Statement params result -> TransactionIO result
TransactionIO.statement () (forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement ByteString
closeQuery Params ()
noParams Result ()
noResult Bool
True)

-- | Fetch results from a cursor
fetchWithCursor :: Cursor s a -> CursorTransactionIO s a
fetchWithCursor :: forall s a. Cursor s a -> CursorTransactionIO s a
fetchWithCursor (Cursor ByteString
cursorVar Result a
decoder) = do
  let fetchQuery :: ByteString
fetchQuery = ByteString
"FETCH " forall a. Semigroup a => a -> a -> a
<> ByteString
cursorVar
  forall params result s.
params -> Statement params result -> CursorTransactionIO s result
statement () (forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement ByteString
fetchQuery Params ()
noParams Result a
decoder Bool
True)