git.iko.soy/squeal
on dev help sign in
rejiggering
6adfc90Eitan Chatav
squeel-postgresql/exe/Example.hs+20−20
compare with dev
unifiedsplit
@@ -10,13 +10,15 @@
10
10
11module Main (main) where
11module Main (main) where
12
12
13+import Control.Category ((>>>))
13import Control.Monad.Base
14import Control.Monad.Base
14import Control.Monad.Except
15import Control.Monad.Except
15import Control.Monad.Trans.Maybe
16import Control.Monad.Trans.Maybe
17+import Data.Foldable (for_)
16import Data.Function ((&))
18import Data.Function ((&))
17import Data.Int
19import Data.Int
18import Data.Monoid
20import Data.Monoid
19−import Generics.SOP
21+import Generics.SOP hiding (from)
20import Squeel.PostgreSQL
22import Squeel.PostgreSQL
21
23
22import qualified Data.ByteString.Char8 as Char8
24import qualified Data.ByteString.Char8 as Char8
@@ -29,23 +31,22 @@ main = do
29 Char8.putStrLn $ "connecting to " <> connectionString
31 Char8.putStrLn $ "connecting to " <> connectionString
30 connection0 :: Connection '[] <- connectdb connectionString
32 connection0 :: Connection '[] <- connectdb connectionString
31 Char8.putStrLn "setting up database"
33 Char8.putStrLn "setting up database"
32− connection1 <- flip execPQ connection0 $
34+ connection1 :: Connection Tables <- flip execPQ connection0 $ pqExec $
33− pqExec
34− ( createTable #students
35+ createTable #students
35− ( (text & notNull) `As` #name
36+ ( (text & notNull) `As` #name
36− :* Nil ) )
37+ :* Nil )
37− & pqThenExec
38+ >>>
38− ( createTable #table1
39+ createTable #table1
39− ( (int4 & notNull) `As` #col1
40+ ( (int4 & notNull) `As` #col1
40− :* (int4 & notNull) `As` #col2
41+ :* (int4 & notNull) `As` #col2
41− :* Nil ) )
42+ :* Nil )
42− & pqThenExec
43− ( insertInto #table1 ( 1 `As` #col1 :* 2 `As` #col2 :* Nil ) )
44− & pqThenExec
45− ( insertInto #table1 ( 3 `As` #col1 :* 4 `As` #col2 :* Nil ) )
46 Char8.putStrLn "querying"
43 Char8.putStrLn "querying"
47− connection2 <- flip execPQ connection1 $ do
44+ connection2 :: Connection Tables <- flip execPQ connection1 $ do
45+ for_ [I i :* I (i+1) :* Nil | i <- [1::Int32,3..9]] $
46+ pqExecParams
47+ (insertInto #table1 (param1 `As` #col1 :* param2 `As` #col2 :* Nil))
48− Just result <- pqExecNil $ select $ starFrom #table1
48+ Just result <- pqExecNil . query $
49+ selectStar (from (Table (#table1 `As` #table1)))
49 runMaybeT . runExceptT . flip runValue result $ do
50 runMaybeT . runExceptT . flip runValue result $ do
50 value00 <- getValue (RowNumber 0) (columnNumber @0)
51 value00 <- getValue (RowNumber 0) (columnNumber @0)
51 value01 <- getValue (RowNumber 0) (columnNumber @1)
52 value01 <- getValue (RowNumber 0) (columnNumber @1)
@@ -61,9 +62,8 @@ main = do
61 print (row0 :: NP I '[Int32,Int32])
62 print (row0 :: NP I '[Int32,Int32])
62 print (row1 :: NP I '[Int32,Int32])
63 print (row1 :: NP I '[Int32,Int32])
63 Char8.putStrLn "tearing down database"
64 Char8.putStrLn "tearing down database"
64− connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec
65+ connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec $
65− (dropTable #table1 :: Statement '[] '[] Tables '["students" ::: StudentsColumns])
66− & pqThenExec (dropTable #students)
66+ dropTable #table1 >>> dropTable #students
67 finish connection3
67 finish connection3
68
68
69type Columns =
69type Columns =
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+6−44
@@ -77,49 +77,29 @@ class AtkeyPQ pq where
77
77
78 pqExec
78 pqExec
79 :: MonadBase IO io
79 :: MonadBase IO io
80− => Statement '[] '[] db0 db1
80+ => DataDefinition db0 db1
81 -> pq db0 db1 io (Maybe (Result '[]))
81 -> pq db0 db1 io (Maybe (Result '[]))
82
82
83 pqThenExec
83 pqThenExec
84 :: MonadBase IO io
84 :: MonadBase IO io
85− => Statement '[] '[] db1 db2
85+ => DataDefinition db1 db2
86 -> pq db0 db1 io x
86 -> pq db0 db1 io x
87 -> pq db0 db2 io (Maybe (Result '[]))
87 -> pq db0 db2 io (Maybe (Result '[]))
88 pqThenExec = pqThen . pqExec
88 pqThenExec = pqThen . pqExec
89
89
90− -- pqPrepare
91− -- :: (MonadBase IO io, ToOids ps)
92− -- => ByteString
93− -- -> Statement ps xs db0 db1
94− -- -> pq db0 db1 io (Maybe (Result '[]), PreparedStatement ps xs db0 db1)
95−
96− -- pqThenPrepare
97− -- :: MonadBase IO io
98− -- => ByteString
99− -- -> Statement ps xs schema0 schema1
100− -- -> pq db0 db1 io x
101− -- -> pq db1 db1 io (Maybe (Result '[]), PreparedStatement ps xs schema0 schema1)
102− -- pqThenPrepare name st pq = pqThen (pqPrepare name st) pq
103−
104class MonadPQ db m | m -> db where
90class MonadPQ db m | m -> db where
105
91
106 pqExecParams
92 pqExecParams
107 :: (ToOids ps, AllZip HasEncoding ps xs)
93 :: (ToOids ps, AllZip HasEncoding ps xs)
108− => Statement ps ys db db
94+ => DataManipulation db ps ys
109 -> NP I xs
95 -> NP I xs
110 -> m (Maybe (Result ys))
96 -> m (Maybe (Result ys))
111
97
112 pqExecNil
98 pqExecNil
113− :: Statement '[] ys db db
99+ :: DataManipulation db '[] ys
114 -> m (Maybe (Result ys))
100 -> m (Maybe (Result ys))
115 pqExecNil statement = pqExecParams statement Nil
101 pqExecNil statement = pqExecParams statement Nil
116
102
117− -- pqExecPrepared
118− -- :: AllZip HasEncoding ps xs
119− -- => PreparedStatement ps ys db db
120− -- -> NP I xs
121− -- -> m (Maybe (Result ys))
122−
123instance AtkeyPQ PQ where
103instance AtkeyPQ PQ where
124
104
125 pqAp (PQ f) (PQ x) = PQ $ \ conn -> do
105 pqAp (PQ f) (PQ x) = PQ $ \ conn -> do
@@ -131,22 +111,13 @@ instance AtkeyPQ PQ where
131 (x', conn') <- x conn
111 (x', conn') <- x conn
132 runPQ (f x') conn'
112 runPQ (f x') conn'
133
113
134− pqExec (UnsafeStatement q) = PQ $ \ (Connection conn) -> do
114+ pqExec (UnsafeDataDefinition q) = PQ $ \ (Connection conn) -> do
135 result <- liftBase $ LibPQ.exec conn q
115 result <- liftBase $ LibPQ.exec conn q
136 return (Result <$> result, Connection conn)
116 return (Result <$> result, Connection conn)
137
117
138− -- pqPrepare statementName (UnsafeStatement q :: Statement ps ys db0 db1) =
139− -- PQ $ \ (Connection conn) -> do
140− -- result <- liftBase $
141− -- LibPQ.prepare conn statementName q (Just (toOids (proxy# :: Proxy# ps)))
142− -- return
143− -- ( ( Result <$> result
144− -- , UnsafePreparedStatement statementName
145− -- ) , Connection conn )
146−
147instance MonadBase IO io => MonadPQ db (PQ db db io) where
118instance MonadBase IO io => MonadPQ db (PQ db db io) where
148
119
149− pqExecParams (UnsafeStatement q :: Statement ps ys db0 db1) params =
120+ pqExecParams (UnsafeDataManipulation q :: DataManipulation db ps ys) params =
150 PQ $ \ (Connection conn) -> do
121 PQ $ \ (Connection conn) -> do
151 let
122 let
152 paramValues = encodings (Proxy :: Proxy ps) params
123 paramValues = encodings (Proxy :: Proxy ps) params
@@ -158,15 +129,6 @@ instance MonadBase IO io => MonadPQ db (PQ db db io) where
158 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
129 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
159 return (Result <$> result, Connection conn)
130 return (Result <$> result, Connection conn)
160
131
161− -- pqExecPrepared (q :: PreparedStatement ps ys db0 db1) params =
162− -- PQ $ \ (Connection conn) -> do
163− -- let
164− -- paramValues = encodings (Proxy :: Proxy ps) params
165− -- params' = [ Just (param', LibPQ.Binary) | param' <- paramValues ]
166− -- result <- liftBase $
167− -- LibPQ.execPrepared conn (renderPreparedStatement q) params' LibPQ.Binary
168− -- return (Result <$> result, Connection conn)
169−
170instance Monad m => Applicative (PQ db db m) where
132instance Monad m => Applicative (PQ db db m) where
171 pure x = PQ $ \ conn -> pure (x, conn)
133 pure x = PQ $ \ conn -> pure (x, conn)
172 (<*>) = pqAp
134 (<*>) = pqAp
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+22−19
@@ -26,14 +26,15 @@ module Squeel.PostgreSQL.Schema
26 , Aliased (As)
26 , Aliased (As)
27 , renderAliased
27 , renderAliased
28 , NullityType (..)
28 , NullityType (..)
29− , NullifyColumn
29+ , NullifyType
30 , NullifyColumns
30 , NullifyColumns
31− , NullifyTable
31+ , NullifyTables
32+ , ColumnType (..)
32 , Create
33 , Create
33 , Drop
34 , Drop
34 , Alter
35 , Alter
35 , Rename
36 , Rename
36− , ColumnType (..)
37+ , Join
37 , module GHC.OverloadedLabels
38 , module GHC.OverloadedLabels
38 , module GHC.TypeLits
39 , module GHC.TypeLits
39 ) where
40 ) where
@@ -75,12 +76,12 @@ data PGType
75
76
76class ToOid pg where toOid :: Proxy# pg -> LibPQ.Oid
77class ToOid pg where toOid :: Proxy# pg -> LibPQ.Oid
77--staticTypeInfo
78--staticTypeInfo
78−instance ToOid ('NotNull 'PGBool) where toOid _ = LibPQ.Oid 16
79+instance ToOid ('Required ('NotNull 'PGBool)) where toOid _ = LibPQ.Oid 16
79−instance ToOid ('NotNull 'PGBytea) where toOid _ = LibPQ.Oid 17
80+instance ToOid ('Required ('NotNull 'PGBytea)) where toOid _ = LibPQ.Oid 17
80−instance ToOid ('NotNull 'PGInt8) where toOid _ = LibPQ.Oid 20
81+instance ToOid ('Required ('NotNull 'PGInt8)) where toOid _ = LibPQ.Oid 20
81−instance ToOid ('NotNull 'PGInt2) where toOid _ = LibPQ.Oid 21
82+instance ToOid ('Required ('NotNull 'PGInt2)) where toOid _ = LibPQ.Oid 21
82−instance ToOid ('NotNull 'PGInt4) where toOid _ = LibPQ.Oid 23
83+instance ToOid ('Required ('NotNull 'PGInt4)) where toOid _ = LibPQ.Oid 23
83−instance ToOid ('NotNull 'PGText) where toOid _ = LibPQ.Oid 26
84+instance ToOid ('Required ('NotNull 'PGText)) where toOid _ = LibPQ.Oid 26
84class ToOids pgs where toOids :: Proxy# pgs -> [LibPQ.Oid]
85class ToOids pgs where toOids :: Proxy# pgs -> [LibPQ.Oid]
85instance ToOids '[] where toOids _ = []
86instance ToOids '[] where toOids _ = []
86instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
87instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
@@ -122,10 +123,6 @@ data Aliased expression aliased where
122 -> Alias alias
123 -> Alias alias
123 -> Aliased expression (alias ::: ty)
124 -> Aliased expression (alias ::: ty)
124
125
125−instance (KnownSymbol alias, IsLabel alias (expression ty))
126− => IsLabel alias (Aliased expression (alias ::: ty)) where
127− fromLabel alias = fromLabel alias `As` fromLabel alias
128−
129renderAliased
126renderAliased
130 :: (forall ty. expression ty -> ByteString)
127 :: (forall ty. expression ty -> ByteString)
131 -> Aliased expression aliased
128 -> Aliased expression aliased
@@ -137,17 +134,19 @@ data NullityType = Null PGType | NotNull PGType
137
134
138data ColumnType = Optional NullityType | Required NullityType
135data ColumnType = Optional NullityType | Required NullityType
139
136
140−type family NullifyColumn (column :: ColumnType) where
137+type family NullifyType (ty :: ColumnType) where
141− NullifyColumn (optionality ('Null ty)) = optionality ('Null ty)
138+ NullifyType (optionality ('Null ty)) = optionality ('Null ty)
142− NullifyColumn (optionality ('NotNull ty)) = optionality ('Null ty)
139+ NullifyType (optionality ('NotNull ty)) = optionality ('Null ty)
143
140
144type family NullifyColumns columns where
141type family NullifyColumns columns where
145 NullifyColumns '[] = '[]
142 NullifyColumns '[] = '[]
146 NullifyColumns ((column ::: ty) ': columns) =
143 NullifyColumns ((column ::: ty) ': columns) =
147− (column ::: NullifyColumn ty) ': (NullifyColumns columns)
144+ (column ::: NullifyType ty) ': NullifyColumns columns
148
145
149−type family NullifyTable table where
146+type family NullifyTables tables where
147+ NullifyTables '[] = '[]
148+ NullifyTables ((column ::: ty) ': columns) =
150− NullifyTable (table ::: columns) = table ::: NullifyColumns columns
149+ (column ::: NullifyColumns ty) ': NullifyTables columns
151
150
152type family Create alias x xs where
151type family Create alias x xs where
153 Create alias x '[] = '[alias ::: x]
152 Create alias x '[] = '[alias ::: x]
@@ -164,3 +163,7 @@ type family Alter alias xs x where
164type family Rename alias0 alias1 xs where
163type family Rename alias0 alias1 xs where
165 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs
164 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs
166 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs
165 Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs
166+
167+type family Join xs ys where
168+ Join '[] ys = ys
169+ Join (x ': xs) ys = x ': Join xs ys
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+233−234
@@ -17,17 +17,19 @@
17
17
18module Squeel.PostgreSQL.Statement where
18module Squeel.PostgreSQL.Statement where
19
19
20+import Control.Category
20import Data.ByteString (ByteString)
21import Data.ByteString (ByteString)
21import Data.Foldable
22import Data.Foldable
22import Data.Maybe
23import Data.Maybe
23import Data.Monoid
24import Data.Monoid
24import Data.Ratio
25import Data.Ratio
25import Data.String
26import Data.String
27+import Data.Word
26import Generics.SOP
28import Generics.SOP
27import GHC.Exts
29import GHC.Exts
28import GHC.OverloadedLabels
30import GHC.OverloadedLabels
29import GHC.TypeLits
31import GHC.TypeLits
30−import Prelude hiding (RealFrac(..))
32+import Prelude hiding (RealFrac(..), id, (.))
31
33
32import qualified Data.ByteString as ByteString
34import qualified Data.ByteString as ByteString
33
35
@@ -267,33 +269,34 @@ instance IsString (Expression params tables ('Required (nullity 'PGText))) where
267 '\\' -> "\\\\"
269 '\\' -> "\\\\"
268 c -> [c]
270 c -> [c]
269
271
272+type Condition params tables =
270−type Predicate params tables = Expression params tables ('Required ('NotNull 'PGBool))
273+ Expression params tables ('Required ('NotNull 'PGBool))
271
274
272−true :: Predicate params tables
275+true :: Condition params tables
273true = UnsafeExpression "TRUE"
276true = UnsafeExpression "TRUE"
274
277
275−false :: Predicate params tables
278+false :: Condition params tables
276false = UnsafeExpression "FALSE"
279false = UnsafeExpression "FALSE"
277
280
278notB
281notB
279− :: Predicate params tables
282+ :: Condition params tables
280− -> Predicate params tables
283+ -> Condition params tables
281notB = unsafeUnaryOp "NOT"
284notB = unsafeUnaryOp "NOT"
282
285
283(&&*)
286(&&*)
284− :: Predicate params tables
287+ :: Condition params tables
285− -> Predicate params tables
288+ -> Condition params tables
286− -> Predicate params tables
289+ -> Condition params tables
287(&&*) = unsafeBinaryOp "AND"
290(&&*) = unsafeBinaryOp "AND"
288
291
289(||*)
292(||*)
290− :: Predicate params tables
293+ :: Condition params tables
291− -> Predicate params tables
294+ -> Condition params tables
292− -> Predicate params tables
295+ -> Condition params tables
293(||*) = unsafeBinaryOp "OR"
296(||*) = unsafeBinaryOp "OR"
294
297
295caseWhenThenElse
298caseWhenThenElse
296− :: [(Predicate params tables, Expression params tables ty)]
299+ :: [(Condition params tables, Expression params tables ty)]
297 -> Expression params tables ty
300 -> Expression params tables ty
298 -> Expression params tables ty
301 -> Expression params tables ty
299caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
302caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
@@ -310,7 +313,7 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
310 ]
313 ]
311
314
312ifThenElse
315ifThenElse
313− :: Predicate params tables
316+ :: Condition params tables
314 -> Expression params tables ty
317 -> Expression params tables ty
315 -> Expression params tables ty
318 -> Expression params tables ty
316 -> Expression params tables ty
319 -> Expression params tables ty
@@ -319,37 +322,37 @@ ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
319(==*)
322(==*)
320 :: Expression params tables ty
323 :: Expression params tables ty
321 -> Expression params tables ty
324 -> Expression params tables ty
322− -> Predicate params tables
325+ -> Condition params tables
323(==*) = unsafeBinaryOp "="
326(==*) = unsafeBinaryOp "="
324
327
325(/=*)
328(/=*)
326 :: Expression params tables ty
329 :: Expression params tables ty
327 -> Expression params tables ty
330 -> Expression params tables ty
328− -> Predicate params tables
331+ -> Condition params tables
329(/=*) = unsafeBinaryOp "<>"
332(/=*) = unsafeBinaryOp "<>"
330
333
331(>=*)
334(>=*)
332 :: Expression params tables ty
335 :: Expression params tables ty
333 -> Expression params tables ty
336 -> Expression params tables ty
334− -> Predicate params tables
337+ -> Condition params tables
335(>=*) = unsafeBinaryOp ">="
338(>=*) = unsafeBinaryOp ">="
336
339
337(<*)
340(<*)
338 :: Expression params tables ty
341 :: Expression params tables ty
339 -> Expression params tables ty
342 -> Expression params tables ty
340− -> Predicate params tables
343+ -> Condition params tables
341(<*) = unsafeBinaryOp "<"
344(<*) = unsafeBinaryOp "<"
342
345
343(<=*)
346(<=*)
344 :: Expression params tables ty
347 :: Expression params tables ty
345 -> Expression params tables ty
348 -> Expression params tables ty
346− -> Predicate params tables
349+ -> Condition params tables
347(<=*) = unsafeBinaryOp "<="
350(<=*) = unsafeBinaryOp "<="
348
351
349(>*)
352(>*)
350 :: Expression params tables ty
353 :: Expression params tables ty
351 -> Expression params tables ty
354 -> Expression params tables ty
352− -> Predicate params tables
355+ -> Condition params tables
353(>*) = unsafeBinaryOp ">"
356(>*) = unsafeBinaryOp ">"
354
357
355{-----------------------------------------
358{-----------------------------------------
@@ -357,7 +360,6 @@ tables
357-----------------------------------------}
360-----------------------------------------}
358
361
359newtype Table
362newtype Table
360− (params :: [ColumnType])
361 (schema :: [(Symbol,[(Symbol,ColumnType)])])
363 (schema :: [(Symbol,[(Symbol,ColumnType)])])
362 (columns :: [(Symbol,ColumnType)])
364 (columns :: [(Symbol,ColumnType)])
363 = UnsafeTable { renderTable :: ByteString }
365 = UnsafeTable { renderTable :: ByteString }
@@ -365,7 +367,7 @@ newtype Table
365
367
366class KnownSymbol table => HasTable table tables columns
368class KnownSymbol table => HasTable table tables columns
367 | table tables -> columns where
369 | table tables -> columns where
368− getTable :: Proxy# table -> Table params tables columns
370+ getTable :: Proxy# table -> Table tables columns
369 getTable table = UnsafeTable $ fromString $ symbolVal' table
371 getTable table = UnsafeTable $ fromString $ symbolVal' table
370instance {-# OVERLAPPING #-} KnownSymbol table
372instance {-# OVERLAPPING #-} KnownSymbol table
371 => HasTable table ((table ::: columns) ': tables) columns
373 => HasTable table ((table ::: columns) ': tables) columns
@@ -374,9 +376,136 @@ instance {-# OVERLAPPABLE #-}
374 => HasTable table (table' ': schema) columns
376 => HasTable table (table' ': schema) columns
375
377
376instance HasTable table schema columns
378instance HasTable table schema columns
377− => IsLabel table (Table params schema columns) where
379+ => IsLabel table (Table schema columns) where
378 fromLabel = getTable
380 fromLabel = getTable
379
381
382+data TableReference params schema tables where
383+ Table
384+ :: Aliased (Table schema) table
385+ -> TableReference params schema '[table]
386+ Subquery
387+ :: Aliased (Query schema params) table
388+ -> TableReference params schema '[table]
389+ CrossJoin
390+ :: TableReference params schema right
391+ -> TableReference params schema left
392+ -> TableReference params schema (Join left right)
393+ InnerJoin
394+ :: TableReference params schema right
395+ -> Condition params (Join left right)
396+ -> TableReference params schema left
397+ -> TableReference params schema (Join left right)
398+ LeftOuterJoin
399+ :: TableReference params schema right
400+ -> Condition params (Join left right)
401+ -> TableReference params schema left
402+ -> TableReference params schema (Join left (NullifyTables right))
403+ RightOuterJoin
404+ :: TableReference params schema right
405+ -> Condition params (Join left right)
406+ -> TableReference params schema left
407+ -> TableReference params schema (Join (NullifyTables left) right)
408+ FullOuterJoin
409+ :: TableReference params schema right
410+ -> Condition params (Join left right)
411+ -> TableReference params schema left
412+ -> TableReference params schema
413+ (Join (NullifyTables left) (NullifyTables right))
414+
415+renderTableReference :: TableReference params schema tables -> ByteString
416+renderTableReference = \case
417+ Table table -> renderAliased renderTable table
418+ Subquery selection -> renderAliased renderQuery selection
419+ CrossJoin right left -> mconcat
420+ [ renderTableReference left
421+ , " CROSS JOIN "
422+ , renderTableReference right
423+ ]
424+ InnerJoin right on left -> mconcat
425+ [ renderTableReference left
426+ , " INNER JOIN "
427+ , renderTableReference right
428+ , " ON "
429+ , renderExpression on
430+ ]
431+ LeftOuterJoin right on left -> mconcat
432+ [ renderTableReference left
433+ , " LEFT OUTER JOIN "
434+ , renderTableReference right
435+ , " ON "
436+ , renderExpression on
437+ ]
438+ RightOuterJoin right on left -> mconcat
439+ [ renderTableReference left
440+ , " RIGHT OUTER JOIN "
441+ , renderTableReference right
442+ , " ON "
443+ , renderExpression on
444+ ]
445+ FullOuterJoin right on left -> mconcat
446+ [ renderTableReference left
447+ , " FULL OUTER JOIN "
448+ , renderTableReference right
449+ , " ON "
450+ , renderExpression on
451+ ]
452+
453+data TableExpression
454+ (params :: [ColumnType])
455+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
456+ (tables :: [(Symbol,[(Symbol,ColumnType)])])
457+ = TableExpression
458+ { fromClause :: TableReference params schema tables
459+ , whereClause :: [Condition params tables]
460+ , limitClause :: Maybe Word64
461+ , offsetClause :: Maybe Word64
462+ }
463+
464+renderTableExpression
465+ :: TableExpression params schema tables
466+ -> ByteString
467+renderTableExpression (TableExpression tables whs' lims' offs') = mconcat
468+ [ "FROM ", renderTableReference tables
469+ , renderWheres whs'
470+ , renderLimits lims'
471+ , renderOffsets offs'
472+ ] where
473+ renderWheres = \case
474+ [] -> ""
475+ wh:[] -> " WHERE " <> renderExpression wh
476+ wh:whs -> " WHERE " <> renderExpression (foldr (&&*) wh whs)
477+ renderLimits = \case
478+ Nothing -> ""
479+ Just lim -> " LIMIT " <> fromString (show lim)
480+ renderOffsets = \case
481+ Nothing -> ""
482+ Just off -> " OFFSET " <> fromString (show off)
483+
484+from
485+ :: TableReference params schema tables
486+ -> TableExpression params schema tables
487+from tables = TableExpression tables [] Nothing Nothing
488+
489+where_
490+ :: Condition params tables
491+ -> TableExpression params schema tables
492+ -> TableExpression params schema tables
493+where_ wh tables = tables {whereClause = wh : whereClause tables}
494+
495+limit
496+ :: Word64
497+ -> TableExpression params schema tables
498+ -> TableExpression params schema tables
499+limit lim tables = tables
500+ {limitClause = maybe (Just lim) (Just . min lim) (limitClause tables)}
501+
502+offset
503+ :: Word64
504+ -> TableExpression params schema tables
505+ -> TableExpression params schema tables
506+offset off tables = tables
507+ {offsetClause = maybe (Just off) (Just . (off +)) (offsetClause tables)}
508+
380{-----------------------------------------
509{-----------------------------------------
381type expressions
510type expressions
382-----------------------------------------}
511-----------------------------------------}
@@ -511,209 +640,80 @@ instance PGTyped 'PGJsonb where pgtype = jsonb
511statements
640statements
512-----------------------------------------}
641-----------------------------------------}
513
642
514−newtype Statement
643+newtype DataDefinition
515− (params :: [ColumnType])
516− (columns :: [(Symbol,ColumnType)])
517 (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
644 (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
518 (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
645 (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
519− = UnsafeStatement { renderStatement :: ByteString }
646+ = UnsafeDataDefinition { renderDataDefinition :: ByteString }
520− deriving (Show,Eq)
521
647
522−-- newtype PreparedStatement
648+instance Category DataDefinition where
523−-- (params :: [ColumnType])
649+ id = UnsafeDataDefinition ";"
524−-- (columns :: [(Symbol,ColumnType)])
650+ dd1 . dd0 = UnsafeDataDefinition $
525−-- (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
651+ renderDataDefinition dd0 <> " " <> renderDataDefinition dd1
526−-- (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
527−-- = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
528−-- deriving (Show,Eq)
529−
530−{-----------------------------------------
531−SELECT statements
532−-----------------------------------------}
533
652
534−data Join params schema tables where
653+newtype DataManipulation
535− Table
536− :: Aliased (Table params schema) table
537− -> Join params schema '[table]
538− Subselect
539− :: Aliased (Selection params schema) table
540− -> Join params schema '[table]
541− Cross
542− :: Aliased (Table params schema) table
543− -> Join params schema tables
544− -> Join params schema (table ': tables)
545− Inner
546− :: Aliased (Table params schema) table
547− -> Predicate params (table ': tables)
548− -> Join params schema tables
549− -> Join params schema (table ': tables)
550− LeftOuter
551− :: Aliased (Table params schema) right
552− -> Predicate params '[left,right]
553− -> Join params schema (tables)
554− -> Join params schema (NullifyTable right ': left ': tables)
555− RightOuter
556− :: Aliased (Table params schema) right
557− -> Predicate params '[left,right]
558− -> Join params schema (left : tables)
559− -> Join params schema (right ': NullifyTable left ': tables)
560− FullOuter
561− :: Aliased (Table params schema) right
562− -> Predicate params '[left,right]
563− -> Join params schema (left : tables)
564− -> Join params schema
565− (NullifyTable right ': NullifyTable left ': tables)
566−
567−renderJoin :: Join params schema tables -> ByteString
568−renderJoin = \case
569− Table table -> renderAliased renderTable table
570− Subselect selection -> "SELECT " <> renderAliased renderSelection selection
571− Cross table tables -> mconcat
572− [ renderJoin tables
573− , " CROSS JOIN "
574− , renderAliased renderTable table
575− ]
576− Inner table on tables -> mconcat
577− [ renderJoin tables
578− , " INNER JOIN "
579− , renderAliased renderTable table
580− , " ON "
581− , renderExpression on
582− ]
583− LeftOuter table on tables -> mconcat
584− [ renderJoin tables
585− , " LEFT OUTER JOIN "
586− , renderAliased renderTable table
587− , " ON "
588− , renderExpression on
589− ]
590− RightOuter table on tables -> mconcat
591− [ renderJoin tables
592− , " RIGHT OUTER JOIN "
593− , renderAliased renderTable table
594− , " ON "
595− , renderExpression on
596− ]
597− FullOuter table on tables -> mconcat
598− [ renderJoin tables
599− , " FULL OUTER JOIN "
600− , renderAliased renderTable table
601− , " ON "
602− , renderExpression on
603− ]
604−
605−instance HasTable table schema columns
606− => IsLabel table (Join params schema '[table ::: columns]) where
607− fromLabel p = Table $ fromLabel p
608−
609−data TableExpression
610− (params :: [ColumnType])
611 (schema :: [(Symbol,[(Symbol,ColumnType)])])
654 (schema :: [(Symbol,[(Symbol,ColumnType)])])
612− (tables :: [(Symbol,[(Symbol,ColumnType)])])
613− = TableExpression
614− { joinClause :: Join params schema tables
615− , whereClause :: [Predicate params tables]
616− , limitClause :: [Expression params '[] ('Required ('NotNull 'PGInt8))]
617− , offsetClause :: [Expression params '[] ('Required ('NotNull 'PGInt8))]
618− }
619−
620−renderTableExpression :: TableExpression params schema tables -> ByteString
621−renderTableExpression (TableExpression tables whs' lims' offs') = mconcat
622− [ renderJoin tables
623− , renderWheres whs'
624− , renderLimits lims'
625− , renderOffsets offs'
626− ] where
627− renderWheres = \case
628− [] -> ""
629− wh:[] -> " WHERE " <> renderExpression wh
630− wh:whs -> " WHERE " <> renderExpression (foldr (&&*) wh whs)
631− renderLimits = \case
632− [] -> ""
633− lim:[] -> " LIMIT " <> renderExpression lim
634− lims -> mconcat
635− [ " LIMIT LEAST("
636− , ByteString.intercalate ", " (renderExpression <$> reverse lims)
637− , ")"
638− ]
639− renderOffsets = \case
640− [] -> ""
641− off:[] -> " OFFSET " <> renderExpression off
642− off:offs -> " OFFSET " <> renderExpression (foldr (+) off offs)
643−
644−instance (HasTable table schema columns, table ~ table')
645− => IsLabel table (TableExpression params schema '[table' ::: columns]) where
646− fromLabel p = join (fromLabel p)
647−
648−join
649− :: Join params schema tables
650− -> TableExpression params schema tables
651−join tables = TableExpression tables [] [] []
652−
653−where_
654− :: Predicate params tables
655− -> TableExpression params schema tables
656− -> TableExpression params schema tables
657−where_ wh (TableExpression tabs whs lims offs) =
658− TableExpression tabs (wh:whs) lims offs
659−
660−limit
661− :: Expression params '[] ('Required ('NotNull 'PGInt8))
662− -> TableExpression params schema tables
663− -> TableExpression params schema tables
664−limit lim (TableExpression tabs whs lims offs) =
665− TableExpression tabs whs (lim:lims) offs
666−
667−offset
668− :: Expression params '[] ('Required ('NotNull 'PGInt8))
669− -> TableExpression params schema tables
670− -> TableExpression params schema tables
671−offset off (TableExpression tabs whs lims offs) =
672− TableExpression tabs whs lims (off:offs)
673−
674−newtype Selection
675 (params :: [ColumnType])
655 (params :: [ColumnType])
676− (schema :: [(Symbol,[(Symbol,ColumnType)])])
677 (columns :: [(Symbol,ColumnType)])
656 (columns :: [(Symbol,ColumnType)])
678− = UnsafeSelection { renderSelection :: ByteString }
657+ = UnsafeDataManipulation { renderDataManipulation :: ByteString }
679− deriving (Show,Eq)
680
658
681−starFrom
659+newtype Query
682− :: tables ~ '[table ::: columns]
660+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
683− => TableExpression params schema tables
661+ (params :: [ColumnType])
662+ (columns :: [(Symbol,ColumnType)])
663+ = UnsafeQuery { renderQuery :: ByteString }
664+
665+query
666+ :: Query schema params columns
667+ -> DataManipulation schema params columns
668+query q = UnsafeDataManipulation $ renderQuery q <> ";"
669+
670+union, unionAll, intersect, intersectAll, except, exceptAll
671+ :: Query schema params columns
672+ -> Query schema params columns
684− -> Selection params schema columns
673+ -> Query schema params columns
685−starFrom tabs = UnsafeSelection $ "* FROM " <> renderTableExpression tabs
674+q1 `union` q2 = UnsafeQuery $
675+ renderQuery q1 <> " UNION " <> renderQuery q2
676+q1 `unionAll` q2 = UnsafeQuery $
677+ renderQuery q1 <> " UNION ALL " <> renderQuery q2
678+q1 `intersect` q2 = UnsafeQuery $
679+ renderQuery q1 <> " INTERSECT " <> renderQuery q2
680+q1 `intersectAll` q2 = UnsafeQuery $
681+ renderQuery q1 <> " INTERSECT ALL " <> renderQuery q2
682+q1 `except` q2 = UnsafeQuery $
683+ renderQuery q1 <> " EXCEPT " <> renderQuery q2
684+q1 `exceptAll` q2 = UnsafeQuery $
685+ renderQuery q1 <> " EXCEPT ALL " <> renderQuery q2
686
686
687−dotStarFrom
687+{-----------------------------------------
688− :: HasTable table tables columns
688+SELECT statements
689− => Alias table
689+-----------------------------------------}
690− -> TableExpression params schema tables
691− -> Selection params schema columns
692−table `dotStarFrom` tables = UnsafeSelection $
693− renderAlias table <> ".* FROM " <> renderTableExpression tables
694
690
695−from
691+select
696 :: SListI columns
692 :: SListI columns
697 => NP (Aliased (Expression params tables)) columns
693 => NP (Aliased (Expression params tables)) columns
698 -> TableExpression params schema tables
694 -> TableExpression params schema tables
699− -> Selection params schema columns
695+ -> Query schema params columns
700−list `from` tabs = UnsafeSelection $
696+select list tabs = UnsafeQuery $
701− renderList list <> " FROM " <> renderTableExpression tabs
697+ "SELECT " <> renderList list <> " " <> renderTableExpression tabs
702 where
698 where
703 renderList
699 renderList
704 = ByteString.intercalate ", "
700 = ByteString.intercalate ", "
705 . hcollapse
701 . hcollapse
706 . hmap (K . renderAliased renderExpression)
702 . hmap (K . renderAliased renderExpression)
707
703
708−select
704+selectStar
709− :: Selection params schema columns
705+ :: (tables ~ '[table ::: columns])
706+ => TableExpression params schema tables
710− -> Statement params columns schema schema
707+ -> Query schema params columns
711−select = UnsafeStatement . ("SELECT " <>) . (<> ";") . renderSelection
708+selectStar tabs = UnsafeQuery $ "SELECT * " <> renderTableExpression tabs
712
709
713−subselect
710+selectDotStar
714− :: Aliased (Selection params schema) table
711+ :: HasTable table tables columns
712+ => Alias table
715− -> TableExpression params schema '[table]
713+ -> TableExpression params schema tables
716−subselect selection = join (Subselect selection)
714+ -> Query schema params columns
715+selectDotStar table tables = UnsafeQuery $
716+ "SELECT " <> renderAlias table <> ".* " <> renderTableExpression tables
717
717
718{-----------------------------------------
718{-----------------------------------------
719CREATE statements
719CREATE statements
@@ -723,8 +723,8 @@ createTable
723 :: (KnownSymbol table, SListI columns)
723 :: (KnownSymbol table, SListI columns)
724 => Alias table
724 => Alias table
725 -> NP (Aliased TypeExpression) columns
725 -> NP (Aliased TypeExpression) columns
726− -> Statement '[] '[] schema (Create table columns schema)
726+ -> DataDefinition schema (Create table columns schema)
727−createTable table columns = UnsafeStatement $ mconcat
727+createTable table columns = UnsafeDataDefinition $ mconcat
728 [ "CREATE TABLE "
728 [ "CREATE TABLE "
729 , renderAlias table
729 , renderAlias table
730 , " ("
730 , " ("
@@ -744,9 +744,8 @@ DROP statements
744dropTable
744dropTable
745 :: KnownSymbol table
745 :: KnownSymbol table
746 => Alias table
746 => Alias table
747− -> Statement '[] '[] schema (Drop table schema)
747+ -> DataDefinition schema (Drop table schema)
748−dropTable table = UnsafeStatement $
749− "DROP TABLE " <> renderAlias table <> ";"
748+dropTable table = UnsafeDataDefinition $ "DROP TABLE " <> renderAlias table <> ";"
750
749
751{-----------------------------------------
750{-----------------------------------------
752ALTER statements
751ALTER statements
@@ -756,8 +755,8 @@ alterTable
756 :: HasTable table schema columns0
755 :: HasTable table schema columns0
757 => Alias table
756 => Alias table
758 -> AlterTable columns0 columns1
757 -> AlterTable columns0 columns1
759− -> Statement '[] '[] schema (Alter table schema columns1)
758+ -> DataDefinition schema (Alter table schema columns1)
760−alterTable table alteration = UnsafeStatement $
759+alterTable table alteration = UnsafeDataDefinition $
761 "ALTER TABLE "
760 "ALTER TABLE "
762 <> renderAlias table
761 <> renderAlias table
763 <> " "
762 <> " "
@@ -768,8 +767,8 @@ alterTableRename
768 :: (KnownSymbol table0, KnownSymbol table1)
767 :: (KnownSymbol table0, KnownSymbol table1)
769 => Alias table0
768 => Alias table0
770 -> Alias table1
769 -> Alias table1
771− -> Statement '[] '[] schema (Rename table0 table1 schema)
770+ -> DataDefinition schema (Rename table0 table1 schema)
772−alterTableRename table0 table1 = UnsafeStatement $
771+alterTableRename table0 table1 = UnsafeDataDefinition $
773 "ALTER TABLE "
772 "ALTER TABLE "
774 <> renderAlias table0
773 <> renderAlias table0
775 <> " RENAME TO "
774 <> " RENAME TO "
@@ -862,8 +861,8 @@ insertInto
862 :: (SListI columns, HasTable table schema columns)
861 :: (SListI columns, HasTable table schema columns)
863 => Alias table
862 => Alias table
864 -> NP (Aliased (Expression params '[])) columns
863 -> NP (Aliased (Expression params '[])) columns
865− -> Statement params '[] schema schema
864+ -> DataManipulation schema params '[]
866−insertInto table expressions = UnsafeStatement $ "INSERT INTO "
865+insertInto table expressions = UnsafeDataManipulation $ "INSERT INTO "
867 <> renderAlias table
866 <> renderAlias table
868 <> " (" <> ByteString.intercalate ", " aliases
867 <> " (" <> ByteString.intercalate ", " aliases
869 <> ") VALUES ("
868 <> ") VALUES ("
@@ -882,9 +881,9 @@ insertIntoReturning
882 => Alias table
881 => Alias table
883 -> NP (Aliased (Expression params '[])) columns
882 -> NP (Aliased (Expression params '[])) columns
884 -> NP (Aliased (Expression params '[table ::: columns])) results
883 -> NP (Aliased (Expression params '[table ::: columns])) results
885− -> Statement params results schema schema
884+ -> DataManipulation schema params results
886insertIntoReturning table inserts results
885insertIntoReturning table inserts results
887− = UnsafeStatement . mconcat $
886+ = UnsafeDataManipulation . mconcat $
888 [ "INSERT INTO "
887 [ "INSERT INTO "
889 , renderAlias table
888 , renderAlias table
890 , " (" <> ByteString.intercalate ", " aliases
889 , " (" <> ByteString.intercalate ", " aliases
@@ -929,9 +928,9 @@ update
929 :: (HasTable table schema columns, SListI columns)
928 :: (HasTable table schema columns, SListI columns)
930 => Alias table
929 => Alias table
931 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
930 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
932− -> Predicate params '[table ::: columns]
931+ -> Condition params '[table ::: columns]
933− -> Statement params '[] schema schema
932+ -> DataManipulation schema params '[]
934−update table columns wh = UnsafeStatement $ mconcat
933+update table columns wh = UnsafeDataManipulation $ mconcat
935 [ "UPDATE "
934 [ "UPDATE "
936 , renderAlias table
935 , renderAlias table
937 , " SET "
936 , " SET "
@@ -944,10 +943,10 @@ updateReturning
944 :: (SListI columns, SListI results, HasTable table schema columns)
943 :: (SListI columns, SListI results, HasTable table schema columns)
945 => Alias table
944 => Alias table
946 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
945 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
947− -> Predicate params '[table ::: columns]
946+ -> Condition params '[table ::: columns]
948 -> NP (Aliased (Expression params '[table ::: columns])) results
947 -> NP (Aliased (Expression params '[table ::: columns])) results
949− -> Statement params results schema schema
948+ -> DataManipulation schema params results
950−updateReturning table updates wh results = UnsafeStatement $ mconcat
949+updateReturning table updates wh results = UnsafeDataManipulation $ mconcat
951 [ "UPDATE "
950 [ "UPDATE "
952 , renderAlias table
951 , renderAlias table
953 , " SET "
952 , " SET "
@@ -968,9 +967,9 @@ upsertInto
968 => Alias table
967 => Alias table
969 -> NP (Aliased (Expression params '[])) columns
968 -> NP (Aliased (Expression params '[])) columns
970 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
969 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
971− -> Predicate params '[table ::: columns]
970+ -> Condition params '[table ::: columns]
972− -> Statement params '[] schema schema
971+ -> DataManipulation schema params '[]
973−upsertInto table inserts updates wh = UnsafeStatement . mconcat $
972+upsertInto table inserts updates wh = UnsafeDataManipulation . mconcat $
974 [ "INSERT INTO "
973 [ "INSERT INTO "
975 , renderAlias table
974 , renderAlias table
976 , " (" <> ByteString.intercalate ", " aliases
975 , " (" <> ByteString.intercalate ", " aliases
@@ -995,11 +994,11 @@ upsertIntoReturning
995 => Alias table
994 => Alias table
996 -> NP (Aliased (Expression params '[])) columns
995 -> NP (Aliased (Expression params '[])) columns
997 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
996 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
998− -> Predicate params '[table ::: columns]
997+ -> Condition params '[table ::: columns]
999 -> NP (Aliased (Expression params '[table ::: columns])) results
998 -> NP (Aliased (Expression params '[table ::: columns])) results
1000− -> Statement params results schema schema
999+ -> DataManipulation schema params results
1001upsertIntoReturning table inserts updates wh results =
1000upsertIntoReturning table inserts updates wh results =
1002− UnsafeStatement . mconcat $
1001+ UnsafeDataManipulation . mconcat $
1003 [ "INSERT INTO "
1002 [ "INSERT INTO "
1004 , renderAlias table
1003 , renderAlias table
1005 , " (" <> ByteString.intercalate ", " aliases
1004 , " (" <> ByteString.intercalate ", " aliases
@@ -1032,9 +1031,9 @@ DELETE statements
1032deleteFrom
1031deleteFrom
1033 :: HasTable table schema columns
1032 :: HasTable table schema columns
1034 => Alias table
1033 => Alias table
1035− -> Predicate params '[table ::: columns]
1034+ -> Condition params '[table ::: columns]
1036− -> Statement params '[] schema schema
1035+ -> DataManipulation schema params '[]
1037−deleteFrom table wh = UnsafeStatement $ mconcat
1036+deleteFrom table wh = UnsafeDataManipulation $ mconcat
1038 [ "DELETE FROM "
1037 [ "DELETE FROM "
1039 , renderAlias table
1038 , renderAlias table
1040 , " WHERE ", renderExpression wh, ";"
1039 , " WHERE ", renderExpression wh, ";"
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+95−81
@@ -18,129 +18,142 @@ import Squeel.PostgreSQL.Schema
18spec :: Spec
18spec :: Spec
19spec = do
19spec = do
20 let
20 let
21− query `shouldRenderAs` str = renderStatement query `shouldBe` str
21+ qry `queryRenders` str = query qry `manipulationRenders` str
22+ definition `definitionRenders` str =
23+ renderDataDefinition definition `shouldBe` str
24+ manipulation `manipulationRenders` str =
25+ renderDataManipulation manipulation `shouldBe` str
22 it "correctly renders a simple SELECT query" $ do
26 it "correctly renders a simple SELECT query" $ do
23 let
27 let
24− statement :: Statement '[] SumAndCol1 Tables Tables
28+ statement :: Query Tables '[] SumAndCol1
25− statement = select $
29+ statement = select
26− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
30+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
27− `from` (#table1 & where_ (#col1 >* #col2))
31+ (from (Table (#table1 `As` #table1)) & where_ (#col1 >* #col2))
28− statement `shouldRenderAs`
32+ statement `queryRenders`
29 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (col1 > col2);"
33 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (col1 > col2);"
30 it "combines WHEREs using AND" $ do
34 it "combines WHEREs using AND" $ do
31 let
35 let
32− statement :: Statement '[] SumAndCol1 Tables Tables
36+ statement :: Query Tables '[] SumAndCol1
33− statement = select $
37+ statement = select
34− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
38+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
35− `from` (#table1 & where_ true & where_ false)
39+ (from (Table (#table1 `As` #table1)) & where_ true & where_ false)
36− statement `shouldRenderAs`
40+ statement `queryRenders`
37 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (TRUE AND FALSE);"
41 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (TRUE AND FALSE);"
38 it "performs sub SELECTs" $ do
42 it "performs sub SELECTs" $ do
39 let
43 let
44+ selection = select
40− selection = ((#col1 + #col2) `As` #sum :* #col1 :* Nil) `from` #table1
45+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
46+ (from (Table (#table1 `As` #table1)))
41− statement :: Statement '[] SumAndCol1 Tables Tables
47+ statement :: Query Tables '[] SumAndCol1
42− statement = select $ starFrom (subselect (selection `As` #sub))
48+ statement = selectStar (from (Subquery (selection `As` #sub)))
43− statement `shouldRenderAs`
49+ statement `queryRenders`
44 "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 AS sub;"
50 "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 AS sub;"
45 it "does LIMIT clauses" $ do
51 it "does LIMIT clauses" $ do
46 let
52 let
47− statement :: Statement '[] Columns Tables Tables
53+ statement :: Query Tables '[] Columns
48− statement = select $ starFrom (#table1 & limit 1)
54+ statement = selectStar
55+ (from (Table (#table1 `As` #table1)) & limit 1)
49− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT 1;"
56+ statement `queryRenders` "SELECT * FROM table1 AS table1 LIMIT 1;"
50 it "should use the minimum of given LIMITs" $ do
57 it "should use the minimum of given LIMITs" $ do
51 let
58 let
52− statement :: Statement '[] Columns Tables Tables
59+ statement :: Query Tables '[] Columns
60+ statement = selectStar
53− statement = select $ starFrom (#table1 & limit 1 & limit 2)
61+ (from (Table (#table1 `As` #table1)) & limit 1 & limit 2)
54− statement `shouldRenderAs`
62+ statement `queryRenders`
55− "SELECT * FROM table1 AS table1 LIMIT LEAST(1, 2);"
63+ "SELECT * FROM table1 AS table1 LIMIT 1;"
56 it "should render parameters using $ signs" $ do
64 it "should render parameters using $ signs" $ do
57 let
65 let
58− statement :: Statement '[ 'Required ('NotNull 'PGInt8)] Columns Tables Tables
66+ statement :: Query Tables '[ 'Required ('NotNull 'PGBool)] Columns
59− statement = select $ starFrom (#table1 & limit param1)
67+ statement = selectStar
68+ (from (Table (#table1 `As` #table1)) & where_ param1)
60− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT $1;"
69+ statement `queryRenders` "SELECT * FROM table1 AS table1 WHERE $1;"
61 it "does OFFSET clauses" $ do
70 it "does OFFSET clauses" $ do
62 let
71 let
63− statement :: Statement '[] Columns Tables Tables
72+ statement :: Query Tables '[] Columns
64− statement = select $ starFrom (#table1 & offset 1)
73+ statement = selectStar
74+ (from (Table (#table1 `As` #table1)) & offset 1)
65− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET 1;"
75+ statement `queryRenders` "SELECT * FROM table1 AS table1 OFFSET 1;"
66 it "should use the sum of given OFFSETs" $ do
76 it "should use the sum of given OFFSETs" $ do
67 let
77 let
68− statement :: Statement '[] Columns Tables Tables
78+ statement :: Query Tables '[] Columns
79+ statement = selectStar
69− statement = select $ starFrom (#table1 & offset 1 & offset 2)
80+ (from (Table (#table1 `As` #table1)) & offset 1 & offset 2)
70− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET (1 + 2);"
81+ statement `queryRenders` "SELECT * FROM table1 AS table1 OFFSET 3;"
71 it "correctly renders simple INSERTs" $ do
82 it "correctly renders simple INSERTs" $ do
72 let
83 let
73− statement :: Statement '[] '[] Tables Tables
84+ statement :: DataManipulation Tables '[] '[]
74 statement = insertInto #table1 $ 2 `As` #col1 :* 4 `As` #col2 :* Nil
85 statement = insertInto #table1 $ 2 `As` #col1 :* 4 `As` #col2 :* Nil
75− statement `shouldRenderAs`
86+ statement `manipulationRenders`
76 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"
87 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"
77 it "correctly renders returning INSERTs" $ do
88 it "correctly renders returning INSERTs" $ do
78 let
89 let
79− statement :: Statement '[] SumAndCol1 Tables Tables
90+ statement :: DataManipulation Tables '[] SumAndCol1
80 statement = insertIntoReturning #table1
91 statement = insertIntoReturning #table1
81 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
92 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
82− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
93+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
83− statement `shouldRenderAs`
94+ statement `manipulationRenders`
84 "INSERT INTO table1 (col1, col2) VALUES (2, 4) RETURNING (col1 + col2) AS sum, col1 AS col1;"
95 "INSERT INTO table1 (col1, col2) VALUES (2, 4) RETURNING (col1 + col2) AS sum, col1 AS col1;"
85 it "correctly renders simple UPDATEs" $ do
96 it "correctly renders simple UPDATEs" $ do
86 let
97 let
87− statement :: Statement '[] '[] Tables Tables
98+ statement :: DataManipulation Tables '[] '[]
99+ statement = update #table1
88− statement = update #table1 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil) (#col1 /=* #col2)
100+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
89− statement `shouldRenderAs`
101+ (#col1 /=* #col2)
102+ statement `manipulationRenders`
90 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
103 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
91 it "correctly renders returning UPDATEs" $ do
104 it "correctly renders returning UPDATEs" $ do
92 let
105 let
93− statement :: Statement '[] SumAndCol1 Tables Tables
106+ statement :: DataManipulation Tables '[] SumAndCol1
94 statement = updateReturning #table1
107 statement = updateReturning #table1
95 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
108 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
96 (#col1 /=* #col2)
109 (#col1 /=* #col2)
97− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
110+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
98− statement `shouldRenderAs`
111+ statement `manipulationRenders`
99 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2) RETURNING (col1 + col2) AS sum, col1 AS col1;"
112 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2) RETURNING (col1 + col2) AS sum, col1 AS col1;"
100 it "correctly renders upsert INSERTs" $ do
113 it "correctly renders upsert INSERTs" $ do
101 let
114 let
102− statement :: Statement '[] '[] Tables Tables
115+ statement :: DataManipulation Tables '[] '[]
103 statement = upsertInto #table1
116 statement = upsertInto #table1
104 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
117 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
105 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
118 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
106 (#col1 /=* #col2)
119 (#col1 /=* #col2)
107− statement `shouldRenderAs`
120+ statement `manipulationRenders`
108 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
121 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
109 it "correctly renders returning upsert INSERTs" $ do
122 it "correctly renders returning upsert INSERTs" $ do
110 let
123 let
111− statement :: Statement '[] SumAndCol1 Tables Tables
124+ statement :: DataManipulation Tables '[] SumAndCol1
112 statement = upsertIntoReturning #table1
125 statement = upsertIntoReturning #table1
113 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
126 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
114 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
127 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
115 (#col1 /=* #col2)
128 (#col1 /=* #col2)
116− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
129+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
117− statement `shouldRenderAs`
130+ statement `manipulationRenders`
118 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2) RETURNING (col1 + col2) AS sum, col1 AS col1;"
131 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2) RETURNING (col1 + col2) AS sum, col1 AS col1;"
119 it "correctly renders DELETEs" $ do
132 it "correctly renders DELETEs" $ do
120 let
133 let
121− statement :: Statement '[] '[] Tables Tables
134+ statement :: DataManipulation Tables '[] '[]
122 statement = deleteFrom #table1 (#col1 ==* #col2)
135 statement = deleteFrom #table1 (#col1 ==* #col2)
123− statement `shouldRenderAs`
136+ statement `manipulationRenders`
124 "DELETE FROM table1 WHERE (col1 = col2);"
137 "DELETE FROM table1 WHERE (col1 = col2);"
125 it "should be safe against SQL injection in literal text" $ do
138 it "should be safe against SQL injection in literal text" $ do
126 let
139 let
127− statement :: Statement '[] '[] StudentsTable StudentsTable
140+ statement :: DataManipulation StudentsTable '[] '[]
128 statement = insertInto #students $
141 statement = insertInto #students $
129 "Robert'); DROP TABLE students;" `As` #name :* Nil
142 "Robert'); DROP TABLE students;" `As` #name :* Nil
130− statement `shouldRenderAs`
143+ statement `manipulationRenders`
131 "INSERT INTO students (name) VALUES (E'Robert''); DROP TABLE students;');"
144 "INSERT INTO students (name) VALUES (E'Robert''); DROP TABLE students;');"
132 describe "JOINs" $ do
145 describe "JOINs" $ do
133− let
134− vals =
135− (#orders &. #orderVal) `As` #orderVal
136− :* (#customers &. #customerVal) `As` #customerVal
137− :* (#shippers &. #shipperVal) `As` #shipperVal :* Nil
138 it "should render CROSS JOINs" $ do
146 it "should render CROSS JOINs" $ do
139 let
147 let
140− statement :: Statement '[] ValueColumns JoinTables JoinTables
148+ statement :: Query JoinTables '[] ValueColumns
141− statement = select $ vals `from`
149+ statement = select
142− (join (#orders & Cross #customers & Cross #shippers))
150+ ( (#orders &. #orderVal) `As` #orderVal
151+ :* (#customers &. #customerVal) `As` #customerVal
152+ :* (#shippers &. #shipperVal) `As` #shipperVal :* Nil)
153+ ( from (Table (#orders `As` #orders)
154+ & CrossJoin (Table (#customers `As` #customers))
155+ & CrossJoin (Table (#shippers `As` #shippers))))
143− statement `shouldRenderAs`
156+ statement `queryRenders`
144 "SELECT\
157 "SELECT\
145 \ orders.orderVal AS orderVal,\
158 \ orders.orderVal AS orderVal,\
146 \ customers.customerVal AS customerVal,\
159 \ customers.customerVal AS customerVal,\
@@ -150,16 +163,17 @@ spec = do
150 \ CROSS JOIN shippers AS shippers;"
163 \ CROSS JOIN shippers AS shippers;"
151 it "should render INNER JOINs" $ do
164 it "should render INNER JOINs" $ do
152 let
165 let
153− innerJoins :: TableExpression '[] JoinTables JoinTables
166+ statement :: Query JoinTables '[] ValueColumns
154− innerJoins = join $
167+ statement = select
155− #orders
168+ ( (#orders &. #orderVal) `As` #orderVal
156− & Inner #customers
169+ :* (#customers &. #customerVal) `As` #customerVal
157− ((#orders &. #customerID) ==* (#customers &. #customerID))
170+ :* (#shippers &. #shipperVal) `As` #shipperVal :* Nil)
158− & Inner #shippers
171+ ( from (Table (#orders `As` #orders)
159− ((#orders &. #shipperID) ==* (#shippers &. #shipperID))
172+ & InnerJoin (Table (#customers `As` #customers))
160− selection :: Statement '[] ValueColumns JoinTables JoinTables
173+ ((#orders &. #customerID) ==* (#customers &. #customerID))
161− selection = select $ vals `from` innerJoins
174+ & InnerJoin (Table (#shippers `As` #shippers))
162− selection `shouldRenderAs`
175+ ((#orders &. #shipperID) ==* (#shippers &. #shipperID))))
176+ statement `queryRenders`
163 "SELECT\
177 "SELECT\
164 \ orders.orderVal AS orderVal,\
178 \ orders.orderVal AS orderVal,\
165 \ customers.customerVal AS customerVal,\
179 \ customers.customerVal AS customerVal,\
@@ -171,11 +185,11 @@ spec = do
171 \ ON (orders.shipperID = shippers.shipperID);"
185 \ ON (orders.shipperID = shippers.shipperID);"
172 it "should render self JOINs" $ do
186 it "should render self JOINs" $ do
173 let
187 let
174− statement :: Statement '[] OrderColumns JoinTables JoinTables
188+ statement :: Query JoinTables '[] OrderColumns
175− statement = select $ #orders1 `dotStarFrom`
189+ statement = selectDotStar #orders1
176− (join (Table (#orders `As` #orders1)
190+ (from (Table (#orders `As` #orders1)
177− & Cross (#orders `As` #orders2)))
191+ & CrossJoin (Table (#orders `As` #orders2))))
178− statement `shouldRenderAs`
192+ statement `queryRenders`
179 "SELECT orders1.*\
193 "SELECT orders1.*\
180 \ FROM orders AS orders1\
194 \ FROM orders AS orders1\
181 \ CROSS JOIN orders AS orders2;"
195 \ CROSS JOIN orders AS orders2;"
@@ -184,20 +198,20 @@ spec = do
184 ( (int4 & notNull) `As` #col1
198 ( (int4 & notNull) `As` #col1
185 :* (int4 & notNull) `As` #col2
199 :* (int4 & notNull) `As` #col2
186 :* Nil)
200 :* Nil)
187− `shouldRenderAs`
201+ `definitionRenders`
188 "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"
202 "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"
189 createTable #table2
203 createTable #table2
190 ( serial `As` #col1
204 ( serial `As` #col1
191 :* text `As` #col2
205 :* text `As` #col2
192 :* (int8 & notNull & default_ 8) `As` #col3
206 :* (int8 & notNull & default_ 8) `As` #col3
193 :* Nil)
207 :* Nil)
194− `shouldRenderAs`
208+ `definitionRenders`
195 "CREATE TABLE table2 (col1 serial, col2 text, col3 int8 NOT NULL DEFAULT 8);"
209 "CREATE TABLE table2 (col1 serial, col2 text, col3 int8 NOT NULL DEFAULT 8);"
196 it "should render DROP TABLE statements" $ do
210 it "should render DROP TABLE statements" $ do
197 let
211 let
198− statement :: Statement '[] '[] Tables '[]
212+ statement :: DataDefinition Tables '[]
199 statement = dropTable #table1
213 statement = dropTable #table1
200− statement `shouldRenderAs` "DROP TABLE table1;"
214+ statement `definitionRenders` "DROP TABLE table1;"
201
215
202type Columns =
216type Columns =
203 '[ "col1" ::: 'Required ('NotNull 'PGInt4)
217 '[ "col1" ::: 'Required ('NotNull 'PGInt4)
@@ -222,9 +236,9 @@ type ShipperColumns =
222 , "shipperVal" ::: 'Required ('NotNull 'PGBool)
236 , "shipperVal" ::: 'Required ('NotNull 'PGBool)
223 ]
237 ]
224type JoinTables =
238type JoinTables =
225− '[ "shippers" ::: ShipperColumns
239+ '[ "orders" ::: OrderColumns
226 , "customers" ::: CustomerColumns
240 , "customers" ::: CustomerColumns
227− , "orders" ::: OrderColumns
241+ , "shippers" ::: ShipperColumns
228 ]
242 ]
229type ValueColumns =
243type ValueColumns =
230 '[ "orderVal" ::: 'Required ('NotNull 'PGText)
244 '[ "orderVal" ::: 'Required ('NotNull 'PGText)