@@ -86,6 +86,11 @@ module Squeal.PostgreSQL.Expression
8686 , currentTimestamp
8787 , localTime
8888 , localTimestamp
89+ , TimeOp (..)
90+ , makeDate
91+ , makeTime
92+ , makeTimestamp
93+ , makeTimestamptz
8994 -- ** Text
9095 , lower
9196 , upper
@@ -208,13 +213,13 @@ import Data.ByteString.Lazy (toStrict)
208213import Data.Function ((&))
209214import Data.Semigroup hiding (All)
210215import qualified Data.Aeson as JSON
211−import Data.Ratio
212216import Data.String
213217import Data.Word
214218import Generics.SOP hiding (All, from)
215219import GHC.Generics ((:*:) (..))
216220import GHC.OverloadedLabels
217221import GHC.TypeLits
222+import Numeric
218223import Prelude hiding (id, (.))
219224
220225import qualified Data.ByteString as ByteString
@@ -636,7 +641,12 @@ instance ty `In` PGNum
636641instance (ty `In` PGNum, ty `In` PGFloating) => Fractional
637642 (Expression outer grp commons schemas params from (nullity ty)) where
638643 (/) = unsafeBinaryOp "/"
639− fromRational x = fromInteger (numerator x) / fromInteger (denominator x)
644+ fromRational
645+ = UnsafeExpression
646+ . fromString
647+ . ($ "")
648+ . showFFloat Nothing
649+ . fromRat @Double
640650
641651instance (ty `In` PGNum, ty `In` PGFloating) => Floating
642652 (Expression outer grp commons schemas params from (nullity ty)) where
@@ -2283,3 +2293,134 @@ nthValue
22832293 -> WindowFunction outer grp commons schemas params from ('Null ty)
22842294nthValue value nth = UnsafeWindowFunction $ "nth_value"
22852295 <> parenthesized (commaSeparated [renderSQL value, renderSQL nth])
2296+
2297+{-|
2298+Create date from year, month and day fields
2299+
2300+>>> printSQL (makeDate 1984 7 3)
2301+make_date(1984, 7, 3)
2302+-}
2303+makeDate
2304+ :: Expression outer grp commons schemas params from (nullity 'PGint4)
2305+ -- ^ year
2306+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2307+ -- ^ month
2308+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2309+ -- ^ day
2310+ -> Expression outer grp commons schemas params from (nullity 'PGdate)
2311+makeDate y m d = UnsafeExpression $ "make_date" <>
2312+ parenthesized (renderCommaSeparated renderSQL (y :* m :* d :* Nil))
2313+
2314+{-|
2315+Create time from hour, minute and seconds fields
2316+
2317+>>> printSQL (makeTime 8 15 23.5)
2318+make_time(8, 15, 23.5)
2319+-}
2320+makeTime
2321+ :: Expression outer grp commons schemas params from (nullity 'PGint4)
2322+ -- ^ hour
2323+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2324+ -- ^ min
2325+ -> Expression outer grp commons schemas params from (nullity 'PGfloat8)
2326+ -- ^ sec
2327+ -> Expression outer grp commons schemas params from (nullity 'PGtime)
2328+makeTime h m s = UnsafeExpression $ "make_time" <>
2329+ parenthesized (renderCommaSeparated renderSQL (h :* m :* s :* Nil))
2330+
2331+{-|
2332+Create timestamp from year, month, day, hour, minute and seconds fields
2333+
2334+>>> printSQL (makeTimestamp 2013 7 15 8 15 23.5)
2335+make_timestamp(2013, 7, 15, 8, 15, 23.5)
2336+-}
2337+makeTimestamp
2338+ :: Expression outer grp commons schemas params from (nullity 'PGint4)
2339+ -- ^ year
2340+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2341+ -- ^ month
2342+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2343+ -- ^ day
2344+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2345+ -- ^ hour
2346+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2347+ -- ^ min
2348+ -> Expression outer grp commons schemas params from (nullity 'PGfloat8)
2349+ -- ^ sec
2350+ -> Expression outer grp commons schemas params from (nullity 'PGtimestamp)
2351+makeTimestamp y mon d h m s =
2352+ UnsafeExpression $ "make_timestamp" <> parenthesized
2353+ (renderCommaSeparated renderSQL (y :* mon :* d :* h :* m :* s :* Nil))
2354+
2355+{-|
2356+Create timestamp with time zone from
2357+year, month, day, hour, minute and seconds fields;
2358+the current time zone is used
2359+
2360+>>> printSQL (makeTimestamptz 2013 7 15 8 15 23.5)
2361+make_timestamptz(2013, 7, 15, 8, 15, 23.5)
2362+-}
2363+makeTimestamptz
2364+ :: Expression outer grp commons schemas params from (nullity 'PGint4)
2365+ -- ^ year
2366+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2367+ -- ^ month
2368+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2369+ -- ^ day
2370+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2371+ -- ^ hour
2372+ -> Expression outer grp commons schemas params from (nullity 'PGint4)
2373+ -- ^ min
2374+ -> Expression outer grp commons schemas params from (nullity 'PGfloat8)
2375+ -- ^ sec
2376+ -> Expression outer grp commons schemas params from (nullity 'PGtimestamptz)
2377+makeTimestamptz y mon d h m s =
2378+ UnsafeExpression $ "make_timestamptz" <> parenthesized
2379+ (renderCommaSeparated renderSQL (y :* mon :* d :* h :* m :* s :* Nil))
2380+
2381+{-|
2382+Affine space operations on time types.
2383+-}
2384+class TimeOp time diff | time -> diff where
2385+ {-|
2386+ >>> printSQL (makeDate 1984 7 3 !+ 365)
2387+ (make_date(1984, 7, 3) + 365)
2388+ -}
2389+ (!+)
2390+ :: Expression outer grp commons schemas params from (nullity time)
2391+ -> Expression outer grp commons schemas params from (nullity diff)
2392+ -> Expression outer grp commons schemas params from (nullity time)
2393+ (!+) = unsafeBinaryOp "+"
2394+ {-|
2395+ >>> printSQL (365 +! makeDate 1984 7 3)
2396+ (365 + make_date(1984, 7, 3))
2397+ -}
2398+ (+!)
2399+ :: Expression outer grp commons schemas params from (nullity diff)
2400+ -> Expression outer grp commons schemas params from (nullity time)
2401+ -> Expression outer grp commons schemas params from (nullity time)
2402+ (+!) = unsafeBinaryOp "+"
2403+ {-|
2404+ >>> printSQL (makeDate 1984 7 3 !- 365)
2405+ (make_date(1984, 7, 3) - 365)
2406+ -}
2407+ (!-)
2408+ :: Expression outer grp commons schemas params from (nullity time)
2409+ -> Expression outer grp commons schemas params from (nullity diff)
2410+ -> Expression outer grp commons schemas params from (nullity time)
2411+ (!-) = unsafeBinaryOp "-"
2412+ {-|
2413+ >>> printSQL (makeDate 1984 7 3 !-! currentDate)
2414+ (make_date(1984, 7, 3) - CURRENT_DATE)
2415+ -}
2416+ (!-!)
2417+ :: Expression outer grp commons schemas params from (nullity time)
2418+ -> Expression outer grp commons schemas params from (nullity time)
2419+ -> Expression outer grp commons schemas params from (nullity diff)
2420+ (!-!) = unsafeBinaryOp "-"
2421+instance TimeOp 'PGtimestamp 'PGinterval
2422+instance TimeOp 'PGtimestamptz 'PGinterval
2423+instance TimeOp 'PGtime 'PGinterval
2424+instance TimeOp 'PGtimetz 'PGinterval
2425+instance TimeOp 'PGinterval 'PGinterval
2426+instance TimeOp 'PGdate 'PGint4