Time.hs

{-|
Module: Squeal.PostgreSQL.Expression.Time
Description: date/time functions and operators
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

date/time functions and operators
-}

{-# LANGUAGE
    DataKinds
  , DeriveGeneric
  , FunctionalDependencies
  , LambdaCase
  , MultiParamTypeClasses
  , OverloadedStrings
  , PolyKinds
  , RankNTypes
  , TypeOperators
#-}

module Squeal.PostgreSQL.Expression.Time
  ( -- * Time Operation
    TimeOp (..)
    -- * Time Function
  , currentDate
  , currentTime
  , currentTimestamp
  , localTime
  , localTimestamp
  , now
  , makeDate
  , makeTime
  , makeTimestamp
  , makeTimestamptz
    -- * Interval
  , interval_
  , TimeUnit (..)
  ) where

import Data.Fixed
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.Type.Schema

-- $setup
-- >>> import Squeal.PostgreSQL

-- | >>> printSQL currentDate
-- CURRENT_DATE
currentDate :: Expr (null 'PGdate)
currentDate = UnsafeExpression "CURRENT_DATE"

-- | >>> printSQL currentTime
-- CURRENT_TIME
currentTime :: Expr (null 'PGtimetz)
currentTime = UnsafeExpression "CURRENT_TIME"

-- | >>> printSQL currentTimestamp
-- CURRENT_TIMESTAMP
currentTimestamp :: Expr (null 'PGtimestamptz)
currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"

-- | >>> printSQL localTime
-- LOCALTIME
localTime :: Expr (null 'PGtime)
localTime = UnsafeExpression "LOCALTIME"

-- | >>> printSQL localTimestamp
-- LOCALTIMESTAMP
localTimestamp :: Expr (null 'PGtimestamp)
localTimestamp = UnsafeExpression "LOCALTIMESTAMP"

-- | Current date and time (equivalent to `currentTimestamp`)
--
-- >>> printSQL now
-- now()
now :: Expr (null 'PGtimestamptz)
now = UnsafeExpression "now()"

{-|
Create date from year, month and day fields

>>> printSQL (makeDate (1984 :* 7 *: 3))
make_date((1984 :: int4), (7 :: int4), (3 :: int4))
-}
makeDate :: '[ null 'PGint4, null 'PGint4, null 'PGint4 ] ---> null 'PGdate
makeDate = unsafeFunctionN "make_date"

{-|
Create time from hour, minute and seconds fields

>>> printSQL (makeTime (8 :* 15 *: 23.5))
make_time((8 :: int4), (15 :: int4), (23.5 :: float8))
-}
makeTime :: '[ null 'PGint4, null 'PGint4, null 'PGfloat8 ] ---> null 'PGtime
makeTime = unsafeFunctionN "make_time"

{-|
Create timestamp from year, month, day, hour, minute and seconds fields

>>> printSQL (makeTimestamp (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
make_timestamp((2013 :: int4), (7 :: int4), (15 :: int4), (8 :: int4), (15 :: int4), (23.5 :: float8))
-}
makeTimestamp ::
  '[ null 'PGint4, null 'PGint4, null 'PGint4
   , null 'PGint4, null 'PGint4, null 'PGfloat8 ] ---> null 'PGtimestamp
makeTimestamp = unsafeFunctionN "make_timestamp"

{-|
Create timestamp with time zone from
year, month, day, hour, minute and seconds fields;
the current time zone is used

>>> printSQL (makeTimestamptz (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
make_timestamptz((2013 :: int4), (7 :: int4), (15 :: int4), (8 :: int4), (15 :: int4), (23.5 :: float8))
-}
makeTimestamptz ::
  '[ null 'PGint4, null 'PGint4, null 'PGint4
   , null 'PGint4, null 'PGint4, null 'PGfloat8 ] ---> null 'PGtimestamptz
makeTimestamptz = unsafeFunctionN "make_timestamptz"

{-|
Affine space operations on time types.
-}
class TimeOp time diff | time -> diff where
  {-|
  >>> printSQL (makeDate (1984 :* 7 *: 3) !+ 365)
  (make_date((1984 :: int4), (7 :: int4), (3 :: int4)) + (365 :: int4))
  -}
  (!+) :: Operator (null time) (null diff) (null time)
  (!+) = unsafeBinaryOp "+"
  {-|
  >>> printSQL (365 +! makeDate (1984 :* 7 *: 3))
  ((365 :: int4) + make_date((1984 :: int4), (7 :: int4), (3 :: int4)))
  -}
  (+!) :: Operator (null diff) (null time) (null time)
  (+!) = unsafeBinaryOp "+"
  {-|
  >>> printSQL (makeDate (1984 :* 7 *: 3) !- 365)
  (make_date((1984 :: int4), (7 :: int4), (3 :: int4)) - (365 :: int4))
  -}
  (!-) :: Operator (null time) (null diff) (null time)
  (!-) = unsafeBinaryOp "-"
  {-|
  >>> printSQL (makeDate (1984 :* 7 *: 3) !-! currentDate)
  (make_date((1984 :: int4), (7 :: int4), (3 :: int4)) - CURRENT_DATE)
  -}
  (!-!) :: 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 !-!

-- | A `TimeUnit` to use in `interval_` construction.
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"

-- | >>> printSQL $ interval_ 7 Days
-- (INTERVAL '7.000 days')
interval_ :: Milli -> TimeUnit -> Expr (null 'PGinterval)
interval_ num unit = UnsafeExpression . parenthesized $ "INTERVAL" <+>
  "'" <> fromString (show num) <+> renderSQL unit <> "'"