{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

@since 1.0.0.0
-}
module Orville.PostgreSQL.Marshall.DefaultValue
  ( DefaultValue
  , integerDefault
  , smallIntegerDefault
  , bigIntegerDefault
  , integralDefault
  , doubleDefault
  , booleanDefault
  , textDefault
  , dateDefault
  , currentDateDefault
  , utcTimestampDefault
  , currentUTCTimestampDefault
  , localTimestampDefault
  , currentLocalTimestampDefault
  , coerceDefaultValue
  , defaultValueExpression
  , rawSqlDefault
  )
where

import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as LBS
import Data.Int (Int16, Int32, Int64)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TextEnc
import qualified Data.Time as Time
import qualified Numeric as Numeric

import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.Raw.PgTime as PgTime
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql

{- |
  A 'DefaultValue' is a SQL expression that can be attached to a
  field definition to give a default value for a column at the database level.
  The default value will be used if an insert is done and the column is not
  provided.

  This is useful if you want to add a new column to a table that is already
  in production without breaking a previous version of your application that
  is running (e.g. during a zero-down-time deployment) and without needing to
  make the new column nullable. Default values can also be used to create
  database-assigned values such as using @now()@ to set a @created_at@ column
  on a row automatically in the database.

@since 1.0.0.0
-}
newtype DefaultValue a
  = DefaultValue Expr.ValueExpression

{- |
  Builds a default value for any 'Integral' type @n@ by converting it to an
  'Integer'.

@since 1.0.0.0
-}
integralDefault :: Integral n => n -> DefaultValue n
integralDefault :: forall n. Integral n => n -> DefaultValue n
integralDefault n
n =
  let
    decimalBytes :: ByteString
decimalBytes =
      ByteString -> ByteString
LBS.toStrict
        (ByteString -> ByteString) -> (n -> ByteString) -> n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
        (Builder -> ByteString) -> (n -> Builder) -> n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Builder
BSB.integerDec
        (Integer -> Builder) -> (n -> Integer) -> n -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Integer
forall a. Integral a => a -> Integer
toInteger
        (n -> ByteString) -> n -> ByteString
forall a b. (a -> b) -> a -> b
$ n
n
  in
    if n
n n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0
      then
        ValueExpression -> DefaultValue n
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue n)
-> (RawSql -> ValueExpression) -> RawSql -> DefaultValue n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql (RawSql -> DefaultValue n) -> RawSql -> DefaultValue n
forall a b. (a -> b) -> a -> b
$
          ByteString -> RawSql
RawSql.stringLiteral ByteString
decimalBytes
            RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
"::integer"
      else ValueExpression -> DefaultValue n
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue n)
-> (ByteString -> ValueExpression) -> ByteString -> DefaultValue n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql (RawSql -> ValueExpression)
-> (ByteString -> RawSql) -> ByteString -> ValueExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RawSql
RawSql.fromBytes (ByteString -> DefaultValue n) -> ByteString -> DefaultValue n
forall a b. (a -> b) -> a -> b
$ ByteString
decimalBytes

{- |
  Builds a default value from an 'Int16' for use with small integer fields.

  This is a specialization of 'integerDefault'.

@since 1.0.0.0
-}
smallIntegerDefault :: Int16 -> DefaultValue Int16
smallIntegerDefault :: Int16 -> DefaultValue Int16
smallIntegerDefault = Int16 -> DefaultValue Int16
forall n. Integral n => n -> DefaultValue n
integralDefault

{- |
  Builds a default value from an 'Int32' for use with integer fields.

  This is a specialization of 'integerDefault'.

@since 1.0.0.0
-}
integerDefault :: Int32 -> DefaultValue Int32
integerDefault :: Int32 -> DefaultValue Int32
integerDefault = Int32 -> DefaultValue Int32
forall n. Integral n => n -> DefaultValue n
integralDefault

{- |
  Builds a default value from an 'Int16' for use with big integer fields.

  This is a specialization of 'integerDefault'.

@since 1.0.0.0
-}
bigIntegerDefault :: Int64 -> DefaultValue Int64
bigIntegerDefault :: Int64 -> DefaultValue Int64
bigIntegerDefault = Int64 -> DefaultValue Int64
forall n. Integral n => n -> DefaultValue n
integralDefault

{- |
  Builds a default value from a 'Double' field for use with double fields.

@since 1.0.0.0
-}
doubleDefault :: Double -> DefaultValue Double
doubleDefault :: Double -> DefaultValue Double
doubleDefault Double
d =
  let
    decimalBytes :: ByteString
decimalBytes =
      ByteString -> ByteString
