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