{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Expr.Cursor
  ( DeclareExpr
  , declare
  , ScrollExpr
  , scroll
  , noScroll
  , HoldExpr
  , withHold
  , withoutHold
  , CloseExpr
  , close
  , AllCursors
  , allCursors
  , FetchExpr
  , fetch
  , MoveExpr
  , move
  , CursorDirection
  , next
  , prior
  , first
  , last
  , absolute
  , relative
  , rowCount
  , fetchAll
  , forward
  , forwardCount
  , forwardAll
  , backward
  , backwardCount
  , backwardAll
  )
where

import Data.Maybe (catMaybes)
import Prelude (Either, Int, Maybe (Just), either, fmap, ($), (.), (<>))

import Orville.PostgreSQL.Expr.Name (CursorName)
import Orville.PostgreSQL.Expr.Query (QueryExpr)
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql

{- |
'DeclareExpr' corresponds to the SQL DECLARE statement, for declaring and
opening cursors. E.G.

> DECLARE FOO CURSOR FOR SELECT * FROM BAR

See PostgreSQL [cursor declare
documentation](https://www.postgresql.org/docs/current/sql-declare.html) for
more information.

'DeclareExpr' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype DeclareExpr
  = DeclareExpr RawSql.RawSql
  deriving
    ( -- | @since 1.0.0.0
      RawSql -> DeclareExpr
DeclareExpr -> RawSql
(DeclareExpr -> RawSql)
-> (RawSql -> DeclareExpr) -> SqlExpression DeclareExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: DeclareExpr -> RawSql
toRawSql :: DeclareExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> DeclareExpr
unsafeFromRawSql :: RawSql -> DeclareExpr
RawSql.SqlExpression
    )

{- | A smart constructor for setting up a 'DeclareExpr'. This, along with other functions provided,
   allows users to more safely declare a cursor.

@since 1.0.0.0
-}
declare ::
  CursorName ->
  Maybe ScrollExpr ->
  Maybe HoldExpr ->
  QueryExpr ->
  DeclareExpr
declare :: CursorName
-> Maybe ScrollExpr -> Maybe HoldExpr -> QueryExpr -> DeclareExpr
declare CursorName
cursorName Maybe ScrollExpr
maybeScrollExpr Maybe HoldExpr
maybeHoldExpr QueryExpr
queryExpr =
  RawSql -> DeclareExpr
DeclareExpr (RawSql -> DeclareExpr) -> RawSql -> DeclareExpr
forall a b. (a -> b) -> a -> b
$
    RawSql -> [RawSql] -> RawSql
forall sql (f :: * -> *).
(SqlExpression sql, Foldable f) =>
RawSql -> f sql -> RawSql
RawSql.intercalate RawSql
RawSql.space ([RawSql] -> RawSql) -> [RawSql] -> RawSql
forall a b. (a -> b) -> a -> b
$
      [Maybe RawSql] -> [RawSql]
forall a. [Maybe a] -> [a]
catMaybes
        [ RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ String -> RawSql
RawSql.fromString String
"DECLARE"
        , RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ CursorName -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql CursorName
cursorName
        , (ScrollExpr -> RawSql) -> Maybe ScrollExpr -> Maybe RawSql
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScrollExpr -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql Maybe ScrollExpr
maybeScrollExpr
        , RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ String -> RawSql
RawSql.fromString String
"CURSOR"
        , (HoldExpr -> RawSql) -> Maybe HoldExpr -> Maybe RawSql
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HoldExpr -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql Maybe HoldExpr
maybeHoldExpr
        , RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ String -> RawSql
RawSql.fromString String
"FOR"
        , RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ QueryExpr -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql QueryExpr
queryExpr
        ]

{- |
'ScrollExpr' is used to determine if a cursor should be able to fetch
nonsequentially. E.G.

> NO SCROLL

Note that the default in at least PostgreSQL versions 11-15 is to allow
nonsequential fetches under some, but not all, circumstances.

See PostgreSQL [cursor declare
documentation](https://www.postgresql.org/docs/current/sql-declare.html) for more information.

'ScrollExpr' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype ScrollExpr
  = ScrollExpr RawSql.RawSql
  deriving
    ( -- | @since 1.0.0.0
      RawSql -> ScrollExpr
ScrollExpr -> RawSql
(ScrollExpr -> RawSql)
-> (RawSql -> ScrollExpr) -> SqlExpression ScrollExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: ScrollExpr -> RawSql
toRawSql :: ScrollExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> ScrollExpr
unsafeFromRawSql :: RawSql -> ScrollExpr
RawSql.SqlExpression
    )

{- | Allow a cursor to be used to fetch rows nonsequentially.

@since 1.0.0.0
-}
scroll :: ScrollExpr
scroll :: ScrollExpr
scroll =
  RawSql -> ScrollExpr
ScrollExpr (RawSql -> ScrollExpr)
-> (String -> RawSql) -> String -> ScrollExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> ScrollExpr) -> String -> ScrollExpr
forall a b. (a -> b) -> a -> b
$ String
"SCROLL"

{- | Only allow a cursor to be used to fetch rows sequentially.

@since 1.0.0.0
-}
noScroll :: ScrollExpr
noScroll :: ScrollExpr
noScroll =
  RawSql -> ScrollExpr
ScrollExpr (RawSql -> ScrollExpr)
-> (String -> RawSql) -> String -> ScrollExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> ScrollExpr) -> String -> ScrollExpr
forall a b. (a -> b) -> a -> b
$ String
"NO SCROLL"

{- |
'HoldExpr' is used to determine if a cursor should be available for use after
the transaction that created it has been committed. E.G.

> WITH HOLD

See PostgreSQL [cursor documentation](https://www.postgresql.org/docs/current/sql-declare.html) for
more information.

'HoldExpr' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype HoldExpr
  = HoldExpr RawSql.RawSql
  deriving
    ( -- | @since 1.0.0.0
      RawSql -> HoldExpr
HoldExpr -> RawSql
(HoldExpr -> RawSql)
-> (RawSql -> HoldExpr) -> SqlExpression HoldExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: HoldExpr -> RawSql
toRawSql :: HoldExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> HoldExpr
unsafeFromRawSql :: RawSql -> HoldExpr
RawSql.SqlExpression
    )

{- | Allow a cursor to be used after the transaction creating it is committed.

@since 1.0.0.0
-}
withHold :: HoldExpr
withHold :: HoldExpr
withHold =
  RawSql -> HoldExpr
HoldExpr (RawSql -> HoldExpr) -> (String -> RawSql) -> String -> HoldExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> HoldExpr) -> String -> HoldExpr
forall a b. (a -> b) -> a -> b
$ String
"WITH HOLD"

{- | Do not allow a cursor to be used after the transaction creating it is committed.

@since 1.0.0.0
-}
withoutHold :: HoldExpr
withoutHold :: HoldExpr
withoutHold =
  RawSql -> HoldExpr
HoldExpr (RawSql -> HoldExpr) -> (String -> RawSql) -> String -> HoldExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> HoldExpr) -> String -> HoldExpr
forall a b. (a -> b) -> a -> b
$ String
"WITHOUT HOLD"

{- |
'CloseExpr' corresponds to the SQL CLOSE statement. E.G.

> CLOSE ALL

See PostgreSQL [close documentation](https://www.postgresql.org/docs/current/sql-close.html) for
more information.

'HoldExpr' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype CloseExpr
  = CloseExpr RawSql.RawSql
  deriving
    ( -- | @since 1.0.0.0
      RawSql -> CloseExpr
CloseExpr -> RawSql
(CloseExpr -> RawSql)
-> (RawSql -> CloseExpr) -> SqlExpression CloseExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: CloseExpr -> RawSql
toRawSql :: CloseExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> CloseExpr
unsafeFromRawSql :: RawSql -> CloseExpr
RawSql.SqlExpression
    )

{- | A smart constructor for setting up a 'CloseExpr', either closing all cursors or the given named
   cursor.

@since 1.0.0.0
-}
close :: Either AllCursors CursorName -> CloseExpr
close :: Either AllCursors CursorName -> CloseExpr
close Either AllCursors CursorName
allOrCursorName =
  RawSql -> CloseExpr
CloseExpr (RawSql -> CloseExpr) -> RawSql -> CloseExpr
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"CLOSE "
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> (AllCursors -> RawSql)
-> (CursorName -> RawSql) -> Either AllCursors CursorName -> RawSql
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either AllCursors -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql CursorName -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql Either AllCursors CursorName
allOrCursorName

{- |
'AllCursors' corresponds to the ALL keyword in a CLOSE statement. E.G.

> ALL

'AllCursors' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype AllCursors
  = AllCursors RawSql.RawSql
  deriving
    ( -- | @since 1.0.0.0
      RawSql -> AllCursors
AllCursors -> RawSql
(AllCursors -> RawSql)
-> (RawSql -> AllCursors) -> SqlExpression AllCursors
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: AllCursors -> RawSql
toRawSql :: AllCursors -> RawSql
$cunsafeFromRawSql :: RawSql -> AllCursors
unsafeFromRawSql :: RawSql -> AllCursors
RawSql.SqlExpression
    )

{- | Specify closing all open cursors, for use with a 'CloseExpr'.

@since 1.0.0.0
-}
allCursors :: AllCursors
allCursors :: AllCursors
allCursors =
  RawSql -> AllCursors
AllCursors (RawSql -> AllCursors)
-> (String -> RawSql) -> String -> AllCursors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> AllCursors) -> String -> AllCursors
forall a b. (a -> b) -> a -> b
$ String
"ALL"

{- |
'FetchExpr' corresponds to the SQL FETCH statement, for retrieving rows from a
previously-created cursor. E.G.

> FETCH NEXT FOO

See PostgreSQL [fetch
documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for more
information.

'FetchExpr' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype FetchExpr
  = FetchExpr RawSql.RawSql
  deriving
    ( -- | @since 1.0.0.0
      RawSql -> FetchExpr
FetchExpr -> RawSql
(FetchExpr -> RawSql)
-> (RawSql -> FetchExpr) -> SqlExpression FetchExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: FetchExpr -> RawSql
toRawSql :: FetchExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> FetchExpr
unsafeFromRawSql :: RawSql -> FetchExpr
RawSql.SqlExpression
    )

{- | Construct a 'FetchExpr', for a given cursor and optionally a direction to fetch.

@since 1.0.0.0
-}
fetch :: Maybe CursorDirection -> CursorName -> FetchExpr
fetch :: Maybe CursorDirection -> CursorName -> FetchExpr
fetch Maybe CursorDirection
maybeDirection CursorName
cursorName =
  RawSql -> FetchExpr
FetchExpr (RawSql -> FetchExpr) -> RawSql -> FetchExpr
forall a b. (a -> b) -> a -> b
$
    RawSql -> [RawSql] -> RawSql
forall sql (f :: * -> *).
(SqlExpression sql, Foldable f) =>
RawSql -> f sql -> RawSql
RawSql.intercalate RawSql
RawSql.space ([RawSql] -> RawSql) -> [RawSql] -> RawSql
forall a b. (a -> b) -> a -> b
$
      [Maybe RawSql] -> [RawSql]
forall a. [Maybe a] -> [a]
catMaybes
        [ RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ String -> RawSql
RawSql.fromString String
"FETCH"
        , (CursorDirection -> RawSql)
-> Maybe CursorDirection -> Maybe RawSql
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CursorDirection -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql Maybe CursorDirection
maybeDirection
        , RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ CursorName -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql CursorName
cursorName
        ]

{- |
'MoveExpr' corresponds to the SQL MOVE statement, for positioning a previously
created cursor, /without/ retrieving any rows. E.G.

> MOVE NEXT FOO

'MoveExpr' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype MoveExpr
  = MoveExpr RawSql.RawSql
  deriving
    ( -- | @since 1.0.0.0
      RawSql -> MoveExpr
MoveExpr -> RawSql
(MoveExpr -> RawSql)
-> (RawSql -> MoveExpr) -> SqlExpression MoveExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: MoveExpr -> RawSql
toRawSql :: MoveExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> MoveExpr
unsafeFromRawSql :: RawSql -> MoveExpr
RawSql.SqlExpression
    )

{- | Construct a 'MoveExpr', for a given cursor and optionally a direction to move.

@since 1.0.0.0
-}
move :: Maybe CursorDirection -> CursorName -> MoveExpr
move :: Maybe CursorDirection -> CursorName -> MoveExpr
move Maybe CursorDirection
maybeDirection CursorName
cursorName =
  RawSql -> MoveExpr
MoveExpr
    (RawSql -> MoveExpr)
-> ([RawSql] -> RawSql) -> [RawSql] -> MoveExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> [RawSql] -> RawSql
forall sql (f :: * -> *).
(SqlExpression sql, Foldable f) =>
RawSql -> f sql -> RawSql
RawSql.intercalate RawSql
RawSql.space
    ([RawSql] -> MoveExpr) -> [RawSql] -> MoveExpr
forall a b. (a -> b) -> a -> b
$ [Maybe RawSql] -> [RawSql]
forall a. [Maybe a] -> [a]
catMaybes
      [ RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ String -> RawSql
RawSql.fromString String
"MOVE"
      , (CursorDirection -> RawSql)
-> Maybe CursorDirection -> Maybe RawSql
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CursorDirection -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql Maybe CursorDirection
maybeDirection
      , RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ CursorName -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql CursorName
cursorName
      ]

{- |
'CursorDirection' corresponds to the direction argument to the SQL FETCH and
MOVE statements. E.G.

> BACKWARD

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

'CursorDirection' provides a 'RawSql.SqlExpression' instance. See
'RawSql.unsafeSqlExpression' for how to construct a value with your own custom
SQL.

@since 1.0.0.0
-}
newtype CursorDirection
  = CursorDirection RawSql.RawSql
  deriving
    ( -- | @since 1.0.0.0
      RawSql -> CursorDirection
CursorDirection -> RawSql
(CursorDirection -> RawSql)
-> (RawSql -> CursorDirection) -> SqlExpression CursorDirection
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: CursorDirection -> RawSql
toRawSql :: CursorDirection -> RawSql
$cunsafeFromRawSql :: RawSql -> CursorDirection
unsafeFromRawSql :: RawSql -> CursorDirection
RawSql.SqlExpression
    )

{- | Specify the direction of the next single row. Primarily for use with
    'fetch' or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
next :: CursorDirection
next :: CursorDirection
next =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection)
-> (String -> RawSql) -> String -> CursorDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> CursorDirection) -> String -> CursorDirection
forall a b. (a -> b) -> a -> b
$ String
"NEXT"

{- | Specify the direction of the prior single row. Primarily for use with
    'fetch' or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
prior :: CursorDirection
prior :: CursorDirection
prior =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection)
-> (String -> RawSql) -> String -> CursorDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> CursorDirection) -> String -> CursorDirection
forall a b. (a -> b) -> a -> b
$ String
"PRIOR"

{- | Specify the direction of the first single row. Primarily for use with
    'fetch' or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
first :: CursorDirection
first :: CursorDirection
first =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection)
-> (String -> RawSql) -> String -> CursorDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> CursorDirection) -> String -> CursorDirection
forall a b. (a -> b) -> a -> b
$ String
"FIRST"

{- | Specify the direction of the last single row. Primarily for use with
    'fetch' or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
last :: CursorDirection
last :: CursorDirection
last =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection)
-> (String -> RawSql) -> String -> CursorDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> CursorDirection) -> String -> CursorDirection
forall a b. (a -> b) -> a -> b
$ String
"LAST"

{- | Specify the direction of the single row at an absolute position within the
    cursor. Primarily for use with 'fetch' or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
absolute :: Int -> CursorDirection
absolute :: Int -> CursorDirection
absolute Int
countParam =
  -- postgresql won't let us pass the count as a parameter.
  -- when we try we get an error like such error:
  --  ERROR:  syntax error at or near "$1"
  --  LINE 1: FETCH ABSOLUTE $1 \"testcursor\"
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection) -> RawSql -> CursorDirection
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"ABSOLUTE "
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> Int -> RawSql
RawSql.intDecLiteral Int
countParam

{- | Specify the direction of the single row relative to the cursor's current
    position. Primarily for use with 'fetch' or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
relative :: Int -> CursorDirection
relative :: Int -> CursorDirection
relative Int
countParam =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection) -> RawSql -> CursorDirection
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"RELATIVE "
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<>
      -- postgresql won't let us pass the count as a parameter.
      -- when we try we get an error like such error:
      --  ERROR:  syntax error at or near "$1"
      --  LINE 1: FETCH RELATIVE $1 \"testcursor\"
      Int -> RawSql
RawSql.intDecLiteral Int
countParam

{- | Specify the direction of the next n rows. Primarily for use with 'fetch'
    or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
rowCount :: Int -> CursorDirection
rowCount :: Int -> CursorDirection
rowCount Int
countParam =
  -- postgresql won't let us pass the count as a parameter.
  -- when we try we get an error like such error:
  --  ERROR:  syntax error at or near "$1"
  --  LINE 1: FETCH $1 \"testcursor\"
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection) -> RawSql -> CursorDirection
forall a b. (a -> b) -> a -> b
$
    Int -> RawSql
RawSql.intDecLiteral Int
countParam

{- | Specify the direction of all the next rows. Primarily for use with 'fetch'
    or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
fetchAll :: CursorDirection
fetchAll :: CursorDirection
fetchAll =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection)
-> (String -> RawSql) -> String -> CursorDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> CursorDirection) -> String -> CursorDirection
forall a b. (a -> b) -> a -> b
$ String
"ALL"

{- | Specify the direction of the next single row. Primarily for use with
    'fetch' or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
forward :: CursorDirection
forward :: CursorDirection
forward =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection)
-> (String -> RawSql) -> String -> CursorDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> CursorDirection) -> String -> CursorDirection
forall a b. (a -> b) -> a -> b
$ String
"FORWARD"

{- | Specify the direction of the next n rows. Primarily for use with 'fetch'
    or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
forwardCount :: Int -> CursorDirection
forwardCount :: Int -> CursorDirection
forwardCount Int
countParam =
  -- postgresql won't let us pass the count as a parameter.
  -- when we try we get an error like such error:
  --  ERROR:  syntax error at or near "$1"
  --  LINE 1: FETCH FORWARD $1 \"testcursor\"
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection) -> RawSql -> CursorDirection
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"FORWARD "
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> Int -> RawSql
RawSql.intDecLiteral Int
countParam

{- | Specify the direction of all the next rows. Primarily for use with 'fetch'
    or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
forwardAll :: CursorDirection
forwardAll :: CursorDirection
forwardAll =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection)
-> (String -> RawSql) -> String -> CursorDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> CursorDirection) -> String -> CursorDirection
forall a b. (a -> b) -> a -> b
$ String
"FORWARD ALL"

{- | Specify the direction of the prior single row. Primarily for use with
    'fetch' or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
backward :: CursorDirection
backward :: CursorDirection
backward =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection)
-> (String -> RawSql) -> String -> CursorDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> CursorDirection) -> String -> CursorDirection
forall a b. (a -> b) -> a -> b
$ String
"BACKWARD"

{- | Specify the direction of the prior n rows. Primarily for use with 'fetch'
    or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
backwardCount :: Int -> CursorDirection
backwardCount :: Int -> CursorDirection
backwardCount Int
countParam =
  -- postgresql won't let us pass the count as a parameter.
  -- when we try we get an error like such error:
  --  ERROR:  syntax error at or near "$1"
  --  LINE 1: FETCH BACKWARD $1 \"testcursor\"
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection) -> RawSql -> CursorDirection
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"BACKWARD "
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> Int -> RawSql
RawSql.intDecLiteral Int
countParam

{- | Specify the direction of all the prior rows. Primarily for use with
    'fetch' or 'move'.

See PostgreSQL [fetch documentation](https://www.postgresql.org/docs/current/sql-fetch.html) for
more information.

@since 1.0.0.0
-}
backwardAll :: CursorDirection
backwardAll :: CursorDirection
backwardAll =
  RawSql -> CursorDirection
CursorDirection (RawSql -> CursorDirection)
-> (String -> RawSql) -> String -> CursorDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> CursorDirection) -> String -> CursorDirection
forall a b. (a -> b) -> a -> b
$ String
"BACKWARD ALL"