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

Interactions to work with database sequence values on the Haskell side,
including inspection of the current and next values in the sequence as well as
updating a sequence to a given value.

@since 1.0.0.0
-}
module Orville.PostgreSQL.Execution.Sequence
  ( sequenceNextValue
  , sequenceCurrentValue
  , sequenceSetValue
  )
where

import Data.Int (Int64)

import qualified Orville.PostgreSQL.Execution.Execute as Execute
import qualified Orville.PostgreSQL.Execution.QueryType as QueryType
import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.Internal.RowCountExpectation as RowCountExpectation
import qualified Orville.PostgreSQL.Marshall as Marshall
import qualified Orville.PostgreSQL.Monad as Monad
import Orville.PostgreSQL.Schema (SequenceDefinition, sequenceName)

{- |
  Fetches the next value from a sequence via the PostgreSQL @nextval@ function.

@since 1.0.0.0
-}
sequenceNextValue :: Monad.MonadOrville m => SequenceDefinition -> m Int64
sequenceNextValue :: forall (m :: * -> *).
MonadOrville m =>
SequenceDefinition -> m Int64
sequenceNextValue SequenceDefinition
sequenceDef =
  String -> ValueExpression -> m Int64
forall (m :: * -> *).
MonadOrville m =>
String -> ValueExpression -> m Int64
selectInt64Value
    String
"sequenceNextValue"
    (Qualified SequenceName -> ValueExpression
Expr.nextVal (SequenceDefinition -> Qualified SequenceName
sequenceName SequenceDefinition
sequenceDef))

{- |
  Fetches the current value from a sequence via the PostgreSQL @currval@ function.

@since 1.0.0.0
-}
sequenceCurrentValue :: Monad.MonadOrville m => SequenceDefinition -> m Int64
sequenceCurrentValue :: forall (m :: * -> *).
MonadOrville m =>
SequenceDefinition -> m Int64
sequenceCurrentValue SequenceDefinition
sequenceDef =
  String -> ValueExpression -> m Int64
forall (m :: * -> *).
MonadOrville m =>
String -> ValueExpression -> m Int64
selectInt64Value
    String
"sequenceCurrentValue"
    (Qualified SequenceName -> ValueExpression
Expr.currVal (SequenceDefinition -> Qualified SequenceName
sequenceName SequenceDefinition
sequenceDef))

{- |
  Sets the current value from a sequence via the PostgreSQL @setval@ function.

@since 1.0.0.0
-}
sequenceSetValue :: Monad.MonadOrville m => SequenceDefinition -> Int64 -> m Int64
sequenceSetValue :: forall (m :: * -> *).
MonadOrville m =>
SequenceDefinition -> Int64 -> m Int64
sequenceSetValue SequenceDefinition
sequenceDef Int64
newValue =
  String -> ValueExpression -> m Int64
forall (m :: * -> *).
MonadOrville m =>
String -> ValueExpression -> m Int64
selectInt64Value
    String
"sequenceSetValue"
    (Qualified SequenceName -> Int64 -> ValueExpression
Expr.setVal (SequenceDefinition -> Qualified SequenceName
sequenceName SequenceDefinition
sequenceDef) Int64
newValue)

selectInt64Value :: Monad.MonadOrville m => String -> Expr.ValueExpression -> m Int64
selectInt64Value :: forall (m :: * -> *).
MonadOrville m =>
String -> ValueExpression -> m Int64
selectInt64Value String
caller ValueExpression
valueExpression = do
  let
    queryExpr :: QueryExpr
queryExpr =
      SelectClause -> SelectList -> Maybe TableExpr -> QueryExpr
Expr.queryExpr
        (SelectExpr -> SelectClause
Expr.selectClause (Maybe Distinct -> SelectExpr
Expr.selectExpr Maybe Distinct
forall a. Maybe a
Nothing))
        ( [DerivedColumn] -> SelectList
Expr.selectDerivedColumns
            [ValueExpression -> ColumnName -> DerivedColumn
Expr.deriveColumnAs ValueExpression
valueExpression (String -> ColumnName
Expr.columnName String
"result")]
        )
        Maybe TableExpr
forall a. Maybe a
Nothing

    marshaller :: AnnotatedSqlMarshaller Int64 Int64
marshaller =
      SqlMarshaller Int64 Int64 -> AnnotatedSqlMarshaller Int64 Int64
forall writeEntity readEntity.
SqlMarshaller writeEntity readEntity
-> AnnotatedSqlMarshaller writeEntity readEntity
Marshall.annotateSqlMarshallerEmptyAnnotation
        (SqlMarshaller Int64 Int64 -> AnnotatedSqlMarshaller Int64 Int64)
-> (FieldDefinition NotNull Int64 -> SqlMarshaller Int64 Int64)
-> FieldDefinition NotNull Int64
-> AnnotatedSqlMarshaller Int64 Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64)
-> FieldDefinition NotNull Int64 -> SqlMarshaller Int64 Int64
forall writeEntity fieldValue nullability.
(writeEntity -> fieldValue)
-> FieldDefinition nullability fieldValue
-> SqlMarshaller writeEntity fieldValue
Marshall.marshallField Int64 -> Int64
forall a. a -> a
id
        (FieldDefinition NotNull Int64
 -> AnnotatedSqlMarshaller Int64 Int64)
-> FieldDefinition NotNull Int64
-> AnnotatedSqlMarshaller Int64 Int64
forall a b. (a -> b) -> a -> b
$ String -> FieldDefinition NotNull Int64
Marshall.bigIntegerField String
"result"
  [Int64]
values <- QueryType
-> QueryExpr -> AnnotatedSqlMarshaller Int64 Int64 -> m [Int64]
forall (m :: * -> *) sql writeEntity readEntity.
(MonadOrville m, SqlExpression sql) =>
QueryType
-> sql
-> AnnotatedSqlMarshaller writeEntity readEntity
-> m [readEntity]
Execute.executeAndDecode QueryType
QueryType.SelectQuery QueryExpr
queryExpr AnnotatedSqlMarshaller Int64 Int64
marshaller
  String -> [Int64] -> m Int64
forall (m :: * -> *) a. MonadIO m => String -> [a] -> m a
RowCountExpectation.expectExactlyOneRow String
caller [Int64]
values