{-# LANGUAGE GADTs #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

Functions and types for working with PostgreSQL cursors. You can use cursors to
execute a query and consume rows from the result set incrementally. Rows that
you do not consume will never be sent from the database to the client.

@since 1.0.0.0
-}
module Orville.PostgreSQL.Execution.Cursor
  ( Cursor
  , withCursor
  , declareCursor
  , closeCursor
  , fetch
  , move
  , Expr.CursorDirection
  , Expr.next
  , Expr.prior
  , Expr.first
  , Expr.last
  , Expr.absolute
  , Expr.relative
  , Expr.count
  , Expr.fetchAll
  , Expr.forward
  , Expr.forwardCount
  , Expr.forwardAll
  , Expr.backward
  , Expr.backwardCount
  , Expr.backwardAll
  )
where

import Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Data.Time as Time
import qualified Data.Time.Clock.POSIX as POSIXTime
import qualified Data.Word as Word
import qualified System.Random as Random
import qualified Text.Printf as Printf

import qualified Orville.PostgreSQL.Execution.Execute as Execute
import qualified Orville.PostgreSQL.Execution.QueryType as QueryType
import Orville.PostgreSQL.Execution.Select (Select, useSelect)
import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.Internal.Bracket as Bracket
import Orville.PostgreSQL.Marshall (AnnotatedSqlMarshaller)
import qualified Orville.PostgreSQL.Monad as Monad

{- |
  A 'Cursor' allows you to fetch rows incrementally from PostgreSQL. Using
  a cursor will allow you to execute a query that returns a very large
  result set without the entire result set being loaded in memory in your
  application and instead pulling rows as you're able to process them.

  See 'withCursor', 'fetch' and 'move' for details on creating and using
  'Cursor' values.

@since 1.0.0.0
-}
data Cursor readEntity where
  Cursor ::
    AnnotatedSqlMarshaller writeEntity readEntity ->
    Expr.CursorName ->
    Cursor readEntity

{- |
  Declares a @CURSOR@ in PostgreSQL that is available for the duration of the
  action passed to 'withCursor' and closes the cursor when that action
  completes (or raises an exception).

  See @https://www.postgresql.org/docs/current/sql-declare.html@ for details
  about the 'Expr.ScrollExpr' and 'Expr.HoldExpr' parameters and how cursors
  behave in general.

  We recommend you use this instead of 'declareCursor' and 'closeCursor'
  unless you need to control the cursor resource acquisition and release
  yourself and can do so safely.

@since 1.0.0.0
-}
withCursor ::
  Monad.MonadOrville m =>
  Maybe Expr.ScrollExpr ->
  Maybe Expr.HoldExpr ->
  Select readEntity ->
  (Cursor readEntity -> m a) ->
  m a
withCursor :: forall (m :: * -> *) readEntity a.
MonadOrville m =>
Maybe ScrollExpr
-> Maybe HoldExpr
-> Select readEntity
-> (Cursor readEntity -> m a)
-> m a
withCursor Maybe ScrollExpr
scrollExpr Maybe HoldExpr
holdExpr Select readEntity
select Cursor readEntity -> m a
useCursor =
  m (Cursor readEntity)
-> (Cursor readEntity -> BracketResult -> m ())
-> (Cursor readEntity -> m a)
-> m a
forall (m :: * -> *) a c b.
(MonadIO m, MonadOrvilleControl m) =>
m a -> (a -> BracketResult -> m c) -> (a -> m b) -> m b
Bracket.bracketWithResult
    (Maybe ScrollExpr
-> Maybe HoldExpr -> Select readEntity -> m (Cursor readEntity)
forall (m :: * -> *) readEntity.
MonadOrville m =>
Maybe ScrollExpr
-> Maybe HoldExpr -> Select readEntity -> m (Cursor readEntity)
declareCursor Maybe ScrollExpr
scrollExpr Maybe HoldExpr
holdExpr Select readEntity
select)
    (\Cursor readEntity
cursor BracketResult
_bracketResult -> Cursor readEntity -> m ()
forall (m :: * -> *) readEntity.
MonadOrville m =>
Cursor readEntity -> m ()
closeCursor Cursor readEntity
cursor)
    Cursor readEntity -> m a
useCursor

