mirror of
https://github.com/circuithub/rel8.git
synced 2024-09-11 16:05:41 +03:00
Restore Rel8.Time
This commit is contained in:
parent
3f94330a35
commit
eb6adcc1d3
@ -33,6 +33,7 @@ library
|
|||||||
exposed-modules:
|
exposed-modules:
|
||||||
Rel8
|
Rel8
|
||||||
Rel8.Text
|
Rel8.Text
|
||||||
|
Rel8.Time
|
||||||
other-modules:
|
other-modules:
|
||||||
Rel8.Optimize
|
Rel8.Optimize
|
||||||
|
|
||||||
|
13
src/Rel8.hs
13
src/Rel8.hs
@ -56,7 +56,9 @@ module Rel8
|
|||||||
|
|
||||||
-- * Expressions
|
-- * Expressions
|
||||||
, Expr
|
, Expr
|
||||||
|
, unsafeCastExpr
|
||||||
, unsafeCoerceExpr
|
, unsafeCoerceExpr
|
||||||
|
, unsafeLiteral
|
||||||
, binaryOperator
|
, binaryOperator
|
||||||
|
|
||||||
-- ** @null@
|
-- ** @null@
|
||||||
@ -458,11 +460,22 @@ columnToExpr :: Opaleye.Column b -> Expr a
|
|||||||
columnToExpr (Opaleye.Column a) = Expr a
|
columnToExpr (Opaleye.Column a) = Expr a
|
||||||
|
|
||||||
|
|
||||||
|
-- | Cast an @Expr@ from one type to another.
|
||||||
|
unsafeCastExpr :: String -> Expr a -> Expr b
|
||||||
|
unsafeCastExpr t (Expr x) = Expr $ Opaleye.CastExpr t x
|
||||||
|
|
||||||
|
|
||||||
-- | Unsafely treat an 'Expr' that returns @a@s as returning @b@s.
|
-- | Unsafely treat an 'Expr' that returns @a@s as returning @b@s.
|
||||||
unsafeCoerceExpr :: Expr a -> Expr b
|
unsafeCoerceExpr :: Expr a -> Expr b
|
||||||
unsafeCoerceExpr (Expr x) = Expr x
|
unsafeCoerceExpr (Expr x) = Expr x
|
||||||
|
|
||||||
|
|
||||||
|
-- | Construct a SQL expression from some literal text. The provided literal
|
||||||
|
-- will be interpolated exactly as specified with no escaping.
|
||||||
|
unsafeLiteral :: forall a. String -> Expr a
|
||||||
|
unsafeLiteral = columnToExpr @a @a . Opaleye.Column . Opaleye.ConstExpr . Opaleye.OtherLit
|
||||||
|
|
||||||
|
|
||||||
-- | Construct an expression by applying an infix binary operator to two
|
-- | Construct an expression by applying an infix binary operator to two
|
||||||
-- operands.
|
-- operands.
|
||||||
binaryOperator :: String -> Expr a -> Expr b -> Expr c
|
binaryOperator :: String -> Expr a -> Expr b -> Expr c
|
||||||
|
124
src/Rel8/Time.hs
Normal file
124
src/Rel8/Time.hs
Normal file
@ -0,0 +1,124 @@
|
|||||||
|
module Rel8.Time
|
||||||
|
( -- * Working with @Day@
|
||||||
|
today
|
||||||
|
, toDay
|
||||||
|
, fromDay
|
||||||
|
, addDays
|
||||||
|
, diffDays
|
||||||
|
, subtractDays
|
||||||
|
|
||||||
|
-- * Working with @UTCTime@
|
||||||
|
, now
|
||||||
|
, addTime
|
||||||
|
, diffTime
|
||||||
|
, subtractTime
|
||||||
|
|
||||||
|
-- Working with @NominalDiffTime@
|
||||||
|
, seconds
|
||||||
|
, minutes
|
||||||
|
, hours
|
||||||
|
, days
|
||||||
|
, months
|
||||||
|
, years
|
||||||
|
) where
|
||||||
|
|
||||||
|
-- base
|
||||||
|
import Data.Int ( Int32 )
|
||||||
|
|
||||||
|
-- rel8
|
||||||
|
import Rel8
|
||||||
|
( Expr
|
||||||
|
, binaryOperator
|
||||||
|
, function
|
||||||
|
, unsafeCastExpr
|
||||||
|
, unsafeLiteral, nullaryFunction
|
||||||
|
)
|
||||||
|
|
||||||
|
-- time
|
||||||
|
import Data.Time.Calendar ( Day )
|
||||||
|
import Data.Time.Clock ( UTCTime, NominalDiffTime )
|
||||||
|
|
||||||
|
|
||||||
|
-- | Corresponds to @date(now())@.
|
||||||
|
today :: Expr Day
|
||||||
|
today = toDay now
|
||||||
|
|
||||||
|
|
||||||
|
-- | Corresponds to calling the @date@ function with a given time.
|
||||||
|
toDay :: Expr UTCTime -> Expr Day
|
||||||
|
toDay = function "date"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Corresponds to @x::timestamptz@.
|
||||||
|
fromDay :: Expr Day -> Expr UTCTime
|
||||||
|
fromDay = unsafeCastExpr "timestamptz"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Move forward a given number of days from a particular day.
|
||||||
|
addDays :: Expr Int32 -> Expr Day -> Expr Day
|
||||||
|
addDays = flip (binaryOperator "+")
|
||||||
|
|
||||||
|
|
||||||
|
-- | Find the number of days between two days. Corresponds to the @-@ operator.
|
||||||
|
diffDays :: Expr Day -> Expr Day -> Expr Int32
|
||||||
|
diffDays = binaryOperator "-"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Subtract a given number of days from a particular 'Day'.
|
||||||
|
subtractDays :: Expr Int32 -> Expr Day -> Expr Day
|
||||||
|
subtractDays = flip (binaryOperator "-")
|
||||||
|
|
||||||
|
|
||||||
|
-- | Corresponds to @now()@.
|
||||||
|
now :: Expr UTCTime
|
||||||
|
now = nullaryFunction "now"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Add a time interval to a point in time, yielding a new point in time.
|
||||||
|
addTime :: Expr NominalDiffTime -> Expr UTCTime -> Expr UTCTime
|
||||||
|
addTime = flip (binaryOperator "+")
|
||||||
|
|
||||||
|
|
||||||
|
-- | Find the duration between two times.
|
||||||
|
diffTime :: Expr UTCTime -> Expr UTCTime -> Expr NominalDiffTime
|
||||||
|
diffTime = binaryOperator "-"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Subtract a time interval from a point in time, yielding a new point in time.
|
||||||
|
subtractTime :: Expr NominalDiffTime -> Expr UTCTime -> Expr UTCTime
|
||||||
|
subtractTime = flip (binaryOperator "-")
|
||||||
|
|
||||||
|
|
||||||
|
-- | Create a literal interval from an integral number of seconds.
|
||||||
|
seconds :: Int -> Expr NominalDiffTime
|
||||||
|
seconds = interval "seconds"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Create a literal interval from an integral number of minutes.
|
||||||
|
minutes :: Int -> Expr NominalDiffTime
|
||||||
|
minutes = interval "minutes"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Create a literal interval from an integral number of hours.
|
||||||
|
hours :: Int -> Expr NominalDiffTime
|
||||||
|
hours = interval "hours"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Create a literal interval from an integral number of days.
|
||||||
|
days :: Int -> Expr NominalDiffTime
|
||||||
|
days = interval "days"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Create a literal interval from an integral number of months.
|
||||||
|
months :: Int -> Expr NominalDiffTime
|
||||||
|
months = interval "months"
|
||||||
|
|
||||||
|
|
||||||
|
-- | Create a literal interval from an integral number of years.
|
||||||
|
years :: Int -> Expr NominalDiffTime
|
||||||
|
years = interval "years"
|
||||||
|
|
||||||
|
|
||||||
|
interval :: String -> Int -> Expr NominalDiffTime
|
||||||
|
interval unit quantity =
|
||||||
|
unsafeLiteral ("interval '" ++ show quantity ++ " " ++ unit ++ "'")
|
Loading…
Reference in New Issue
Block a user