git.iko.soy/squeal
on dev help sign in
Merge pull request #34 from echatav/table-constraints

Table constraints

commit35d90cd131890ce4afdb7e4bf167b8537db570b1 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 11 Aug 2017, 10:33 (9 years ago) parente1912e98172906
3 files changed+133−14
compare with dev
unifiedsplit
squeel-postgresql/exe/Example.hs+2−2 squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+83−8 squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+48−4
squeel-postgresql/exe/Example.hs+2−2
@@ -32,12 +32,12 @@ main = do
3232 connection1 <- flip execPQ (connection0 :: Connection '[]) $ pqExec $
3333 createTable #students
3434 ( (text & notNull) `As` #name
35− :* Nil )
35+ :* Nil ) []
3636 >>>
3737 createTable #table1
3838 ( (int4 & notNull) `As` #col1
3939 :* (int4 & notNull) `As` #col2
40− :* Nil )
40+ :* Nil ) []
4141 Char8.putStrLn "querying"
4242 connection2 <- flip execPQ (connection1 :: Connection Tables) $ do
4343 for_ [I i :* I (i+1) :* Nil | i <- [1::Int32,3..9]] $ pqExecParams
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+83−8
@@ -108,9 +108,8 @@ coalesce
108108 -> Expression params tables grouping ('Required ('NotNull x))
109109 -> Expression params tables grouping ('Required ('NotNull x))
110110coalesce nulls isn'tNull = UnsafeExpression $
111− "COALESCE"
112− <> parenthesized (commaSeparated (renderExpression <$> nulls))
113− <> ", " <> renderExpression isn'tNull
111+ "COALESCE" <> parenthesized (commaSeparated
112+ ((renderExpression <$> nulls) <> [renderExpression isn'tNull]))
114113
115114unsafeBinaryOp
116115 :: ByteString
@@ -384,12 +383,18 @@ data By
384383 (tables :: [(Symbol,[(Symbol,ColumnType)])])
385384 (tabcol :: (Symbol,Symbol)) where
386385 By
386+ :: (tables ~ '[table ::: columns], HasColumn column columns ty)
387+ => Alias column
388+ -> By tables '(table, column)
389+ By2
387390 :: (HasTable table tables columns, HasColumn column columns ty)
388391 => (Alias table, Alias column)
389392 -> By tables '(table, column)
390393
391394renderBy :: By tables tabcolty -> ByteString
392−renderBy (By (table, column)) = renderAlias table <> "." <> renderAlias column
395+renderBy = \case
396+ By column -> renderAlias column
397+ By2 (table, column) -> renderAlias table <> "." <> renderAlias column
393398
394399data GroupByClause tables grouping where
395400 NoGroups :: GroupByClause tables 'Ungrouped
@@ -866,14 +871,84 @@ createTable
866871 :: (KnownSymbol table, SListI columns)
867872 => Alias table
868873 -> NP (Aliased TypeExpression) columns
874+ -> [TableConstraint schema columns]
869875 -> Definition schema (Create table columns schema)
870−createTable table columns = UnsafeDefinition $
876+createTable table columns constraints = UnsafeDefinition $
871877 "CREATE TABLE" <+> renderAlias table
872− <+> parenthesized (renderCommaSeparated renderColumn columns) <> ";"
878+ <+> parenthesized
879+ ( renderCommaSeparated renderColumnDef columns
880+ <> renderConstraints constraints )
881+ <> ";"
873882 where
874− renderColumn :: Aliased TypeExpression x -> ByteString
875− renderColumn (ty `As` column) =
883+ renderColumnDef :: Aliased TypeExpression x -> ByteString
884+ renderColumnDef (ty `As` column) =
876885 renderAlias column <+> renderTypeExpression ty
886+ renderConstraints :: [TableConstraint schema columns] -> ByteString
887+ renderConstraints = \case
888+ [] -> ""
889+ _ -> ", " <> commaSeparated (renderTableConstraint <$> constraints)
890+
891+data TableConstraint
892+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
893+ (columns :: [(Symbol,ColumnType)])
894+ = UnsafeTableConstraint { renderTableConstraint :: ByteString }
895+
896+check
897+ :: Condition '[] '[table ::: columns] 'Ungrouped
898+ -> TableConstraint schema columns
899+check condition = UnsafeTableConstraint $
900+ "CHECK" <+> parenthesized (renderExpression condition)
901+
902+data Column
903+ (columns :: [(Symbol,ColumnType)])
904+ (columnty :: (Symbol,ColumnType))
905+ where
906+ Column
907+ :: HasColumn column columns ty
908+ => Alias column
909+ -> Column columns (column ::: ty)
910+
911+renderColumn :: Column columns columnty -> ByteString
912+renderColumn (Column column) = renderAlias column
913+
914+unique
915+ :: SListI subcolumns
916+ => NP (Column columns) subcolumns
917+ -> TableConstraint schema columns
918+unique columns = UnsafeTableConstraint $
919+ "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)
920+
921+primaryKey
922+ :: (SListI subcolumns, NotNullTypes subcolumns)
923+ => NP (Column columns) subcolumns
924+ -> TableConstraint schema columns
925+primaryKey columns = UnsafeTableConstraint $
926+ "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
927+
928+type family SameTypes columns0 columns1 :: Constraint where
929+ SameTypes '[] '[] = ()
930+ SameTypes ((column0 ::: ty0) ': columns0) ((column1 ::: ty1) ': columns1)
931+ = (ty0 ~ ty1, SameTypes columns0 columns1)
932+
933+type family NotNullTypes columns :: Constraint where
934+ NotNullTypes '[] = ()
935+ NotNullTypes ((column ::: (optionality ('NotNull ty))) ': columns)
936+ = NotNullTypes columns
937+
938+foreignKey
939+ :: ( HasTable reftable schema refcolumns
940+ , SameTypes subcolumns refsubcolumns
941+ , NotNullTypes subcolumns
942+ , SListI subcolumns
943+ , SListI refsubcolumns)
944+ => NP (Column columns) subcolumns
945+ -> Alias reftable
946+ -> NP (Column refcolumns) refsubcolumns
947+ -> TableConstraint schema columns
948+foreignKey columns reftable refcolumns = UnsafeTableConstraint $
949+ "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
950+ <+> "REFERENCES" <+> renderAlias reftable
951+ <+> parenthesized (renderCommaSeparated renderColumn refcolumns)
877952
878953{-----------------------------------------
879954DROP statements
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+48−4
@@ -8,6 +8,7 @@
88
99module Squeel.PostgreSQL.StatementSpec where
1010
11+import Control.Category ((>>>))
1112import Data.Function
1213import Generics.SOP hiding (from)
1314import Test.Hspec
@@ -87,12 +88,12 @@ spec = do
8788 statement =
8889 select (sum_ #col2 `As` #sum :* #col1 `As` #col1 :* Nil)
8990 ( from (Table (#table1 `As` #table1))
90− & group (By (#table1,#col1) :* Nil)
91+ & group (By #col1 :* Nil)
9192 & having ((#col1 + sum_ #col2) >* 1) )
9293 statement `queryRenders`
9394 "SELECT sum(col2) AS sum, col1 AS col1\
9495 \ FROM table1 AS table1\
95− \ GROUP BY table1.col1\
96+ \ GROUP BY col1\
9697 \ HAVING ((col1 + sum(col2)) > 1);"
9798 it "correctly renders simple INSERTs" $ do
9899 let
@@ -227,18 +228,61 @@ spec = do
227228 it "should render CREATE TABLE statements" $ do
228229 createTable #table1
229230 ((int4 & notNull) `As` #col1 :* (int4 & notNull) `As` #col2 :* Nil)
231+ [primaryKey (Column #col1 :* Column #col2 :* Nil)]
230232 `definitionRenders`
231233 "CREATE TABLE table1\
232− \ (col1 int4 NOT NULL, col2 int4 NOT NULL);"
234+ \ (col1 int4 NOT NULL, col2 int4 NOT NULL,\
235+ \ PRIMARY KEY (col1, col2));"
233236 createTable #table2
234237 ( serial `As` #col1 :*
235238 text `As` #col2 :*
236239 (int8 & notNull & default_ 8) `As` #col3 :* Nil )
240+ [check (#col3 >* 0)]
237241 `definitionRenders`
238242 "CREATE TABLE table2\
239243 \ (col1 serial,\
240244 \ col2 text,\
241− \ col3 int8 NOT NULL DEFAULT 8);"
245+ \ col3 int8 NOT NULL DEFAULT 8,\
246+ \ CHECK ((col3 > 0)));"
247+ let
248+ statement :: Definition '[]
249+ '[ "users" :::
250+ '[ "id" ::: 'Optional ('NotNull 'PGInt4)
251+ , "username" ::: 'Required ('NotNull 'PGText)
252+ ]
253+ , "emails" :::
254+ '[ "id" ::: 'Optional ('NotNull 'PGInt4)
255+ , "userid" ::: 'Required ('NotNull 'PGInt4)
256+ , "email" ::: 'Required ('NotNull 'PGText)
257+ ]
258+ ]
259+ statement =
260+ createTable #users
261+ (serial `As` #id :* (text & notNull) `As` #username :* Nil)
262+ [primaryKey (Column #id :* Nil)]
263+ >>>
264+ createTable #emails
265+ ( serial `As` #id :*
266+ (integer & notNull) `As` #userid :*
267+ (text & notNull) `As` #email :* Nil )
268+ [ primaryKey (Column #id :* Nil)
269+ , foreignKey (Column #userid :* Nil) #users (Column #id :* Nil)
270+ , unique (Column #email :* Nil)
271+ , check (#email /=* "")
272+ ]
273+ statement `definitionRenders`
274+ "CREATE TABLE users\
275+ \ (id serial, username text NOT NULL,\
276+ \ PRIMARY KEY (id));\
277+ \ \
278+ \CREATE TABLE emails\
279+ \ (id serial,\
280+ \ userid integer NOT NULL,\
281+ \ email text NOT NULL,\
282+ \ PRIMARY KEY (id),\
283+ \ FOREIGN KEY (userid) REFERENCES users (id),\
284+ \ UNIQUE (email),\
285+ \ CHECK ((email <> E'')));"
242286 it "should render DROP TABLE statements" $ do
243287 let
244288 statement :: Definition Tables '[]