b6dd1b9 · squeal · git.iko.soy

git.iko.soy/squeal

remove boolean

for better inference

commitb6dd1b933d254701b08e055756eae0d20c68465c authorEitan Chatav <eitan.chatav@gmail.com> dateTue 18 Jul 2017, 13:05 (9 years ago) parent1aeda35

2 files changed+118−76

compare with dev

unifiedsplit

squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+108−66 squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+10−10

squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+108−66

@@ -16,8 +16,8 @@

1616

1717module Squeel.PostgreSQL.Statement where

1818

19−import Data.Boolean

20−import Data.Boolean.Numbers

19+-- import Data.Boolean

20+-- import Data.Boolean.Numbers

2121import Data.ByteString (ByteString)

2222import Data.Foldable

2323import Data.Maybe

@@ -200,52 +200,52 @@ instance PGCast 'PGInt8 'PGFloat4

200200instance PGCast 'PGInt8 'PGFloat8

201201instance PGCast 'PGInt8 'PGNumeric

202202

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 <> ")"

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 <> ")"

249249

250250instance IsString (Expression params tables ('Required (nullity 'PGText))) where

251251 fromString str = UnsafeExpression $

@@ -262,15 +262,28 @@ instance IsString (Expression params tables ('Required (nullity 'PGText))) where

262262 '\\' -> "\\\\"

263263 c -> [c]

264264

