{-|
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
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Expression.Time
  ( -- * Time Operation
    TimeOp (..)
    -- * Time Function
  , currentDate
  , currentTime
  , currentTimestamp
  , dateTrunc
  , localTime
  , localTimestamp
  , now
  , makeDate
  , makeTime
  , makeTimestamp
  , makeTimestamptz
  , atTimeZone
  , PGAtTimeZone
    -- * Interval
  , 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

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

-- | >>> printSQL currentDate
-- CURRENT_DATE
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"

-- | >>> printSQL currentTime
-- CURRENT_TIME
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"

-- | >>> printSQL currentTimestamp
-- CURRENT_TIMESTAMP
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"

-- | >>> printSQL localTime
-- LOCALTIME
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"

-- | >>> printSQL localTimestamp
-- LOCALTIMESTAMP
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"

-- | Current date and time (equivalent to `currentTimestamp`)
--
-- >>> printSQL now
-- now()
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()"

{-|
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 :: 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"

{-|
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 :: 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"

{-|
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 :: 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"

{-|
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 :: 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"

{-|
Truncate a timestamp with the specified precision

>>> printSQL $ dateTrunc Quarter (makeTimestamp (2010 :* 5 :* 6 :* 14 :* 45 *: 11.4))
date_trunc('quarter', make_timestamp((2010 :: int4), (5 :: int4), (6 :: int4), (14 :: int4), (45 :: int4), (11.4 :: float8)))
-}
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

-- | Calculate the return time type of the `atTimeZone` `Operator`.
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 )

{-|
Convert a timestamp, timestamp with time zone, or time of day with timezone to a different timezone using an interval offset or specific timezone denoted by text. When using the interval offset, the interval duration must be less than one day or 24 hours.

>>> printSQL $ (makeTimestamp (2009 :* 7 :* 22 :* 19 :* 45 *: 11.4)) `atTimeZone` (interval_ 8 Hours)
(make_timestamp((2009 :: int4), (7 :: int4), (22 :: int4), (19 :: int4), (45 :: int4), (11.4 :: float8)) AT TIME ZONE (INTERVAL '8.000 hours'))

>>> :{
 let
   timezone :: Expr (null 'PGtext)
   timezone = "EST"
 in printSQL $ (makeTimestamptz (2015 :* 9 :* 15 :* 4 :* 45 *: 11.4)) `atTimeZone` timezone
:}
(make_timestamptz((2015 :: int4), (9 :: int4), (15 :: int4), (4 :: int4), (45 :: int4), (11.4 :: float8)) AT TIME ZONE (E'EST' :: text))
-}
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"

{-|
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)
  (!+) = ByteString -> Operator (null time) (null diff) (null time)
forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"+"
  {-|
  >>> printSQL (365 +! makeDate (1984 :* 7 *: 3))
  ((365 :: int4) + make_date((1984 :: int4), (7 :: int4), (3 :: int4)))
  -}
  (+!) :: 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
"+"
  {-|
  >>> printSQL (makeDate (1984 :* 7 *: 3) !- 365)
  (make_date((1984 :: int4), (7 :: int4), (3 :: int4)) - (365 :: int4))
  -}
  (!-) :: 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
"-"
  {-|
  >>> printSQL (makeDate (1984 :* 7 *: 3) !-! currentDate)
  (make_date((1984 :: int4), (7 :: int4), (3 :: int4)) - CURRENT_DATE)
  -}
  (!-!) :: 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 !-!

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

-- | >>> printSQL $ interval_ 7 Days
-- (INTERVAL '7.000 days')
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
"'"