git.iko.soy/squeal
on dev help sign in
complex create statements
c8d6bbdEitan Chatav
squeel-postgresql/exe/Example.hs+17−7
compare with dev
unifiedsplit
@@ -8,11 +8,12 @@
8
8
9module Main (main) where
9module Main (main) where
10
10
11+import Control.Category ((>>>))
11import Control.Monad.Base
12import Control.Monad.Base
13+import Data.Function ((&))
12import Data.Int
14import Data.Int
13import Data.Monoid
15import Data.Monoid
14import Data.Vinyl
16import Data.Vinyl
15−import GHC.Exts
16import Squeel.PostgreSQL
17import Squeel.PostgreSQL
17
18
18import qualified Data.ByteString.Char8 as Char8
19import qualified Data.ByteString.Char8 as Char8
@@ -26,11 +27,18 @@ main = do
26 connection0 <- connectdb connectionString
27 connection0 <- connectdb connectionString
27 Char8.putStrLn "creating tables"
28 Char8.putStrLn "creating tables"
28 connection1 <- flip execPQ connection0 $ pqExec $
29 connection1 <- flip execPQ connection0 $ pqExec $
29− createTable #table1 (proxy# :: Proxy# Columns)
30+ createTable #students
31+ ( (text & notNull) `As` #name
32+ :& RNil )
33+ >>>
34+ createTable #table1
35+ ( (int4 & notNull) `As` #col1
36+ :& (int4 & notNull) `As` #col2
37+ :& RNil )
30 connection2 <- flip execPQ connection1 $ do
38 connection2 <- flip execPQ connection1 $ do
31 _insertTable1Result <- pqExec $
39 _insertTable1Result <- pqExec $
32 insertInto #table1 ( 1 `As` #col1 :& 2 `As` #col2 :& RNil )
40 insertInto #table1 ( 1 `As` #col1 :& 2 `As` #col2 :& RNil )
33− &>>
41+ >>>
34 insertInto #table1 ( 3 `As` #col1 :& 4 `As` #col2 :& RNil )
42 insertInto #table1 ( 3 `As` #col1 :& 4 `As` #col2 :& RNil )
35 Just selectTable1Result <- flip pqExecParams RNil $
43 Just selectTable1Result <- flip pqExecParams RNil $
36 (select $ starFrom #table1 :: Statement '[] Columns Tables Tables)
44 (select $ starFrom #table1 :: Statement '[] Columns Tables Tables)
@@ -45,11 +53,13 @@ main = do
45 print (value11 :: Int32)
53 print (value11 :: Int32)
46 finish connection2
54 finish connection2
47
55
56+type Columns =
48−type Columns = '[ "col1" ::: 'NotNull 'PGInt4, "col2" ::: 'NotNull 'PGInt4]
57+ '[ "col1" ::: 'Required ('NotNull 'PGInt4)
49−type Tables = '[ "table1" ::: Columns ]
58+ , "col2" ::: 'Required ('NotNull 'PGInt4)
59+ ]
50-- type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
60-- type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
51−-- type StudentsColumns = '["name" ::: 'NotNull 'PGText]
61+type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]
52−-- type StudentsTable = '["students" ::: StudentsColumns]
62+type Tables = '[ "table1" ::: Columns, "students" ::: StudentsColumns]
53-- type OrderColumns =
63-- type OrderColumns =
54-- [ "orderID" ::: 'NotNull 'PGInt4
64-- [ "orderID" ::: 'NotNull 'PGInt4
55-- , "orderVal" ::: 'NotNull 'PGText
65-- , "orderVal" ::: 'NotNull 'PGText
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+1−1
@@ -80,7 +80,7 @@ instance FromValue 'PGTimestampTZ UTCTime where
80 fromValue _ = Decoder.timestamptz_int
80 fromValue _ = Decoder.timestamptz_int
81instance FromValue 'PGInterval DiffTime where
81instance FromValue 'PGInterval DiffTime where
82 fromValue _ = Decoder.interval_int
82 fromValue _ = Decoder.interval_int
83−instance FromValue pg ty => FromValue (column ::: 'NotNull pg) ty where
83+instance FromValue pg ty => FromValue (column ::: 'Required ('NotNull pg)) ty where
84 fromValue _ = fromValue (proxy# :: Proxy# pg)
84 fromValue _ = fromValue (proxy# :: Proxy# pg)
85
85
86class FromValues pgs xs where
86class FromValues pgs xs where
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+2−2
@@ -37,8 +37,8 @@ import Squeel.PostgreSQL.Schema
37newtype Connection db = Connection { unConnection :: LibPQ.Connection }
37newtype Connection db = Connection { unConnection :: LibPQ.Connection }
38
38
39newtype PQ
39newtype PQ
40− (db0 :: [(Symbol,[(Symbol,NullityType)])])
40+ (db0 :: [(Symbol,[(Symbol,ColumnType)])])
41− (db1 :: [(Symbol,[(Symbol,NullityType)])])
41+ (db1 :: [(Symbol,[(Symbol,ColumnType)])])
42 (m :: * -> *)
42 (m :: * -> *)
43 (x :: *) =
43 (x :: *) =
44 PQ { runPQ :: Connection db0 -> m (x, Connection db1) }
44 PQ { runPQ :: Connection db0 -> m (x, Connection db1) }
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+17−14
@@ -25,9 +25,10 @@ module Squeel.PostgreSQL.Schema
25 , KnownColumns (..)
25 , KnownColumns (..)
26 , renderAliased
26 , renderAliased
27 , NullityType (..)
27 , NullityType (..)
28− , NullifyType
28+ -- , NullifyType
29− , NullifyColumns
29+ -- , NullifyColumns
30− , NullifyTable
30+ -- , NullifyTable
31+ , ColumnType (..)
31 , module GHC.OverloadedLabels
32 , module GHC.OverloadedLabels
32 , module GHC.TypeLits
33 , module GHC.TypeLits
33 ) where
34 ) where
@@ -191,14 +192,16 @@ instance
191
192
192data NullityType = Null PGType | NotNull PGType
193data NullityType = Null PGType | NotNull PGType
193
194
194−type family NullifyType nullty where
195+-- type family NullifyType nullty where
195− NullifyType ('Null ty) = 'Null ty
196+-- NullifyType ('Null ty) = 'Null ty
196− NullifyType ('NotNull ty) = 'Null ty
197+-- NullifyType ('NotNull ty) = 'Null ty
197−
198+--
198−type family NullifyColumns columns where
199+-- type family NullifyColumns columns where
199− NullifyColumns '[] = '[]
200+-- NullifyColumns '[] = '[]
200− NullifyColumns ((column ::: ty) ': columns) =
201+-- NullifyColumns ((column ::: ty) ': columns) =
201− (column ::: (NullifyType ty)) ': (NullifyColumns columns)
202+-- (column ::: (NullifyType ty)) ': (NullifyColumns columns)
202−
203+--
203−type family NullifyTable table where
204+-- type family NullifyTable table where
204− NullifyTable (table ::: columns) = table ::: NullifyColumns columns
205+-- NullifyTable (table ::: columns) = table ::: NullifyColumns columns
206+
207+data ColumnType = Optional NullityType | Required NullityType
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+130−95
@@ -14,6 +14,7 @@
14
14
15module Squeel.PostgreSQL.Statement where
15module Squeel.PostgreSQL.Statement where
16
16
17+import Control.Category
17import Data.Boolean
18import Data.Boolean
18import Data.ByteString (ByteString)
19import Data.ByteString (ByteString)
19import Data.Maybe
20import Data.Maybe
@@ -24,15 +25,16 @@ import Data.Vinyl.Functor
24import GHC.Exts
25import GHC.Exts
25import GHC.OverloadedLabels
26import GHC.OverloadedLabels
26import GHC.TypeLits
27import GHC.TypeLits
28+import Prelude hiding (id,(.))
27
29
28import qualified Data.ByteString as ByteString
30import qualified Data.ByteString as ByteString
29
31
30import Squeel.PostgreSQL.Schema
32import Squeel.PostgreSQL.Schema
31
33
32newtype Expression
34newtype Expression
33− (params :: [NullityType])
35+ (params :: [ColumnType])
34− (tables :: [(Symbol,[(Symbol,NullityType)])])
36+ (tables :: [(Symbol,[(Symbol,ColumnType)])])
35− (ty :: NullityType)
37+ (ty :: ColumnType)
36 = UnsafeExpression { renderExpression :: ByteString }
38 = UnsafeExpression { renderExpression :: ByteString }
37
39
38class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
40class KnownNat n => HasParameter (n :: Nat) params ty | n params -> ty where
@@ -58,7 +60,7 @@ class KnownSymbol column => HasColumn column columns ty
58 getColumn :: Proxy# column -> Expression params '[table ::: columns] ty
60 getColumn :: Proxy# column -> Expression params '[table ::: columns] ty
59 getColumn column = UnsafeExpression $ fromString $ symbolVal' column
61 getColumn column = UnsafeExpression $ fromString $ symbolVal' column
60instance {-# OVERLAPPING #-} KnownSymbol column
62instance {-# OVERLAPPING #-} KnownSymbol column
61− => HasColumn column ((column ::: ty) ': tys) ty
63+ => HasColumn column ((column ::: optionality ty) ': tys) ('Required ty)
62instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
64instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
63 => HasColumn column (ty' ': table) ty
65 => HasColumn column (ty' ': table) ty
64
66
@@ -96,7 +98,7 @@ unsafeFunction
96unsafeFunction fn x = UnsafeExpression $ mconcat
98unsafeFunction fn x = UnsafeExpression $ mconcat
97 [fn, "(", renderExpression x, ")"]
99 [fn, "(", renderExpression x, ")"]
98
100
99−instance PGNum ty => Num (Expression params tables (nullity ty)) where
101+instance PGNum ty => Num (Expression params tables ('Required (nullity ty))) where
100 (+) = unsafeBinaryOp "+"
102 (+) = unsafeBinaryOp "+"
101 (-) = unsafeBinaryOp "-"
103 (-) = unsafeBinaryOp "-"
102 (*) = unsafeBinaryOp "*"
104 (*) = unsafeBinaryOp "*"
@@ -104,7 +106,7 @@ instance PGNum ty => Num (Expression params tables (nullity ty)) where
104 signum = unsafeFunction "sign"
106 signum = unsafeFunction "sign"
105 fromInteger = UnsafeExpression . fromString . show
107 fromInteger = UnsafeExpression . fromString . show
106
108
107−instance IsString (Expression params tables (nullity 'PGText)) where
109+instance IsString (Expression params tables ('Required (nullity 'PGText))) where
108 fromString str = UnsafeExpression $
110 fromString str = UnsafeExpression $
109 "E\'" <> fromString (escape =<< str) <> "\'"
111 "E\'" <> fromString (escape =<< str) <> "\'"
110 where
112 where
@@ -119,7 +121,7 @@ instance IsString (Expression params tables (nullity 'PGText)) where
119 '\\' -> "\\\\"
121 '\\' -> "\\\\"
120 c -> [c]
122 c -> [c]
121
123
122−instance Boolean (Expression params tables ('NotNull 'PGBool)) where
124+instance Boolean (Expression params tables ('Required ('NotNull 'PGBool))) where
123 true = UnsafeExpression "TRUE"
125 true = UnsafeExpression "TRUE"
124 false = UnsafeExpression "FALSE"
126 false = UnsafeExpression "FALSE"
125 notB = unsafeUnaryOp "NOT"
127 notB = unsafeUnaryOp "NOT"
@@ -127,21 +129,21 @@ instance Boolean (Expression params tables ('NotNull 'PGBool)) where
127 (||*) = unsafeBinaryOp "OR"
129 (||*) = unsafeBinaryOp "OR"
128
130
129type instance BooleanOf (Expression params tables ty) =
131type instance BooleanOf (Expression params tables ty) =
130− Expression params tables ('NotNull 'PGBool)
132+ Expression params tables ('Required ('NotNull 'PGBool))
131
133
132coalesce
134coalesce
133− :: [Expression params tables ('Null x)]
135+ :: [Expression params tables ('Required ('Null x))]
134− -> Expression params tables ('NotNull x)
136+ -> Expression params tables ('Required ('NotNull x))
135− -> Expression params tables ('NotNull x)
137+ -> Expression params tables ('Required ('NotNull x))
136−coalesce nulls notNull = UnsafeExpression $ mconcat
138+coalesce nulls isn'tNull = UnsafeExpression $ mconcat
137 [ "COALESCE("
139 [ "COALESCE("
138 , ByteString.intercalate ", " $ map renderExpression nulls
140 , ByteString.intercalate ", " $ map renderExpression nulls
139− , ", ", renderExpression notNull
141+ , ", ", renderExpression isn'tNull
140 , ")"
142 , ")"
141 ]
143 ]
142
144
143caseWhenThenElse
145caseWhenThenElse
144− :: [(Expression params tables ('NotNull 'PGBool), Expression params tables ty)]
146+ :: [(Expression params tables ('Required ('NotNull 'PGBool)), Expression params tables ty)]
145 -> Expression params tables ty
147 -> Expression params tables ty
146 -> Expression params tables ty
148 -> Expression params tables ty
147caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
149caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
@@ -171,9 +173,9 @@ instance OrdB (Expression params tables ty) where
171 (<=*) = unsafeBinaryOp "<="
173 (<=*) = unsafeBinaryOp "<="
172
174
173newtype TableExpression
175newtype TableExpression
174− (params :: [NullityType])
176+ (params :: [ColumnType])
175− (schema :: [(Symbol,[(Symbol,NullityType)])])
177+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
176− (columns :: [(Symbol,NullityType)])
178+ (columns :: [(Symbol,ColumnType)])
177 = UnsafeTableExpression { renderTableExpression :: ByteString }
179 = UnsafeTableExpression { renderTableExpression :: ByteString }
178
180
179data JoinExpression params schema tables where
181data JoinExpression params schema tables where
@@ -189,25 +191,25 @@ data JoinExpression params schema tables where
189 -> JoinExpression params schema (table ': tables)
191 -> JoinExpression params schema (table ': tables)
190 Inner
192 Inner
191 :: Aliased (TableExpression params schema) table
193 :: Aliased (TableExpression params schema) table
192− -> Expression params (table ': tables) ('NotNull 'PGBool)
194+ -> Expression params (table ': tables) ('Required ('NotNull 'PGBool))
193 -> JoinExpression params schema tables
195 -> JoinExpression params schema tables
194 -> JoinExpression params schema (table ': tables)
196 -> JoinExpression params schema (table ': tables)
195− LeftOuter
197+ -- LeftOuter
196− :: Aliased (TableExpression params schema) right
198+ -- :: Aliased (TableExpression params schema) right
197− -> Expression params '[left,right] ('NotNull 'PGBool)
199+ -- -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
198− -> JoinExpression params schema (tables)
200+ -- -> JoinExpression params schema (tables)
199− -> JoinExpression params schema (NullifyTable right ': left ': tables)
201+ -- -> JoinExpression params schema (NullifyTable right ': left ': tables)
200− RightOuter
202+ -- RightOuter
201− :: Aliased (TableExpression params schema) right
203+ -- :: Aliased (TableExpression params schema) right
202− -> Expression params '[left,right] ('NotNull 'PGBool)
204+ -- -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
203− -> JoinExpression params schema (left : tables)
205+ -- -> JoinExpression params schema (left : tables)
204− -> JoinExpression params schema (right ': NullifyTable left ': tables)
206+ -- -> JoinExpression params schema (right ': NullifyTable left ': tables)
205− FullOuter
207+ -- FullOuter
206− :: Aliased (TableExpression params schema) right
208+ -- :: Aliased (TableExpression params schema) right
207− -> Expression params '[left,right] ('NotNull 'PGBool)
209+ -- -> Expression params '[left,right] ('Required ('NotNull 'PGBool))
208− -> JoinExpression params schema (left : tables)
210+ -- -> JoinExpression params schema (left : tables)
209− -> JoinExpression params schema
211+ -- -> JoinExpression params schema
210− (NullifyTable right ': NullifyTable left ': tables)
212+ -- (NullifyTable right ': NullifyTable left ': tables)
211
213
212renderJoinExpression :: JoinExpression params schema tables -> ByteString
214renderJoinExpression :: JoinExpression params schema tables -> ByteString
213renderJoinExpression = \case
215renderJoinExpression = \case
@@ -225,27 +227,27 @@ renderJoinExpression = \case
225 , " ON "
227 , " ON "
226 , renderExpression on
228 , renderExpression on
227 ]
229 ]
228− LeftOuter table on tables -> mconcat
230+ -- LeftOuter table on tables -> mconcat
229− [ renderJoinExpression tables
231+ -- [ renderJoinExpression tables
230− , " LEFT OUTER JOIN "
232+ -- , " LEFT OUTER JOIN "
231− , renderAliased renderTableExpression table
233+ -- , renderAliased renderTableExpression table
232− , " ON "
234+ -- , " ON "
233− , renderExpression on
235+ -- , renderExpression on
234− ]
236+ -- ]
235− RightOuter table on tables -> mconcat
237+ -- RightOuter table on tables -> mconcat
236− [ renderJoinExpression tables
238+ -- [ renderJoinExpression tables
237− , " RIGHT OUTER JOIN "
239+ -- , " RIGHT OUTER JOIN "
238− , renderAliased renderTableExpression table
240+ -- , renderAliased renderTableExpression table
239− , " ON "
241+ -- , " ON "
240− , renderExpression on
242+ -- , renderExpression on
241− ]
243+ -- ]
242− FullOuter table on tables -> mconcat
244+ -- FullOuter table on tables -> mconcat
243− [ renderJoinExpression tables
245+ -- [ renderJoinExpression tables
244− , " FULL OUTER JOIN "
246+ -- , " FULL OUTER JOIN "
245− , renderAliased renderTableExpression table
247+ -- , renderAliased renderTableExpression table
246− , " ON "
248+ -- , " ON "
247− , renderExpression on
249+ -- , renderExpression on
248− ]
250+ -- ]
249
251
250class KnownSymbol table => HasTable table tables columns
252class KnownSymbol table => HasTable table tables columns
251 | table tables -> columns where
253 | table tables -> columns where
@@ -266,9 +268,9 @@ instance HasTable table schema columns
266 fromLabel p = Table $ fromLabel p
268 fromLabel p = Table $ fromLabel p
267
269
268data Clauses params tables = Clauses
270data Clauses params tables = Clauses
269− { whereClause :: Maybe (Expression params tables ('NotNull 'PGBool))
271+ { whereClause :: Maybe (Expression params tables ('Required ('NotNull 'PGBool)))
270− , limitClause :: Maybe (Expression params '[] ('NotNull 'PGInt8))
272+ , limitClause :: Maybe (Expression params '[] ('Required ('NotNull 'PGInt8)))
271− , offsetClause :: Maybe (Expression params '[] ('NotNull 'PGInt8))
273+ , offsetClause :: Maybe (Expression params '[] ('Required ('NotNull 'PGInt8)))
272 }
274 }
273
275
274instance Monoid (Clauses params tables) where
276instance Monoid (Clauses params tables) where
@@ -292,9 +294,9 @@ instance Monoid (Clauses params tables) where
292 }
294 }
293
295
294data FromExpression
296data FromExpression
295− (params :: [NullityType])
297+ (params :: [ColumnType])
296− (schema :: [(Symbol,[(Symbol,NullityType)])])
298+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
297− (tables :: [(Symbol,[(Symbol,NullityType)])])
299+ (tables :: [(Symbol,[(Symbol,ColumnType)])])
298 = FromExpression
300 = FromExpression
299 { joinExpression :: JoinExpression params schema tables
301 { joinExpression :: JoinExpression params schema tables
300 , clauses :: Clauses params tables
302 , clauses :: Clauses params tables
@@ -318,30 +320,30 @@ instance (HasTable table schema columns, table ~ table')
318 fromLabel p = FromExpression (fromLabel p) mempty
320 fromLabel p = FromExpression (fromLabel p) mempty
319
321
320where_
322where_
321− :: Expression params tables ('NotNull 'PGBool)
323+ :: Expression params tables ('Required ('NotNull 'PGBool))
322 -> FromExpression params schema tables
324 -> FromExpression params schema tables
323 -> FromExpression params schema tables
325 -> FromExpression params schema tables
324where_ wh (FromExpression tabs clauses1) = FromExpression tabs
326where_ wh (FromExpression tabs clauses1) = FromExpression tabs
325 (clauses1 <> Clauses (Just wh) Nothing Nothing)
327 (clauses1 <> Clauses (Just wh) Nothing Nothing)
326
328
327limit
329limit
328− :: Expression params '[] ('NotNull 'PGInt8)
330+ :: Expression params '[] ('Required ('NotNull 'PGInt8))
329 -> FromExpression params schema tables
331 -> FromExpression params schema tables
330 -> FromExpression params schema tables
332 -> FromExpression params schema tables
331limit lim (FromExpression tabs clauses1) = FromExpression tabs
333limit lim (FromExpression tabs clauses1) = FromExpression tabs
332 (clauses1 <> Clauses Nothing (Just lim) Nothing)
334 (clauses1 <> Clauses Nothing (Just lim) Nothing)
333
335
334offset
336offset
335− :: Expression params '[] ('NotNull 'PGInt8)
337+ :: Expression params '[] ('Required ('NotNull 'PGInt8))
336 -> FromExpression params schema tables
338 -> FromExpression params schema tables
337 -> FromExpression params schema tables
339 -> FromExpression params schema tables
338offset off (FromExpression tabs clauses1) = FromExpression tabs
340offset off (FromExpression tabs clauses1) = FromExpression tabs
339 (clauses1 <> Clauses Nothing Nothing (Just off))
341 (clauses1 <> Clauses Nothing Nothing (Just off))
340
342
341newtype Selection
343newtype Selection
342− (params :: [NullityType])
344+ (params :: [ColumnType])
343− (schema :: [(Symbol,[(Symbol,NullityType)])])
345+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
344− (columns :: [(Symbol,NullityType)])
346+ (columns :: [(Symbol,ColumnType)])
345 = UnsafeSelection { renderSelection :: ByteString }
347 = UnsafeSelection { renderSelection :: ByteString }
346
348
347starFrom
349starFrom
@@ -371,24 +373,22 @@ list `from` tabs = UnsafeSelection $
371 . rmap (Const . renderAliased renderExpression)
373 . rmap (Const . renderAliased renderExpression)
372
374
373newtype Statement
375newtype Statement
374− (params :: [NullityType])
376+ (params :: [ColumnType])
375− (columns :: [(Symbol,NullityType)])
377+ (columns :: [(Symbol,ColumnType)])
376− (schema0 :: [(Symbol,[(Symbol,NullityType)])])
378+ (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
377− (schema1 :: [(Symbol,[(Symbol,NullityType)])])
379+ (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
378 = UnsafeStatement { renderStatement :: ByteString }
380 = UnsafeStatement { renderStatement :: ByteString }
379
381
380−(&>>)
382+instance Category (Statement '[] '[]) where
381− :: Statement '[] '[] schema0 schema1
383+ id = UnsafeStatement ""
382− -> Statement '[] '[] schema1 schema2
383− -> Statement '[] '[] schema0 schema2
384−statement1 &>> statement2 = UnsafeStatement $
384+ statement2 . statement1 = UnsafeStatement $
385− renderStatement statement1 <> " " <> renderStatement statement2
385+ renderStatement statement1 <> " " <> renderStatement statement2
386
386
387newtype PreparedStatement
387newtype PreparedStatement
388− (params :: [NullityType])
388+ (params :: [ColumnType])
389− (columns :: [(Symbol,NullityType)])
389+ (columns :: [(Symbol,ColumnType)])
390− (schema0 :: [(Symbol,[(Symbol,NullityType)])])
390+ (schema0 :: [(Symbol,[(Symbol,ColumnType)])])
391− (schema1 :: [(Symbol,[(Symbol,NullityType)])])
391+ (schema1 :: [(Symbol,[(Symbol,ColumnType)])])
392 = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
392 = UnsafePreparedStatement { renderPreparedStatement :: ByteString }
393
393
394select
394select
@@ -423,19 +423,6 @@ insertInto (Alias table) expressions = UnsafeStatement $ "INSERT INTO "
423 (\ (expression `As` _) -> Const (renderExpression expression))
423 (\ (expression `As` _) -> Const (renderExpression expression))
424 expressions
424 expressions
425
425
426−createTable
427− :: (KnownSymbol table, KnownColumns columns)
428− => Alias table
429− -> Proxy# columns
430− -> Statement '[] '[] schema ((table ::: columns) ': schema)
431−createTable (Alias table) columns = UnsafeStatement $ mconcat
432− [ "CREATE TABLE "
433− , fromString $ symbolVal' table
434− , " ("
435− , renderColumns columns
436− , ");"
437− ]
438−
439class KnownSymbol table => DropTable table schema0 schema1
426class KnownSymbol table => DropTable table schema0 schema1
440 | table schema0 -> schema1 where
427 | table schema0 -> schema1 where
441 dropTable :: Alias table -> Statement '[] '[] schema0 schema1
428 dropTable :: Alias table -> Statement '[] '[] schema0 schema1
@@ -458,7 +445,7 @@ update
458 :: HasTable table schema columns
445 :: HasTable table schema columns
459 => Alias table
446 => Alias table
460 -> Rec (Aliased (Maybe `Compose` Expression params '[table ::: columns])) columns
447 -> Rec (Aliased (Maybe `Compose` Expression params '[table ::: columns])) columns
461− -> Expression params '[table ::: columns] ('NotNull 'PGBool)
448+ -> Expression params '[table ::: columns] ('Required ('NotNull 'PGBool))
462 -> Statement params '[] schema schema
449 -> Statement params '[] schema schema
463update (Alias table) columns where' = UnsafeStatement $ mconcat
450update (Alias table) columns where' = UnsafeStatement $ mconcat
464 [ "UPDATE "
451 [ "UPDATE "
@@ -478,3 +465,51 @@ update (Alias table) columns where' = UnsafeStatement $ mconcat
478 , renderExpression expression
465 , renderExpression expression
479 ]
466 ]
480 Compose Nothing `As` _ -> Nothing
467 Compose Nothing `As` _ -> Nothing
468+
469+
470+{-----------------------------------------
471+CREATE statements
472+-----------------------------------------}
473+
474+newtype TypeExpression (ty :: ColumnType)
475+ = UnsafeTypeExpression { renderTypeExpression :: ByteString }
476+int2 :: TypeExpression ('Required ('Null 'PGInt2))
477+int2 = UnsafeTypeExpression "int2"
478+int4 :: TypeExpression ('Required ('Null 'PGInt4))
479+int4 = UnsafeTypeExpression "int4"
480+int8 :: TypeExpression ('Required ('Null 'PGInt8))
481+int8 = UnsafeTypeExpression "int8"
482+bool :: TypeExpression ('Required ('Null 'PGBool))
483+bool = UnsafeTypeExpression "bool"
484+text :: TypeExpression ('Required ('Null 'PGText))
485+text = UnsafeTypeExpression "text"
486+notNull
487+ :: TypeExpression ('Required ('Null ty))
488+ -> TypeExpression ('Required ('NotNull ty))
489+notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <> " NOT NULL"
490+default_
491+ :: Expression '[] '[] ('Required ty)
492+ -> TypeExpression ('Required ty)
493+ -> TypeExpression ('Optional ty)
494+default_ x ty = UnsafeTypeExpression $
495+ renderTypeExpression ty <> " DEFAULT " <> renderExpression x
496+serial :: TypeExpression ('Optional ('NotNull 'PGInt4))
497+serial = UnsafeTypeExpression "serial"
498+
499+createTable
500+ :: KnownSymbol table
501+ => Alias table
502+ -> Rec (Aliased TypeExpression) columns
503+ -> Statement '[] '[] schema ((table ::: columns) ': schema)
504+createTable (Alias table) columns = UnsafeStatement $ mconcat
505+ [ "CREATE TABLE "
506+ , fromString $ symbolVal' table
507+ , " ("
508+ , ByteString.intercalate ", " . recordToList $
509+ rmap (Const . renderColumn) columns
510+ , ");"
511+ ]
512+ where
513+ renderColumn :: Aliased TypeExpression x -> ByteString
514+ renderColumn (ty `As` Alias column) =
515+ fromString (symbolVal' column) <> " " <> renderTypeExpression ty
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+30−21
@@ -11,7 +11,6 @@ module Squeel.PostgreSQL.StatementSpec where
11import Data.Boolean
11import Data.Boolean
12import Data.Function
12import Data.Function
13import Data.Vinyl
13import Data.Vinyl
14−import GHC.Exts
15import Test.Hspec
14import Test.Hspec
16
15
17import Squeel.PostgreSQL.Statement
16import Squeel.PostgreSQL.Statement
@@ -57,7 +56,7 @@ spec = do
57 "SELECT * FROM table1 AS table1 LIMIT CASE WHEN (1 <= 2) THEN 1 ELSE 2 END;"
56 "SELECT * FROM table1 AS table1 LIMIT CASE WHEN (1 <= 2) THEN 1 ELSE 2 END;"
58 it "should render parameters using $ signs" $ do
57 it "should render parameters using $ signs" $ do
59 let
58 let
60− statement :: Statement '[ 'NotNull 'PGInt8] Columns Tables Tables
59+ statement :: Statement '[ 'Required ('NotNull 'PGInt8)] Columns Tables Tables
61 statement = select $ starFrom (#table1 & limit param1)
60 statement = select $ starFrom (#table1 & limit param1)
62 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT $1;"
61 statement `shouldRenderAs` "SELECT * FROM table1 AS table1 LIMIT $1;"
63 it "does OFFSET clauses" $ do
62 it "does OFFSET clauses" $ do
@@ -136,7 +135,10 @@ spec = do
136 it "should render simple CREATE TABLE statements" $ do
135 it "should render simple CREATE TABLE statements" $ do
137 let
136 let
138 statement :: Statement '[] '[] '[] Tables
137 statement :: Statement '[] '[] '[] Tables
139− statement = createTable #table1 (proxy# :: Proxy# Columns)
138+ statement = createTable #table1
139+ ( (int4 & notNull) `As` #col1
140+ :& (int4 & notNull) `As` #col2
141+ :& RNil)
140 statement `shouldRenderAs`
142 statement `shouldRenderAs`
141 "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"
143 "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"
142 it "should render DROP TABLE statements" $ do
144 it "should render DROP TABLE statements" $ do
@@ -145,28 +147,35 @@ spec = do
145 statement = dropTable #table1
147 statement = dropTable #table1
146 statement `shouldRenderAs` "DROP TABLE table1;"
148 statement `shouldRenderAs` "DROP TABLE table1;"
147
149
150+type Columns =
148−type Columns = '[ "col1" ::: 'NotNull 'PGInt4, "col2" ::: 'NotNull 'PGInt4]
151+ '[ "col1" ::: 'Required ('NotNull 'PGInt4)
152+ , "col2" ::: 'Required ('NotNull 'PGInt4)
153+ ]
149type Tables = '[ "table1" ::: Columns ]
154type Tables = '[ "table1" ::: Columns ]
150−type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
155+type SumAndCol1 = '[ "sum" ::: 'Required ('NotNull 'PGInt4), "col1" ::: 'Required ('NotNull 'PGInt4)]
151−type StudentsColumns = '["name" ::: 'NotNull 'PGText]
156+type StudentsColumns = '["name" ::: 'Required ('NotNull 'PGText)]
152type StudentsTable = '["students" ::: StudentsColumns]
157type StudentsTable = '["students" ::: StudentsColumns]
153type OrderColumns =
158type OrderColumns =
154− [ "orderID" ::: 'NotNull 'PGInt4
159+ '[ "orderID" ::: 'Required ('NotNull 'PGInt4)
155− , "orderVal" ::: 'NotNull 'PGText
160+ , "orderVal" ::: 'Required ('NotNull 'PGText)
156− , "customerID" ::: 'NotNull 'PGInt4
161+ , "customerID" ::: 'Required ('NotNull 'PGInt4)
157− , "shipperID" ::: 'NotNull 'PGInt4
162+ , "shipperID" ::: 'Required ('NotNull 'PGInt4)
158− ]
163+ ]
159type CustomerColumns =
164type CustomerColumns =
165+ '[ "customerID" ::: 'Required ('NotNull 'PGInt4)
160− [ "customerID" ::: 'NotNull 'PGInt4, "customerVal" ::: 'NotNull 'PGFloat4 ]
166+ , "customerVal" ::: 'Required ('NotNull 'PGFloat4)
167+ ]
161type ShipperColumns =
168type ShipperColumns =
169+ '[ "shipperID" ::: 'Required ('NotNull 'PGInt4)
162− [ "shipperID" ::: 'NotNull 'PGInt4, "shipperVal" ::: 'NotNull 'PGBool ]
170+ , "shipperVal" ::: 'Required ('NotNull 'PGBool)
171+ ]
163type JoinTables =
172type JoinTables =
164− [ "shippers" ::: ShipperColumns
173+ '[ "shippers" ::: ShipperColumns
165− , "customers" ::: CustomerColumns
174+ , "customers" ::: CustomerColumns
166− , "orders" ::: OrderColumns
175+ , "orders" ::: OrderColumns
167− ]
176+ ]
168type ValueColumns =
177type ValueColumns =
169− [ "orderVal" ::: 'NotNull 'PGText
178+ '[ "orderVal" ::: 'Required ('NotNull 'PGText)
170− , "customerVal" ::: 'NotNull 'PGFloat4
179+ , "customerVal" ::: 'Required ('NotNull 'PGFloat4)
171− , "shipperVal" ::: 'NotNull 'PGBool
180+ , "shipperVal" ::: 'Required ('NotNull 'PGBool)
172− ]
181+ ]