module Hasql.CursorQuery.Private.CursorQuery where

import qualified Control.Foldl as D
import Hasql.CursorQuery.Private.Prelude
import qualified Hasql.CursorTransaction as H
import qualified Hasql.Decoders as B
import qualified Hasql.Encoders as A

-- |
-- A specification of a streaming query.
--
-- Provides an abstraction over Postgres Cursor,
-- which allows to process result sets of any size in constant memory.
--
-- Essentially it is a parametric query specification extended with a reduction strategy and a batch size,
-- where reduction strategy determines how to fold the rows into the final result,
-- and batch size determines how many rows to fetch during each roundtrip to the database.
data CursorQuery params result
  = CursorQuery !ByteString !(A.Params params) !(ReducingDecoder result) !H.BatchSize

instance Profunctor CursorQuery where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> CursorQuery b c -> CursorQuery a d
dimap a -> b
fn1 c -> d
fn2 (CursorQuery ByteString
template Params b
encoder ReducingDecoder c
decoder BatchSize
batchSize) =
    ByteString
-> Params a -> ReducingDecoder d -> BatchSize -> CursorQuery a d
forall params result.
ByteString
-> Params params
-> ReducingDecoder result
-> BatchSize
-> CursorQuery params result
CursorQuery ByteString
template ((a -> b) -> Params b -> Params a
forall a' a. (a' -> a) -> Params a -> Params a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a -> b
fn1 Params b
encoder) ((c -> d) -> ReducingDecoder c -> ReducingDecoder d
forall a b. (a -> b) -> ReducingDecoder a -> ReducingDecoder b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
fn2 ReducingDecoder c
decoder) BatchSize
batchSize

instance Functor (CursorQuery params) where
  fmap :: forall a b.
(a -> b) -> CursorQuery params a -> CursorQuery params b
fmap =
    (a -> b) -> CursorQuery params a -> CursorQuery params b
forall b c a. (b -> c) -> CursorQuery a b -> CursorQuery a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap

-- |
-- Given an SQL template, a params encoder, a reducing result decoder and a batch-size,
-- constructs CursorQuery.
cursorQuery :: ByteString -> A.Params params -> ReducingDecoder result -> H.BatchSize -> CursorQuery params result
cursorQuery :: forall params result.
ByteString
-> Params params
-> ReducingDecoder result
-> BatchSize
-> CursorQuery params result
cursorQuery =
  ByteString
-> Params params
-> ReducingDecoder result
-> BatchSize
-> CursorQuery params result
forall params result.
ByteString
-> Params params
-> ReducingDecoder result
-> BatchSize
-> CursorQuery params result
CursorQuery

-- |
-- A specification of how to decode and reduce multiple rows.
--
-- Composable with the Applicative interface.
data ReducingDecoder reduction
  = forall row. ReducingDecoder !(B.Row row) !(D.Fold row reduction)

instance Functor ReducingDecoder where
  fmap :: forall a b. (a -> b) -> ReducingDecoder a -> ReducingDecoder b
fmap a -> b
fn (ReducingDecoder Row row
rowDecoder Fold row a
rowsFold) =
    Row row -> Fold row b -> ReducingDecoder b
forall reduction row.
Row row -> Fold row reduction -> ReducingDecoder reduction
ReducingDecoder Row row
rowDecoder ((a -> b) -> Fold row a -> Fold row b
forall a b. (a -> b) -> Fold row a -> Fold row b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn Fold row a
rowsFold)

instance Applicative ReducingDecoder where
  pure :: forall a. a -> ReducingDecoder a
pure a
reduction =
    Row () -> Fold () a -> ReducingDecoder a
forall reduction row.
Row row -> Fold row reduction -> ReducingDecoder reduction
ReducingDecoder (() -> Row ()
forall a. a -> Row a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (a -> Fold () a
forall a. a -> Fold () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
reduction)
  <*> :: forall a b.
ReducingDecoder (a -> b) -> ReducingDecoder a -> ReducingDecoder b
(<*>) (ReducingDecoder Row row
rowDecoder1 Fold row (a -> b)
rowsFold1) (ReducingDecoder Row row
rowDecoder2 Fold row a
rowsFold2) =
    Row (row, row) -> Fold (row, row) b -> ReducingDecoder b
forall reduction row.
Row row -> Fold row reduction -> ReducingDecoder reduction
ReducingDecoder Row (row, row)
rowDecoder3 Fold (row, row) b
rowsFold3
    where
      rowDecoder3 :: Row (row, row)
rowDecoder3 =
        row -> row -> (row, row)
forall {a} {b}. a -> b -> (a, b)
strictPair (row -> row -> (row, row)) -> Row row -> Row (row -> (row, row))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row row
rowDecoder1 Row (row -> (row, row)) -> Row row -> Row (row, row)
forall a b. Row (a -> b) -> Row a -> Row b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Row row
rowDecoder2
        where
          strictPair :: a -> b -> (a, b)
strictPair !a
a !b
b =
            (a
a, b
b)
      rowsFold3 :: Fold (row, row) b
rowsFold3 =
        ((row, row) -> row)
-> Fold row (a -> b) -> Fold (row, row) (a -> b)
forall a b c. (a -> b) -> Fold b c -> Fold a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (row, row) -> row
forall a b. (a, b) -> a
fst Fold row (a -> b)
rowsFold1 Fold (row, row) (a -> b) -> Fold (row, row) a -> Fold (row, row) b
forall a b.
Fold (row, row) (a -> b) -> Fold (row, row) a -> Fold (row, row) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((row, row) -> row) -> Fold row a -> Fold (row, row) a
forall a b c. (a -> b) -> Fold b c -> Fold a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (row, row) -> row
forall a b. (a, b) -> b
snd Fold row a
rowsFold2

-- |
-- Packs a row decoder and a fold over rows into ReducingDecoder.
reducingDecoder :: B.Row row -> D.Fold row reduction -> ReducingDecoder reduction
reducingDecoder :: forall row reduction.
Row row -> Fold row reduction -> ReducingDecoder reduction
reducingDecoder =
  Row row -> Fold row reduction -> ReducingDecoder reduction
forall reduction row.
Row row -> Fold row reduction -> ReducingDecoder reduction
ReducingDecoder