265−instance Boolean (Expression params tables ('Required ('NotNull 'PGBool))) where

266− true = UnsafeExpression "TRUE"

267− false = UnsafeExpression "FALSE"

268− notB = unsafeUnaryOp "NOT"

269− (&&*) = unsafeBinaryOp "AND"

270− (||*) = unsafeBinaryOp "OR"

265+-- instance Boolean (Expression params tables ('Required ('NotNull 'PGBool))) where

266+true :: Expression params tables ('Required ('NotNull 'PGBool))

267+true = UnsafeExpression "TRUE"

268+false :: Expression params tables ('Required ('NotNull 'PGBool))

269+false = UnsafeExpression "FALSE"

270+notB

271+ :: Expression params tables ('Required ('NotNull 'PGBool))

272+ -> Expression params tables ('Required ('NotNull 'PGBool))

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))

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))

283+(||*) = unsafeBinaryOp "OR"

271284

272−type instance BooleanOf (Expression params tables ty) =

273− Expression params tables ('Required ('NotNull 'PGBool))

285+-- type instance BooleanOf (Expression params tables ty) =

286+-- Expression params tables ('Required ('NotNull 'PGBool))

274287

275288caseWhenThenElse

276289 :: [(Expression params tables ('Required ('NotNull 'PGBool)), Expression params tables ty)]

@@ -289,18 +302,47 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat

289302 , " END"

290303 ]

291304

292−instance IfB (Expression params tables ty) where

293− ifB if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_

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

311+ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_

294312

295−instance EqB (Expression params tables (optionality ('NotNull ty))) where

296− (==*) = unsafeBinaryOp "="

297− (/=*) = unsafeBinaryOp "<>"

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))

318+(==*) = unsafeBinaryOp "="

319+(/=*)

320+ :: Expression params tables ty

321+ -> Expression params tables ty

322+ -> Expression params tables ('Required ('NotNull 'PGBool))

323+(/=*) = unsafeBinaryOp "<>"

298324

299−instance OrdB (Expression params tables (optionality ('NotNull ty))) where

300− (>*) = unsafeBinaryOp ">"

301− (>=*) = unsafeBinaryOp ">="

302− (<*) = unsafeBinaryOp "<"

303− (<=*) = unsafeBinaryOp "<="

325+-- instance OrdB (Expression params tables (optionality ('NotNull ty))) where

326+(>=*)

327+ :: Expression params tables ty

328+ -> Expression params tables ty

329+ -> Expression params tables ('Required ('NotNull 'PGBool))

330+(>=*) = unsafeBinaryOp ">="

331+(<*)

332+ :: Expression params tables ty

333+ -> Expression params tables ty

334+ -> Expression params tables ('Required ('NotNull 'PGBool))

335+(<*) = unsafeBinaryOp "<"

336+(<=*)

337+ :: Expression params tables ty

338+ -> Expression params tables ty

339+ -> Expression params tables ('Required ('NotNull 'PGBool))

340+(<=*) = unsafeBinaryOp "<="

341+(>*)

342+ :: Expression params tables ty

343+ -> Expression params tables ty

344+ -> Expression params tables ('Required ('NotNull 'PGBool))

345+(>*) = unsafeBinaryOp ">"

304346

305347{-----------------------------------------

306348tables

squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+10−10

@@ -8,7 +8,7 @@

99module Squeel.PostgreSQL.StatementSpec where

1010

11−import Data.Boolean

11+-- import Data.Boolean

1212import Data.Function

1313import Generics.SOP hiding (from)

1414import Test.Hspec

@@ -25,7 +25,7 @@ spec = do

2525 statement :: Statement '[] SumAndCol1 Tables Tables

2626 statement = select $

2727 ((#col1 + #col2) `As` #sum :* #col1 :* Nil)

28− `from` (#table1 & where_ ((#col1 :: Expression '[] Tables ('Required ('NotNull 'PGInt4))) >* #col2))

28+ `from` (#table1 & where_ (#col1 >* #col2))

2929 statement `shouldRenderAs`

3030 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (col1 > col2);"

3131 it "combines WHEREs using AND" $ do

@@ -78,7 +78,7 @@ spec = do

7878 it "correctly render simple UPDATEs" $ do

7979 let

8080 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)

8282 statement `shouldRenderAs`

8383 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"

8484 it "correctly render upsert INSERTs" $ do

@@ -87,13 +87,13 @@ spec = do

8787 statement = upsertInto #table1

8888 (2 `As` #col1 :* 4 `As` #col2 :* Nil)

8989 (set 2 `As` #col1 :* same `As` #col2 :* Nil)

90− ((#col1 :: Expression '[] Tables ('Required ('NotNull 'PGInt4))) /=* #col2)

90+ (#col1 /=* #col2)

9191 statement `shouldRenderAs`

9292 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"

9393 it "correctly renders DELETEs" $ do

9494 let

9595 statement :: Statement '[] '[] Tables Tables

96− statement = deleteFrom #table1 ((#col1 :: Expression '[] Tables ('Required ('NotNull 'PGInt4))) ==* #col2)

96+ statement = deleteFrom #table1 (#col1 ==* #col2)

9797 statement `shouldRenderAs`

9898 "DELETE FROM table1 WHERE (col1 = col2);"

9999 it "should be safe against SQL injection in literal text" $ do

@@ -106,9 +106,9 @@ spec = do

106106 describe "JOINs" $ do

107107 let

108108 vals =

109− #orders &. #orderVal `As` #orderVal

110− :* #customers &. #customerVal `As` #customerVal

111− :* #shippers &. #shipperVal `As` #shipperVal :* Nil

109+ (#orders &. #orderVal) `As` #orderVal

110+ :* (#customers &. #customerVal) `As` #customerVal

111+ :* (#shippers &. #shipperVal) `As` #shipperVal :* Nil

112112 it "should render CROSS JOINs" $ do

113113 let

114114 statement :: Statement '[] ValueColumns JoinTables JoinTables

@@ -128,9 +128,9 @@ spec = do

128128 innerJoins = join $

129129 #orders

130130 & Inner #customers

131− (#orders &. #customerID ==* #customers &. #customerID)

131+ ((#orders &. #customerID) ==* (#customers &. #customerID))

132132 & Inner #shippers

133− (#orders &. #shipperID ==* #shippers &. #shipperID)

133+ ((#orders &. #shipperID) ==* (#shippers &. #shipperID))

134134 selection :: Statement '[] ValueColumns JoinTables JoinTables

135135 selection = select $ vals `from` innerJoins

136136 selection `shouldRenderAs`