git.iko.soy/rel8
on ca7aaef help sign in
rel8/src/Rel8/Expr/Time.hs
167 lines 3.9 kB history raw
1module Rel8.Expr.Time
2 ( -- * Working with @Day@
3 today
4 , toDay
5 , fromDay
6 , addDays
7 , diffDays
8 , subtractDays
10 -- * Working with @UTCTime@
11 , now
12 , addTime
13 , diffTime
14 , subtractTime
16 -- * Working with @CalendarDiffTime@
17 , scaleInterval
18 , second, seconds
19 , minute, minutes
20 , hour, hours
21 , day, days
22 , week, weeks
23 , month, months
24 , year, years
25 ) where
27-- base
28import Data.Int ( Int32 )
29import Prelude
31-- rel8
32import Rel8.Expr ( Expr )
33import Rel8.Expr.Function ( binaryOperator, nullaryFunction )
34import Rel8.Expr.Opaleye ( unsafeCastExpr, unsafeLiteral )
36-- time
37import Data.Time.Calendar ( Day )
38import Data.Time.Clock ( UTCTime )
39import Data.Time.LocalTime ( CalendarDiffTime )
42-- | Corresponds to @date(now())@.
43today :: Expr Day
44today = toDay now
47-- | Corresponds to calling the @date@ function with a given time.
48toDay :: Expr UTCTime -> Expr Day
49toDay = unsafeCastExpr
52-- | Corresponds to @x::timestamptz@.
53fromDay :: Expr Day -> Expr UTCTime
54fromDay = unsafeCastExpr
57-- | Move forward a given number of days from a particular day.
58addDays :: Expr Int32 -> Expr Day -> Expr Day
59addDays = flip (binaryOperator "+")
62-- | Find the number of days between two days. Corresponds to the @-@ operator.
63diffDays :: Expr Day -> Expr Day -> Expr Int32
64diffDays = binaryOperator "-"
67-- | Subtract a given number of days from a particular 'Day'.
68subtractDays :: Expr Int32 -> Expr Day -> Expr Day
69subtractDays = flip (binaryOperator "-")
72-- | Corresponds to @now()@.
73now :: Expr UTCTime
74now = nullaryFunction "now"
77-- | Add a time interval to a point in time, yielding a new point in time.
78addTime :: Expr CalendarDiffTime -> Expr UTCTime -> Expr UTCTime
79addTime = flip (binaryOperator "+")
82-- | Find the duration between two times.
83diffTime :: Expr UTCTime -> Expr UTCTime -> Expr CalendarDiffTime
84diffTime = binaryOperator "-"
87-- | Subtract a time interval from a point in time, yielding a new point in time.
88subtractTime :: Expr CalendarDiffTime -> Expr UTCTime -> Expr UTCTime
89subtractTime = flip (binaryOperator "-")
92scaleInterval :: Expr Double -> Expr CalendarDiffTime -> Expr CalendarDiffTime
93scaleInterval = binaryOperator "*"
96-- | An interval of one second.
97second :: Expr CalendarDiffTime
98second = singleton "second"
101-- | Create a literal interval from a number of seconds.
102seconds :: Expr Double -> Expr CalendarDiffTime
103seconds = (`scaleInterval` second)
106-- | An interval of one minute.
107minute :: Expr CalendarDiffTime
108minute = singleton "minute"
111-- | Create a literal interval from a number of minutes.
112minutes :: Expr Double -> Expr CalendarDiffTime
113minutes = (`scaleInterval` minute)
116-- | An interval of one hour.
117hour :: Expr CalendarDiffTime
118hour = singleton "hour"
121-- | Create a literal interval from a number of hours.
122hours :: Expr Double -> Expr CalendarDiffTime
123hours = (`scaleInterval` hour)
126-- | An interval of one day.
127day :: Expr CalendarDiffTime
128day = singleton "day"
131-- | Create a literal interval from a number of days.
132days :: Expr Double -> Expr CalendarDiffTime
133days = (`scaleInterval` day)
136-- | An interval of one week.
137week :: Expr CalendarDiffTime
138week = singleton "week"
141-- | Create a literal interval from a number of weeks.
142weeks :: Expr Double -> Expr CalendarDiffTime
143weeks = (`scaleInterval` week)
146-- | An interval of one month.
147month :: Expr CalendarDiffTime
148month = singleton "month"
151-- | Create a literal interval from a number of months.
152months :: Expr Double -> Expr CalendarDiffTime
153months = (`scaleInterval` month)
156-- | An interval of one year.
157year :: Expr CalendarDiffTime
158year = singleton "year"
161-- | Create a literal interval from a number of years.
162years :: Expr Double -> Expr CalendarDiffTime
163years = (`scaleInterval` year)
166singleton :: String -> Expr CalendarDiffTime
167singleton unit = unsafeLiteral $ "'1 " ++ unit ++ "'"