git.iko.soy/squeal
on dev help sign in
rejiggering
commit6adfc90c81d5171c7223dc11e1511d99839fb48e authorEitan Chatav <eitan.chatav@gmail.com> dateSun 6 Aug 2017, 13:37 (9 years ago) parentf0422c5
5 files changed+376−398
compare with dev
unifiedsplit
squeel-postgresql/exe/Example.hs+20−20 squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+6−44 squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+22−19 squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+233−234 squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+95−81
squeel-postgresql/exe/Example.hs+20−20
@@ -10,13 +10,15 @@
1010
1111module Main (main) where
1212
13+import Control.Category ((>>>))
1314import Control.Monad.Base
1415import Control.Monad.Except
1516import Control.Monad.Trans.Maybe
17+import Data.Foldable (for_)
1618import Data.Function ((&))
1719import Data.Int
1820import Data.Monoid
19−import Generics.SOP
21+import Generics.SOP hiding (from)
2022import Squeel.PostgreSQL
2123
2224import qualified Data.ByteString.Char8 as Char8
@@ -29,23 +31,22 @@ main = do
2931 Char8.putStrLn $ "connecting to " <> connectionString
3032 connection0 :: Connection '[] <- connectdb connectionString
3133 Char8.putStrLn "setting up database"
32− connection1 <- flip execPQ connection0 $
33− pqExec
34− ( createTable #students
35− ( (text & notNull) `As` #name
36− :* Nil ) )
37− & pqThenExec
38− ( createTable #table1
39− ( (int4 & notNull) `As` #col1
40− :* (int4 & notNull) `As` #col2
41− :* 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 ) )
34+ connection1 :: Connection Tables <- flip execPQ connection0 $ pqExec $
35+ createTable #students
36+ ( (text & notNull) `As` #name
37+ :* Nil )
38+ >>>
39+ createTable #table1
40+ ( (int4 & notNull) `As` #col1
41+ :* (int4 & notNull) `As` #col2
42+ :* Nil )
4643 Char8.putStrLn "querying"
47− connection2 <- flip execPQ connection1 $ do
48− Just result <- pqExecNil $ select $ starFrom #table1
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 . query $
49+ selectStar (from (Table (#table1 `As` #table1)))
4950 runMaybeT . runExceptT . flip runValue result $ do
5051 value00 <- getValue (RowNumber 0) (columnNumber @0)
5152 value01 <- getValue (RowNumber 0) (columnNumber @1)
@@ -61,9 +62,8 @@ main = do
6162 print (row0 :: NP I '[Int32,Int32])
6263 print (row1 :: NP I '[Int32,Int32])
6364 Char8.putStrLn "tearing down database"
64− connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec
65− (dropTable #table1 :: Statement '[] '[] Tables '["students" ::: StudentsColumns])
66− & pqThenExec (dropTable #students)
65+ connection3 :: Connection '[] <- flip execPQ connection2 $ pqExec $
66+ dropTable #table1 >>> dropTable #students
6767 finish connection3
6868
6969type Columns =
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+6−44
@@ -77,49 +77,29 @@ class AtkeyPQ pq where
7777
7878 pqExec
7979 :: MonadBase IO io
80− => Statement '[] '[] db0 db1
80+ => DataDefinition db0 db1
8181 -> pq db0 db1 io (Maybe (Result '[]))
8282
8383 pqThenExec
8484 :: MonadBase IO io
85− => Statement '[] '[] db1 db2
85+ => DataDefinition db1 db2
8686 -> pq db0 db1 io x
8787 -> pq db0 db2 io (Maybe (Result '[]))
8888 pqThenExec = pqThen . pqExec
8989
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−
10490class MonadPQ db m | m -> db where
10591
10692 pqExecParams
10793 :: (ToOids ps, AllZip HasEncoding ps xs)
108− => Statement ps ys db db
94+ => DataManipulation db ps ys
10995 -> NP I xs
11096 -> m (Maybe (Result ys))
11197
11298 pqExecNil
113− :: Statement '[] ys db db
99+ :: DataManipulation db '[] ys
114100 -> m (Maybe (Result ys))
115101 pqExecNil statement = pqExecParams statement Nil
116102
117− -- pqExecPrepared
118− -- :: AllZip HasEncoding ps xs
119− -- => PreparedStatement ps ys db db
120− -- -> NP I xs
121− -- -> m (Maybe (Result ys))
122−
123103instance AtkeyPQ PQ where
124104
125105 pqAp (PQ f) (PQ x) = PQ $ \ conn -> do
@@ -131,22 +111,13 @@ instance AtkeyPQ PQ where
131111 (x', conn') <- x conn
132112 runPQ (f x') conn'
133113
134− pqExec (UnsafeStatement q) = PQ $ \ (Connection conn) -> do
114+ pqExec (UnsafeDataDefinition q) = PQ $ \ (Connection conn) -> do
135115 result <- liftBase $ LibPQ.exec conn q
136116 return (Result <$> result, Connection conn)
137117
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−
147118instance MonadBase IO io => MonadPQ db (PQ db db io) where
148119
149− pqExecParams (UnsafeStatement q :: Statement ps ys db0 db1) params =
120+ pqExecParams (UnsafeDataManipulation q :: DataManipulation db ps ys) params =
150121 PQ $ \ (Connection conn) -> do
151122 let
152123 paramValues = encodings (Proxy :: Proxy ps) params
@@ -158,15 +129,6 @@ instance MonadBase IO io => MonadPQ db (PQ db db io) where
158129 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
159130 return (Result <$> result, Connection conn)
160131
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−
170132instance Monad m => Applicative (PQ db db m) where
171133 pure x = PQ $ \ conn -> pure (x, conn)
172134 (<*>) = pqAp
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+22−19
@@ -26,14 +26,15 @@ module Squeel.PostgreSQL.Schema
2626 , Aliased (As)
2727 , renderAliased
2828 , NullityType (..)
29− , NullifyColumn
29+ , NullifyType
3030 , NullifyColumns
31− , NullifyTable
31+ , NullifyTables
32+ , ColumnType (..)
3233 , Create
3334 , Drop
3435 , Alter
3536 , Rename
36− , ColumnType (..)
37+ , Join
3738 , module GHC.OverloadedLabels
3839 , module GHC.TypeLits
3940 ) where
@@ -75,12 +76,12 @@ data PGType
7576
7677class ToOid pg where toOid :: Proxy# pg -> LibPQ.Oid
7778--staticTypeInfo
78−instance ToOid ('NotNull 'PGBool) where toOid _ = LibPQ.Oid 16
79−instance ToOid ('NotNull 'PGBytea) where toOid _ = LibPQ.Oid 17
80−instance ToOid ('NotNull 'PGInt8) where toOid _ = LibPQ.Oid 20
81−instance ToOid ('NotNull 'PGInt2) where toOid _ = LibPQ.Oid 21
82−instance ToOid ('NotNull 'PGInt4) where toOid _ = LibPQ.Oid 23
83−instance ToOid ('NotNull 'PGText) where toOid _ = LibPQ.Oid 26
79+instance ToOid ('Required ('NotNull 'PGBool)) where toOid _ = LibPQ.Oid 16
80+instance ToOid ('Required ('NotNull 'PGBytea)) where toOid _ = LibPQ.Oid 17
81+instance ToOid ('Required ('NotNull 'PGInt8)) where toOid _ = LibPQ.Oid 20
82+instance ToOid ('Required ('NotNull 'PGInt2)) where toOid _ = LibPQ.Oid 21
83+instance ToOid ('Required ('NotNull 'PGInt4)) where toOid _ = LibPQ.Oid 23
84+instance ToOid ('Required ('NotNull 'PGText)) where toOid _ = LibPQ.Oid 26
8485class ToOids pgs where toOids :: Proxy# pgs -> [LibPQ.Oid]
8586instance ToOids '[] where toOids _ = []
8687instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
@@ -122,10 +123,6 @@ data Aliased expression aliased where
122123 -> Alias alias
123124 -> Aliased expression (alias ::: ty)
124125
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−
129126renderAliased
130127 :: (forall ty. expression ty -> ByteString)
131128 -> Aliased expression aliased
@@ -137,17 +134,19 @@ data NullityType = Null PGType | NotNull PGType
137134
138135data ColumnType = Optional NullityType | Required NullityType
139136
140−type family NullifyColumn (column :: ColumnType) where
141− NullifyColumn (optionality ('Null ty)) = optionality ('Null ty)
142− NullifyColumn (optionality ('NotNull ty)) = optionality ('Null ty)
137+type family NullifyType (ty :: ColumnType) where
138+ NullifyType (optionality ('Null ty)) = optionality ('Null ty)
139+ NullifyType (optionality ('NotNull ty)) = optionality ('Null ty)
143140
144141type family NullifyColumns columns where
145142 NullifyColumns '[] = '[]
146143 NullifyColumns ((column ::: ty) ': columns) =
147− (column ::: NullifyColumn ty) ': (NullifyColumns columns)
144+ (column ::: NullifyType ty) ': NullifyColumns columns
148145
149−type family NullifyTable table where
150− NullifyTable (table ::: columns) = table ::: NullifyColumns columns
146+type family NullifyTables tables where
147+ NullifyTables '[] = '[]
148+ NullifyTables ((column ::: ty) ': columns) =
149+ (column ::: NullifyColumns ty) ': NullifyTables columns
151150
152151type family Create alias x xs where
153152 Create alias x '[] = '[alias ::: x]
@@ -164,3 +163,7 @@ type family Alter alias xs x where
164163type family Rename alias0 alias1 xs where
165164 Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs
166165 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 @@
1717
1818module Squeel.PostgreSQL.Statement where
1919
20+import Control.Category
2021import Data.ByteString (ByteString)
2122import Data.Foldable
2223import Data.Maybe
2324import Data.Monoid
2425import Data.Ratio
2526import Data.String
27+import Data.Word
2628import Generics.SOP
2729import GHC.Exts
2830import GHC.OverloadedLabels
2931import GHC.TypeLits
30−import Prelude hiding (RealFrac(..))
32+import Prelude hiding (RealFrac(..), id, (.))
3133
3234import qualified Data.ByteString as ByteString
3335
@@ -267,33 +269,34 @@ instance IsString (Expression params tables ('Required (nullity 'PGText))) where
267269 '\\' -> "\\\\"
268270 c -> [c]
269271
270−type Predicate params tables = Expression params tables ('Required ('NotNull 'PGBool))
272+type Condition params tables =
273+ Expression params tables ('Required ('NotNull 'PGBool))
271274
272−true :: Predicate params tables
275+true :: Condition params tables
273276true = UnsafeExpression "TRUE"
274277
275−false :: Predicate params tables
278+false :: Condition params tables
276279false = UnsafeExpression "FALSE"
277280
278281notB
279− :: Predicate params tables
280− -> Predicate params tables
282+ :: Condition params tables
283+ -> Condition params tables
281284notB = unsafeUnaryOp "NOT"
282285
283286(&&*)
284− :: Predicate params tables
285− -> Predicate params tables
286− -> Predicate params tables
287+ :: Condition params tables
288+ -> Condition params tables
289+ -> Condition params tables
287290(&&*) = unsafeBinaryOp "AND"
288291
289292(||*)
290− :: Predicate params tables
291− -> Predicate params tables
292− -> Predicate params tables
293+ :: Condition params tables
294+ -> Condition params tables
295+ -> Condition params tables
293296(||*) = unsafeBinaryOp "OR"
294297
295298caseWhenThenElse
296− :: [(Predicate params tables, Expression params tables ty)]
299+ :: [(Condition params tables, Expression params tables ty)]
297300 -> Expression params tables ty
298301 -> Expression params tables ty
299302caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
@@ -310,7 +313,7 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
310313 ]
311314
312315ifThenElse
313− :: Predicate params tables
316+ :: Condition params tables
314317 -> Expression params tables ty
315318 -> Expression params tables ty
316319 -> Expression params tables ty
@@ -319,37 +322,37 @@ ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
319322(==*)
320323 :: Expression params tables ty
321324 -> Expression params tables ty
322− -> Predicate params tables
325+ -> Condition params tables
323326(==*) = unsafeBinaryOp "="
324327
325328(/=*)
326329 :: Expression params tables ty
327330 -> Expression params tables ty
328− -> Predicate params tables
331+ -> Condition params tables
329332(/=*) = unsafeBinaryOp "<>"
330333
331334(>=*)
332335 :: Expression params tables ty
333336 -> Expression params tables ty
334− -> Predicate params tables
337+ -> Condition params tables
335338(>=*) = unsafeBinaryOp ">="
336339
337340(<*)
338341 :: Expression params tables ty
339342 -> Expression params tables ty
340− -> Predicate params tables
343+ -> Condition params tables
341344(<*) = unsafeBinaryOp "<"
342345
343346(<=*)
344347 :: Expression params tables ty
345348 -> Expression params tables ty
346− -> Predicate params tables
349+ -> Condition params tables
347350(<=*) = unsafeBinaryOp "<="
348351
349352(>*)
350353 :: Expression params tables ty
351354 -> Expression params tables ty
352− -> Predicate params tables
355+ -> Condition params tables
353356(>*) = unsafeBinaryOp ">"
354357
355358{-----------------------------------------
@@ -357,7 +360,6 @@ tables
357360-----------------------------------------}
358361
359362newtype Table
360− (params :: [ColumnType])
361363 (schema :: [(Symbol,[(Symbol,ColumnType)])])
362364 (columns :: [(Symbol,ColumnType)])
363365 = UnsafeTable { renderTable :: ByteString }
@@ -365,7 +367,7 @@ newtype Table
365367
366368class KnownSymbol table => HasTable table tables columns
367369 | table tables -> columns where
368− getTable :: Proxy# table -> Table params tables columns
370+ getTable :: Proxy# table -> Table tables columns
369371 getTable table = UnsafeTable $ fromString $ symbolVal' table
370372instance {-# OVERLAPPING #-} KnownSymbol table
371373 => HasTable table ((table ::: columns) ': tables) columns
@@ -374,9 +376,136 @@ instance {-# OVERLAPPABLE #-}
374376 => HasTable table (table' ': schema) columns
375377
376378instance HasTable table schema columns
377− => IsLabel table (Table params schema columns) where
379+ => IsLabel table (Table schema columns) where
378380 fromLabel = getTable
379381
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+
380509{-----------------------------------------
381510type expressions
382511-----------------------------------------}
@@ -511,209 +640,80 @@ instance PGTyped 'PGJsonb where pgtype = jsonb
511640statements
512641-----------------------------------------}
513642
514−newtype Statement
515− (params :: [ColumnType])
516− (columns :: [(Symbol,ColumnType)])
643+newtype DataDefinition
517644 (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
518645 (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
519− = UnsafeStatement { renderStatement :: ByteString }
520− deriving (Show,Eq)
646+ = UnsafeDataDefinition { renderDataDefinition :: ByteString }
521647
522−-- newtype PreparedStatement
523−-- (params :: [ColumnType])
524−-- (columns :: [(Symbol,ColumnType)])
525−-- (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
526−-- (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
527−-- = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
528−-- deriving (Show,Eq)
529−
530−{-----------------------------------------
531−SELECT statements
532−-----------------------------------------}
648+instance Category DataDefinition where
649+ id = UnsafeDataDefinition ";"
650+ dd1 . dd0 = UnsafeDataDefinition $
651+ renderDataDefinition dd0 <> " " <> renderDataDefinition dd1
533652
534−data Join params schema tables where
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])
653+newtype DataManipulation
611654 (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
675655 (params :: [ColumnType])
676− (schema :: [(Symbol,[(Symbol,ColumnType)])])
677656 (columns :: [(Symbol,ColumnType)])
678− = UnsafeSelection { renderSelection :: ByteString }
679− deriving (Show,Eq)
657+ = UnsafeDataManipulation { renderDataManipulation :: ByteString }
680658
681−starFrom
682− :: tables ~ '[table ::: columns]
683− => TableExpression params schema tables
684− -> Selection params schema columns
685−starFrom tabs = UnsafeSelection $ "* FROM " <> renderTableExpression tabs
659+newtype Query
660+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
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
673+ -> Query schema params columns
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
686686
687−dotStarFrom
688− :: HasTable table tables columns
689− => Alias table
690− -> TableExpression params schema tables
691− -> Selection params schema columns
692−table `dotStarFrom` tables = UnsafeSelection $
693− renderAlias table <> ".* FROM " <> renderTableExpression tables
687+{-----------------------------------------
688+SELECT statements
689+-----------------------------------------}
694690
695−from
691+select
696692 :: SListI columns
697693 => NP (Aliased (Expression params tables)) columns
698694 -> TableExpression params schema tables
699− -> Selection params schema columns
700−list `from` tabs = UnsafeSelection $
701− renderList list <> " FROM " <> renderTableExpression tabs
695+ -> Query schema params columns
696+select list tabs = UnsafeQuery $
697+ "SELECT " <> renderList list <> " " <> renderTableExpression tabs
702698 where
703699 renderList
704700 = ByteString.intercalate ", "
705701 . hcollapse
706702 . hmap (K . renderAliased renderExpression)
707703
708−select
709− :: Selection params schema columns
710− -> Statement params columns schema schema
711−select = UnsafeStatement . ("SELECT " <>) . (<> ";") . renderSelection
704+selectStar
705+ :: (tables ~ '[table ::: columns])
706+ => TableExpression params schema tables
707+ -> Query schema params columns
708+selectStar tabs = UnsafeQuery $ "SELECT * " <> renderTableExpression tabs
712709
713−subselect
714− :: Aliased (Selection params schema) table
715− -> TableExpression params schema '[table]
716−subselect selection = join (Subselect selection)
710+selectDotStar
711+ :: HasTable table tables columns
712+ => Alias table
713+ -> TableExpression params schema tables
714+ -> Query schema params columns
715+selectDotStar table tables = UnsafeQuery $
716+ "SELECT " <> renderAlias table <> ".* " <> renderTableExpression tables
717717
718718{-----------------------------------------
719719CREATE statements
@@ -723,8 +723,8 @@ createTable
723723 :: (KnownSymbol table, SListI columns)
724724 => Alias table
725725 -> NP (Aliased TypeExpression) columns
726− -> Statement '[] '[] schema (Create table columns schema)
727−createTable table columns = UnsafeStatement $ mconcat
726+ -> DataDefinition schema (Create table columns schema)
727+createTable table columns = UnsafeDataDefinition $ mconcat
728728 [ "CREATE TABLE "
729729 , renderAlias table
730730 , " ("
@@ -744,9 +744,8 @@ DROP statements
744744dropTable
745745 :: KnownSymbol table
746746 => Alias table
747− -> Statement '[] '[] schema (Drop table schema)
748−dropTable table = UnsafeStatement $
749− "DROP TABLE " <> renderAlias table <> ";"
747+ -> DataDefinition schema (Drop table schema)
748+dropTable table = UnsafeDataDefinition $ "DROP TABLE " <> renderAlias table <> ";"
750749
751750{-----------------------------------------
752751ALTER statements
@@ -756,8 +755,8 @@ alterTable
756755 :: HasTable table schema columns0
757756 => Alias table
758757 -> AlterTable columns0 columns1
759− -> Statement '[] '[] schema (Alter table schema columns1)
760−alterTable table alteration = UnsafeStatement $
758+ -> DataDefinition schema (Alter table schema columns1)
759+alterTable table alteration = UnsafeDataDefinition $
761760 "ALTER TABLE "
762761 <> renderAlias table
763762 <> " "
@@ -768,8 +767,8 @@ alterTableRename
768767 :: (KnownSymbol table0, KnownSymbol table1)
769768 => Alias table0
770769 -> Alias table1
771− -> Statement '[] '[] schema (Rename table0 table1 schema)
772−alterTableRename table0 table1 = UnsafeStatement $
770+ -> DataDefinition schema (Rename table0 table1 schema)
771+alterTableRename table0 table1 = UnsafeDataDefinition $
773772 "ALTER TABLE "
774773 <> renderAlias table0
775774 <> " RENAME TO "
@@ -862,8 +861,8 @@ insertInto
862861 :: (SListI columns, HasTable table schema columns)
863862 => Alias table
864863 -> NP (Aliased (Expression params '[])) columns
865− -> Statement params '[] schema schema
866−insertInto table expressions = UnsafeStatement $ "INSERT INTO "
864+ -> DataManipulation schema params '[]
865+insertInto table expressions = UnsafeDataManipulation $ "INSERT INTO "
867866 <> renderAlias table
868867 <> " (" <> ByteString.intercalate ", " aliases
869868 <> ") VALUES ("
@@ -882,9 +881,9 @@ insertIntoReturning
882881 => Alias table
883882 -> NP (Aliased (Expression params '[])) columns
884883 -> NP (Aliased (Expression params '[table ::: columns])) results
885− -> Statement params results schema schema
884+ -> DataManipulation schema params results
886885insertIntoReturning table inserts results
887− = UnsafeStatement . mconcat $
886+ = UnsafeDataManipulation . mconcat $
888887 [ "INSERT INTO "
889888 , renderAlias table
890889 , " (" <> ByteString.intercalate ", " aliases
@@ -929,9 +928,9 @@ update
929928 :: (HasTable table schema columns, SListI columns)
930929 => Alias table
931930 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
932− -> Predicate params '[table ::: columns]
933− -> Statement params '[] schema schema
934−update table columns wh = UnsafeStatement $ mconcat
931+ -> Condition params '[table ::: columns]
932+ -> DataManipulation schema params '[]
933+update table columns wh = UnsafeDataManipulation $ mconcat
935934 [ "UPDATE "
936935 , renderAlias table
937936 , " SET "
@@ -944,10 +943,10 @@ updateReturning
944943 :: (SListI columns, SListI results, HasTable table schema columns)
945944 => Alias table
946945 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
947− -> Predicate params '[table ::: columns]
946+ -> Condition params '[table ::: columns]
948947 -> NP (Aliased (Expression params '[table ::: columns])) results
949− -> Statement params results schema schema
950−updateReturning table updates wh results = UnsafeStatement $ mconcat
948+ -> DataManipulation schema params results
949+updateReturning table updates wh results = UnsafeDataManipulation $ mconcat
951950 [ "UPDATE "
952951 , renderAlias table
953952 , " SET "
@@ -968,9 +967,9 @@ upsertInto
968967 => Alias table
969968 -> NP (Aliased (Expression params '[])) columns
970969 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
971− -> Predicate params '[table ::: columns]
972− -> Statement params '[] schema schema
973−upsertInto table inserts updates wh = UnsafeStatement . mconcat $
970+ -> Condition params '[table ::: columns]
971+ -> DataManipulation schema params '[]
972+upsertInto table inserts updates wh = UnsafeDataManipulation . mconcat $
974973 [ "INSERT INTO "
975974 , renderAlias table
976975 , " (" <> ByteString.intercalate ", " aliases
@@ -995,11 +994,11 @@ upsertIntoReturning
995994 => Alias table
996995 -> NP (Aliased (Expression params '[])) columns
997996 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
998− -> Predicate params '[table ::: columns]
997+ -> Condition params '[table ::: columns]
999998 -> NP (Aliased (Expression params '[table ::: columns])) results
1000− -> Statement params results schema schema
999+ -> DataManipulation schema params results
10011000upsertIntoReturning table inserts updates wh results =
1002− UnsafeStatement . mconcat $
1001+ UnsafeDataManipulation . mconcat $
10031002 [ "INSERT INTO "
10041003 , renderAlias table
10051004 , " (" <> ByteString.intercalate ", " aliases
@@ -1032,9 +1031,9 @@ DELETE statements
10321031deleteFrom
10331032 :: HasTable table schema columns
10341033 => Alias table
1035− -> Predicate params '[table ::: columns]
1036− -> Statement params '[] schema schema
1037−deleteFrom table wh = UnsafeStatement $ mconcat
1034+ -> Condition params '[table ::: columns]
1035+ -> DataManipulation schema params '[]
1036+deleteFrom table wh = UnsafeDataManipulation $ mconcat
10381037 [ "DELETE FROM "
10391038 , renderAlias table
10401039 , " WHERE ", renderExpression wh, ";"
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+95−81
@@ -18,129 +18,142 @@ import Squeel.PostgreSQL.Schema
1818spec :: Spec
1919spec = do
2020 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
2226 it "correctly renders a simple SELECT query" $ do
2327 let
24− statement :: Statement '[] SumAndCol1 Tables Tables
25− statement = select $
26− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
27− `from` (#table1 & where_ (#col1 >* #col2))
28− statement `shouldRenderAs`
28+ statement :: Query Tables '[] SumAndCol1
29+ statement = select
30+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
31+ (from (Table (#table1 `As` #table1)) & where_ (#col1 >* #col2))
32+ statement `queryRenders`
2933 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (col1 > col2);"
3034 it "combines WHEREs using AND" $ do
3135 let
32− statement :: Statement '[] SumAndCol1 Tables Tables
33− statement = select $
34− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
35− `from` (#table1 & where_ true & where_ false)
36− statement `shouldRenderAs`
36+ statement :: Query Tables '[] SumAndCol1
37+ statement = select
38+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
39+ (from (Table (#table1 `As` #table1)) & where_ true & where_ false)
40+ statement `queryRenders`
3741 "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (TRUE AND FALSE);"
3842 it "performs sub SELECTs" $ do
3943 let
40− selection = ((#col1 + #col2) `As` #sum :* #col1 :* Nil) `from` #table1
41− statement :: Statement '[] SumAndCol1 Tables Tables
42− statement = select $ starFrom (subselect (selection `As` #sub))
43− statement `shouldRenderAs`
44+ selection = select
45+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
46+ (from (Table (#table1 `As` #table1)))
47+ statement :: Query Tables '[] SumAndCol1
48+ statement = selectStar (from (Subquery (selection `As` #sub)))
49+ statement `queryRenders`
4450 "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 AS sub;"
4551 it "does LIMIT clauses" $ do
4652 let
47− statement :: Statement '[] Columns Tables Tables
48− statement = select $ starFrom (#table1 & limit 1)
49− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT 1;"
53+ statement :: Query Tables '[] Columns
54+ statement = selectStar
55+ (from (Table (#table1 `As` #table1)) & limit 1)
56+ statement `queryRenders` "SELECT * FROM table1 AS table1 LIMIT 1;"
5057 it "should use the minimum of given LIMITs" $ do
5158 let
52− statement :: Statement '[] Columns Tables Tables
53− statement = select $ starFrom (#table1 & limit 1 & limit 2)
54− statement `shouldRenderAs`
55− "SELECT * FROM table1 AS table1 LIMIT LEAST(1, 2);"
59+ statement :: Query Tables '[] Columns
60+ statement = selectStar
61+ (from (Table (#table1 `As` #table1)) & limit 1 & limit 2)
62+ statement `queryRenders`
63+ "SELECT * FROM table1 AS table1 LIMIT 1;"
5664 it "should render parameters using $ signs" $ do
5765 let
58− statement :: Statement '[ 'Required ('NotNull 'PGInt8)] Columns Tables Tables
59− statement = select $ starFrom (#table1 & limit param1)
60− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT $1;"
66+ statement :: Query Tables '[ 'Required ('NotNull 'PGBool)] Columns
67+ statement = selectStar
68+ (from (Table (#table1 `As` #table1)) & where_ param1)
69+ statement `queryRenders` "SELECT * FROM table1 AS table1 WHERE $1;"
6170 it "does OFFSET clauses" $ do
6271 let
63− statement :: Statement '[] Columns Tables Tables
64− statement = select $ starFrom (#table1 & offset 1)
65− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET 1;"
72+ statement :: Query Tables '[] Columns
73+ statement = selectStar
74+ (from (Table (#table1 `As` #table1)) & offset 1)
75+ statement `queryRenders` "SELECT * FROM table1 AS table1 OFFSET 1;"
6676 it "should use the sum of given OFFSETs" $ do
6777 let
68− statement :: Statement '[] Columns Tables Tables
69− statement = select $ starFrom (#table1 & offset 1 & offset 2)
70− statement `shouldRenderAs` "SELECT * FROM table1 AS table1 OFFSET (1 + 2);"
78+ statement :: Query Tables '[] Columns
79+ statement = selectStar
80+ (from (Table (#table1 `As` #table1)) & offset 1 & offset 2)
81+ statement `queryRenders` "SELECT * FROM table1 AS table1 OFFSET 3;"
7182 it "correctly renders simple INSERTs" $ do
7283 let
73− statement :: Statement '[] '[] Tables Tables
84+ statement :: DataManipulation Tables '[] '[]
7485 statement = insertInto #table1 $ 2 `As` #col1 :* 4 `As` #col2 :* Nil
75− statement `shouldRenderAs`
86+ statement `manipulationRenders`
7687 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"
7788 it "correctly renders returning INSERTs" $ do
7889 let
79− statement :: Statement '[] SumAndCol1 Tables Tables
90+ statement :: DataManipulation Tables '[] SumAndCol1
8091 statement = insertIntoReturning #table1
8192 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
82− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
83− statement `shouldRenderAs`
93+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
94+ statement `manipulationRenders`
8495 "INSERT INTO table1 (col1, col2) VALUES (2, 4) RETURNING (col1 + col2) AS sum, col1 AS col1;"
8596 it "correctly renders simple UPDATEs" $ do
8697 let
87− statement :: Statement '[] '[] Tables Tables
88− statement = update #table1 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil) (#col1 /=* #col2)
89− statement `shouldRenderAs`
98+ statement :: DataManipulation Tables '[] '[]
99+ statement = update #table1
100+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
101+ (#col1 /=* #col2)
102+ statement `manipulationRenders`
90103 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
91104 it "correctly renders returning UPDATEs" $ do
92105 let
93− statement :: Statement '[] SumAndCol1 Tables Tables
106+ statement :: DataManipulation Tables '[] SumAndCol1
94107 statement = updateReturning #table1
95108 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
96109 (#col1 /=* #col2)
97− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
98− statement `shouldRenderAs`
110+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
111+ statement `manipulationRenders`
99112 "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2) RETURNING (col1 + col2) AS sum, col1 AS col1;"
100113 it "correctly renders upsert INSERTs" $ do
101114 let
102− statement :: Statement '[] '[] Tables Tables
115+ statement :: DataManipulation Tables '[] '[]
103116 statement = upsertInto #table1
104117 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
105118 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
106119 (#col1 /=* #col2)
107− statement `shouldRenderAs`
120+ statement `manipulationRenders`
108121 "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
109122 it "correctly renders returning upsert INSERTs" $ do
110123 let
111− statement :: Statement '[] SumAndCol1 Tables Tables
124+ statement :: DataManipulation Tables '[] SumAndCol1
112125 statement = upsertIntoReturning #table1
113126 (2 `As` #col1 :* 4 `As` #col2 :* Nil)
114127 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
115128 (#col1 /=* #col2)
116− ((#col1 + #col2) `As` #sum :* #col1 :* Nil)
117− statement `shouldRenderAs`
129+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
130+ statement `manipulationRenders`
118131 "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;"
119132 it "correctly renders DELETEs" $ do
120133 let
121− statement :: Statement '[] '[] Tables Tables
134+ statement :: DataManipulation Tables '[] '[]
122135 statement = deleteFrom #table1 (#col1 ==* #col2)
123− statement `shouldRenderAs`
136+ statement `manipulationRenders`
124137 "DELETE FROM table1 WHERE (col1 = col2);"
125138 it "should be safe against SQL injection in literal text" $ do
126139 let
127− statement :: Statement '[] '[] StudentsTable StudentsTable
140+ statement :: DataManipulation StudentsTable '[] '[]
128141 statement = insertInto #students $
129142 "Robert'); DROP TABLE students;" `As` #name :* Nil
130− statement `shouldRenderAs`
143+ statement `manipulationRenders`
131144 "INSERT INTO students (name) VALUES (E'Robert''); DROP TABLE students;');"
132145 describe "JOINs" $ do
133− let
134− vals =
135− (#orders &. #orderVal) `As` #orderVal
136− :* (#customers &. #customerVal) `As` #customerVal
137− :* (#shippers &. #shipperVal) `As` #shipperVal :* Nil
138146 it "should render CROSS JOINs" $ do
139147 let
140− statement :: Statement '[] ValueColumns JoinTables JoinTables
141− statement = select $ vals `from`
142− (join (#orders & Cross #customers & Cross #shippers))
143− statement `shouldRenderAs`
148+ statement :: Query JoinTables '[] ValueColumns
149+ statement = select
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))))
156+ statement `queryRenders`
144157 "SELECT\
145158 \ orders.orderVal AS orderVal,\
146159 \ customers.customerVal AS customerVal,\
@@ -150,16 +163,17 @@ spec = do
150163 \ CROSS JOIN shippers AS shippers;"
151164 it "should render INNER JOINs" $ do
152165 let
153− innerJoins :: TableExpression '[] JoinTables JoinTables
154− innerJoins = join $
155− #orders
156− & Inner #customers
157− ((#orders &. #customerID) ==* (#customers &. #customerID))
158− & Inner #shippers
159− ((#orders &. #shipperID) ==* (#shippers &. #shipperID))
160− selection :: Statement '[] ValueColumns JoinTables JoinTables
161− selection = select $ vals `from` innerJoins
162− selection `shouldRenderAs`
166+ statement :: Query JoinTables '[] ValueColumns
167+ statement = select
168+ ( (#orders &. #orderVal) `As` #orderVal
169+ :* (#customers &. #customerVal) `As` #customerVal
170+ :* (#shippers &. #shipperVal) `As` #shipperVal :* Nil)
171+ ( from (Table (#orders `As` #orders)
172+ & InnerJoin (Table (#customers `As` #customers))
173+ ((#orders &. #customerID) ==* (#customers &. #customerID))
174+ & InnerJoin (Table (#shippers `As` #shippers))
175+ ((#orders &. #shipperID) ==* (#shippers &. #shipperID))))
176+ statement `queryRenders`
163177 "SELECT\
164178 \ orders.orderVal AS orderVal,\
165179 \ customers.customerVal AS customerVal,\
@@ -171,11 +185,11 @@ spec = do
171185 \ ON (orders.shipperID = shippers.shipperID);"
172186 it "should render self JOINs" $ do
173187 let
174− statement :: Statement '[] OrderColumns JoinTables JoinTables
175− statement = select $ #orders1 `dotStarFrom`
176− (join (Table (#orders `As` #orders1)
177− & Cross (#orders `As` #orders2)))
178− statement `shouldRenderAs`
188+ statement :: Query JoinTables '[] OrderColumns
189+ statement = selectDotStar #orders1
190+ (from (Table (#orders `As` #orders1)
191+ & CrossJoin (Table (#orders `As` #orders2))))
192+ statement `queryRenders`
179193 "SELECT orders1.*\
180194 \ FROM orders AS orders1\
181195 \ CROSS JOIN orders AS orders2;"
@@ -184,20 +198,20 @@ spec = do
184198 ( (int4 & notNull) `As` #col1
185199 :* (int4 & notNull) `As` #col2
186200 :* Nil)
187− `shouldRenderAs`
201+ `definitionRenders`
188202 "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"
189203 createTable #table2
190204 ( serial `As` #col1
191205 :* text `As` #col2
192206 :* (int8 & notNull & default_ 8) `As` #col3
193207 :* Nil)
194− `shouldRenderAs`
208+ `definitionRenders`
195209 "CREATE TABLE table2 (col1 serial, col2 text, col3 int8 NOT NULL DEFAULT 8);"
196210 it "should render DROP TABLE statements" $ do
197211 let
198− statement :: Statement '[] '[] Tables '[]
212+ statement :: DataDefinition Tables '[]
199213 statement = dropTable #table1
200− statement `shouldRenderAs` "DROP TABLE table1;"
214+ statement `definitionRenders` "DROP TABLE table1;"
201215
202216type Columns =
203217 '[ "col1" ::: 'Required ('NotNull 'PGInt4)
@@ -222,9 +236,9 @@ type ShipperColumns =
222236 , "shipperVal" ::: 'Required ('NotNull 'PGBool)
223237 ]
224238type JoinTables =
225− '[ "shippers" ::: ShipperColumns
239+ '[ "orders" ::: OrderColumns
226240 , "customers" ::: CustomerColumns
227− , "orders" ::: OrderColumns
241+ , "shippers" ::: ShipperColumns
228242 ]
229243type ValueColumns =
230244 '[ "orderVal" ::: 'Required ('NotNull 'PGText)