{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Expr.Update
  ( UpdateExpr
  , updateExpr
  , SetClauseList
  , setClauseList
  , SetClause
  , setColumn
  )
where

import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (catMaybes)

import Orville.PostgreSQL.Expr.Name (ColumnName, Qualified, TableName)
import Orville.PostgreSQL.Expr.ReturningExpr (ReturningExpr)
import Orville.PostgreSQL.Expr.WhereClause (WhereClause)
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
import qualified Orville.PostgreSQL.Raw.SqlValue as SqlValue

{- |
Type to represent a SQL @UPDATE@ statement. E.G.

> UPDATE foo
> SET id = 1
> WHERE id <> 1

'UpdateExpr' 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 UpdateExpr
  = UpdateExpr RawSql.RawSql
  deriving (RawSql -> UpdateExpr
UpdateExpr -> RawSql
(UpdateExpr -> RawSql)
-> (RawSql -> UpdateExpr) -> SqlExpression UpdateExpr
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: UpdateExpr -> RawSql
toRawSql :: UpdateExpr -> RawSql
$cunsafeFromRawSql :: RawSql -> UpdateExpr
unsafeFromRawSql :: RawSql -> UpdateExpr
RawSql.SqlExpression)

{- |
  Constructs an 'UpdateExpr' with the given options.

  @since 1.0.0.0
-}
updateExpr ::
  -- | The name of the table to be updated.
  Qualified TableName ->
  -- | The updates to be made to the table.
  SetClauseList ->
  -- | An optional where clause to limit the rows updated.
  Maybe WhereClause ->
  -- | An optional returning clause to return data from the updated rows.
  Maybe ReturningExpr ->
  UpdateExpr
updateExpr :: Qualified TableName
-> SetClauseList
-> Maybe WhereClause
-> Maybe ReturningExpr
-> UpdateExpr
updateExpr Qualified TableName
tableName SetClauseList
setClause Maybe WhereClause
maybeWhereClause Maybe ReturningExpr
maybeReturningExpr =
  RawSql -> UpdateExpr
UpdateExpr (RawSql -> UpdateExpr) -> RawSql -> UpdateExpr
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
"UPDATE"
        , RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ Qualified TableName -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql Qualified TableName
tableName
        , 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
"SET"
        , RawSql -> Maybe RawSql
forall a. a -> Maybe a
Just (RawSql -> Maybe RawSql) -> RawSql -> Maybe RawSql
forall a b. (a -> b) -> a -> b
$ SetClauseList -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql SetClauseList
setClause
        , (WhereClause -> RawSql) -> Maybe WhereClause -> Maybe RawSql
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WhereClause -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql Maybe WhereClause
maybeWhereClause
        , (ReturningExpr -> RawSql) -> Maybe ReturningExpr -> Maybe RawSql
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ReturningExpr -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql Maybe ReturningExpr
maybeReturningExpr
        ]

{- |
Type to represent the list of updates to be made in an @UPDATE@ statement. E.G.

> foo = 1,
> bar = 2

'SetClauseList' 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 SetClauseList
  = SetClauseList RawSql.RawSql
  deriving (RawSql -> SetClauseList
SetClauseList -> RawSql
(SetClauseList -> RawSql)
-> (RawSql -> SetClauseList) -> SqlExpression SetClauseList
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: SetClauseList -> RawSql
toRawSql :: SetClauseList -> RawSql
$cunsafeFromRawSql :: RawSql -> SetClauseList
unsafeFromRawSql :: RawSql -> SetClauseList
RawSql.SqlExpression)

{- |
  Constructs a 'SetClauseList' with the specified set clauses.

  @since 1.0.0.0
-}
setClauseList :: NonEmpty SetClause -> SetClauseList
setClauseList :: NonEmpty SetClause -> SetClauseList
setClauseList =
  RawSql -> SetClauseList
SetClauseList (RawSql -> SetClauseList)
-> (NonEmpty SetClause -> RawSql)
-> NonEmpty SetClause
-> SetClauseList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> NonEmpty SetClause -> RawSql
forall sql (f :: * -> *).
(SqlExpression sql, Foldable f) =>
RawSql -> f sql -> RawSql
RawSql.intercalate RawSql
RawSql.comma

{- |
Type to represent a single update to be made in an @UPDATE@ statement. E.G.

> foo = 1

'SetClause' 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 SetClause
  = SetClause RawSql.RawSql
  deriving (RawSql -> SetClause
SetClause -> RawSql
(SetClause -> RawSql)
-> (RawSql -> SetClause) -> SqlExpression SetClause
forall a. (a -> RawSql) -> (RawSql -> a) -> SqlExpression a
$ctoRawSql :: SetClause -> RawSql
toRawSql :: SetClause -> RawSql
$cunsafeFromRawSql :: RawSql -> SetClause
unsafeFromRawSql :: RawSql -> SetClause
RawSql.SqlExpression)

{- |
  Constructs a 'SetClause' that will set the specified column to the specified
  value.

  @since 1.0.0.0
-}
setColumn :: ColumnName -> SqlValue.SqlValue -> SetClause
setColumn :: ColumnName -> SqlValue -> SetClause
setColumn ColumnName
columnName SqlValue
value =
  RawSql -> SetClause
SetClause (RawSql -> SetClause) -> RawSql -> SetClause
forall a b. (a -> b) -> a -> b
$
    ColumnName -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql ColumnName
columnName
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
"="
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> SqlValue -> RawSql
RawSql.parameter SqlValue
value