{-# LANGUAGE
DataKinds
, DeriveGeneric
, FunctionalDependencies
, LambdaCase
, MultiParamTypeClasses
, OverloadedStrings
, PolyKinds
, RankNTypes
#-}
module Squeal.PostgreSQL.Expression.Time
( TimeOp (..)
, currentDate
, currentTime
, currentTimestamp
, localTime
, localTimestamp
, now
, makeDate
, makeTime
, makeTimestamp
, makeTimestamptz
, interval_
, TimeUnit (..)
) where
import Data.String
import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Schema
currentDate :: Expr (null 'PGdate)
currentDate = UnsafeExpression "CURRENT_DATE"
currentTime :: Expr (null 'PGtimetz)
currentTime = UnsafeExpression "CURRENT_TIME"
currentTimestamp :: Expr (null 'PGtimestamptz)
currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"
localTime :: Expr (null 'PGtime)
localTime = UnsafeExpression "LOCALTIME"
localTimestamp :: Expr (null 'PGtimestamp)
localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
now :: Expr (null 'PGtimestamptz)
now = UnsafeExpression "now()"
makeDate :: FunctionN
'[ null 'PGint4, null 'PGint4, null 'PGint4 ]
( null 'PGdate )
makeDate = unsafeFunctionN "make_date"
makeTime :: FunctionN
'[ null 'PGint4, null 'PGint4, null 'PGfloat8 ]
( null 'PGtime )
makeTime = unsafeFunctionN "make_time"
makeTimestamp :: FunctionN
'[ null 'PGint4, null 'PGint4, null 'PGint4
, null 'PGint4, null 'PGint4, null 'PGfloat8 ]
( null 'PGtimestamp )
makeTimestamp = unsafeFunctionN "make_timestamp"
makeTimestamptz :: FunctionN
'[ null 'PGint4, null 'PGint4, null 'PGint4
, null 'PGint4, null 'PGint4, null 'PGfloat8 ]
( null 'PGtimestamptz )
makeTimestamptz = unsafeFunctionN "make_timestamptz"
class TimeOp time diff | time -> diff where
(!+) :: Operator (null time) (null diff) (null time)
(!+) = unsafeBinaryOp "+"
(+!) :: Operator (null diff) (null time) (null time)
(+!) = unsafeBinaryOp "+"
(!-) :: Operator (null time) (null diff) (null time)
(!-) = unsafeBinaryOp "-"
(!-!) :: Operator (null time) (null time) (null diff)
(!-!) = unsafeBinaryOp "-"
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 | Months | Weeks | Days
| Hours | Minutes | Seconds
| Microseconds | Milliseconds
| Decades | Centuries | Millennia
deriving (Eq, Ord, Show, Read, Enum, GHC.Generic)
instance SOP.Generic TimeUnit
instance SOP.HasDatatypeInfo TimeUnit
instance RenderSQL TimeUnit where
renderSQL = \case
Years -> "years"
Months -> "months"
Weeks -> "weeks"
Days -> "days"
Hours -> "hours"
Minutes -> "minutes"
Seconds -> "seconds"
Microseconds -> "microseconds"
Milliseconds -> "milliseconds"
Decades -> "decades"
Centuries -> "centuries"
Millennia -> "millennia"
interval_ :: Double -> TimeUnit -> Expr (null 'PGinterval)
interval_ num unit = UnsafeExpression . parenthesized $ "INTERVAL" <+>
"'" <> fromString (show num) <+> renderSQL unit <> "'"