git.iko.soy/squeal
on dev help sign in
update to query types
c183ec5Eitan Chatav
squeel-postgresql/squeel-postgresql.cabal+2−1
compare with dev
unifiedsplit
@@ -16,7 +16,7 @@ library
16 Squeel.PostgreSQL
16 Squeel.PostgreSQL
17 Squeel.PostgreSQL.PQ
17 Squeel.PostgreSQL.PQ
18 Squeel.PostgreSQL.Query
18 Squeel.PostgreSQL.Query
19− Squeel.PostgreSQL.Type
19+ Squeel.PostgreSQL.Schema
20 Squeel.PostgreSQL.Value
20 Squeel.PostgreSQL.Value
21 default-language: Haskell2010
21 default-language: Haskell2010
22 ghc-options: -Wall -Werror
22 ghc-options: -Wall -Werror
@@ -52,6 +52,7 @@ test-suite squeel-postgresql-test
52 Squeel.PostgreSQL.ValueSpec
52 Squeel.PostgreSQL.ValueSpec
53 build-depends: base
53 build-depends: base
54 , Boolean
54 , Boolean
55+ , bytestring
55 , hspec
56 , hspec
56 , squeel-postgresql
57 , squeel-postgresql
57 , vinyl
58 , vinyl
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+13−8
@@ -4,6 +4,7 @@
4 , DeriveFunctor
4 , DeriveFunctor
5 , FlexibleContexts
5 , FlexibleContexts
6 , FlexibleInstances
6 , FlexibleInstances
7+ , MagicHash
7 , MultiParamTypeClasses
8 , MultiParamTypeClasses
8 , RankNTypes
9 , RankNTypes
9 , ScopedTypeVariables
10 , ScopedTypeVariables
@@ -20,17 +21,17 @@ import Control.Monad.Base
20import Control.Monad.Trans
21import Control.Monad.Trans
21import Control.Monad.Trans.Control
22import Control.Monad.Trans.Control
22import Data.ByteString (ByteString)
23import Data.ByteString (ByteString)
23−import Data.Proxy
24import Data.Text (Text)
24import Data.Text (Text)
25import Data.Vinyl
25import Data.Vinyl
26import Data.Vinyl.Functor
26import Data.Vinyl.Functor
27+import GHC.Exts
27import GHC.TypeLits
28import GHC.TypeLits
28
29
29import qualified Database.PostgreSQL.LibPQ as LibPQ
30import qualified Database.PostgreSQL.LibPQ as LibPQ
30
31
31import Squeel.PostgreSQL.Query
32import Squeel.PostgreSQL.Query
32import Squeel.PostgreSQL.Value
33import Squeel.PostgreSQL.Value
33−import Squeel.PostgreSQL.Type
34+import Squeel.PostgreSQL.Schema
34
35
35newtype Connection db = Connection { unConnection :: LibPQ.Connection }
36newtype Connection db = Connection { unConnection :: LibPQ.Connection }
36
37
@@ -104,9 +105,11 @@ instance MonadPQ PQ where
104 PQ $ \ (Connection conn) -> do
105 PQ $ \ (Connection conn) -> do
105 let
106 let
106 params' =
107 params' =
107− [ Just (oid, param, LibPQ.Binary)
108+ [ Just (oid, param', LibPQ.Binary)
108− | (oid, param) <-
109+ | (oid, param') <-
110+ zip
111+ (toOids (proxy# :: Proxy# ps))
109− zip (toOids (Proxy @ps)) (toValues (Proxy @ps) params)
112+ (toValues (proxy# :: Proxy# ps) params)
110 ]
113 ]
111 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
114 result <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary
112 return (Result <$> result, Connection conn)
115 return (Result <$> result, Connection conn)
@@ -114,7 +117,7 @@ instance MonadPQ PQ where
114 pqPrepare statementName (UnsafeQuery q :: Query ps db0 db1 ys) =
117 pqPrepare statementName (UnsafeQuery q :: Query ps db0 db1 ys) =
115 PQ $ \ (Connection conn) -> do
118 PQ $ \ (Connection conn) -> do
116 result <- liftBase $
119 result <- liftBase $
117− LibPQ.prepare conn statementName q (Just (toOids (Proxy @ps)))
120+ LibPQ.prepare conn statementName q (Just (toOids (proxy# :: Proxy# ps)))
118 return
121 return
119 ( ( Result <$> result
122 ( ( Result <$> result
120 , UnsafePreparedQuery statementName
123 , UnsafePreparedQuery statementName
@@ -124,7 +127,9 @@ instance MonadPQ PQ where
124 PQ $ \ (Connection conn) -> do
127 PQ $ \ (Connection conn) -> do
125 let
128 let
126 params' =
129 params' =
130+ [ Just (param', LibPQ.Binary)
127− [Just (param, LibPQ.Binary) | param <- toValues (Proxy @ps) params]
131+ | param' <- toValues (proxy# :: Proxy# ps) params
132+ ]
128 result <- liftBase $
133 result <- liftBase $
129 LibPQ.execPrepared conn (renderPreparedQuery q) params' LibPQ.Binary
134 LibPQ.execPrepared conn (renderPreparedQuery q) params' LibPQ.Binary
130 return (Result <$> result, Connection conn)
135 return (Result <$> result, Connection conn)
@@ -194,7 +199,7 @@ colNum4 = ColumnNumber 4
194
199
195getvalue
200getvalue
196 :: (FromValue x y, MonadBase IO io)
201 :: (FromValue x y, MonadBase IO io)
197− => Proxy x
202+ => Proxy# x
198 -> Result xs
203 -> Result xs
199 -> RowNumber
204 -> RowNumber
200 -> ColumnNumber xs x
205 -> ColumnNumber xs x
squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+239−215
@@ -1,9 +1,12 @@
1+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
1{-# LANGUAGE
2{-# LANGUAGE
2 DataKinds
3 DataKinds
3 , FlexibleContexts
4 , FlexibleContexts
4 , FlexibleInstances
5 , FlexibleInstances
6+ , FunctionalDependencies
5 , GADTs
7 , GADTs
6 , LambdaCase
8 , LambdaCase
9+ , MagicHash
7 , MultiParamTypeClasses
10 , MultiParamTypeClasses
8 , OverloadedStrings
11 , OverloadedStrings
9 , PolyKinds
12 , PolyKinds
@@ -12,6 +15,7 @@
12 , TypeApplications
15 , TypeApplications
13 , TypeFamilies
16 , TypeFamilies
14 , TypeOperators
17 , TypeOperators
18+ , UndecidableInstances
15#-}
19#-}
16
20
17module Squeel.PostgreSQL.Query where
21module Squeel.PostgreSQL.Query where
@@ -19,106 +23,94 @@ module Squeel.PostgreSQL.Query where
19import Data.Boolean
23import Data.Boolean
20import Data.ByteString (ByteString)
24import Data.ByteString (ByteString)
21import Data.Monoid
25import Data.Monoid
22−import Data.Proxy
23import Data.String
26import Data.String
24import Data.Vinyl
27import Data.Vinyl
25import Data.Vinyl.Functor
28import Data.Vinyl.Functor
29+import GHC.Exts
26import GHC.OverloadedLabels
30import GHC.OverloadedLabels
27import GHC.TypeLits
31import GHC.TypeLits
28
32
29import qualified Data.ByteString as ByteString
33import qualified Data.ByteString as ByteString
30−import qualified Data.ByteString.Char8 as Char8
34+
31−
32−import Squeel.PostgreSQL.Type
35+import Squeel.PostgreSQL.Schema
33−
34−class HasField label xs x where
35− fieldName :: Proxy label -> Proxy xs -> Proxy x -> ByteString
36−instance {-# OVERLAPPING #-} KnownSymbol label
37− => HasField label ('(label, x) ': xs) x where
38− fieldName _ _ _ = Char8.pack (symbolVal (Proxy @label))
39−instance {-# OVERLAPPABLE #-} HasField label xs y
40− => HasField label (x ': xs) y where
41− fieldName _ _ _ = fieldName (Proxy @label) (Proxy @xs) (Proxy @y)
42−
43−data Alias label = Alias
44−data Aliased obj labeled where
45− As :: obj x -> Alias label -> Aliased obj '(label, x)
46−instance IsLabel label (Alias label) where fromLabel _ = Alias
47−instance IsLabel label (obj x)
48− => IsLabel label (Aliased obj '(label, x)) where
49− fromLabel p = fromLabel p `As` fromLabel p
50−
51−aliasName :: forall label. KnownSymbol label => Alias label -> ByteString
52−aliasName _ = Char8.pack (symbolVal (Proxy @label))
53−
54−alias :: Aliased obj '(label, x) -> Alias label
55−alias _ = Alias
56−
57−unalias :: Aliased obj '(label, x) -> obj x
58−unalias (obj `As` _) = obj
59−
60−renderAliased
61− :: KnownSymbol label
62− => (obj x -> ByteString)
63− -> Aliased obj '(label, x)
64− -> ByteString
65−renderAliased render (obj `As` label) =
66− render obj <> " AS " <> Char8.pack (symbolVal label)
67−
68−class UnzipAliased (xs :: [(Symbol,k)]) where
69− type Unaliased xs :: [k]
70− unzipAliased
71− :: Rec (Aliased obj) xs
72− -> ([ByteString], Rec obj (Unaliased xs))
73−instance UnzipAliased '[] where
74− type Unaliased '[] = '[]
75− unzipAliased _ = ([], RNil)
76−instance (KnownSymbol label, UnzipAliased xs)
77− => UnzipAliased ( '(label, x) ': xs) where
78− type Unaliased ( '(label, x) ': xs) = x ': Unaliased xs
79− unzipAliased (x :& xs) =
80− let
81− (labels,values) = unzipAliased xs
82− in
83− (aliasName (alias x) : labels, unalias x :& values)
84−
85−class AllAliased xs where
86− renderAllAliased
87− :: (forall x. obj x -> ByteString)
88− -> Rec (Aliased obj) xs
89− -> ByteString
90−instance KnownSymbol label => AllAliased '[ '(label, x)] where
91− renderAllAliased render
92− (aliased :& RNil :: Rec (Aliased obj) '[ '(label, x)]) =
93− renderAliased render aliased
94−instance (KnownSymbol label, AllAliased (x' ': xs))
95− => AllAliased ('(label, x) ': (x' ': xs)) where
96− renderAllAliased render
97− (x :& xs :: Rec (Aliased obj) ('(label, x) ': x' : xs)) =
98− renderAliased render x <> ", " <> renderAllAliased render xs
99
36
100newtype Expression
37newtype Expression
101− (ps :: [PGType])
38+ (params :: [PGType])
102− (xs :: [(Symbol,PGType)])
39+ (tables :: [(Symbol,[(Symbol,PGType)])])
103− (y :: PGType) =
40+ (ty :: PGType)
104− UnsafeExpression { renderExpression :: ByteString }
41+ = UnsafeExpression { renderExpression :: ByteString }
105−
42+
43+class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
44+ param :: Proxy# n -> Expression params tables ty
45+ param p = UnsafeExpression $ ("$" <>) $ fromString $ show $ natVal' p
46+instance {-# OVERLAPPING #-} HasParameter 1 (ty1:tys) ty1
47+instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)
48+ => HasParameter n (ty' : params) ty
49+
106−param1 :: Expression (p1:ps) cols p1
50+param1 :: Expression (ty1:tys) tables ty1
107−param1 = UnsafeExpression "$1"
51+param1 = param (proxy# :: Proxy# 1)
108−param2 :: Expression (p1:p2:ps) cols p2
52+param2 :: Expression (ty1:ty2:tys) tables ty2
109−param2 = UnsafeExpression "$2"
53+param2 = param (proxy# :: Proxy# 2)
110−param3 :: Expression (p1:p2:p3:ps) cols p3
54+param3 :: Expression (ty1:ty2:ty3:tys) tables ty3
111−param3 = UnsafeExpression "$3"
55+param3 = param (proxy# :: Proxy# 3)
112−param4 :: Expression (p1:p2:p3:p4:ps) cols p4
56+param4 :: Expression (ty1:ty2:ty3:ty4:tys) tables ty4
113−param4 = UnsafeExpression "$4"
57+param4 = param (proxy# :: Proxy# 4)
114−param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
58+param5 :: Expression (ty1:ty2:ty3:ty4:ty5:tys) tables ty5
115−param5 = UnsafeExpression "$5"
59+param5 = param (proxy# :: Proxy# 5)
116−
60+
61+class KnownSymbol column => HasColumn column columns ty
62+ | column columns -> ty where
63+ getColumn :: Proxy# column -> Expression params '[table ::: columns] ty
64+ getColumn column = UnsafeExpression $ fromString $ symbolVal' column
65+instance {-# OVERLAPPING #-} KnownSymbol column
66+ => HasColumn column ((column ::: ty) ': tys) ty
67+instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
68+ => HasColumn column (ty' ': table) ty
69+
70+instance HasColumn column columns ty
117−instance HasField label xs x => IsLabel label (Expression ps xs x) where
71+ => IsLabel column (Expression params '[table ::: columns] ty) where
72+ fromLabel = getColumn
73+
74+(.&.)
75+ :: forall columns column params tables table ty
76+ . (HasTable table tables columns, HasColumn column columns ty)
77+ => Alias table -> Alias column -> Expression params tables ty
118− fromLabel _ = UnsafeExpression $
78+Alias table .&. Alias column = UnsafeExpression $
119− fieldName (Proxy @label) (Proxy @xs) (Proxy @x)
79+ fromString (symbolVal' table)
120−
80+ <> "." <>
81+ fromString (symbolVal' column)
82+
83+unsafeBinaryOp
84+ :: ByteString
85+ -> Expression params tables ty0
86+ -> Expression params tables ty1
87+ -> Expression params tables ty2
88+unsafeBinaryOp op x y = UnsafeExpression $ mconcat
89+ ["(", renderExpression x, " ", op, " ", renderExpression y, ")"]
90+
91+unsafeUnaryOp
92+ :: ByteString
93+ -> Expression params tables ty0
94+ -> Expression params tables ty1
95+unsafeUnaryOp op x = UnsafeExpression $ mconcat
96+ ["(", op, " ", renderExpression x, ")"]
97+
98+unsafeFunction
99+ :: ByteString
100+ -> Expression params tables xty
101+ -> Expression params tables yty
102+unsafeFunction fn x = UnsafeExpression $ mconcat
103+ [fn, "(", renderExpression x, ")"]
104+
105+instance PGNum ty => Num (Expression params tables ty) where
106+ (+) = unsafeBinaryOp "+"
107+ (-) = unsafeBinaryOp "-"
108+ (*) = unsafeBinaryOp "*"
109+ abs = unsafeUnaryOp "@"
110+ signum = unsafeFunction "sign"
111+ fromInteger = UnsafeExpression . fromString . show
112+
121−instance IsString (Expression ps xs 'PGText) where
113+instance IsString (Expression params tables 'PGText) where
122 fromString str = UnsafeExpression $
114 fromString str = UnsafeExpression $
123 "E\'" <> fromString (escape =<< str) <> "\'"
115 "E\'" <> fromString (escape =<< str) <> "\'"
124 where
116 where
@@ -133,169 +125,201 @@ instance IsString (Expression ps xs 'PGText) where
133 '\\' -> "\\\\"
125 '\\' -> "\\\\"
134 c -> [c]
126 c -> [c]
135
127
136−instance Num (Expression ps xs 'PGInt2) where
137− fromInteger n = UnsafeExpression . fromString $ show n
138− x + y = UnsafeExpression $ renderExpression x <> "+" <> renderExpression y
139− x * y = UnsafeExpression $ renderExpression x <> "*" <> renderExpression y
140− UnsafeExpression x - UnsafeExpression y = UnsafeExpression $ x <> "+" <> y
141− abs (UnsafeExpression x) = UnsafeExpression $ "@" <> x
142− signum (UnsafeExpression x) = UnsafeExpression $ "sign(" <> x <> ")"
143−
144−instance Num (Expression ps xs 'PGInt4) where
145− fromInteger n = UnsafeExpression . fromString $ show n
146− x + y = UnsafeExpression $ renderExpression x <> "+" <> renderExpression y
147− x * y = UnsafeExpression $ renderExpression x <> "*" <> renderExpression y
148− UnsafeExpression x - UnsafeExpression y = UnsafeExpression $ x <> "+" <> y
149− abs (UnsafeExpression x) = UnsafeExpression $ "@" <> x
150− signum (UnsafeExpression x) = UnsafeExpression $ "sign(" <> x <> ")"
151−
152−instance Num (Expression ps xs 'PGInt8) where
153− fromInteger n = UnsafeExpression . fromString $ show n
154− x + y = UnsafeExpression $ renderExpression x <> "+" <> renderExpression y
155− x * y = UnsafeExpression $ renderExpression x <> "*" <> renderExpression y
156− UnsafeExpression x - UnsafeExpression y = UnsafeExpression $ x <> "+" <> y
157− abs (UnsafeExpression x) = UnsafeExpression $ "@" <> x
158− signum (UnsafeExpression x) = UnsafeExpression $ "sign(" <> x <> ")"
159−
160−instance Boolean (Expression ps xs 'PGBool) where
128+instance Boolean (Expression params tables 'PGBool) where
161 true = UnsafeExpression "TRUE"
129 true = UnsafeExpression "TRUE"
162 false = UnsafeExpression "FALSE"
130 false = UnsafeExpression "FALSE"
163− notB x = UnsafeExpression $ "NOT " <> renderExpression x
131+ notB = unsafeUnaryOp "NOT"
164− x &&* y = UnsafeExpression $
132+ (&&*) = unsafeBinaryOp "AND"
165− renderExpression x <> " AND " <> renderExpression y
133+ (||*) = unsafeBinaryOp "OR"
166− x ||* y = UnsafeExpression $
167− renderExpression x <> " OR " <> renderExpression y
168
134
169−type instance BooleanOf (Expression ps xs y) = Expression ps xs 'PGBool
135+type instance BooleanOf (Expression params tables ty) =
136+ Expression params tables 'PGBool
170
137
171−instance IfB (Expression ps xs y) where
138+instance IfB (Expression params tables ty) where
172− ifB predicate then_ else_ = UnsafeExpression $ mconcat
139+ ifB if_ then_ else_ = UnsafeExpression $ mconcat
173− [ "CASE WHEN ",renderExpression predicate
140+ [ "CASE WHEN ",renderExpression if_
174 , " THEN ",renderExpression then_
141 , " THEN ",renderExpression then_
175 , " ELSE ",renderExpression else_
142 , " ELSE ",renderExpression else_
176 , " END"
143 , " END"
177 ]
144 ]
178
145
179−instance EqB (Expression ps xs y) where
146+instance EqB (Expression params tables ty) where
180− x ==* y = UnsafeExpression $ renderExpression x <> "=" <> renderExpression y
147+ (==*) = unsafeBinaryOp "="
181− x /=* y = UnsafeExpression $ renderExpression x <> "<>" <> renderExpression y
148+ (/=*) = unsafeBinaryOp "<>"
182−
149+
183−instance OrdB (Expression ps xs y) where
150+instance OrdB (Expression params tables ty) where
184− x >* y = UnsafeExpression $ renderExpression x <> ">" <> renderExpression y
151+ (>*) = unsafeBinaryOp ">"
185− x >=* y = UnsafeExpression $ renderExpression x <> ">=" <> renderExpression y
152+ (>=*) = unsafeBinaryOp ">="
186− x <* y = UnsafeExpression $ renderExpression x <> "<" <> renderExpression y
153+ (<*) = unsafeBinaryOp "<"
154+ (<=*) = unsafeBinaryOp "<="
155+
156+newtype TableRef
157+ (params :: [PGType])
158+ (schema :: [(Symbol,[(Symbol,PGType)])])
159+ (tables :: [(Symbol,[(Symbol,PGType)])])
160+ = UnsafeTableRef { renderTableRef :: ByteString }
161+
162+class KnownSymbol table => HasTable table tables columns
163+ | table tables -> columns where
164+ getTable :: Proxy# table -> TableRef params tables '[table ::: columns]
165+ getTable table = UnsafeTableRef $ fromString $ symbolVal' table
166+instance {-# OVERLAPPING #-} KnownSymbol table
167+ => HasTable table ((table ::: columns) ': tables) columns
168+instance {-# OVERLAPPABLE #-}
169+ (KnownSymbol table, HasTable table schema columns)
170+ => HasTable table (table' ': schema) columns
171+
172+crossJoin
173+ :: TableRef params schema '[table]
174+ -> TableRef params schema tables
175+ -> TableRef params schema (table ': tables)
176+crossJoin table tables = UnsafeTableRef $
177+ "(" <> renderTableRef tables <> " CROSS JOIN " <> renderTableRef table <> ")"
178+
179+innerJoin
180+ :: TableRef params tables '[left]
181+ -> Expression params '[left,right] 'PGBool
182+ -> TableRef params tables (right ': rest)
183+ -> TableRef params tables (left ': right ': rest)
184+innerJoin table on tables = UnsafeTableRef $
185+ renderTableRef tables
186+ <> " INNER JOIN " <>
187+ renderTableRef table
188+ <> " ON " <>
187− x <=* y = UnsafeExpression $ renderExpression x <> "<=" <> renderExpression y
189+ renderExpression on
188
190
189newtype Projection
191newtype Projection
190− (ps :: [PGType])
192+ (params :: [PGType])
191− (xs :: [(Symbol,PGType)])
193+ (tables :: [(Symbol,[(Symbol,PGType)])])
192− (ys :: [(Symbol,PGType)]) =
194+ (columns :: [(Symbol,PGType)]) =
193 UnsafeProjection { renderProjection :: ByteString }
195 UnsafeProjection { renderProjection :: ByteString }
194
196
195−star :: Projection ps xs xs
197+star :: Projection params '[table ::: columns] columns
196star = UnsafeProjection "*"
198star = UnsafeProjection "*"
197
199
200+tableStar
201+ :: HasTable table tables columns
202+ => Alias table -> Projection params tables columns
203+tableStar (Alias table) = UnsafeProjection $
204+ fromString (symbolVal' table) <> ".*"
205+
198project
206project
199− :: AllAliased ys
200− => Rec (Aliased (Expression ps xs)) ys
207+ :: Rec (Aliased (Expression params tables)) columns
201− -> Projection ps xs ys
208+ -> Projection params tables columns
209+project
202−project = UnsafeProjection . renderAllAliased renderExpression
210+ = UnsafeProjection
203−
211+ . ByteString.intercalate ", "
204−data Relation ps xss xs = UnsafeRelation
212+ . recordToList
205− { relation :: ByteString
213+ . rmap (Const . renderAliased renderExpression)
214+
215+data Tabulation
216+ (params :: [PGType])
217+ (schema :: [(Symbol,[(Symbol,PGType)])])
218+ (tables :: [(Symbol,[(Symbol,PGType)])])
219+ = Tabulation
220+ { fromClause :: TableRef params schema tables
206− , restriction :: Maybe (Expression ps xs 'PGBool)
221+ , whereClause :: Maybe (Expression params tables 'PGBool)
207− , limitation :: Maybe (Expression ps '[] 'PGInt8)
222+ , limitClause :: Maybe (Expression params '[] 'PGInt8)
208− , offsetting :: Maybe (Expression ps '[] 'PGInt8)
223+ , offsetClause :: Maybe (Expression params '[] 'PGInt8)
209 }
224 }
210
225
211−renderRelation :: Relation ps xss xs -> ByteString
226+tabulation :: TableRef params schema tables -> Tabulation params schema tables
212−renderRelation (UnsafeRelation rel wh lim off) = rel
227+tabulation tab = Tabulation tab Nothing Nothing Nothing
228+
229+renderTabulation :: Tabulation params schema tables -> ByteString
230+renderTabulation (Tabulation fr wh lim off)= mconcat
231+ [ renderTableRef fr
213− <> maybe "" ((" WHERE " <>) . renderExpression) wh
232+ , maybe "" ((" WHERE " <>) . renderExpression) wh
214− <> maybe "" ((" LIMIT " <>) . renderExpression) lim
233+ , maybe "" ((" LIMIT " <>) . renderExpression) lim
215− <> maybe "" ((" OFFSET " <>) . renderExpression) off
234+ , maybe "" ((" OFFSET " <>) . renderExpression) off
235+ ]
236+
237+instance HasTable table schema columns
238+ => IsLabel table (TableRef params schema '[table ::: columns]) where
239+ fromLabel = getTable
240+
241+instance HasTable table schema columns
242+ => IsLabel table (Tabulation params schema '[table ::: columns]) where
243+ fromLabel p = Tabulation (getTable p) Nothing Nothing Nothing
216
244
217−-- | where_ is a morphism of monoids `PGBool -> End Relation` under (&&*), true
218where_
245where_
219− :: Expression ps xs 'PGBool
246+ :: Expression params tables 'PGBool
220− -> Relation ps xss xs
247+ -> Tabulation params schema tables
221− -> Relation ps xss xs
248+ -> Tabulation params schema tables
222−where_ condition ys = ys
249+where_ condition tables = tables
223− { restriction = case restriction ys of
250+ { whereClause = case whereClause tables of
224 Nothing -> Just condition
251 Nothing -> Just condition
225 Just conditions -> Just (conditions &&* condition)
252 Just conditions -> Just (conditions &&* condition)
226 }
253 }
227
254
228−-- | limit is a morphism of semigroups `PGInt8 -> End Relation` under minB
229limit
255limit
230− :: Expression ps '[] 'PGInt8
256+ :: Expression params '[] 'PGInt8
231− -> Relation ps xss xs
257+ -> Tabulation params schema tables
232− -> Relation ps xss xs
258+ -> Tabulation params schema tables
233−limit n ys = ys
259+limit n tables = tables
234− { limitation = case limitation ys of
260+ { limitClause = case limitClause tables of
235 Nothing -> Just n
261 Nothing -> Just n
236 Just n' -> Just (n' `minB` n)
262 Just n' -> Just (n' `minB` n)
237 }
263 }
238
264
239−-- | offset is a morphism of monoids `PGInt8 -> End Relation` under (+), 0
240offset
265offset
241− :: Expression ps '[] 'PGInt8
266+ :: Expression params '[] 'PGInt8
242− -> Relation ps xss xs
267+ -> Tabulation params schema tables
243− -> Relation ps xss xs
268+ -> Tabulation params schema tables
244−offset n ys = ys
269+offset n tables = tables
245− { offsetting = case offsetting ys of
270+ { offsetClause = case offsetClause tables of
246 Nothing -> Just n
271 Nothing -> Just n
247 Just n' -> Just (n' + n)
272 Just n' -> Just (n' + n)
248 }
273 }
249
274
250−instance HasField label xss xs
251− => IsLabel label (Relation ps xss xs) where
252− fromLabel _ = UnsafeRelation
253− { relation = fieldName (Proxy @label) (Proxy @xss) (Proxy @xs)
254− , restriction = Nothing
255− , limitation = Nothing
256− , offsetting = Nothing
257− }
258−
259−newtype Selection ps xss ys = UnsafeSelection
275+newtype Selection params schema columns = UnsafeSelection
260 { renderSelection :: ByteString }
276 { renderSelection :: ByteString }
261
277
262−from :: Projection ps xs ys -> Relation ps xss xs -> Selection ps xss ys
278+from
279+ :: Projection params tables columns
280+ -> Tabulation params schema tables
281+ -> Selection params schema columns
263−ys `from` xs = UnsafeSelection $
282+from projection tables = UnsafeSelection $
264− renderProjection ys <> " FROM " <> renderRelation xs
283+ renderProjection projection <> " FROM " <> renderTabulation tables
265−
284+
266−subselect :: Selection ps xss ys -> Relation ps xss ys
285+newtype Query params schema0 schema1 columns = UnsafeQuery
286+ { renderQuery :: ByteString }
287+
288+newtype PreparedQuery params schema0 schema1 columns = UnsafePreparedQuery
289+ { renderPreparedQuery :: ByteString }
290+
291+select
292+ :: Selection params schema columns
293+ -> Query params schema schema columns
294+select = UnsafeQuery . ("SELECT " <>) . (<> ";") . renderSelection
295+
296+subselect
297+ :: Aliased (Selection params schema) table
298+ -> Tabulation params schema '[table]
267−subselect selection = UnsafeRelation
299+subselect selection = Tabulation
300+ { fromClause = UnsafeTableRef . ("SELECT " <>) $
268− { relation = "SELECT " <> renderSelection selection
301+ renderAliased renderSelection selection
269− , restriction = Nothing
302+ , whereClause = Nothing
270− , limitation = Nothing
303+ , limitClause = Nothing
271− , offsetting = Nothing
304+ , offsetClause = Nothing
272 }
305 }
273
306
274−newtype Query
275− (ps :: [PGType])
276− (xss :: [(Symbol,[(Symbol,PGType)])])
277− (yss :: [(Symbol,[(Symbol,PGType)])])
278− (zs :: [(Symbol,PGType)]) =
279− UnsafeQuery { renderQuery :: ByteString }
280−newtype PreparedQuery ps xss yss zs =
281− UnsafePreparedQuery { renderPreparedQuery :: ByteString }
282−
283−select :: Selection ps xss ys -> Query ps xss xss ys
284−select selection = UnsafeQuery $
285− "SELECT " <> renderSelection selection <> ";"
286−
287insertInto
307insertInto
288− :: forall xss xs label ps
308+ :: forall schema columns table params
289− . (HasField label xss xs, UnzipAliased xs)
309+ . HasTable table schema columns
290− => Proxy label
310+ => Alias table
291− -> Rec (Aliased (Expression ps '[])) xs
311+ -> Rec (Aliased (Expression params '[])) columns
292− -> Query ps xss xss '[]
312+ -> Query params schema schema '[]
293−insertInto table values = UnsafeQuery $ "INSERT INTO "
313+insertInto (Alias table) expressions = UnsafeQuery $ "INSERT INTO "
294− <> fieldName table (Proxy @xss) (Proxy @xs)
314+ <> fromString (symbolVal' table)
295− <> " (" <> ByteString.intercalate ", " names
315+ <> " (" <> ByteString.intercalate ", " aliases
296 <> ") VALUES ("
316 <> ") VALUES ("
297− <> ByteString.intercalate ", "
317+ <> ByteString.intercalate ", " values
298− (recordToList (rmap (Const . renderExpression) exprs))
299 <> ");"
318 <> ");"
300 where
319 where
301− (names,exprs) = unzipAliased values
320+ aliases = recordToList $ rmap
321+ (\ (_ `As` Alias name) -> Const (fromString (symbolVal' name)))
322+ expressions
323+ values = recordToList $ rmap
324+ (\ (expression `As` _) -> Const (renderExpression expression))
325+ expressions
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hsnew file+100
@@ -0,0 +1,100 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , FlexibleContexts
4+ , FlexibleInstances
5+ , GADTs
6+ , MagicHash
7+ , MultiParamTypeClasses
8+ , OverloadedStrings
9+ , PolyKinds
10+ , RankNTypes
11+ , ScopedTypeVariables
12+ , TypeApplications
13+ , TypeOperators
14+#-}
15+
16+module Squeel.PostgreSQL.Schema
17+ ( PGType (..)
18+ , ToOid (..)
19+ , ToOids (..)
20+ , PGNum
21+ , (:::)
22+ , Alias (Alias)
23+ , Aliased (As)
24+ , renderAliased
25+ , module GHC.OverloadedLabels
26+ , module GHC.TypeLits
27+ ) where
28+
29+import Data.ByteString
30+import Data.Monoid
31+import Data.String
32+import GHC.Exts
33+import GHC.OverloadedLabels
34+import GHC.TypeLits
35+
36+import qualified Database.PostgreSQL.LibPQ as LibPQ
37+
38+data PGType
39+ = PGBool
40+ | PGInt2
41+ | PGInt4
42+ | PGInt8
43+ | PGNumeric
44+ | PGFloat4
45+ | PGFloat8
46+ | PGSerial2
47+ | PGSerial4
48+ | PGSerial8
49+ | PGMoney
50+ | PGChar Nat
51+ | PGVarChar Nat
52+ | PGText
53+ | PGBytea
54+ | PGTimestamp
55+ | PGTimestampTZ
56+ | PGDate
57+ | PGTime
58+ | PGTimeTZ
59+ | PGInterval
60+ | PGUuid
61+ | PGJson
62+ | PGJsonb
63+
64+class ToOid pg where toOid :: Proxy# pg -> LibPQ.Oid
65+class ToOids pgs where toOids :: Proxy# pgs -> [LibPQ.Oid]
66+instance ToOids '[] where toOids _ = []
67+instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
68+ toOids _ = toOid (proxy# :: Proxy# pg) : toOids (proxy# :: Proxy# pgs)
69+
70+class PGNum (ty :: PGType) where
71+instance PGNum 'PGInt2
72+instance PGNum 'PGInt4
73+instance PGNum 'PGInt8
74+instance PGNum 'PGNumeric
75+instance PGNum 'PGFloat4
76+instance PGNum 'PGFloat8
77+
78+type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)
79+
80+data Alias (alias :: Symbol) = Alias (Proxy# alias)
81+
82+instance IsLabel alias (Alias alias) where fromLabel = Alias
83+
84+data Aliased expression aliased where
85+ As
86+ :: KnownSymbol alias
87+ => expression ty
88+ -> Alias alias
89+ -> Aliased expression (alias ::: ty)
90+
91+instance (KnownSymbol alias, IsLabel alias (expression ty))
92+ => IsLabel alias (Aliased expression (alias ::: ty)) where
93+ fromLabel alias = fromLabel alias `As` fromLabel alias
94+
95+renderAliased
96+ :: (forall ty. expression ty -> ByteString)
97+ -> Aliased expression aliased
98+ -> ByteString
99+renderAliased render (expression `As` Alias alias) =
100+ render expression <> " AS " <> fromString (symbolVal' alias)
squeel-postgresql/src/Squeel/PostgreSQL/Type.hsdeleted−46
@@ -1,46 +0,0 @@
1−{-# LANGUAGE
2− DataKinds
3− , PolyKinds
4− , ScopedTypeVariables
5− , TypeApplications
6− , TypeOperators
7−#-}
8−
9−module Squeel.PostgreSQL.Type where
10−
11−import Data.Proxy
12−import GHC.TypeLits
13−
14−import qualified Database.PostgreSQL.LibPQ as LibPQ
15−
16−data PGType
17− = PGBool
18− | PGInt2
19− | PGInt4
20− | PGInt8
21− | PGNumeric
22− | PGFloat4
23− | PGFloat8
24− | PGSerial2
25− | PGSerial4
26− | PGSerial8
27− | PGMoney
28− | PGChar Nat
29− | PGVarChar Nat
30− | PGText
31− | PGBytea
32− | PGTimestamp
33− | PGTimestampTZ
34− | PGDate
35− | PGTime
36− | PGTimeTZ
37− | PGInterval
38− | PGUuid
39− | PGJson
40− | PGJsonb
41−
42−class ToOid pg where toOid :: Proxy pg -> LibPQ.Oid
43−class ToOids pgs where toOids :: Proxy pgs -> [LibPQ.Oid]
44−instance ToOids '[] where toOids _ = []
45−instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where
46− toOids (_ :: Proxy (pg ': pgs)) = toOid (Proxy @pg) : toOids (Proxy @pgs)
squeel-postgresql/src/Squeel/PostgreSQL/Value.hs+11−10
@@ -3,6 +3,7 @@
3 , FlexibleInstances
3 , FlexibleInstances
4 , FunctionalDependencies
4 , FunctionalDependencies
5 , KindSignatures
5 , KindSignatures
6+ , MagicHash
6 , MultiParamTypeClasses
7 , MultiParamTypeClasses
7 , PolyKinds
8 , PolyKinds
8 , ScopedTypeVariables
9 , ScopedTypeVariables
@@ -17,16 +18,15 @@ import Control.Arrow (left)
17import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
18import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
18import Data.ByteString (ByteString)
19import Data.ByteString (ByteString)
19import Data.Int (Int16,Int32,Int64)
20import Data.Int (Int16,Int32,Int64)
20−import Data.Proxy
21import Data.Vinyl
21import Data.Vinyl
22import Data.Vinyl.Functor
22import Data.Vinyl.Functor
23import PostgreSQL.Binary.Decoder (Decoder)
23import PostgreSQL.Binary.Decoder (Decoder)
24import PostgreSQL.Binary.Encoder (Encoder)
24import PostgreSQL.Binary.Encoder (Encoder)
25−import Data.Proxy (Proxy)
26import Data.Scientific (Scientific)
25import Data.Scientific (Scientific)
27import Data.Text (Text)
26import Data.Text (Text)
28import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
27import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
29import Data.UUID (UUID)
28import Data.UUID (UUID)
29+import GHC.Exts
30
30
31import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
31import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict)
32import qualified Data.Text as Text (pack)
32import qualified Data.Text as Text (pack)
@@ -34,13 +34,13 @@ import qualified Data.Text.Lazy as Lazy (Text)
34import qualified PostgreSQL.Binary.Decoder as Decoder
34import qualified PostgreSQL.Binary.Decoder as Decoder
35import qualified PostgreSQL.Binary.Encoder as Encoder
35import qualified PostgreSQL.Binary.Encoder as Encoder
36
36
37−import Squeel.PostgreSQL.Type
37+import Squeel.PostgreSQL.Schema
38
38
39−decodeValue :: FromValue pg x => Proxy pg -> ByteString -> Either Text x
39+decodeValue :: FromValue pg x => Proxy# pg -> ByteString -> Either Text x
40−decodeValue = Decoder.run . fromValue
40+decodeValue p = Decoder.run $ fromValue p
41
41
42class FromValue (pg :: PGType) x where
42class FromValue (pg :: PGType) x where
43− fromValue :: Proxy pg -> Decoder x
43+ fromValue :: Proxy# pg -> Decoder x
44instance FromValue 'PGInt2 Int16 where
44instance FromValue 'PGInt2 Int16 where
45 fromValue _ = Decoder.int
45 fromValue _ = Decoder.int
46instance FromValue 'PGInt4 Int32 where
46instance FromValue 'PGInt4 Int32 where
@@ -85,7 +85,7 @@ instance FromValue 'PGInterval DiffTime where
85 fromValue _ = Decoder.interval_int
85 fromValue _ = Decoder.interval_int
86
86
87class ToValue x (pg :: PGType) where
87class ToValue x (pg :: PGType) where
88− toValue :: Proxy pg -> Encoder x
88+ toValue :: Proxy# pg -> Encoder x
89instance ToValue Int16 'PGInt2 where
89instance ToValue Int16 'PGInt2 where
90 toValue _ = Encoder.int2_int16
90 toValue _ = Encoder.int2_int16
91instance ToValue Int32 'PGInt4 where
91instance ToValue Int32 'PGInt4 where
@@ -130,9 +130,10 @@ instance ToValue DiffTime 'PGInterval where
130 toValue _ = Encoder.interval_int
130 toValue _ = Encoder.interval_int
131
131
132class ToValues xs pgs where
132class ToValues xs pgs where
133− toValues :: Proxy pgs -> Rec Identity xs -> [ByteString]
133+ toValues :: Proxy# pgs -> Rec Identity xs -> [ByteString]
134instance ToValues '[] '[] where toValues _ _ = []
134instance ToValues '[] '[] where toValues _ _ = []
135instance (ToValue x pg, ToValues xs pgs)
135instance (ToValue x pg, ToValues xs pgs)
136 => ToValues (x ': xs) (pg ': pgs) where
136 => ToValues (x ': xs) (pg ': pgs) where
137− toValues (_ :: Proxy (pg ': pgs)) (Identity x :& xs) =
137+ toValues _ (Identity x :& xs)
138− Encoder.run (toValue (Proxy @pg)) x : toValues (Proxy @pgs) xs
138+ = Encoder.run (toValue (proxy# :: Proxy# pg)) x
139+ : toValues (proxy# :: Proxy# pgs) xs
squeel-postgresql/test/Squeel/PostgreSQL/QuerySpec.hs+101−38
@@ -2,75 +2,138 @@
2 DataKinds
2 DataKinds
3 , OverloadedLabels
3 , OverloadedLabels
4 , OverloadedStrings
4 , OverloadedStrings
5+ , PolyKinds
5 , TypeApplications
6 , TypeApplications
7+ , TypeOperators
6#-}
8#-}
7
9
8module Squeel.PostgreSQL.QuerySpec where
10module Squeel.PostgreSQL.QuerySpec where
9
11
10import Data.Boolean
12import Data.Boolean
13+import Data.ByteString
11import Data.Function
14import Data.Function
12−import Data.Proxy
13import Data.Vinyl
15import Data.Vinyl
14import Test.Hspec
16import Test.Hspec
15
17
16import Squeel.PostgreSQL.Query
18import Squeel.PostgreSQL.Query
17−import Squeel.PostgreSQL.Type
19+import Squeel.PostgreSQL.Schema
18
20
19spec :: Spec
21spec :: Spec
20spec = do
22spec = do
21 it "correctly renders a simple SELECT query" $ do
23 it "correctly renders a simple SELECT query" $ do
22− renderQuery (select (sumAndCol1 `from` (table1 & where_ true)))
24+ select (sumAndCol1 `from` (table1 & where_ true))
23− `shouldBe`
25+ `shouldRenderAs`
24− "SELECT col1+col2 AS sum, col1 AS col1 FROM table1 WHERE TRUE;"
26+ "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 WHERE TRUE;"
25 it "combines WHEREs using AND" $ do
27 it "combines WHEREs using AND" $ do
26− renderQuery (select (sumAndCol1 `from` (table1 & where_ true & where_ false)))
28+ select (sumAndCol1 `from` (table1 & where_ true & where_ false))
27− `shouldBe`
29+ `shouldRenderAs`
28− "SELECT col1+col2 AS sum, col1 AS col1 FROM table1 WHERE TRUE AND FALSE;"
30+ "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 WHERE (TRUE AND FALSE);"
29− it "performs subSELECTs" $ do
31+ it "performs sub SELECTs" $ do
30− renderQuery (select (star `from` subselect (sumAndCol1 `from` table1)))
32+ select (star `from` subselect ((sumAndCol1 `from` table1) `As` (#sub :: Alias "sub")))
31− `shouldBe`
33+ `shouldRenderAs`
32− "SELECT * FROM SELECT col1+col2 AS sum, col1 AS col1 FROM table1;"
34+ "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS sub;"
33 it "does LIMIT clauses" $ do
35 it "does LIMIT clauses" $ do
34− renderQuery (select (star `from` (table1 & limit 1)))
36+ select (star `from` (table1 & limit 1))
35− `shouldBe`
37+ `shouldRenderAs`
36 "SELECT * FROM table1 LIMIT 1;"
38 "SELECT * FROM table1 LIMIT 1;"
37 it "should use the minimum of given LIMITs" $ do
39 it "should use the minimum of given LIMITs" $ do
38− renderQuery (select (star `from` (table1 & limit 1 & limit 2)))
40+ select (star `from` (table1 & limit 1 & limit 2))
39− `shouldBe`
41+ `shouldRenderAs`
40− "SELECT * FROM table1 LIMIT CASE WHEN 1<=2 THEN 1 ELSE 2 END;"
42+ "SELECT * FROM table1 LIMIT CASE WHEN (1 <= 2) THEN 1 ELSE 2 END;"
41 it "should render parameters using $ signs" $ do
43 it "should render parameters using $ signs" $ do
42− renderQuery (select (star `from` (parameterizedTable1 & limit param1)))
44+ select (star `from` (parameterizedTable1 & limit param1))
43− `shouldBe`
45+ `shouldRenderAs`
44 "SELECT * FROM table1 LIMIT $1;"
46 "SELECT * FROM table1 LIMIT $1;"
45 it "does OFFSET clauses" $ do
47 it "does OFFSET clauses" $ do
46− renderQuery (select (star `from` (table1 & offset 1)))
48+ select (star `from` (table1 & offset 1))
47− `shouldBe`
49+ `shouldRenderAs`
48 "SELECT * FROM table1 OFFSET 1;"
50 "SELECT * FROM table1 OFFSET 1;"
49 it "should use the sum of given OFFSETs" $ do
51 it "should use the sum of given OFFSETs" $ do
50− renderQuery (select (star `from` (table1 & offset 1 & offset 2)))
52+ select (star `from` (table1 & offset 1 & offset 2))
51− `shouldBe`
53+ `shouldRenderAs`
52− "SELECT * FROM table1 OFFSET 1+2;"
54+ "SELECT * FROM table1 OFFSET (1 + 2);"
53 it "correctly render simple INSERTs" $ do
55 it "correctly render simple INSERTs" $ do
54− renderQuery (insertInto @Tables @Columns (Proxy @"table1")
56+ insertInto @Tables @Columns
57+ (#table1 :: Alias "table1")
55− ((2 `As` #col1 :& 4 `As` #col2 :& RNil)))
58+ (2 `As` #col1 :& 4 `As` #col2 :& RNil)
56− `shouldBe`
59+ `shouldRenderAs`
57 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"
60 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"
58 it "should be safe against SQL injection in literal text" $ do
61 it "should be safe against SQL injection in literal text" $ do
59− renderQuery (select (literalText `from` table1))
62+ insertInto @StudentsTable @StudentsColumns
60− `shouldBe`
63+ (#students :: Alias "students")
61− "SELECT E''';DROP TABLE table1;' AS literal FROM table1;"
64+ ("Robert'); DROP TABLE students;" `As` #name :& RNil)
65+ `shouldRenderAs`
66+ "INSERT INTO students (name) VALUES (E'Robert''); DROP TABLE students;');"
67+ -- describe "JOINs" $ do
68+ -- it "should render CROSS JOINs" $
69+ -- pending
70+ -- it "should render INNER JOINs" $ do
71+ -- select (vals `from` joinTable) `shouldRenderAs`
72+ -- "((orders\
73+ -- \ INNER JOIN customers ON orders.customerID = customers.customerID)\
74+ -- \ INNER JOIN shippers ON orders.shipperID = shippers.shipperID)"
75+-- #orders
76+-- & innerJoin #customers
77+-- (#orders .&. #customerID ==* #customers .&. #customerID)
78+-- & innerJoin #shippers
79+-- (#orders .&. #shipperID ==* #shippers .&. #shipperID)
80+-- `shouldRenderAs`
81+-- "((orders\
82+-- \ INNER JOIN customers ON orders.customerID = customers.customerID)\
83+-- \ INNER JOIN shippers ON orders.shipperID = shippers.shipperID)"
62
84
63−type Columns = '[ '("col1", 'PGInt4), '("col2", 'PGInt4)]
85+type Columns = '[ "col1" ::: 'PGInt4, "col2" ::: 'PGInt4]
64−type Tables = '[ '("table1", Columns)]
86+type Tables = '[ "table1" ::: Columns ]
65
87
88+sumAndCol1 :: Projection '[] Tables
66−sumAndCol1 :: Projection '[] Columns '[ '("sum", 'PGInt4), '("col1", 'PGInt4)]
89+ '["sum" ::: 'PGInt4, "col1" ::: 'PGInt4]
67−sumAndCol1 = project ((#col1 + #col2) `As` #sum :& #col1 :& RNil)
90+sumAndCol1 = project $
91+ (#col1 + #col2) `As` #sum
92+ :& #col1 :& RNil
68
93
69−literalText :: Projection '[] Columns '[ '("literal", 'PGText)]
94+literalText :: Projection '[] Tables '["literal" ::: 'PGText]
70−literalText = project ("\';DROP TABLE table1;" `As` #literal :& RNil)
95+literalText = project $ "\';DROP TABLE table1;" `As` #literal :& RNil
71
96
72−table1 :: Relation '[] Tables Columns
97+table1 :: Tabulation '[] Tables Tables
73table1 = #table1
98table1 = #table1
74
99
75−parameterizedTable1 :: Relation '[ 'PGInt8] Tables Columns
100+parameterizedTable1 :: Tabulation '[ 'PGInt8] Tables Tables
76parameterizedTable1 = #table1
101parameterizedTable1 = #table1
102+
103+shouldRenderAs
104+ :: Query params schema1 schema2 columns
105+ -> ByteString
106+ -> Expectation
107+shouldRenderAs query str = renderQuery query `shouldBe` str
108+
109+type StudentsColumns = '["name" ::: 'PGText]
110+type StudentsTable = '["students" ::: StudentsColumns]
111+
112+type OrderColumns =
113+ [ "orderID" ::: 'PGInt4, "orderVal" ::: 'PGText ]
114+type CustomerColumns =
115+ [ "customerID" ::: 'PGInt4, "customerVal" ::: 'PGFloat4 ]
116+type ShipperColumns =
117+ [ "shipperID" ::: 'PGInt4, "shipperVal" ::: 'PGBool ]
118+type JoinTables =
119+ '[ "order" ::: OrderColumns
120+ , "customer" ::: CustomerColumns
121+ , "shipper" ::: ShipperColumns
122+ ]
123+type ValueColumns =
124+ [ "orderVal" ::: 'PGText
125+ , "customerVal" ::: 'PGFloat4
126+ , "shipperVal" ::: 'PGBool
127+ ]
128+-- vals :: Projection '[] JoinTables ValueColumns
129+-- vals = project $
130+-- #orders .&. #orderVal `As` #orderVal
131+-- :& #customers .&. #customerVal `As` #customerVal
132+-- :& #shippers .&. #shippersVal `As` #shippersVal :& RNil
133+-- joinTable :: Tabulation '[] JoinTables JoinTables
134+-- joinTable = tabulation $
135+-- #orders
136+-- & innerJoin #customers
137+-- (#orders .&. #customerID ==* #customers .&. #customerID)
138+-- & innerJoin #shippers
139+-- (#orders .&. #shipperID ==* #shippers .&. #shipperID)