{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Expr.Select
  ( SelectClause
  , selectClause
  , SelectExpr
  , selectExpr
  , Distinct (Distinct)
  )
where

import qualified Orville.PostgreSQL.Raw.RawSql as RawSql

{- |
Type to represent the @SELECT@ part of a SQL query. E.G.

> SELECT

or

> SELECT DISTINCT

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

{- |
  Constructs a 'SelectClause' using the given 'SelectExpr', which may indicate
  that this is a @DISTINCT@ select.

@since 1.0.0.0
-}
selectClause :: SelectExpr -> SelectClause
selectClause :: SelectExpr -> SelectClause
selectClause SelectExpr
expr = RawSql -> SelectClause
SelectClause (String -> RawSql
RawSql.fromString String
"SELECT " RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> SelectExpr -> RawSql
forall a. SqlExpression a => a -> RawSql
RawSql.toRawSql SelectExpr
expr)

{- |
Type to represent any expression modifying the @SELECT@ part of a SQL. E.G.

> DISTINCT

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

{- |
  A simple value type used to indicate that a @SELECT@ should be distinct when
  constructing a 'SelectExpr'.

@since 1.0.0.0
-}
data Distinct = Distinct

{- |
  Constructs a 'SelectExpr' that may or may not make the @SELECT@ distinct,
  depending on whether 'Just Distinct' is passed or not.

@since 1.0.0.0
-}
selectExpr :: Maybe Distinct -> SelectExpr
selectExpr :: Maybe Distinct -> SelectExpr
selectExpr Maybe Distinct
mbDistinct =
  RawSql -> SelectExpr
SelectExpr (RawSql -> SelectExpr)
-> (String -> RawSql) -> String -> SelectExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString (String -> SelectExpr) -> String -> SelectExpr
forall a b. (a -> b) -> a -> b
$
    case Maybe Distinct
mbDistinct of
      Just Distinct
Distinct -> String
"DISTINCT "
      Maybe Distinct
Nothing -> String
""