LBS.toStrict
        (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
        (Builder -> ByteString)
-> (String -> Builder) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
BSB.string7
        (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
Numeric.showFFloat Maybe Int
forall a. Maybe a
Nothing Double
d String
""
  in
    if Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0
      then
        ValueExpression -> DefaultValue Double
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue Double)
-> (RawSql -> ValueExpression) -> RawSql -> DefaultValue Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql (RawSql -> DefaultValue Double) -> RawSql -> DefaultValue Double
forall a b. (a -> b) -> a -> b
$
          ByteString -> RawSql
RawSql.stringLiteral ByteString
decimalBytes
            RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
"::numeric"
      else ValueExpression -> DefaultValue Double
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue Double)
-> (ByteString -> ValueExpression)
-> ByteString
-> DefaultValue Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql (RawSql -> ValueExpression)
-> (ByteString -> RawSql) -> ByteString -> ValueExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RawSql
RawSql.fromBytes (ByteString -> DefaultValue Double)
-> ByteString -> DefaultValue Double
forall a b. (a -> b) -> a -> b
$ ByteString
decimalBytes

{- |
  Builds a default value from a 'Bool', for use with boolean fields.

@since 1.0.0.0
-}
booleanDefault :: Bool -> DefaultValue Bool
booleanDefault :: Bool -> DefaultValue Bool
booleanDefault Bool
bool =
  let
    pgString :: String
pgString =
      case Bool
bool of
        Bool
True -> String
"true"
        Bool
False -> String
"false"
  in
    ValueExpression -> DefaultValue Bool
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue Bool)
-> ValueExpression -> DefaultValue Bool
forall a b. (a -> b) -> a -> b
$ String -> ValueExpression
forall a. SqlExpression a => String -> a
RawSql.unsafeSqlExpression String
pgString

{- |
  Builds a default value from a 'T.Text', for use with unbounded, bounded
  and fixed-length text fields.

@since 1.0.0.0
-}
textDefault :: T.Text -> DefaultValue T.Text
textDefault :: Text -> DefaultValue Text
textDefault Text
text =
  ValueExpression -> DefaultValue Text
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue Text)
-> (RawSql -> ValueExpression) -> RawSql -> DefaultValue Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql (RawSql -> DefaultValue Text) -> RawSql -> DefaultValue Text
forall a b. (a -> b) -> a -> b
$
    ByteString -> RawSql
RawSql.stringLiteral (Text -> ByteString
TextEnc.encodeUtf8 Text
text)
      RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
"::text"

{- |
  Builds a default value from a 'Time.Day' for use with date fields.

@since 1.0.0.0
-}
dateDefault :: Time.Day -> DefaultValue Time.Day
dateDefault :: Day -> DefaultValue Day
dateDefault Day
day =
  let
    pgText :: ByteString
pgText =
      Day -> ByteString
PgTime.dayToPostgreSQL Day
day
  in
    ValueExpression -> DefaultValue Day
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue Day)
-> (RawSql -> ValueExpression) -> RawSql -> DefaultValue Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql (RawSql -> DefaultValue Day) -> RawSql -> DefaultValue Day
forall a b. (a -> b) -> a -> b
$
      ByteString -> RawSql
RawSql.stringLiteral ByteString
pgText
        RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
"::date"

{- |
  Builds a default value that will default to the current date (i.e. the
  date at which the database populates the default value on a given row).

  For use with date fields.

@since 1.0.0.0
-}
currentDateDefault :: DefaultValue Time.Day
currentDateDefault :: DefaultValue Day
currentDateDefault =
  ValueExpression -> DefaultValue Day
forall a. ValueExpression -> DefaultValue a
DefaultValue
    (ValueExpression -> DefaultValue Day)
-> (String -> ValueExpression) -> String -> DefaultValue Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql
    (RawSql -> ValueExpression)
-> (String -> RawSql) -> String -> ValueExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSql
RawSql.fromString
    (String -> DefaultValue Day) -> String -> DefaultValue Day
forall a b. (a -> b) -> a -> b
$ String
"('now'::text)::date"

{- |
  Builds a default value from a 'Time.UTCTime' for use with UTC timestamp fields.

@since 1.0.0.0
-}
utcTimestampDefault :: Time.UTCTime -> DefaultValue Time.UTCTime
utcTimestampDefault :: UTCTime -> DefaultValue UTCTime
utcTimestampDefault UTCTime
utcTime =
  let
    pgText :: ByteString
pgText =
      UTCTime -> ByteString
PgTime.utcTimeToPostgreSQL UTCTime
utcTime
  in
    ValueExpression -> DefaultValue UTCTime
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue UTCTime)
-> (RawSql -> ValueExpression) -> RawSql -> DefaultValue UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql (RawSql -> DefaultValue UTCTime) -> RawSql -> DefaultValue UTCTime
forall a b. (a -> b) -> a -> b
$
      ByteString -> RawSql
RawSql.stringLiteral ByteString
pgText
        RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
"::timestamp with time zone"

