{-# LANGUAGE OverloadedStrings #-}
module Hasql.Private.CursorTransactionIO where
import Data.ByteString (ByteString)
import ByteString.TreeBuilder
import Control.Monad.Error.Class
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Resource
import Hasql.Encoders (noParams)
import Hasql.Decoders (Result, noResult)
import Hasql.Session hiding (statement)
import Hasql.Statement
import Hasql.Private.Session.UnliftIO
import Hasql.TransactionIO hiding (statement)
import qualified Hasql.TransactionIO as TransactionIO
data Cursor s a = Cursor
{ Cursor s a -> ByteString
cursorVar :: ByteString
, Cursor s a -> Result a
decoder :: Result a
}
deriving (a -> Cursor s b -> Cursor s a
(a -> b) -> Cursor s a -> Cursor s b
(forall a b. (a -> b) -> Cursor s a -> Cursor s b)
-> (forall a b. a -> Cursor s b -> Cursor s a)
-> Functor (Cursor s)
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
<$ :: a -> Cursor s b -> Cursor s a
$c<$ :: forall s a b. a -> Cursor s b -> Cursor s a
fmap :: (a -> b) -> Cursor s a -> Cursor s b
$cfmap :: forall s a b. (a -> b) -> Cursor s a -> Cursor s b
Functor)
newtype CursorTransactionIO s a = CursorTransactionIO
( StateT Int (ResourceT TransactionIO) a )
deriving (a -> CursorTransactionIO s b -> CursorTransactionIO s a
(a -> b) -> CursorTransactionIO s a -> CursorTransactionIO s b
(forall a b.
(a -> b) -> CursorTransactionIO s a -> CursorTransactionIO s b)
-> (forall a b.
a -> CursorTransactionIO s b -> CursorTransactionIO s a)
-> Functor (CursorTransactionIO s)
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
<$ :: a -> CursorTransactionIO s b -> CursorTransactionIO s a
$c<$ :: forall s a b.
a -> CursorTransactionIO s b -> CursorTransactionIO s a
fmap :: (a -> b) -> CursorTransactionIO s a -> CursorTransactionIO s b
$cfmap :: forall s a b.
(a -> b) -> CursorTransactionIO s a -> CursorTransactionIO s b
Functor, Functor (CursorTransactionIO s)
a -> CursorTransactionIO s a
Functor (CursorTransactionIO s)
-> (forall a. a -> CursorTransactionIO s a)
-> (forall 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 a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b)
-> (forall a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s a)
-> Applicative (CursorTransactionIO s)
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s a
CursorTransactionIO s (a -> b)
-> CursorTransactionIO s a -> CursorTransactionIO s b
(a -> b -> c)
-> CursorTransactionIO s a
-> CursorTransactionIO s b
-> CursorTransactionIO s c
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
<* :: CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s a
$c<* :: forall s a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s a
*> :: CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
$c*> :: forall s a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
liftA2 :: (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
<*> :: 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 :: a -> CursorTransactionIO s a
$cpure :: forall s a. a -> CursorTransactionIO s a
$cp1Applicative :: forall s. Functor (CursorTransactionIO s)
Applicative, Applicative (CursorTransactionIO s)
a -> CursorTransactionIO s a
Applicative (CursorTransactionIO s)
-> (forall a b.
CursorTransactionIO s a
-> (a -> CursorTransactionIO s b) -> CursorTransactionIO s b)
-> (forall a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b)
-> (forall a. a -> CursorTransactionIO s a)
-> Monad (CursorTransactionIO s)
CursorTransactionIO s a
-> (a -> CursorTransactionIO s b) -> CursorTransactionIO s b
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
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 :: a -> CursorTransactionIO s a
$creturn :: forall s a. a -> CursorTransactionIO s a
>> :: CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s b
$c>> :: forall s a b.
CursorTransactionIO s a
-> CursorTransactionIO s b -> CursorTransactionIO s 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
$cp1Monad :: forall s. Applicative (CursorTransactionIO s)
Monad, Monad (CursorTransactionIO s)
Monad (CursorTransactionIO s)
-> (forall a. IO a -> CursorTransactionIO s a)
-> MonadIO (CursorTransactionIO s)
IO a -> CursorTransactionIO s a
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 :: IO a -> CursorTransactionIO s a
$cliftIO :: forall s a. IO a -> CursorTransactionIO s a
$cp1MonadIO :: forall s. Monad (CursorTransactionIO s)
MonadIO, MonadIO (CursorTransactionIO s)
MonadIO (CursorTransactionIO s)
-> (forall a. ResourceT IO a -> CursorTransactionIO s a)
-> MonadResource (CursorTransactionIO s)
ResourceT IO a -> CursorTransactionIO s a
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 :: ResourceT IO a -> CursorTransactionIO s a
$cliftResourceT :: forall s a. ResourceT IO a -> CursorTransactionIO s a
$cp1MonadResource :: forall s. MonadIO (CursorTransactionIO s)
MonadResource, MonadState Int)
run :: (forall s. CursorTransactionIO s a) -> TransactionIO a
run :: (forall s. CursorTransactionIO s a) -> TransactionIO a
run (CursorTransactionIO ctxio) = ResourceT TransactionIO a -> TransactionIO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT TransactionIO a -> TransactionIO a)
-> (StateT Int (ResourceT TransactionIO) a
-> ResourceT TransactionIO a)
-> StateT Int (ResourceT TransactionIO) a
-> TransactionIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT Int (ResourceT TransactionIO) a
-> Int -> ResourceT TransactionIO a)
-> Int
-> StateT Int (ResourceT TransactionIO) a
-> ResourceT TransactionIO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Int (ResourceT TransactionIO) a
-> Int -> ResourceT TransactionIO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Int
0 (StateT Int (ResourceT TransactionIO) a -> TransactionIO a)
-> StateT Int (ResourceT TransactionIO) a -> TransactionIO a
forall a b. (a -> b) -> a -> b
$ StateT Int (ResourceT TransactionIO) a
ctxio
sql :: ByteString -> CursorTransactionIO s ()
sql :: ByteString -> CursorTransactionIO s ()
sql = StateT Int (ResourceT TransactionIO) () -> CursorTransactionIO s ()
forall s a.
StateT Int (ResourceT TransactionIO) a -> CursorTransactionIO s a
CursorTransactionIO (StateT Int (ResourceT TransactionIO) ()
-> CursorTransactionIO s ())
-> (ByteString -> StateT Int (ResourceT TransactionIO) ())
-> ByteString
-> CursorTransactionIO s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT TransactionIO ()
-> StateT Int (ResourceT TransactionIO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT TransactionIO ()
-> StateT Int (ResourceT TransactionIO) ())
-> (ByteString -> ResourceT TransactionIO ())
-> ByteString
-> StateT Int (ResourceT TransactionIO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionIO () -> ResourceT TransactionIO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransactionIO () -> ResourceT TransactionIO ())
-> (ByteString -> TransactionIO ())
-> ByteString
-> ResourceT TransactionIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> TransactionIO ()
TransactionIO.sql
statement :: params -> Statement params result -> CursorTransactionIO s result
statement :: params -> Statement params result -> CursorTransactionIO s result
statement params
params Statement params result
stmt = StateT Int (ResourceT TransactionIO) result
-> CursorTransactionIO s result
forall s a.
StateT Int (ResourceT TransactionIO) a -> CursorTransactionIO s a
CursorTransactionIO (StateT Int (ResourceT TransactionIO) result
-> CursorTransactionIO s result)
-> (TransactionIO result
-> StateT Int (ResourceT TransactionIO) result)
-> TransactionIO result
-> CursorTransactionIO s result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT TransactionIO result
-> StateT Int (ResourceT TransactionIO) result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT TransactionIO result
-> StateT Int (ResourceT TransactionIO) result)
-> (TransactionIO result -> ResourceT TransactionIO result)
-> TransactionIO result
-> StateT Int (ResourceT TransactionIO) result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionIO result -> ResourceT TransactionIO result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransactionIO result -> CursorTransactionIO s result)
-> TransactionIO result -> CursorTransactionIO s result
forall a b. (a -> b) -> a -> b
$ params -> Statement params result -> TransactionIO result
forall params result.
params -> Statement params result -> TransactionIO result
TransactionIO.statement params
params Statement params result
stmt
ignoreFailedTransactionError :: MonadError QueryError m => m () -> m ()
ignoreFailedTransactionError :: m () -> m ()
ignoreFailedTransactionError m ()
sess =
m () -> (QueryError -> m ()) -> m ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m ()
sess ((QueryError -> m ()) -> m ()) -> (QueryError -> m ()) -> m ()
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
_)) -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
QueryError
_ -> QueryError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QueryError
qe
declareCursorFor :: params -> Statement params result -> CursorTransactionIO s (Cursor s result)
declareCursorFor :: 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 <- StateT Int (ResourceT TransactionIO) (UnliftIO TransactionIO)
-> CursorTransactionIO s (UnliftIO TransactionIO)
forall s a.
StateT Int (ResourceT TransactionIO) a -> CursorTransactionIO s a
CursorTransactionIO (StateT Int (ResourceT TransactionIO) (UnliftIO TransactionIO)
-> CursorTransactionIO s (UnliftIO TransactionIO))
-> (TransactionIO (UnliftIO TransactionIO)
-> StateT Int (ResourceT TransactionIO) (UnliftIO TransactionIO))
-> TransactionIO (UnliftIO TransactionIO)
-> CursorTransactionIO s (UnliftIO TransactionIO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT TransactionIO (UnliftIO TransactionIO)
-> StateT Int (ResourceT TransactionIO) (UnliftIO TransactionIO)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT TransactionIO (UnliftIO TransactionIO)
-> StateT Int (ResourceT TransactionIO) (UnliftIO TransactionIO))
-> (TransactionIO (UnliftIO TransactionIO)
-> ResourceT TransactionIO (UnliftIO TransactionIO))
-> TransactionIO (UnliftIO TransactionIO)
-> StateT Int (ResourceT TransactionIO) (UnliftIO TransactionIO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionIO (UnliftIO TransactionIO)
-> ResourceT TransactionIO (UnliftIO TransactionIO)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransactionIO (UnliftIO TransactionIO)
-> CursorTransactionIO s (UnliftIO TransactionIO))
-> TransactionIO (UnliftIO TransactionIO)
-> CursorTransactionIO s (UnliftIO TransactionIO)
forall a b. (a -> b) -> a -> b
$ TransactionIO (UnliftIO TransactionIO)
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
Int
cursorIx <- CursorTransactionIO s Int
forall s (m :: * -> *). MonadState s m => m s
get
let cursorVar :: ByteString
cursorVar = Builder -> ByteString
toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
"Hasql_CursorTransactionIO_" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
asciiIntegral Int
cursorIx
(Int -> Int) -> CursorTransactionIO s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
(ReleaseKey
_, Cursor s result
cursor) <- IO (Cursor s result)
-> (Cursor s result -> IO ())
-> CursorTransactionIO s (ReleaseKey, Cursor s result)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate
(TransactionIO (Cursor s result) -> IO (Cursor s result)
forall a. TransactionIO a -> IO a
runInIO (TransactionIO (Cursor s result) -> IO (Cursor s result))
-> TransactionIO (Cursor s result) -> IO (Cursor s result)
forall a b. (a -> b) -> a -> b
$ ByteString
-> params
-> Statement params result
-> TransactionIO (Cursor s result)
forall params result s.
ByteString
-> params
-> Statement params result
-> TransactionIO (Cursor s result)
newCursor ByteString
cursorVar params
params Statement params result
stmt)
(TransactionIO () -> IO ()
forall a. TransactionIO a -> IO a
runInIO (TransactionIO () -> IO ())
-> (Cursor s result -> TransactionIO ())
-> Cursor s result
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransactionIO () -> TransactionIO ()
forall (m :: * -> *). MonadError QueryError m => m () -> m ()
ignoreFailedTransactionError (TransactionIO () -> TransactionIO ())
-> (Cursor s result -> TransactionIO ())
-> Cursor s result
-> TransactionIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor s result -> TransactionIO ()
forall s a. Cursor s a -> TransactionIO ()
closeCursor)
Cursor s result -> CursorTransactionIO s (Cursor s result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cursor s result
cursor
newCursor :: ByteString -> params -> Statement params result -> TransactionIO (Cursor s result)
newCursor :: 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 " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cursorVar ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" NO SCROLL CURSOR FOR " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
query
params -> Statement params () -> TransactionIO ()
forall params result.
params -> Statement params result -> TransactionIO result
TransactionIO.statement params
params (ByteString
-> Params params -> Result () -> Bool -> Statement params ()
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement ByteString
cursorQuery Params params
encoder Result ()
noResult Bool
prepare)
Cursor s result -> TransactionIO (Cursor s result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cursor s result -> TransactionIO (Cursor s result))
-> Cursor s result -> TransactionIO (Cursor s result)
forall a b. (a -> b) -> a -> b
$ ByteString -> Result result -> Cursor s result
forall s a. ByteString -> Result a -> Cursor s a
Cursor ByteString
cursorVar Result result
decoder
closeCursor :: Cursor s a -> TransactionIO ()
closeCursor :: Cursor s a -> TransactionIO ()
closeCursor (Cursor ByteString
cursorVar Result a
_) = do
let closeQuery :: ByteString
closeQuery = ByteString
"CLOSE " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cursorVar
() -> Statement () () -> TransactionIO ()
forall params result.
params -> Statement params result -> TransactionIO result
TransactionIO.statement () (ByteString -> Params () -> Result () -> Bool -> Statement () ()
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement ByteString
closeQuery Params ()
noParams Result ()
noResult Bool
True)
fetchWithCursor :: Cursor s a -> CursorTransactionIO s a
fetchWithCursor :: Cursor s a -> CursorTransactionIO s a
fetchWithCursor (Cursor ByteString
cursorVar Result a
decoder) = do
let fetchQuery :: ByteString
fetchQuery = ByteString
"FETCH " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cursorVar
() -> Statement () a -> CursorTransactionIO s a
forall params result s.
params -> Statement params result -> CursorTransactionIO s result
statement () (ByteString -> Params () -> Result a -> Bool -> Statement () a
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Statement ByteString
fetchQuery Params ()
noParams Result a
decoder Bool
True)