{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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
newtype DefaultValue a
= DefaultValue Expr.ValueExpression
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
smallIntegerDefault :: Int16 -> DefaultValue Int16
smallIntegerDefault :: Int16 -> DefaultValue Int16
smallIntegerDefault = Int16 -> DefaultValue Int16
forall n. Integral n => n -> DefaultValue n
integralDefault
integerDefault :: Int32 -> DefaultValue Int32
integerDefault :: Int32 -> DefaultValue Int32
integerDefault = Int32 -> DefaultValue Int32
forall n. Integral n => n -> DefaultValue n
integralDefault
bigIntegerDefault :: Int64 -> DefaultValue Int64
bigIntegerDefault :: Int64 -> DefaultValue Int64
bigIntegerDefault = Int64 -> DefaultValue Int64
forall n. Integral n => n -> DefaultValue n
integralDefault
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
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
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"
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"
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"
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"
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()"
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"
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"
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
defaultValueExpression :: DefaultValue a -> Expr.ValueExpression
defaultValueExpression :: forall a. DefaultValue a -> ValueExpression
defaultValueExpression (DefaultValue ValueExpression
expression) =
ValueExpression
expression
rawSqlDefault :: Expr.ValueExpression -> DefaultValue a
rawSqlDefault :: forall a. ValueExpression -> DefaultValue a
rawSqlDefault =
ValueExpression -> DefaultValue a
forall a. ValueExpression -> DefaultValue a
DefaultValue