{- |
  Builds a default value that will default to the current UTC time (i.e. the
  time at which the database populates the default value on a given row).

  For use with UTC timestamp fields.

@since 1.0.0.0
-}
currentUTCTimestampDefault :: DefaultValue Time.UTCTime
currentUTCTimestampDefault :: DefaultValue UTCTime
currentUTCTimestampDefault =
  ValueExpression -> DefaultValue UTCTime
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue UTCTime)
-> ValueExpression -> DefaultValue UTCTime
forall a b. (a -> b) -> a -> b
$ String -> ValueExpression
forall a. SqlExpression a => String -> a
RawSql.unsafeSqlExpression String
"now()"

{- |
  Builds a default value from a 'Time.LocalTime' for use with local timestamp fields.

@since 1.0.0.0
-}
localTimestampDefault :: Time.LocalTime -> DefaultValue Time.LocalTime
localTimestampDefault :: LocalTime -> DefaultValue LocalTime
localTimestampDefault LocalTime
localTime =
  let
    pgText :: ByteString
pgText =
      LocalTime -> ByteString
PgTime.localTimeToPostgreSQL LocalTime
localTime
  in
    ValueExpression -> DefaultValue LocalTime
forall a. ValueExpression -> DefaultValue a
DefaultValue
      (ValueExpression -> DefaultValue LocalTime)
-> (RawSql -> ValueExpression) -> RawSql -> DefaultValue LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSql -> ValueExpression
forall a. SqlExpression a => RawSql -> a
RawSql.unsafeFromRawSql
      (RawSql -> DefaultValue LocalTime)
-> RawSql -> DefaultValue LocalTime
forall a b. (a -> b) -> a -> b
$ ByteString -> RawSql
RawSql.stringLiteral ByteString
pgText
        RawSql -> RawSql -> RawSql
forall a. Semigroup a => a -> a -> a
<> String -> RawSql
RawSql.fromString String
"::timestamp without time zone"

{- |
  Builds a default value that will default to the current local time (i.e. the
  time at which the database populates the default value on a given row).

  Note: "local" time here will be determined by the database itself, subject to
  whatever timezone offset has been configured in its settings.

  For use with local timestamp fields.

@since 1.0.0.0
-}
currentLocalTimestampDefault :: DefaultValue Time.LocalTime
currentLocalTimestampDefault :: DefaultValue LocalTime
currentLocalTimestampDefault =
  ValueExpression -> DefaultValue LocalTime
forall a. ValueExpression -> DefaultValue a
DefaultValue (ValueExpression -> DefaultValue LocalTime)
-> ValueExpression -> DefaultValue LocalTime
forall a b. (a -> b) -> a -> b
$ String -> ValueExpression
forall a. SqlExpression a => String -> a
RawSql.unsafeSqlExpression String
"('now'::text)::timestamp without time zone"

{- |
  Coerces a 'DefaultValue' so that it can be used with field definitions of
  a different Haskell type. The coercion will always succeed, and is safe as
  far as Haskell itself is concerned. As long as the 'DefaultValue' is used
  with a column whose database type is the same as the one the 'DefaultValue'
  was originally intended for, everything will work as expected.

@since 1.0.0.0
-}
coerceDefaultValue :: DefaultValue a -> DefaultValue b
coerceDefaultValue :: forall a b. DefaultValue a -> DefaultValue b
coerceDefaultValue (DefaultValue ValueExpression
expression) =
  ValueExpression -> DefaultValue b
forall a. ValueExpression -> DefaultValue a
DefaultValue ValueExpression
expression

{- |
  Returns a database value expression for the default value.

@since 1.0.0.0
-}
defaultValueExpression :: DefaultValue a -> Expr.ValueExpression
defaultValueExpression :: forall a. DefaultValue a -> ValueExpression
defaultValueExpression (DefaultValue ValueExpression
expression) =
  ValueExpression
expression

{- |
  Constructs a default value from a 'Expr.ValueExpression'. You can use this to
  construct default values for any SQL expression that Orville does not support
  directly.

  Note: If you are using auto-migrations, the 'Expr.ValueExpression' that you
  pass here must match what is returned by the PostgreSQL @pg_get_expr@
  function. @pg_get_expr@ decompiles the compiled version of the default
  experssion back to source text, sometimes in non-obvious ways. Orville's
  auto-migration compares the expression given in the field definition with the
  decompiled expression from the database to determine whether the default
  value needs to be updated in the schema or not. If the expression given by a
  'DefaultValue' is logically equivalent but does not match the decompiled
  form, auto-migration will continue to execute SQL statements to update the
  schema even when it does not need to.

@since 1.0.0.0
-}
rawSqlDefault :: Expr.ValueExpression -> DefaultValue a
rawSqlDefault :: forall a. ValueExpression -> DefaultValue a
rawSqlDefault =
  ValueExpression -> DefaultValue a
forall a. ValueExpression -> DefaultValue a
DefaultValue