on dev help sign in
remove boolean
b6dd1b9Eitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+108−66
@@ -16,8 +16,8 @@
16
16
17module Squeel.PostgreSQL.Statement where
17module Squeel.PostgreSQL.Statement where
18
18
19−import Data.Boolean
19+-- import Data.Boolean
20−import Data.Boolean.Numbers
20+-- import Data.Boolean.Numbers
21import Data.ByteString (ByteString)
21import Data.ByteString (ByteString)
22import Data.Foldable
22import Data.Foldable
23import Data.Maybe
23import Data.Maybe
@@ -200,52 +200,52 @@ instance PGCast 'PGInt8 'PGFloat4
200instance PGCast 'PGInt8 'PGFloat8
200instance PGCast 'PGInt8 'PGFloat8
201instance PGCast 'PGInt8 'PGNumeric
201instance PGCast 'PGInt8 'PGNumeric
202
202
203−instance (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty)
203+-- instance (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty)
204− => NumB (Expression params tables ('Required (nullity ty))) where
204+-- => NumB (Expression params tables ('Required (nullity ty))) where
205− type IntegerOf (Expression params tables ('Required (nullity ty)))
205+-- type IntegerOf (Expression params tables ('Required (nullity ty)))
206− = (Expression params tables ('Required (nullity 'PGInt8)))
206+-- = (Expression params tables ('Required (nullity 'PGInt8)))
207− fromIntegerB = cast pgtype
207+-- fromIntegerB = cast pgtype
208−
208+
209−instance (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty, PGCast ty 'PGInt8)
209+-- instance (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty, PGCast ty 'PGInt8)
210− => IntegralB (Expression params tables ('Required ('NotNull ty))) where
210+-- => IntegralB (Expression params tables ('Required ('NotNull ty))) where
211− quot = unsafeBinaryOp "/"
211+-- quot = unsafeBinaryOp "/"
212− rem = unsafeBinaryOp "%"
212+-- rem = unsafeBinaryOp "%"
213− div = unsafeBinaryOp "/"
213+-- div = unsafeBinaryOp "/"
214− mod = unsafeBinaryOp "%"
214+-- mod = unsafeBinaryOp "%"
215− toIntegerB = cast int8
215+-- toIntegerB = cast int8
216−
216+
217−instance
217+-- instance
218− ( IntegerOf (Expression params tables ('Required ('NotNull ty)))
218+-- ( IntegerOf (Expression params tables ('Required ('NotNull ty)))
219− ~ (Expression params tables ('Required ('NotNull 'PGInt8)))
219+-- ~ (Expression params tables ('Required ('NotNull 'PGInt8)))
220− , PGNum ty
220+-- , PGNum ty
221− , PGTyped ty
221+-- , PGTyped ty
222− , PGCast 'PGInt8 ty
222+-- , PGCast 'PGInt8 ty
223− , PGFractional ty
223+-- , PGFractional ty
224− )
224+-- )
225− => RealFracB (Expression params tables ('Required ('NotNull ty))) where
225+-- => RealFracB (Expression params tables ('Required ('NotNull ty))) where
226− properFraction x = (truncate x, x - unsafeFunction "trunc" x)
226+-- properFraction x = (truncate x, x - unsafeFunction "trunc" x)
227− truncate = fromIntegerB . unsafeFunction "trunc"
227+-- truncate = fromIntegerB . unsafeFunction "trunc"
228− round = fromIntegerB . unsafeFunction "round"
228+-- round = fromIntegerB . unsafeFunction "round"
229− ceiling = fromIntegerB . unsafeFunction "ceiling"
229+-- ceiling = fromIntegerB . unsafeFunction "ceiling"
230− floor = fromIntegerB . unsafeFunction "floor"
230+-- floor = fromIntegerB . unsafeFunction "floor"
231−
231+
232−instance
232+-- instance
233− ( IntegerOf (Expression params tables ('Required ('NotNull ty)))
233+-- ( IntegerOf (Expression params tables ('Required ('NotNull ty)))
234− ~ (Expression params tables ('Required ('NotNull 'PGInt8)))
234+-- ~ (Expression params tables ('Required ('NotNull 'PGInt8)))
235− , PGNum ty
235+-- , PGNum ty
236− , PGTyped ty
236+-- , PGTyped ty
237− , PGCast 'PGInt8 ty
237+-- , PGCast 'PGInt8 ty
238− , PGCast 'PGNumeric ty
238+-- , PGCast 'PGNumeric ty
239− , PGFloating ty
239+-- , PGFloating ty
240− )
240+-- )
241− => RealFloatB (Expression params tables ('Required ('NotNull ty))) where
241+-- => RealFloatB (Expression params tables ('Required ('NotNull ty))) where
242− isNaN x = x ==* UnsafeExpression "\'NaN\'"
242+-- isNaN x = x ==* UnsafeExpression "\'NaN\'"
243− isInfinite x = x ==* UnsafeExpression "\'Infinity\'"
243+-- isInfinite x = x ==* UnsafeExpression "\'Infinity\'"
244− ||* x ==* UnsafeExpression "\'-Infinity\'"
244+-- ||* x ==* UnsafeExpression "\'-Infinity\'"
245− isNegativeZero x = x ==* UnsafeExpression "-0"
245+-- isNegativeZero x = x ==* UnsafeExpression "-0"
246− isIEEE _ = true
246+-- isIEEE _ = true
247− atan2 y x = UnsafeExpression $
247+-- atan2 y x = UnsafeExpression $
248− "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
248+-- "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
249
249
250instance IsString (Expression params tables ('Required (nullity 'PGText))) where
250instance IsString (Expression params tables ('Required (nullity 'PGText))) where
251 fromString str = UnsafeExpression $
251 fromString str = UnsafeExpression $
@@ -262,15 +262,28 @@ instance IsString (Expression params tables ('Required (nullity 'PGText))) where
262 '\\' -> "\\\\"
262 '\\' -> "\\\\"
263 c -> [c]
263 c -> [c]
264
264
265−instance Boolean (Expression params tables ('Required ('NotNull 'PGBool))) where
265+-- instance Boolean (Expression params tables ('Required ('NotNull 'PGBool))) where
266+true :: Expression params tables ('Required ('NotNull 'PGBool))
266− true = UnsafeExpression "TRUE"
267+true = UnsafeExpression "TRUE"
268+false :: Expression params tables ('Required ('NotNull 'PGBool))
267− false = UnsafeExpression "FALSE"
269+false = UnsafeExpression "FALSE"
270+notB
271+ :: Expression params tables ('Required ('NotNull 'PGBool))
272+ -> Expression params tables ('Required ('NotNull 'PGBool))
268− notB = unsafeUnaryOp "NOT"
273+notB = unsafeUnaryOp "NOT"
274+(&&*)
275+ :: Expression params tables ('Required ('NotNull 'PGBool))
276+ -> Expression params tables ('Required ('NotNull 'PGBool))
277+ -> Expression params tables ('Required ('NotNull 'PGBool))
269− (&&*) = unsafeBinaryOp "AND"
278+(&&*) = unsafeBinaryOp "AND"
279+(||*)
280+ :: Expression params tables ('Required ('NotNull 'PGBool))
281+ -> Expression params tables ('Required ('NotNull 'PGBool))
282+ -> Expression params tables ('Required ('NotNull 'PGBool))
270− (||*) = unsafeBinaryOp "OR"
283+(||*) = unsafeBinaryOp "OR"
271
284
272−type instance BooleanOf (Expression params tables ty) =
285+-- type instance BooleanOf (Expression params tables ty) =
273− Expression params tables ('Required ('NotNull 'PGBool))
286+-- Expression params tables ('Required ('NotNull 'PGBool))
274
287
275caseWhenThenElse
288caseWhenThenElse
276 :: [(Expression params tables ('Required ('NotNull 'PGBool)), Expression params tables ty)]
289 :: [(Expression params tables ('Required ('NotNull 'PGBool)), Expression params tables ty)]
@@ -289,18 +302,47 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
289 , " END"
302 , " END"
290 ]
303 ]
291
304
292−instance IfB (Expression params tables ty) where
305+-- instance IfB (Expression params tables ty) where
306+ifThenElse
307+ :: Expression params tables ('Required ('NotNull 'PGBool))
308+ -> Expression params tables ty
309+ -> Expression params tables ty
310+ -> Expression params tables ty
293− ifB if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
311+ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
294
312
295−instance EqB (Expression params tables (optionality ('NotNull ty))) where
313+-- instance EqB (Expression params tables (optionality ('NotNull ty))) where
314+(==*)
315+ :: Expression params tables ty
316+ -> Expression params tables ty
317+ -> Expression params tables ('Required ('NotNull 'PGBool))
296− (==*) = unsafeBinaryOp "="
318+(==*) = unsafeBinaryOp "="
319+(/=*)
320+ :: Expression params tables ty
321+ -> Expression params tables ty
322+ -> Expression params tables ('Required ('NotNull 'PGBool))
297− (/=*) = unsafeBinaryOp "<>"
323+(/=*) = unsafeBinaryOp "<>"
298
324
299−instance OrdB (Expression params tables (optionality ('NotNull ty))) where
325+-- instance OrdB (Expression params tables (optionality ('NotNull ty))) where
300− (>*) = unsafeBinaryOp ">"
326+(>=*)
327+ :: Expression params tables ty
328+ -> Expression params tables ty
329+ -> Expression params tables ('Required ('NotNull 'PGBool))
301− (>=*) = unsafeBinaryOp ">="
330+(>=*) = unsafeBinaryOp ">="
331+(<*)
332+ :: Expression params tables ty
333+ -> Expression params tables ty
334+ -> Expression params tables ('Required ('NotNull 'PGBool))
302− (<*) = unsafeBinaryOp "<"
335+(<*) = unsafeBinaryOp "<"
336+(<=*)
337+ :: Expression params tables ty
338+ -> Expression params tables ty
339+ -> Expression params tables ('Required ('NotNull 'PGBool))
303− (<=*) = unsafeBinaryOp "<="
340+(<=*) = unsafeBinaryOp "<="
341+(>*)
342+ :: Expression params tables ty
343+ -> Expression params tables ty
344+ -> Expression params tables ('Required ('NotNull 'PGBool))
345+(>*) = unsafeBinaryOp ">"
304
346
305{-----------------------------------------
347{-----------------------------------------
306tables
348tables
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+10−10
@@ -8,7 +8,7 @@
8
8
9module Squeel.PostgreSQL.StatementSpec where
9module Squeel.PostgreSQL.StatementSpec where
10
10
11−import Data.Boolean
11+-- import Data.Boolean
12import Data.Function
12import Data.Function
13import Generics.SOP hiding (from)
13import Generics.SOP hiding (from)
14import Test.Hspec
14import Test.Hspec
@@ -25,7 +25,7 @@ spec = do
25 statement :: Statement '[] SumAndCol1 Tables Tables
25 statement :: Statement '[] SumAndCol1 Tables Tables
26 statement = select $
26 statement = select $
27 ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
27 ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
28− `from` (#table1 & where_ ((#col1 :: Expression '[] Tables ('Required ('NotNull 'PGInt4))) >* #col2))
28+ `from` (#table1 & where_ (#col1 >* #col2))
29 statement `shouldRenderAs`
29 statement `shouldRenderAs`
30 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (col1 > col2);"
30 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (col1 > col2);"
31 it "combines WHEREs using AND" $ do
31 it "combines WHEREs using AND" $ do
@@ -78,7 +78,7 @@ spec = do
78 it "correctly render simple UPDATEs" $ do
78 it "correctly render simple UPDATEs" $ do
79 let
79 let
80 statement :: Statement '[] '[] Tables Tables
80 statement :: Statement '[] '[] Tables Tables
81− statement = update #table1 (set 2 `As` #col1 :* same `As` #col2 :* Nil) ((#col1 :: Expression '[] Tables ('Required ('NotNull 'PGInt4))) /=* #col2)
81+ statement = update #table1 (set 2 `As` #col1 :* same `As` #col2 :* Nil) (#col1 /=* #col2)
82 statement `shouldRenderAs`
82 statement `shouldRenderAs`
83 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
83 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
84 it "correctly render upsert INSERTs" $ do
84 it "correctly render upsert INSERTs" $ do
@@ -87,13 +87,13 @@ spec = do
87 statement = upsertInto #table1
87 statement = upsertInto #table1
88 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
88 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
89 (set 2 `As` #col1 :* same `As` #col2 :* Nil)
89 (set 2 `As` #col1 :* same `As` #col2 :* Nil)
90− ((#col1 :: Expression '[] Tables ('Required ('NotNull 'PGInt4))) /=* #col2)
90+ (#col1 /=* #col2)
91 statement `shouldRenderAs`
91 statement `shouldRenderAs`
92 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
92 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
93 it "correctly renders DELETEs" $ do
93 it "correctly renders DELETEs" $ do
94 let
94 let
95 statement :: Statement '[] '[] Tables Tables
95 statement :: Statement '[] '[] Tables Tables
96− statement = deleteFrom #table1 ((#col1 :: Expression '[] Tables ('Required ('NotNull 'PGInt4))) ==* #col2)
96+ statement = deleteFrom #table1 (#col1 ==* #col2)
97 statement `shouldRenderAs`
97 statement `shouldRenderAs`
98 "DELETE FROM table1 WHERE (col1 = col2);"
98 "DELETE FROM table1 WHERE (col1 = col2);"
99 it "should be safe against SQL injection in literal text" $ do
99 it "should be safe against SQL injection in literal text" $ do
@@ -106,9 +106,9 @@ spec = do
106 describe "JOINs" $ do
106 describe "JOINs" $ do
107 let
107 let
108 vals =
108 vals =
109− #orders &. #orderVal `As` #orderVal
109+ (#orders &. #orderVal) `As` #orderVal
110− :* #customers &. #customerVal `As` #customerVal
110+ :* (#customers &. #customerVal) `As` #customerVal
111− :* #shippers &. #shipperVal `As` #shipperVal :* Nil
111+ :* (#shippers &. #shipperVal) `As` #shipperVal :* Nil
112 it "should render CROSS JOINs" $ do
112 it "should render CROSS JOINs" $ do
113 let
113 let
114 statement :: Statement '[] ValueColumns JoinTables JoinTables
114 statement :: Statement '[] ValueColumns JoinTables JoinTables
@@ -128,9 +128,9 @@ spec = do
128 innerJoins = join $
128 innerJoins = join $
129 #orders
129 #orders
130 & Inner #customers
130 & Inner #customers
131− (#orders &. #customerID ==* #customers &. #customerID)
131+ ((#orders &. #customerID) ==* (#customers &. #customerID))
132 & Inner #shippers
132 & Inner #shippers
133− (#orders &. #shipperID ==* #shippers &. #shipperID)
133+ ((#orders &. #shipperID) ==* (#shippers &. #shipperID))
134 selection :: Statement '[] ValueColumns JoinTables JoinTables
134 selection :: Statement '[] ValueColumns JoinTables JoinTables
135 selection = select $ vals `from` innerJoins
135 selection = select $ vals `from` innerJoins
136 selection `shouldRenderAs`
136 selection `shouldRenderAs`