module Hasql.CursorQuery.Private.CursorTransactions where

import qualified Control.Foldl as D
import qualified Hasql.CursorQuery.Private.CursorQuery as B
import qualified Hasql.CursorQuery.Private.Decoders as I
import Hasql.CursorQuery.Private.Prelude
import qualified Hasql.CursorTransaction as G
import qualified Hasql.Decoders as E

-- |
-- Fetch and fold the data from cursor until it dries out.
fetchAndFoldCursor :: G.Cursor s -> G.BatchSize -> E.Row row -> D.Fold row result -> G.CursorTransaction s result
fetchAndFoldCursor :: forall s row result.
Cursor s
-> BatchSize
-> Row row
-> Fold row result
-> CursorTransaction s result
fetchAndFoldCursor Cursor s
cursor BatchSize
batchSize Row row
rowDecoder (D.Fold x -> row -> x
progress x
enter x -> result
exit) =
  (x -> result)
-> CursorTransaction s x -> CursorTransaction s result
forall a b.
(a -> b) -> CursorTransaction s a -> CursorTransaction s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> result
exit
    (CursorTransaction s x -> CursorTransaction s result)
-> CursorTransaction s x -> CursorTransaction s result
forall a b. (a -> b) -> a -> b
$ x -> CursorTransaction s x
fetchAndFoldMore x
enter
  where
    fetchAndFoldMore :: x -> CursorTransaction s x
fetchAndFoldMore x
batch =
      do
        (Bool
null, x
fetchedBatch) <- CursorTransaction s (Bool, x)
fetchBatch
        if Bool
null
          then x -> CursorTransaction s x
forall a. a -> CursorTransaction s a
forall (m :: * -> *) a. Monad m => a -> m a
return x
batch
          else x -> CursorTransaction s x
fetchAndFoldMore x
fetchedBatch
      where
        fetchBatch :: CursorTransaction s (Bool, x)
fetchBatch =
          Cursor s
-> BatchSize
-> Row row
-> Fold row (Bool, x)
-> CursorTransaction s (Bool, x)
forall s row result.
Cursor s
-> BatchSize
-> Row row
-> Fold row result
-> CursorTransaction s result
fetchAndFoldCursorBatch Cursor s
cursor BatchSize
batchSize Row row
rowDecoder Fold row (Bool, x)
fold
          where
            fold :: Fold row (Bool, x)
fold =
              (,) (Bool -> x -> (Bool, x))
-> Fold row Bool -> Fold row (x -> (Bool, x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold row Bool
forall a. Fold a Bool
D.null Fold row (x -> (Bool, x)) -> Fold row x -> Fold row (Bool, x)
forall a b. Fold row (a -> b) -> Fold row a -> Fold row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (x -> row -> x) -> x -> (x -> x) -> Fold row x
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
D.Fold x -> row -> x
progress x
batch x -> x
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

fetchAndFoldCursorBatch :: G.Cursor s -> G.BatchSize -> E.Row row -> D.Fold row result -> G.CursorTransaction s result
fetchAndFoldCursorBatch :: forall s row result.
Cursor s
-> BatchSize
-> Row row
-> Fold row result
-> CursorTransaction s result
fetchAndFoldCursorBatch Cursor s
cursor BatchSize
batchSize Row row
rowDecoder Fold row result
rowsFold =
  Cursor s
-> BatchSize -> Result result -> CursorTransaction s result
forall s result.
Cursor s
-> BatchSize -> Result result -> CursorTransaction s result
G.fetchBatch Cursor s
cursor BatchSize
batchSize (Fold row result -> Row row -> Result result
forall a b. Fold a b -> Row a -> Result b
I.fold Fold row result
rowsFold Row row
rowDecoder)

-- |
-- Executes CursorQuery in CursorTransaction provided the parameters.
cursorQuery :: params -> B.CursorQuery params result -> G.CursorTransaction s result
cursorQuery :: forall params result s.
params -> CursorQuery params result -> CursorTransaction s result
cursorQuery params
params (B.CursorQuery ByteString
template Params params
encoder (B.ReducingDecoder Row row
rowDecoder Fold row result
rowsFold) BatchSize
batchSize) =
  do
    Cursor s
cursor <- ByteString -> EncodedParams -> CursorTransaction s (Cursor s)
forall s.
ByteString -> EncodedParams -> CursorTransaction s (Cursor s)
G.declareCursor ByteString
template (Params params -> params -> EncodedParams
forall params. Params params -> params -> EncodedParams
G.encodedParams Params params
encoder params
params)
    Cursor s
-> BatchSize
-> Row row
-> Fold row result
-> CursorTransaction s result
forall s row result.
Cursor s
-> BatchSize
-> Row row
-> Fold row result
-> CursorTransaction s result
fetchAndFoldCursor Cursor s
cursor BatchSize
batchSize Row row
rowDecoder Fold row result
rowsFold