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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Expr.Count
  ( count
  , countFunction
  , count1
  , countColumn
  )
where

import Orville.PostgreSQL.Expr.Name (ColumnName, FunctionName, functionName)
import Orville.PostgreSQL.Expr.ValueExpression (ValueExpression, columnReference, functionCall)
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql

{- | The SQL @count@ function.

@since 1.0.0.0
-}
countFunction :: FunctionName
countFunction :: FunctionName
countFunction = String -> FunctionName
functionName String
"count"

{- | Given a 'ValueExpression', use it as the argument to the SQL @count@.

@since 1.0.0.0
-}
count :: ValueExpression -> ValueExpression
count :: ValueExpression -> ValueExpression
count ValueExpression
value =
  FunctionName -> [ValueExpression] -> ValueExpression
functionCall FunctionName
countFunction [ValueExpression
value]

{- | The SQL @count(1)@.

@since 1.0.0.0
-}
count1 :: ValueExpression
count1 :: ValueExpression
count1 =
  ValueExpression -> ValueExpression
count (ValueExpression -> ValueExpression)
-> (Int -> ValueExpression) -> Int -> ValueExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql (RawSql -> ValueExpression)
-> (Int -> RawSql) -> Int -> ValueExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RawSql
RawSql.intDecLiteral (Int -> ValueExpression) -> Int -> ValueExpression
forall a b. (a -> b) -> a -> b
$ Int
1

{- | Use a given column as the argument to the SQL @count@.

@since 1.0.0.0
-}
countColumn :: ColumnName -> ValueExpression
countColumn :: ColumnName -> ValueExpression
countColumn =
  ValueExpression -> ValueExpression
count (ValueExpression -> ValueExpression)
-> (ColumnName -> ValueExpression) -> ColumnName -> ValueExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnName -> ValueExpression
columnReference