{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Expr.DataType
  ( DataType
  , timestampWithZone
  , timestampWithoutZone
  , date
  , tsvector
  , varchar
  , char
  , text
  , uuid
  , boolean
  , doublePrecision
  , bigSerial
  , bigInt
  , serial
  , int
  , smallint
  , jsonb
  , oid
  )
where

import Data.Int (Int32)

import qualified Orville.PostgreSQL.Raw.RawSql as RawSql

{- |
Type to represent any SQL data type expression. E.G.

  > INTEGER

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

{- | A 'DataType' that represents the PostgreSQL "TIMESTAMP with time zone" data type.

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

@since 1.0.0.0
-}
timestampWithZone :: DataType
timestampWithZone :: DataType
timestampWithZone =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"TIMESTAMP with time zone")

{- | A 'DataType' that represents the PostgreSQL "TIMESTAMP without time zone" data type.

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

@since 1.0.0.0
-}
timestampWithoutZone :: DataType
timestampWithoutZone :: DataType
timestampWithoutZone =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"TIMESTAMP without time zone")

{- | A 'DataType' that represents the PostgreSQL "DATE" data type.

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

@since 1.0.0.0
-}
date :: DataType
date :: DataType
date =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"DATE")

{- | A 'DataType' that represents the PostgreSQL "TSVECTOR" data type.

See [postgresql
documentation](https://www.postgresql.org/docs/current/datatype-textsearch.html#DATATYPE-TSVECTOR)
for more information.

@since 1.0.0.0
-}
tsvector :: DataType
tsvector :: DataType
tsvector =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"TSVECTOR")

{- | A 'DataType' that represents the PostgreSQL "VARCHAR(n)" data type.

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

@since 1.0.0.0
-}
varchar :: Int32 -> DataType
varchar :: Int32 -> DataType
varchar Int32
len =
  -- postgresql won't let us pass the field length as a parameter.
  -- when we try we get an error like such error:
  --  ERROR:  syntax error at or near "$1" at character 48
  --  STATEMENT:  CREATE TABLE field_definition_test(foo VARCHAR($1))
  RawSql -> DataType
DataType (RawSql -> DataType) -> RawSql -> DataType
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"VARCHAR("
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> Int32 -> RawSql
RawSql.int32DecLiteral Int32
len
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
")"

{- | A 'DataType' that represents the PostgreSQL "CHAR(n)" data type.

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

@since 1.0.0.0
-}
char :: Int32 -> DataType
char :: Int32 -> DataType
char Int32
len =
  -- postgresql won't let us pass the field length as a parameter.
  -- when we try, we get an error like such:
  --  ERROR:  syntax error at or near "$1" at character 48
  --  STATEMENT:  CREATE TABLE field_definition_test(foo CHAR($1))
  RawSql -> DataType
DataType (RawSql -> DataType) -> RawSql -> DataType
forall a b. (a -> b) -> a -> b
$
    String -> RawSql
RawSql.fromString String
"CHAR("
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> Int32 -> RawSql
RawSql.int32DecLiteral Int32
len
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
")"

{- | A 'DataType' that represents the PostgreSQL "TEXT" data type.

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

@since 1.0.0.0
-}
text :: DataType
text :: DataType
text =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"TEXT")

{- | A 'DataType' that represents the PostgreSQL "UUID" data type.

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

@since 1.0.0.0
-}
uuid :: DataType
uuid :: DataType
uuid =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"UUID")

{- | A 'DataType' that represents the PostgreSQL "BOOLEAN" data type.

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

@since 1.0.0.0
-}
boolean :: DataType
boolean :: DataType
boolean =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"BOOLEAN")

{- | A 'DataType' that represents the PostgreSQL "DOUBLE PRECISION" data type.

See [postgresql
documentation](https://www.postgresql.org/docs/current/datatype-numeric.html#DATATYPE-FLOAT) for
more information.

@since 1.0.0.0
-}
doublePrecision :: DataType
doublePrecision :: DataType
doublePrecision =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"DOUBLE PRECISION")

{- | A 'DataType' that represents the PostgreSQL "BIGSERIAL" data type.

See [postgresql
documentation](https://www.postgresql.org/docs/current/datatype-numeric.html#DATATYPE-SERIAL) for
more information.

@since 1.0.0.0
-}
bigSerial :: DataType
bigSerial :: DataType
bigSerial =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"BIGSERIAL")

{- | A 'DataType' that represents the PostgreSQL "BIGINT" data type.

See [postgresql
documentation](https://www.postgresql.org/docs/current/datatype-numeric.html#DATATYPE-INT) for
more information.

@since 1.0.0.0
-}
bigInt :: DataType
bigInt :: DataType
bigInt =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"BIGINT")

{- | A 'DataType' that represents the PostgreSQL "SERIAL" data type.

See [postgresql
documentation](https://www.postgresql.org/docs/current/datatype-numeric.html#DATATYPE-SERIAL) for
more information.

@since 1.0.0.0
-}
serial :: DataType
serial :: DataType
serial =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"SERIAL")

{- | A 'DataType' that represents the PostgreSQL "INT" data type.

See [postgresql
documentation](https://www.postgresql.org/docs/current/datatype-numeric.html#DATATYPE-INT) for
more information.

@since 1.0.0.0
-}
int :: DataType
int :: DataType
int =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"INT")

{- | A 'DataType' that represents the PostgreSQL "SMALLINT" data type.

See [postgresql
documentation](https://www.postgresql.org/docs/current/datatype-numeric.html#DATATYPE-INT) for
more information.

@since 1.0.0.0
-}
smallint :: DataType
smallint :: DataType
smallint =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"SMALLINT")

{- |
  A 'DataType' that represents the PostgreSQL "JSONB" data type.

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

@since 1.0.0.0
-}
jsonb :: DataType
jsonb :: DataType
jsonb =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"JSONB")

{- | A 'DataType' that represents the PostgreSQL "OID" data type.

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

@since 1.0.0.0
-}
oid :: DataType
oid :: DataType
oid =
  RawSql -> DataType
DataType (String -> RawSql
RawSql.fromString String
"OID")