{- |
  Declares a @CURSOR@ in PostgreSQL and returns it for you to use. The cursor
  must be closed via 'closeCursor' (or another means) when you are done using
  it. Generally you should use 'withCursor' instead of 'declareCursor' to
  ensure that the cursor gets closed properly.

  See @https://www.postgresql.org/docs/current/sql-declare.html@ for details
  about the 'Expr.ScrollExpr' and 'Expr.HoldExpr' parameters and how cursors
  behave in general.

@since 1.0.0.0
-}
declareCursor ::
  Monad.MonadOrville m =>
  Maybe Expr.ScrollExpr ->
  Maybe Expr.HoldExpr ->
  Select readEntity ->
  m (Cursor readEntity)
declareCursor :: forall (m :: * -> *) readEntity.
MonadOrville m =>
Maybe ScrollExpr
-> Maybe HoldExpr -> Select readEntity -> m (Cursor readEntity)
declareCursor Maybe ScrollExpr
scrollExpr Maybe HoldExpr
holdExpr =
  (forall writeEntity.
 QueryExpr
 -> AnnotatedSqlMarshaller writeEntity readEntity
 -> m (Cursor readEntity))
-> Select readEntity -> m (Cursor readEntity)
forall readEntity a.
(forall writeEntity.
 QueryExpr -> AnnotatedSqlMarshaller writeEntity readEntity -> a)
-> Select readEntity -> a
useSelect ((forall writeEntity.
  QueryExpr
  -> AnnotatedSqlMarshaller writeEntity readEntity
  -> m (Cursor readEntity))
 -> Select readEntity -> m (Cursor readEntity))
-> (forall writeEntity.
    QueryExpr
    -> AnnotatedSqlMarshaller writeEntity readEntity
    -> m (Cursor readEntity))
-> Select readEntity
-> m (Cursor readEntity)
forall a b. (a -> b) -> a -> b
$ \QueryExpr
queryExpr AnnotatedSqlMarshaller writeEntity readEntity
marshaller -> do
    CursorName
cursorName <- m CursorName
forall (m :: * -> *). MonadIO m => m CursorName
newCursorName

    let
      declareExpr :: DeclareExpr
declareExpr =
        CursorName
-> Maybe ScrollExpr -> Maybe HoldExpr -> QueryExpr -> DeclareExpr
Expr.declare CursorName
cursorName Maybe ScrollExpr
scrollExpr Maybe HoldExpr
holdExpr QueryExpr
queryExpr

    ()
_ <- QueryType -> DeclareExpr -> m ()
forall (m :: * -> *) sql.
(MonadOrville m, SqlExpression sql) =>
QueryType -> sql -> m ()
Execute.executeVoid QueryType
QueryType.CursorQuery DeclareExpr
declareExpr
    Cursor readEntity -> m (Cursor readEntity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AnnotatedSqlMarshaller writeEntity readEntity
-> CursorName -> Cursor readEntity
forall writeEntity readEntity.
AnnotatedSqlMarshaller writeEntity readEntity
-> CursorName -> Cursor readEntity
Cursor AnnotatedSqlMarshaller writeEntity readEntity
marshaller CursorName
cursorName)

{- |
  Closes a @CURSOR@ in PostgreSQL that was previously declared.
  This should be used to close any cursors you open via 'declareCursor',
  though we recommend you use 'withCursor' instead to ensure that any
  opened cursors are closed in the event of an exception.

@since 1.0.0.0
-}
closeCursor ::
  Monad.MonadOrville m =>
  Cursor readEntity ->
  m ()
closeCursor :: forall (m :: * -> *) readEntity.
MonadOrville m =>
Cursor readEntity -> m ()
closeCursor (Cursor AnnotatedSqlMarshaller writeEntity readEntity
_ CursorName
cursorName) =
  QueryType -> CloseExpr -> m ()
forall (m :: * -> *) sql.
(MonadOrville m, SqlExpression sql) =>
QueryType -> sql -> m ()
Execute.executeVoid QueryType
QueryType.CursorQuery
    (CloseExpr -> m ())
-> (CursorName -> CloseExpr) -> CursorName -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either AllCursors CursorName -> CloseExpr
Expr.close
    (Either AllCursors CursorName -> CloseExpr)
-> (CursorName -> Either AllCursors CursorName)
-> CursorName
-> CloseExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CursorName -> Either AllCursors CursorName
forall a b. b -> Either a b
Right
    (CursorName -> m ()) -> CursorName -> m ()
