{-# LANGUAGE GADTs #-}
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
data Cursor readEntity where
Cursor ::
AnnotatedSqlMarshaller writeEntity readEntity ->
Expr.CursorName ->
Cursor readEntity
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
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)
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 ::
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
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)
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)