@@ -1,6 +1,7 @@
11{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
22{-# LANGUAGE
33 DataKinds
4+ , FlexibleContexts
45 , FlexibleInstances
56 , FunctionalDependencies
67 , GADTs
@@ -180,6 +181,14 @@ instance (PGFloating ty, PGCast 'PGNumeric ty, PGTyped ty)
180181 acosh x = log (x + sqrt (x*x - 1))
181182 atanh x = log ((1 + x) / (1 - x)) / 2
182183
184+atan2
185+ :: PGFloating float
186+ => Expression params tables ('Required (nullity float))
187+ -> Expression params tables ('Required (nullity float))
188+ -> Expression params tables ('Required (nullity float))
189+atan2 y x = UnsafeExpression $
190+ "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
191+
183192class PGCast (ty0 :: PGType) (ty1 :: PGType) where
184193 cast
185194 :: TypeExpression ('Required ('Null ty1))
@@ -200,52 +209,52 @@ instance PGCast 'PGInt8 'PGFloat4
200209instance PGCast 'PGInt8 'PGFloat8
201210instance PGCast 'PGInt8 'PGNumeric
202211
203−-- instance (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty)
204−-- => NumB (Expression params tables ('Required (nullity ty))) where
205−-- type IntegerOf (Expression params tables ('Required (nullity ty)))
206−-- = (Expression params tables ('Required (nullity 'PGInt8)))
207−-- fromIntegerB = cast pgtype
208−
209−-- instance (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty, PGCast ty 'PGInt8)
210−-- => IntegralB (Expression params tables ('Required ('NotNull ty))) where
211−-- quot = unsafeBinaryOp "/"
212−-- rem = unsafeBinaryOp "%"
213−-- div = unsafeBinaryOp "/"
214−-- mod = unsafeBinaryOp "%"
215−-- toIntegerB = cast int8
216−
217−-- instance
218−-- ( IntegerOf (Expression params tables ('Required ('NotNull ty)))
219−-- ~ (Expression params tables ('Required ('NotNull 'PGInt8)))
220−-- , PGNum ty
221−-- , PGTyped ty
222−-- , PGCast 'PGInt8 ty
223−-- , PGFractional ty
224−-- )
225−-- => RealFracB (Expression params tables ('Required ('NotNull ty))) where
226−-- properFraction x = (truncate x, x - unsafeFunction "trunc" x)
227−-- truncate = fromIntegerB . unsafeFunction "trunc"
228−-- round = fromIntegerB . unsafeFunction "round"
229−-- ceiling = fromIntegerB . unsafeFunction "ceiling"
230−-- floor = fromIntegerB . unsafeFunction "floor"
231−
232−-- instance
233−-- ( IntegerOf (Expression params tables ('Required ('NotNull ty)))
234−-- ~ (Expression params tables ('Required ('NotNull 'PGInt8)))
235−-- , PGNum ty
236−-- , PGTyped ty
237−-- , PGCast 'PGInt8 ty
238−-- , PGCast 'PGNumeric ty
239−-- , PGFloating ty
240−-- )
241−-- => RealFloatB (Expression params tables ('Required ('NotNull ty))) where
242−-- isNaN x = x ==* UnsafeExpression "\'NaN\'"
243−-- isInfinite x = x ==* UnsafeExpression "\'Infinity\'"
244−-- ||* x ==* UnsafeExpression "\'-Infinity\'"
245−-- isNegativeZero x = x ==* UnsafeExpression "-0"
246−-- isIEEE _ = true
247−-- atan2 y x = UnsafeExpression $
248−-- "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
212+div
213+ :: (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty, PGCast ty 'PGInt8)
214+ => Expression params tables ('Required (nullity ty))
215+ -> Expression params tables ('Required (nullity ty))
216+ -> Expression params tables ('Required (nullity ty))
217+div = unsafeBinaryOp "/"
218+
219+mod
220+ :: (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty, PGCast ty 'PGInt8)
221+ => Expression params tables ('Required (nullity ty))
222+ -> Expression params tables ('Required (nullity ty))
223+ -> Expression params tables ('Required (nullity ty))
224+mod = unsafeBinaryOp "%"
225+
226+truncate
227+ :: (PGFractional frac, PGCast 'PGInt4 int, PGTyped int)
228+ => Expression params tables ('Required (nullity frac))
229+ -> Expression params tables ('Required (nullity int))
230+truncate = cast pgtype . truncate'
231+ where
232+ truncate'
233+ :: Expression params tables ('Required (nullity frac))
234+ -> Expression params tables ('Required (nullity 'PGInt4))
235+ truncate' = unsafeFunction "trunc"
236+
237+round
238+ :: (PGFractional frac, PGCast 'PGInt4 int, PGTyped int)
239+ => Expression params tables ('Required (nullity frac))
240+ -> Expression params tables ('Required (nullity int))
241+round = cast pgtype . round'
242+ where
243+ round'
244+ :: Expression params tables ('Required (nullity frac))
245+ -> Expression params tables ('Required (nullity 'PGInt4))
246+ round' = unsafeFunction "round"
247+
248+ceiling
249+ :: (PGFractional frac, PGCast 'PGInt4 int, PGTyped int)
250+ => Expression params tables ('Required (nullity frac))
251+ -> Expression params tables ('Required (nullity int))
252+ceiling = cast pgtype . ceiling'
253+ where
254+ ceiling'
255+ :: Expression params tables ('Required (nullity frac))
256+ -> Expression params tables ('Required (nullity 'PGInt4))
257+ ceiling' = unsafeFunction "ceiling"
249258
250259instance IsString (Expression params tables ('Required (nullity 'PGText))) where
251260 fromString str = UnsafeExpression $
@@ -262,31 +271,33 @@ instance IsString (Expression params tables ('Required (nullity 'PGText))) where
262271 '\\' -> "\\\\"
263272 c -> [c]
264273
265−-- instance Boolean (Expression params tables ('Required ('NotNull 'PGBool))) where
266−true :: Expression params tables ('Required ('NotNull 'PGBool))
274+type Predicate params tables = Expression params tables ('Required ('NotNull 'PGBool))
275+
276+true :: Predicate params tables
267277true = UnsafeExpression "TRUE"
268−false :: Expression params tables ('Required ('NotNull 'PGBool))
278+
279+false :: Predicate params tables
269280false = UnsafeExpression "FALSE"
281+
270282notB
271− :: Expression params tables ('Required ('NotNull 'PGBool))
272− -> Expression params tables ('Required ('NotNull 'PGBool))
283+ :: Predicate params tables
284+ -> Predicate params tables
273285notB = unsafeUnaryOp "NOT"
286+
274287(&&*)
275− :: Expression params tables ('Required ('NotNull 'PGBool))
276− -> Expression params tables ('Required ('NotNull 'PGBool))
277− -> Expression params tables ('Required ('NotNull 'PGBool))
288+ :: Predicate params tables
289+ -> Predicate params tables
290+ -> Predicate params tables
278291(&&*) = unsafeBinaryOp "AND"
292+
279293(||*)
280− :: Expression params tables ('Required ('NotNull 'PGBool))
281− -> Expression params tables ('Required ('NotNull 'PGBool))
282− -> Expression params tables ('Required ('NotNull 'PGBool))
294+ :: Predicate params tables
295+ -> Predicate params tables
296+ -> Predicate params tables
283297(||*) = unsafeBinaryOp "OR"
284298
285−-- type instance BooleanOf (Expression params tables ty) =
286−-- Expression params tables ('Required ('NotNull 'PGBool))
287−
288299caseWhenThenElse
289− :: [(Expression params tables ('Required ('NotNull 'PGBool)), Expression params tables ty)]
300+ :: [(Predicate params tables, Expression params tables ty)]
290301 -> Expression params tables ty
291302 -> Expression params tables ty
292303caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
@@ -302,46 +313,47 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
302313 , " END"
303314 ]
304315
305−-- instance IfB (Expression params tables ty) where
306316ifThenElse
307− :: Expression params tables ('Required ('NotNull 'PGBool))
317+ :: Predicate params tables
308318 -> Expression params tables ty
309319 -> Expression params tables ty
310320 -> Expression params tables ty
311321ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
312322
313−-- instance EqB (Expression params tables (optionality ('NotNull ty))) where
314323(==*)
315324 :: Expression params tables ty
316325 -> Expression params tables ty
317− -> Expression params tables ('Required ('NotNull 'PGBool))
326+ -> Predicate params tables
318327(==*) = unsafeBinaryOp "="
328+
319329(/=*)
320330 :: Expression params tables ty
321331 -> Expression params tables ty
322− -> Expression params tables ('Required ('NotNull 'PGBool))
332+ -> Predicate params tables
323333(/=*) = unsafeBinaryOp "<>"
324334
325−-- instance OrdB (Expression params tables (optionality ('NotNull ty))) where
326335(>=*)
327336 :: Expression params tables ty
328337 -> Expression params tables ty
329− -> Expression params tables ('Required ('NotNull 'PGBool))
338+ -> Predicate params tables
330339(>=*) = unsafeBinaryOp ">="
340+
331341(<*)
332342 :: Expression params tables ty
333343 -> Expression params tables ty
334− -> Expression params tables ('Required ('NotNull 'PGBool))
344+ -> Predicate params tables
335345(<*) = unsafeBinaryOp "<"
346+
336347(<=*)
337348 :: Expression params tables ty
338349 -> Expression params tables ty
339− -> Expression params tables ('Required ('NotNull 'PGBool))
350+ -> Predicate params tables
340351(<=*) = unsafeBinaryOp "<="
352+
341353(>*)
342354 :: Expression params tables ty
343355 -> Expression params tables ty
344− -> Expression params tables ('Required ('NotNull 'PGBool))
356+ -> Predicate params tables
345357(>*) = unsafeBinaryOp ">"
346358
347359{-----------------------------------------
@@ -474,7 +486,7 @@ data TableExpression
474486 (tables :: [(Symbol,[(Symbol,ColumnType)])])
475487 = TableExpression
476488 { joinClause :: Join params schema tables
477− , whereClause :: [Expression params tables ('Required ('NotNull 'PGBool))]
489+ , whereClause :: [Predicate params tables]
478490 , limitClause :: [Expression params '[] ('Required ('NotNull 'PGInt8))]
479491 , offsetClause :: [Expression params '[] ('Required ('NotNull 'PGInt8))]
480492 }
@@ -513,7 +525,7 @@ join
513525join tables = TableExpression tables [] [] []
514526
515527where_
516− :: Expression params tables ('Required ('NotNull 'PGBool))
528+ :: Predicate params tables
517529 -> TableExpression params schema tables
518530 -> TableExpression params schema tables
519531where_ wh (TableExpression tabs whs lims offs) = TableExpression tabs (wh:whs) lims offs