forall a b. (a -> b) -> a -> b
$ CursorName
cursorName

{- |
  Fetch rows from a cursor according to the 'Expr.CursorDirection' given. See
  @https://www.postgresql.org/docs/current/sql-fetch.html@ for details about
  the effects of fetch and the meanings of cursor directions to PostgreSQL.

@since 1.0.0.0
-}
fetch ::
  Monad.MonadOrville m =>
  Maybe Expr.CursorDirection ->
  Cursor readEntity ->
  m [readEntity]
fetch :: forall (m :: * -> *) readEntity.
MonadOrville m =>
Maybe CursorDirection -> Cursor readEntity -> m [readEntity]
fetch Maybe CursorDirection
direction (Cursor AnnotatedSqlMarshaller writeEntity readEntity
marshaller CursorName
cursorName) =
  QueryType
-> FetchExpr
-> AnnotatedSqlMarshaller writeEntity readEntity
-> m [readEntity]
forall (m :: * -> *) sql writeEntity readEntity.
(MonadOrville m, SqlExpression sql) =>
QueryType
-> sql
-> AnnotatedSqlMarshaller writeEntity readEntity
-> m [readEntity]
Execute.executeAndDecode
    QueryType
QueryType.CursorQuery
    (Maybe CursorDirection -> CursorName -> FetchExpr
Expr.fetch Maybe CursorDirection
direction CursorName
cursorName)
    AnnotatedSqlMarshaller writeEntity readEntity
marshaller

{- |
  Moves a cursor according to the 'Expr.CursorDirection' given. See
  @https://www.postgresql.org/docs/current/sql-fetch.html@ for details about
  the effect of move and the meanings of cursor directions to PostgreSQL.

@since 1.0.0.0
-}
move ::
  Monad.MonadOrville m =>
  Maybe Expr.CursorDirection ->
  Cursor readEntity ->
  m ()
move :: forall (m :: * -> *) readEntity.
MonadOrville m =>
Maybe CursorDirection -> Cursor readEntity -> m ()
move Maybe CursorDirection
direction (Cursor AnnotatedSqlMarshaller writeEntity readEntity
_ CursorName
cursorName) =
  QueryType -> MoveExpr -> m ()
forall (m :: * -> *) sql.
(MonadOrville m, SqlExpression sql) =>
QueryType -> sql -> m ()
Execute.executeVoid
    QueryType
QueryType.CursorQuery
    (Maybe CursorDirection -> CursorName -> MoveExpr
Expr.move Maybe CursorDirection
direction CursorName
cursorName)

{- |
  INTERNAL - Generates a unique (or very nearly guaranteed to be) cursor name.
  Cursor names only need to be unique among the currently-open cursors on the
  current connection, so using POSIX time plus a 32-bit random tag should be
  more than sufficient to ensure conflicts are not seen in practice.

@since 1.0.0.0
-}
newCursorName :: MonadIO m => m Expr.CursorName
newCursorName :: forall (m :: * -> *). MonadIO m => m CursorName
newCursorName =
  IO CursorName -> m CursorName
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CursorName -> m CursorName) -> IO CursorName -> m CursorName
forall a b. (a -> b) -> a -> b
$ do
    POSIXTime
now <- IO POSIXTime
POSIXTime.getPOSIXTime
    Word32
randomWord <- IO Word32
forall a (m :: * -> *). (Random a, MonadIO m) => m a
Random.randomIO

    let
      nowAsInteger :: Int
nowAsInteger =
        Pico -> Int
forall a. Enum a => a -> Int
fromEnum (Pico -> Int) -> (POSIXTime -> Pico) -> POSIXTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Pico
Time.nominalDiffTimeToSeconds (POSIXTime -> Int) -> POSIXTime -> Int
forall a b. (a -> b) -> a -> b
$ POSIXTime
now

    CursorName -> IO CursorName
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CursorName -> IO CursorName)
-> (String -> CursorName) -> String -> IO CursorName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CursorName
Expr.cursorName (String -> IO CursorName) -> String -> IO CursorName
forall a b. (a -> b) -> a -> b
$
      String -> Int -> Word32 -> String
forall r. PrintfType r => String -> r
Printf.printf
        String
"orville_cursor_%x_%08x"
        Int
nowAsInteger
        (Word32
randomWord :: Word.Word32)