{-# LANGUAGE
DataKinds
, DeriveGeneric
, FunctionalDependencies
, LambdaCase
, MultiParamTypeClasses
, OverloadedStrings
, PolyKinds
, RankNTypes
, TypeFamilies
, TypeOperators
, UndecidableInstances
#-}
module Squeal.PostgreSQL.Expression.Time
(
TimeOp (..)
, currentDate
, currentTime
, currentTimestamp
, dateTrunc
, localTime
, localTimestamp
, now
, makeDate
, makeTime
, makeTimestamp
, makeTimestamptz
, atTimeZone
, PGAtTimeZone
, interval_
, TimeUnit (..)
) where
import Data.Fixed
import Data.String
import GHC.TypeLits
import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Type.Schema
currentDate :: Expr (null 'PGdate)
currentDate :: Expression grp lat with db params from (null 'PGdate)
currentDate = ByteString -> Expression grp lat with db params from (null 'PGdate)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
(db :: SchemasType) (params :: [NullType]) (from :: FromType)
(ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression ByteString
"CURRENT_DATE"
currentTime :: Expr (null 'PGtimetz)
currentTime :: Expression grp lat with db params from (null 'PGtimetz)
currentTime = ByteString
-> Expression grp lat with db params from (null 'PGtimetz)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
(db :: SchemasType) (params :: [NullType]) (from :: FromType)
(ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression ByteString
"CURRENT_TIME"
currentTimestamp :: Expr (null 'PGtimestamptz)
currentTimestamp :: Expression grp lat with db params from (null 'PGtimestamptz)
currentTimestamp = ByteString
-> Expression grp lat with db params from (null 'PGtimestamptz)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
(db :: SchemasType) (params :: [NullType]) (from :: FromType)
(ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression ByteString
"CURRENT_TIMESTAMP"
localTime :: Expr (null 'PGtime)
localTime :: Expression grp lat with db params from (null 'PGtime)
localTime = ByteString -> Expression grp lat with db params from (null 'PGtime)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
(db :: SchemasType) (params :: [NullType]) (from :: FromType)
(ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression ByteString
"LOCALTIME"
localTimestamp :: Expr (null 'PGtimestamp)
localTimestamp :: Expression grp lat with db params from (null 'PGtimestamp)
localTimestamp = ByteString
-> Expression grp lat with db params from (null 'PGtimestamp)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
(db :: SchemasType) (params :: [NullType]) (from :: FromType)
(ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression ByteString
"LOCALTIMESTAMP"
now :: Expr (null 'PGtimestamptz)
now :: Expression grp lat with db params from (null 'PGtimestamptz)
now = ByteString
-> Expression grp lat with db params from (null 'PGtimestamptz)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
(db :: SchemasType) (params :: [NullType]) (from :: FromType)
(ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression ByteString
"now()"
makeDate :: '[ null 'PGint4, null 'PGint4, null 'PGint4 ] ---> null 'PGdate
makeDate :: NP
(Expression grp lat with db params from)
'[null 'PGint4, null 'PGint4, null 'PGint4]
-> Expression grp lat with db params from (null 'PGdate)
makeDate = ByteString
-> '[null 'PGint4, null 'PGint4, null 'PGint4] ---> null 'PGdate
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"make_date"
makeTime :: '[ null 'PGint4, null 'PGint4, null 'PGfloat8 ] ---> null 'PGtime
makeTime :: NP
(Expression grp lat with db params from)
'[null 'PGint4, null 'PGint4, null 'PGfloat8]
-> Expression grp lat with db params from (null 'PGtime)
makeTime = ByteString
-> '[null 'PGint4, null 'PGint4, null 'PGfloat8] ---> null 'PGtime
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"make_time"
makeTimestamp ::
'[ null 'PGint4, null 'PGint4, null 'PGint4
, null 'PGint4, null 'PGint4, null 'PGfloat8 ] ---> null 'PGtimestamp
makeTimestamp :: NP
(Expression grp lat with db params from)
'[null 'PGint4, null 'PGint4, null 'PGint4, null 'PGint4,
null 'PGint4, null 'PGfloat8]
-> Expression grp lat with db params from (null 'PGtimestamp)
makeTimestamp = ByteString
-> '[null 'PGint4, null 'PGint4, null 'PGint4, null 'PGint4,
null 'PGint4, null 'PGfloat8]
---> null 'PGtimestamp
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"make_timestamp"
makeTimestamptz ::
'[ null 'PGint4, null 'PGint4, null 'PGint4
, null 'PGint4, null 'PGint4, null 'PGfloat8 ] ---> null 'PGtimestamptz
makeTimestamptz :: NP
(Expression grp lat with db params from)
'[null 'PGint4, null 'PGint4, null 'PGint4, null 'PGint4,
null 'PGint4, null 'PGfloat8]
-> Expression grp lat with db params from (null 'PGtimestamptz)
makeTimestamptz = ByteString
-> '[null 'PGint4, null 'PGint4, null 'PGint4, null 'PGint4,
null 'PGint4, null 'PGfloat8]
---> null 'PGtimestamptz
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"make_timestamptz"
dateTrunc
:: time `In` '[ 'PGtimestamp, 'PGtimestamptz ]
=> TimeUnit -> null time --> null time
dateTrunc :: TimeUnit -> null time --> null time
dateTrunc TimeUnit
tUnit Expression grp lat with db params from (null time)
args = ByteString
-> NP
(Expression grp lat with db params from) '[Any 'PGtext, null time]
-> Expression grp lat with db params from (null time)
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"date_trunc" (Expression grp lat with db params from (Any 'PGtext)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
(db :: SchemasType) (params :: [NullType]) (from :: FromType)
(null0 :: PGType -> NullType).
Expression grp lat with db params from (null0 'PGtext)
timeUnitExpr Expression grp lat with db params from (Any 'PGtext)
-> Expression grp lat with db params from (null time)
-> NP
(Expression grp lat with db params from) '[Any 'PGtext, null time]
forall k (f :: k -> *) (x :: k) (y :: k).
f x -> f y -> NP f '[x, y]
*: Expression grp lat with db params from (null time)
args)
where
timeUnitExpr :: forall grp lat with db params from null0.
Expression grp lat with db params from (null0 'PGtext)
timeUnitExpr :: Expression grp lat with db params from (null0 'PGtext)
timeUnitExpr = ByteString
-> Expression grp lat with db params from (null0 'PGtext)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
(db :: SchemasType) (params :: [NullType]) (from :: FromType)
(ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression (ByteString
-> Expression grp lat with db params from (null0 'PGtext))
-> (TimeUnit -> ByteString)
-> TimeUnit
-> Expression grp lat with db params from (null0 'PGtext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8 (ByteString -> ByteString)
-> (TimeUnit -> ByteString) -> TimeUnit -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeUnit -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL (TimeUnit
-> Expression grp lat with db params from (null0 'PGtext))
-> TimeUnit
-> Expression grp lat with db params from (null0 'PGtext)
forall a b. (a -> b) -> a -> b
$ TimeUnit
tUnit
type family PGAtTimeZone ty where
PGAtTimeZone 'PGtimestamptz = 'PGtimestamp
PGAtTimeZone 'PGtimestamp = 'PGtimestamptz
PGAtTimeZone 'PGtimetz = 'PGtimetz
PGAtTimeZone pg = TypeError
( 'Text "Squeal type error: AT TIME ZONE cannot be applied to "
':<>: 'ShowType pg )
atTimeZone
:: zone `In` '[ 'PGtext, 'PGinterval]
=> Operator (null time) (null zone) (null (PGAtTimeZone time))
atTimeZone :: Operator (null time) (null zone) (null (PGAtTimeZone time))
atTimeZone = ByteString
-> Operator (null time) (null zone) (null (PGAtTimeZone time))
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"AT TIME ZONE"
class TimeOp time diff | time -> diff where
(!+) :: Operator (null time) (null diff) (null time)
(!+) = ByteString -> Operator (null time) (null diff) (null time)
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"+"
(+!) :: Operator (null diff) (null time) (null time)
(+!) = ByteString -> Operator (null diff) (null time) (null time)
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"+"
(!-) :: Operator (null time) (null diff) (null time)
(!-) = ByteString -> Operator (null time) (null diff) (null time)
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"-"
(!-!) :: Operator (null time) (null time) (null diff)
(!-!) = ByteString -> Operator (null time) (null time) (null diff)
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"-"
instance TimeOp 'PGtimestamp 'PGinterval
instance TimeOp 'PGtimestamptz 'PGinterval
instance TimeOp 'PGtime 'PGinterval
instance TimeOp 'PGtimetz 'PGinterval
instance TimeOp 'PGinterval 'PGinterval
instance TimeOp 'PGdate 'PGint4
infixl 6 !+
infixl 6 +!
infixl 6 !-
infixl 6 !-!
data TimeUnit
= Years | Quarter | Months | Weeks | Days
| Hours | Minutes | Seconds
| Microseconds | Milliseconds
| Decades | Centuries | Millennia
deriving (TimeUnit -> TimeUnit -> Bool
(TimeUnit -> TimeUnit -> Bool)
-> (TimeUnit -> TimeUnit -> Bool) -> Eq TimeUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeUnit -> TimeUnit -> Bool
$c/= :: TimeUnit -> TimeUnit -> Bool
== :: TimeUnit -> TimeUnit -> Bool
$c== :: TimeUnit -> TimeUnit -> Bool
Eq, Eq TimeUnit
Eq TimeUnit
-> (TimeUnit -> TimeUnit -> Ordering)
-> (TimeUnit -> TimeUnit -> Bool)
-> (TimeUnit -> TimeUnit -> Bool)
-> (TimeUnit -> TimeUnit -> Bool)
-> (TimeUnit -> TimeUnit -> Bool)
-> (TimeUnit -> TimeUnit -> TimeUnit)
-> (TimeUnit -> TimeUnit -> TimeUnit)
-> Ord TimeUnit
TimeUnit -> TimeUnit -> Bool
TimeUnit -> TimeUnit -> Ordering
TimeUnit -> TimeUnit -> TimeUnit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeUnit -> TimeUnit -> TimeUnit
$cmin :: TimeUnit -> TimeUnit -> TimeUnit
max :: TimeUnit -> TimeUnit -> TimeUnit
$cmax :: TimeUnit -> TimeUnit -> TimeUnit
>= :: TimeUnit -> TimeUnit -> Bool
$c>= :: TimeUnit -> TimeUnit -> Bool
> :: TimeUnit -> TimeUnit -> Bool
$c> :: TimeUnit -> TimeUnit -> Bool
<= :: TimeUnit -> TimeUnit -> Bool
$c<= :: TimeUnit -> TimeUnit -> Bool
< :: TimeUnit -> TimeUnit -> Bool
$c< :: TimeUnit -> TimeUnit -> Bool
compare :: TimeUnit -> TimeUnit -> Ordering
$ccompare :: TimeUnit -> TimeUnit -> Ordering
$cp1Ord :: Eq TimeUnit
Ord, Int -> TimeUnit -> ShowS
[TimeUnit] -> ShowS
TimeUnit -> String
(Int -> TimeUnit -> ShowS)
-> (TimeUnit -> String) -> ([TimeUnit] -> ShowS) -> Show TimeUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeUnit] -> ShowS
$cshowList :: [TimeUnit] -> ShowS
show :: TimeUnit -> String
$cshow :: TimeUnit -> String
showsPrec :: Int -> TimeUnit -> ShowS
$cshowsPrec :: Int -> TimeUnit -> ShowS
Show, ReadPrec [TimeUnit]
ReadPrec TimeUnit
Int -> ReadS TimeUnit
ReadS [TimeUnit]
(Int -> ReadS TimeUnit)
-> ReadS [TimeUnit]
-> ReadPrec TimeUnit
-> ReadPrec [TimeUnit]
-> Read TimeUnit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TimeUnit]
$creadListPrec :: ReadPrec [TimeUnit]
readPrec :: ReadPrec TimeUnit
$creadPrec :: ReadPrec TimeUnit
readList :: ReadS [TimeUnit]
$creadList :: ReadS [TimeUnit]
readsPrec :: Int -> ReadS TimeUnit
$creadsPrec :: Int -> ReadS TimeUnit
Read, Int -> TimeUnit
TimeUnit -> Int
TimeUnit -> [TimeUnit]
TimeUnit -> TimeUnit
TimeUnit -> TimeUnit -> [TimeUnit]
TimeUnit -> TimeUnit -> TimeUnit -> [TimeUnit]
(TimeUnit -> TimeUnit)
-> (TimeUnit -> TimeUnit)
-> (Int -> TimeUnit)
-> (TimeUnit -> Int)
-> (TimeUnit -> [TimeUnit])
-> (TimeUnit -> TimeUnit -> [TimeUnit])
-> (TimeUnit -> TimeUnit -> [TimeUnit])
-> (TimeUnit -> TimeUnit -> TimeUnit -> [TimeUnit])
-> Enum TimeUnit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TimeUnit -> TimeUnit -> TimeUnit -> [TimeUnit]
$cenumFromThenTo :: TimeUnit -> TimeUnit -> TimeUnit -> [TimeUnit]
enumFromTo :: TimeUnit -> TimeUnit -> [TimeUnit]
$cenumFromTo :: TimeUnit -> TimeUnit -> [TimeUnit]
enumFromThen :: TimeUnit -> TimeUnit -> [TimeUnit]
$cenumFromThen :: TimeUnit -> TimeUnit -> [TimeUnit]
enumFrom :: TimeUnit -> [TimeUnit]
$cenumFrom :: TimeUnit -> [TimeUnit]
fromEnum :: TimeUnit -> Int
$cfromEnum :: TimeUnit -> Int
toEnum :: Int -> TimeUnit
$ctoEnum :: Int -> TimeUnit
pred :: TimeUnit -> TimeUnit
$cpred :: TimeUnit -> TimeUnit
succ :: TimeUnit -> TimeUnit
$csucc :: TimeUnit -> TimeUnit
Enum, (forall x. TimeUnit -> Rep TimeUnit x)
-> (forall x. Rep TimeUnit x -> TimeUnit) -> Generic TimeUnit
forall x. Rep TimeUnit x -> TimeUnit
forall x. TimeUnit -> Rep TimeUnit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeUnit x -> TimeUnit
$cfrom :: forall x. TimeUnit -> Rep TimeUnit x
GHC.Generic)
instance SOP.Generic TimeUnit
instance SOP.HasDatatypeInfo TimeUnit
instance RenderSQL TimeUnit where
renderSQL :: TimeUnit -> ByteString
renderSQL = \case
TimeUnit
Years -> ByteString
"years"
TimeUnit
Quarter -> ByteString
"quarter"
TimeUnit
Months -> ByteString
"months"
TimeUnit
Weeks -> ByteString
"weeks"
TimeUnit
Days -> ByteString
"days"
TimeUnit
Hours -> ByteString
"hours"
TimeUnit
Minutes -> ByteString
"minutes"
TimeUnit
Seconds -> ByteString
"seconds"
TimeUnit
Microseconds -> ByteString
"microseconds"
TimeUnit
Milliseconds -> ByteString
"milliseconds"
TimeUnit
Decades -> ByteString
"decades"
TimeUnit
Centuries -> ByteString
"centuries"
TimeUnit
Millennia -> ByteString
"millennia"
interval_ :: Milli -> TimeUnit -> Expr (null 'PGinterval)
interval_ :: Milli -> TimeUnit -> Expr (null 'PGinterval)
interval_ Milli
num TimeUnit
unit = ByteString
-> Expression grp lat with db params from (null 'PGinterval)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
(db :: SchemasType) (params :: [NullType]) (from :: FromType)
(ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression (ByteString
-> Expression grp lat with db params from (null 'PGinterval))
-> (ByteString -> ByteString)
-> ByteString
-> Expression grp lat with db params from (null 'PGinterval)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
parenthesized (ByteString
-> Expression grp lat with db params from (null 'PGinterval))
-> ByteString
-> Expression grp lat with db params from (null 'PGinterval)
forall a b. (a -> b) -> a -> b
$ ByteString
"INTERVAL" ByteString -> ByteString -> ByteString
<+>
ByteString
"'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Milli -> String
forall a. Show a => a -> String
show Milli
num) ByteString -> ByteString -> ByteString
<+> TimeUnit -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL TimeUnit
unit ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"'"