git.iko.soy/squeal
on dev help sign in
returning and conflict clauses

and rendering helpers

commit0e94cc0a1cf934f87c73527d8f516325818ad247 authorEitan Chatav <eitan.chatav@gmail.com> dateWed 9 Aug 2017, 15:44 (9 years ago) parent58ba665
4 files changed+301−324
compare with dev
unifiedsplit
squeel-postgresql/exe/Example.hs+3−1 squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+2−2 squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+217−260 squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+79−61
squeel-postgresql/exe/Example.hs+3−1
@@ -41,7 +41,9 @@ main = do
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
44− (insertInto #table1 (param1 `As` #col1 :* param2 `As` #col2 :* Nil))
44+ ( into #table1
45+ (insertRow (param1 `As` #col1 :* param2 `As` #col2 :* Nil))
46+ Conflict ReturningNil )
4547 Just result <- pqExecNil . query $
4648 selectStar (from (Table (#table1 `As` #table1)))
4749 runMaybeT . runExceptT . flip runValue result $ do
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+2−2
@@ -36,7 +36,7 @@ module Squeel.PostgreSQL.Schema
3636 , Rename
3737 , Join
3838 , Grouping (..)
39− , TableColumn (..)
39+ , IsTableColumn (..)
4040 , module GHC.OverloadedLabels
4141 , module GHC.TypeLits
4242 ) where
@@ -174,5 +174,5 @@ data Grouping
174174 = Ungrouped
175175 | Grouped [(Symbol,Symbol)]
176176
177−class TableColumn table column expression where
177+class IsTableColumn table column expression where
178178 (&.) :: Alias table -> Alias column -> expression
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+217−260
@@ -8,6 +8,8 @@
88 , LambdaCase
99 , MagicHash
1010 , OverloadedStrings
11+ , PolyKinds
12+ , RankNTypes
1113 , ScopedTypeVariables
1214 , TypeApplications
1315 , TypeFamilies
@@ -70,7 +72,7 @@ class KnownSymbol column => HasColumn column columns ty
7072 getColumn
7173 :: Proxy# column
7274 -> Expression params '[table ::: columns] 'Ungrouped ty
73− getColumn column = UnsafeExpression $ fromString $ symbolVal' column
75+ getColumn column = UnsafeExpression $ renderSymbol column
7476instance {-# OVERLAPPING #-} KnownSymbol column
7577 => HasColumn column ((column ::: optionality ty) ': tys) ('Required ty)
7678instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)
@@ -81,7 +83,7 @@ instance (HasColumn column columns ty, tables ~ '[table ::: columns])
8183 fromLabel = getColumn
8284
8385instance (HasTable table tables columns, HasColumn column columns ty)
84− => TableColumn table column (Expression params tables 'Ungrouped ty) where
86+ => IsTableColumn table column (Expression params tables 'Ungrouped ty) where
8587 table &. column = UnsafeExpression $
8688 renderAlias table <> "." <> renderAlias column
8789
@@ -105,34 +107,32 @@ coalesce
105107 :: [Expression params tables grouping ('Required ('Null x))]
106108 -> Expression params tables grouping ('Required ('NotNull x))
107109 -> Expression params tables grouping ('Required ('NotNull x))
108−coalesce nulls isn'tNull = UnsafeExpression $ mconcat
109− [ "COALESCE("
110− , ByteString.intercalate ", " $ map renderExpression nulls
111− , ", ", renderExpression isn'tNull
112− , ")"
113− ]
110+coalesce nulls isn'tNull = UnsafeExpression $
111+ "COALESCE"
112+ <> parenthesized (commaSeparated (renderExpression <$> nulls))
113+ <> ", " <> renderExpression isn'tNull
114114
115115unsafeBinaryOp
116116 :: ByteString
117117 -> Expression params tables grouping ty0
118118 -> Expression params tables grouping ty1
119119 -> Expression params tables grouping ty2
120−unsafeBinaryOp op x y = UnsafeExpression $ mconcat
121− ["(", renderExpression x, " ", op, " ", renderExpression y, ")"]
120+unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $
121+ renderExpression x <+> op <+> renderExpression y
122122
123123unsafeUnaryOp
124124 :: ByteString
125125 -> Expression params tables grouping ty0
126126 -> Expression params tables grouping ty1
127−unsafeUnaryOp op x = UnsafeExpression $ mconcat
128− ["(", op, " ", renderExpression x, ")"]
127+unsafeUnaryOp op x = UnsafeExpression $ parenthesized $
128+ op <+> renderExpression x
129129
130130unsafeFunction
131131 :: ByteString
132132 -> Expression params tables grouping xty
133133 -> Expression params tables grouping yty
134−unsafeFunction fun x = UnsafeExpression $ mconcat
135− [fun, "(", renderExpression x, ")"]
134+unsafeFunction fun x = UnsafeExpression $
135+ fun <> parenthesized (renderExpression x)
136136
137137instance PGNum ty
138138 => Num (Expression params tables grouping ('Required (nullity ty))) where
@@ -373,8 +373,8 @@ data SortExpression params tables grouping where
373373
374374renderSortExpression :: SortExpression params tables grouping -> ByteString
375375renderSortExpression = \case
376− Asc expression -> renderExpression expression <> " ASC"
377− Desc expression -> renderExpression expression <> " DESC"
376+ Asc expression -> renderExpression expression <+> "ASC"
377+ Desc expression -> renderExpression expression <+> "DESC"
378378
379379{-----------------------------------------
380380aggregation
@@ -402,8 +402,7 @@ renderGroupByClause :: GroupByClause tables grouping -> ByteString
402402renderGroupByClause = \case
403403 NoGroups -> ""
404404 Group Nil -> ""
405− Group bys -> " GROUP BY " <> ByteString.intercalate ", "
406− (hcollapse (hmap (K . renderBy) bys))
405+ Group bys -> " GROUP BY" <+> renderCommaSeparated renderBy bys
407406
408407data HavingClause params tables grouping where
409408 NoHaving :: HavingClause params tables 'Ungrouped
@@ -415,8 +414,8 @@ renderHavingClause :: HavingClause params tables grouping -> ByteString
415414renderHavingClause = \case
416415 NoHaving -> ""
417416 Having [] -> ""
418− Having conditions -> " HAVING " <> ByteString.intercalate ", "
419− (renderExpression <$> conditions)
417+ Having conditions ->
418+ " HAVING" <+> commaSeparated (renderExpression <$> conditions)
420419
421420class (KnownSymbol table, KnownSymbol column)
422421 => GroupedBy table column bys where
@@ -451,7 +450,7 @@ instance
451450 ( HasTable table tables columns
452451 , HasColumn column columns ty
453452 , GroupedBy table column bys
454− ) => TableColumn table column
453+ ) => IsTableColumn table column
455454 (Expression params tables ('Grouped bys) ty) where (&.) = getGroup2
456455
457456unsafeAggregate
@@ -528,39 +527,16 @@ renderTableReference :: TableReference params schema tables -> ByteString
528527renderTableReference = \case
529528 Table table -> renderAliased renderTable table
530529 Subquery selection -> renderAliased renderQuery selection
531− CrossJoin right left -> mconcat
532− [ renderTableReference left
533− , " CROSS JOIN "
534− , renderTableReference right
535− ]
536− InnerJoin right on left -> mconcat
537− [ renderTableReference left
538− , " INNER JOIN "
539− , renderTableReference right
540− , " ON "
541− , renderExpression on
542− ]
543− LeftOuterJoin right on left -> mconcat
544− [ renderTableReference left
545− , " LEFT OUTER JOIN "
546− , renderTableReference right
547− , " ON "
548− , renderExpression on
549− ]
550− RightOuterJoin right on left -> mconcat
551− [ renderTableReference left
552− , " RIGHT OUTER JOIN "
553− , renderTableReference right
554− , " ON "
555− , renderExpression on
556− ]
557− FullOuterJoin right on left -> mconcat
558− [ renderTableReference left
559− , " FULL OUTER JOIN "
560− , renderTableReference right
561− , " ON "
562− , renderExpression on
563− ]
530+ CrossJoin right left ->
531+ renderTableReference left <+> "CROSS JOIN" <+> renderTableReference right
532+ InnerJoin right on left -> renderJoin "INNER JOIN" right on left
533+ LeftOuterJoin right on left -> renderJoin "LEFT OUTER JOIN" right on left
534+ RightOuterJoin right on left -> renderJoin "RIGHT OUTER JOIN" right on left
535+ FullOuterJoin right on left -> renderJoin "FULL OUTER JOIN" right on left
536+ where
537+ renderJoin op right on left =
538+ renderTableReference left <+> op <+> renderTableReference right
539+ <+> "ON" <+> renderExpression on
564540
565541data TableExpression
566542 (params :: [ColumnType])
@@ -593,18 +569,18 @@ renderTableExpression
593569 where
594570 renderWheres = \case
595571 [] -> ""
596− wh:[] -> " WHERE " <> renderExpression wh
597− wh:whs -> " WHERE " <> renderExpression (foldr (&&*) wh whs)
572+ wh:[] -> " WHERE" <+> renderExpression wh
573+ wh:whs -> " WHERE" <+> renderExpression (foldr (&&*) wh whs)
598574 renderSorts = \case
599575 [] -> ""
600− srts -> " SORT BY "
601− <> ByteString.intercalate ", " (renderSortExpression <$> srts)
576+ srts -> " SORT BY"
577+ <+> commaSeparated (renderSortExpression <$> srts)
602578 renderLimits = \case
603579 [] -> ""
604− lims -> " LIMIT " <> fromString (show (minimum lims))
580+ lims -> " LIMIT" <+> fromString (show (minimum lims))
605581 renderOffsets = \case
606582 [] -> ""
607− offs -> " OFFSET " <> fromString (show (sum offs))
583+ offs -> " OFFSET" <+> fromString (show (sum offs))
608584
609585from
610586 :: TableReference params schema tables
@@ -753,15 +729,15 @@ jsonb :: TypeExpression ('Required ('Null ('PGJsonb)))
753729jsonb = UnsafeTypeExpression "jsonb"
754730
755731notNull
756− :: TypeExpression ('Required ('Null ty))
757− -> TypeExpression ('Required ('NotNull ty))
758−notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <> " NOT NULL"
732+ :: TypeExpression (optionality ('Null ty))
733+ -> TypeExpression (optionality ('NotNull ty))
734+notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <+> "NOT NULL"
759735default_
760736 :: Expression '[] '[] 'Ungrouped ('Required ty)
761737 -> TypeExpression ('Required ty)
762738 -> TypeExpression ('Optional ty)
763739default_ x ty = UnsafeTypeExpression $
764− renderTypeExpression ty <> " DEFAULT " <> renderExpression x
740+ renderTypeExpression ty <+> "DEFAULT" <+> renderExpression x
765741
766742class PGTyped (ty :: PGType) where
767743 pgtype :: TypeExpression ('Required ('Null ty))
@@ -798,8 +774,8 @@ newtype Definition
798774
799775instance Category Definition where
800776 id = UnsafeDefinition ";"
801− dd1 . dd0 = UnsafeDefinition $
802− renderDefinition dd0 <> " " <> renderDefinition dd1
777+ ddl1 . ddl0 = UnsafeDefinition $
778+ renderDefinition ddl0 <+> renderDefinition ddl1
803779
804780newtype Manipulation
805781 (schema :: [(Symbol,[(Symbol,ColumnType)])])
@@ -823,17 +799,29 @@ union, unionAll, intersect, intersectAll, except, exceptAll
823799 -> Query schema params columns
824800 -> Query schema params columns
825801q1 `union` q2 = UnsafeQuery $
826− "(" <> renderQuery q1 <> ") UNION (" <> renderQuery q2 <> ")"
802+ parenthesized (renderQuery q1)
803+ <+> "UNION"
804+ <+> parenthesized (renderQuery q2)
827805q1 `unionAll` q2 = UnsafeQuery $
828− "(" <> renderQuery q1 <> ") UNION ALL " <> renderQuery q2
806+ parenthesized (renderQuery q1)
807+ <+> "UNION" <+> "ALL"
808+ <+> parenthesized (renderQuery q2)
829809q1 `intersect` q2 = UnsafeQuery $
830− "(" <> renderQuery q1 <> ") INTERSECT " <> renderQuery q2
810+ parenthesized (renderQuery q1)
811+ <+> "INTERSECT"
812+ <+> parenthesized (renderQuery q2)
831813q1 `intersectAll` q2 = UnsafeQuery $
832− "(" <> renderQuery q1 <> ") INTERSECT ALL " <> renderQuery q2
814+ parenthesized (renderQuery q1)
815+ <+> "INTERSECT" <+> "ALL"
816+ <+> parenthesized (renderQuery q2)
833817q1 `except` q2 = UnsafeQuery $
834− "(" <> renderQuery q1 <> ") EXCEPT " <> renderQuery q2
818+ parenthesized (renderQuery q1)
819+ <+> "EXCEPT"
820+ <+> parenthesized (renderQuery q2)
835821q1 `exceptAll` q2 = UnsafeQuery $
836− "(" <> renderQuery q1 <> ") EXCEPT ALL " <> renderQuery q2
822+ parenthesized (renderQuery q1)
823+ <+> "EXCEPT" <+> "ALL"
824+ <+> parenthesized (renderQuery q2)
837825
838826{-----------------------------------------
839827SELECT statements
@@ -845,18 +833,15 @@ select
845833 -> TableExpression params schema tables grouping
846834 -> Query schema params columns
847835select list tabs = UnsafeQuery $
848− "SELECT " <> renderList list <> " " <> renderTableExpression tabs
849− where
850− renderList
851− = ByteString.intercalate ", "
852− . hcollapse
853− . hmap (K . renderAliased renderExpression)
836+ "SELECT"
837+ <+> renderCommaSeparated (renderAliased renderExpression) list
838+ <+> renderTableExpression tabs
854839
855840selectStar
856841 :: (tables ~ '[table ::: columns])
857842 => TableExpression params schema tables 'Ungrouped
858843 -> Query schema params columns
859−selectStar tabs = UnsafeQuery $ "SELECT * " <> renderTableExpression tabs
844+selectStar tabs = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression tabs
860845
861846selectDotStar
862847 :: HasTable table tables columns
@@ -864,7 +849,14 @@ selectDotStar
864849 -> TableExpression params schema tables 'Ungrouped
865850 -> Query schema params columns
866851selectDotStar table tables = UnsafeQuery $
867− "SELECT " <> renderAlias table <> ".* " <> renderTableExpression tables
852+ "SELECT" <+> renderAlias table <> ".*" <+> renderTableExpression tables
853+
854+selectRow
855+ :: SListI columns
856+ => NP (Aliased (Expression params '[] 'Ungrouped)) columns
857+ -> Query schema params columns
858+selectRow row = UnsafeQuery $
859+ "SELECT" <+> renderCommaSeparated (renderAliased renderExpression) row
868860
869861{-----------------------------------------
870862CREATE statements
@@ -875,18 +867,13 @@ createTable
875867 => Alias table
876868 -> NP (Aliased TypeExpression) columns
877869 -> Definition schema (Create table columns schema)
878−createTable table columns = UnsafeDefinition $ mconcat
879− [ "CREATE TABLE "
880− , renderAlias table
881− , " ("
882− , ByteString.intercalate ", " . hcollapse $
883− hmap (K . renderColumn) columns
884− , ");"
885− ]
870+createTable table columns = UnsafeDefinition $
871+ "CREATE TABLE" <+> renderAlias table
872+ <+> parenthesized (renderCommaSeparated renderColumn columns) <> ";"
886873 where
887874 renderColumn :: Aliased TypeExpression x -> ByteString
888875 renderColumn (ty `As` column) =
889− renderAlias column <> " " <> renderTypeExpression ty
876+ renderAlias column <+> renderTypeExpression ty
890877
891878{-----------------------------------------
892879DROP statements
@@ -896,7 +883,7 @@ dropTable
896883 :: KnownSymbol table
897884 => Alias table
898885 -> Definition schema (Drop table schema)
899−dropTable table = UnsafeDefinition $ "DROP TABLE " <> renderAlias table <> ";"
886+dropTable table = UnsafeDefinition $ "DROP TABLE" <+> renderAlias table <> ";"
900887
901888{-----------------------------------------
902889ALTER statements
@@ -908,10 +895,9 @@ alterTable
908895 -> AlterTable columns0 columns1
909896 -> Definition schema (Alter table schema columns1)
910897alterTable table alteration = UnsafeDefinition $
911− "ALTER TABLE "
912− <> renderAlias table
913− <> " "
914− <> renderAlterTable alteration
898+ "ALTER TABLE"
899+ <+> renderAlias table
900+ <+> renderAlterTable alteration
915901 <> ";"
916902
917903alterTableRename
@@ -920,11 +906,8 @@ alterTableRename
920906 -> Alias table1
921907 -> Definition schema (Rename table0 table1 schema)
922908alterTableRename table0 table1 = UnsafeDefinition $
923− "ALTER TABLE "
924− <> renderAlias table0
925− <> " RENAME TO "
926− <> renderAlias table1
927− <> ";"
909+ "ALTER TABLE" <+> renderAlias table0
910+ <+> "RENAME TO" <+> renderAlias table1 <> ";"
928911
929912data AlterTable
930913 (columns0 :: [(Symbol, ColumnType)])
@@ -937,10 +920,7 @@ addColumnDefault
937920 -> TypeExpression ('Optional ty)
938921 -> AlterTable columns (Create column ('Optional ty) columns)
939922addColumnDefault column ty = UnsafeAlterTable $
940− "ADD COLUMN "
941− <> renderAlias column
942− <> " "
943− <> renderTypeExpression ty
923+ "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty
944924
945925addColumnNull
946926 :: KnownSymbol column
@@ -948,17 +928,14 @@ addColumnNull
948928 -> TypeExpression ('Required ('Null ty))
949929 -> AlterTable columns ((column ::: 'Required ('Null ty)) ': columns)
950930addColumnNull column ty = UnsafeAlterTable $
951− "ADD COLUMN "
952− <> renderAlias column
953− <> " "
954− <> renderTypeExpression ty
931+ "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty
955932
956933dropColumn
957934 :: KnownSymbol column
958935 => Alias column
959936 -> AlterTable columns (Drop column columns)
960937dropColumn column = UnsafeAlterTable $
961− "DROP COLUMN " <> renderAlias column
938+ "DROP COLUMN" <+> renderAlias column
962939
963940renameColumn
964941 :: (KnownSymbol column0, KnownSymbol column1)
@@ -966,8 +943,7 @@ renameColumn
966943 -> Alias column1
967944 -> AlterTable columns (Rename column0 column1 columns)
968945renameColumn column0 column1 = UnsafeAlterTable $
969− "RENAME COLUMN " <> renderAlias column0
970− <> " TO " <> renderAlias column1
946+ "RENAME COLUMN" <+> renderAlias column0 <+> "TO" <+> renderAlias column1
971947
972948alterColumn
973949 :: (KnownSymbol column, HasColumn column columns ty0)
@@ -975,8 +951,7 @@ alterColumn
975951 -> AlterColumn ty0 ty1
976952 -> AlterTable columns (Alter column columns ty1)
977953alterColumn column alteration = UnsafeAlterTable $
978− "ALTER COLUMN " <> renderAlias column
979− <> " " <> renderAlterColumn alteration
954+ "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration
980955
981956data AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =
982957 UnsafeAlterColumn {renderAlterColumn :: ByteString}
@@ -985,7 +960,7 @@ setDefault
985960 :: Expression '[] '[] 'Ungrouped ('Required ty)
986961 -> AlterColumn ('Required ty) ('Optional ty)
987962setDefault expression = UnsafeAlterColumn $
988− "SET DEFAULT " <> renderExpression expression
963+ "SET DEFAULT" <+> renderExpression expression
989964
990965dropDefault :: AlterColumn ('Optional ty) ('Required ty)
991966dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
@@ -1008,53 +983,90 @@ alterType ty = UnsafeAlterColumn $ "TYPE " <> renderTypeExpression ty
1008983INSERT statements
1009984-----------------------------------------}
1010985
1011−insertInto
1012− :: (SListI columns, HasTable table schema columns)
1013− => Alias table
1014− -> NP (Aliased (Expression params '[] 'Ungrouped)) columns
1015− -> Manipulation schema params '[]
1016−insertInto table expressions = UnsafeManipulation $ "INSERT INTO "
1017− <> renderAlias table
1018− <> " (" <> ByteString.intercalate ", " aliases
1019− <> ") VALUES ("
1020− <> ByteString.intercalate ", " values
1021− <> ");"
1022− where
1023− aliases = hcollapse $ hmap
1024− (\ (_ `As` name) -> K (renderAlias name))
1025− expressions
1026− values = hcollapse $ hmap
1027− (\ (expression `As` _) -> K (renderExpression expression))
1028− expressions
1029−
1030−insertIntoReturning
986+into
1031987 :: (SListI columns, SListI results, HasTable table schema columns)
1032988 => Alias table
1033− -> NP (Aliased (Expression params '[] 'Ungrouped)) columns
1034− -> NP (Aliased (Expression params '[table ::: columns] 'Ungrouped)) results
989+ -> InsertClause schema params columns
990+ -> ConflictClause params columns
991+ -> ReturningClause params columns results
1035992 -> Manipulation schema params results
1036−insertIntoReturning table inserts results
1037− = UnsafeManipulation . mconcat $
1038− [ "INSERT INTO "
1039− , renderAlias table
1040− , " (" <> ByteString.intercalate ", " aliases
1041− , ") VALUES ("
1042− , ByteString.intercalate ", " values
1043− , ") RETURNING "
1044− , renderList results
1045− , ";"
1046− ]
993+into table insert conflict returning = UnsafeManipulation $
994+ "INSERT" <+> "INTO" <+> renderAlias table
995+ <+> renderInsertClause insert
996+ <> renderConflictClause conflict
997+ <> renderReturningClause returning
998+
999+data InsertClause
1000+ (schema :: [(Symbol,[(Symbol,ColumnType)])])
1001+ (params :: [ColumnType])
1002+ (columns :: [(Symbol,ColumnType)])
1003+ = InsertValues
1004+ (NP (Aliased (Expression params '[] 'Ungrouped)) columns)
1005+ [NP (Aliased (Expression params '[] 'Ungrouped)) columns]
1006+ | InsertQuery (Query schema params columns)
1007+
1008+insertRow
1009+ :: (NP (Aliased (Expression params '[] 'Ungrouped)) columns)
1010+ -> InsertClause schema params columns
1011+insertRow row = InsertValues row []
1012+
1013+renderInsertClause
1014+ :: SListI columns
1015+ => InsertClause schema params columns
1016+ -> ByteString
1017+renderInsertClause = \case
1018+ InsertValues row rows ->
1019+ parenthesized (renderCommaSeparated renderAliasPart row)
1020+ <+> "VALUES"
1021+ <+> commaSeparated
1022+ (parenthesized . renderCommaSeparated renderValuePart <$> row:rows)
1023+ where
1024+ renderAliasPart, renderValuePart
1025+ :: Aliased (Expression params '[] 'Ungrouped) ty -> ByteString
1026+ renderAliasPart (_ `As` name) = renderAlias name
1027+ renderValuePart (value `As` _) = renderExpression value
1028+ InsertQuery q -> renderQuery q
1029+
1030+data ReturningClause
1031+ (params :: [ColumnType])
1032+ (columns :: [(Symbol,ColumnType)])
1033+ (results :: [(Symbol,ColumnType)])
10471034 where
1048− aliases = hcollapse $ hmap
1049− (\ (_ `As` name) -> K (renderAlias name))
1050− inserts
1051− values = hcollapse $ hmap
1052− (\ (expression `As` _) -> K (renderExpression expression))
1053− inserts
1054− renderList
1055− = ByteString.intercalate ", "
1056− . hcollapse
1057− . hmap (K . renderAliased renderExpression)
1035+ ReturningNil :: ReturningClause params columns '[]
1036+ ReturningStar :: ReturningClause params columns columns
1037+ Returning
1038+ :: NP (Aliased (Expression params '[table ::: columns] 'Ungrouped)) results
1039+ -> ReturningClause params columns results
1040+
1041+renderReturningClause
1042+ :: SListI results
1043+ => ReturningClause params columns results
1044+ -> ByteString
1045+renderReturningClause = \case
1046+ ReturningNil -> ";"
1047+ ReturningStar -> " RETURNING *;"
1048+ Returning results -> " RETURNING"
1049+ <+> renderCommaSeparated (renderAliased renderExpression) results <> ";"
1050+
1051+data ConflictClause params columns where
1052+ Conflict :: ConflictClause params columns
1053+ OnConflictDoNothing :: ConflictClause params columns
1054+ OnConflictDoUpdate
1055+ :: NP (Aliased (UpdateExpression params '[table ::: columns])) columns
1056+ -> Condition params '[table ::: columns] 'Ungrouped
1057+ -> ConflictClause params columns
1058+
1059+renderConflictClause
1060+ :: SListI columns
1061+ => ConflictClause params columns
1062+ -> ByteString
1063+renderConflictClause = \case
1064+ Conflict -> ""
1065+ OnConflictDoNothing -> " ON CONFLICT DO NOTHING"
1066+ OnConflictDoUpdate updates wh
1067+ -> " ON CONFLICT DO UPDATE SET"
1068+ <+> renderCommaSeparatedMaybe renderUpdateExpression updates
1069+ <+> "WHERE" <+> renderExpression wh
10581070
10591071{-----------------------------------------
10601072UPDATE statements
@@ -1069,111 +1081,23 @@ renderUpdateExpression
10691081 -> Maybe ByteString
10701082renderUpdateExpression = \case
10711083 Same `As` _ -> Nothing
1072− Set expression `As` column -> Just $ mconcat
1073− [ renderAlias column
1074− , " = "
1075− , renderExpression expression
1076− ]
1084+ Set expression `As` column -> Just $
1085+ renderAlias column <+> "=" <+> renderExpression expression
10771086
10781087update
1079− :: (HasTable table schema columns, SListI columns)
1088+ :: (HasTable table schema columns, SListI columns, SListI results)
10801089 => Alias table
10811090 -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
10821091 -> Condition params '[table ::: columns] 'Ungrouped
1083− -> Manipulation schema params '[]
1084−update table columns wh = UnsafeManipulation $ mconcat
1085− [ "UPDATE "
1086− , renderAlias table
1087− , " SET "
1088− , ByteString.intercalate ", " . catMaybes . hcollapse $
1089− hmap (K . renderUpdateExpression) columns
1090− , " WHERE ", renderExpression wh, ";"
1091− ]
1092−
1093−updateReturning
1094− :: (SListI columns, SListI results, HasTable table schema columns)
1095− => Alias table
1096− -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
1097− -> Condition params '[table ::: columns] 'Ungrouped
1098− -> NP (Aliased (Expression params '[table ::: columns] 'Ungrouped)) results
1092+ -> ReturningClause params columns results
10991093 -> Manipulation schema params results
1100−updateReturning table updates wh results = UnsafeManipulation $ mconcat
1101− [ "UPDATE "
1102− , renderAlias table
1103− , " SET "
1104− , ByteString.intercalate ", " . catMaybes . hcollapse $
1105− hmap (K . renderUpdateExpression) updates
1106− , " WHERE ", renderExpression wh
1107− , " RETURNING ", renderList results
1108− , ";"
1109− ]
1110− where
1111− renderList
1112− = ByteString.intercalate ", "
1113− . hcollapse
1114− . hmap (K . renderAliased renderExpression)
1115−
1116−upsertInto
1117− :: (SListI columns, HasTable table schema columns)
1118− => Alias table
1119− -> NP (Aliased (Expression params '[] 'Ungrouped)) columns
1120− -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
1121− -> Condition params '[table ::: columns] 'Ungrouped
1122− -> Manipulation schema params '[]
1123−upsertInto table inserts updates wh = UnsafeManipulation . mconcat $
1124− [ "INSERT INTO "
1125− , renderAlias table
1126− , " (" <> ByteString.intercalate ", " aliases
1127− , ") VALUES ("
1128− , ByteString.intercalate ", " values
1129− , ") ON CONFLICT UPDATE "
1130− , renderAlias table
1131− , " SET "
1132− , ByteString.intercalate ", " . catMaybes . hcollapse $
1133− hmap (K . renderUpdateExpression) updates
1134− , " WHERE ", renderExpression wh, ";"
1135− ] where
1136− aliases = hcollapse $ hmap
1137− (\ (_ `As` name) -> K (renderAlias name))
1138− inserts
1139− values = hcollapse $ hmap
1140− (\ (expression `As` _) -> K (renderExpression expression))
1141− inserts
1142−
1143−upsertIntoReturning
1144− :: (SListI columns, SListI results, HasTable table schema columns)
1145− => Alias table
1146− -> NP (Aliased (Expression params '[] 'Ungrouped)) columns
1147− -> NP (Aliased (UpdateExpression params '[table ::: columns])) columns
1148− -> Condition params '[table ::: columns] 'Ungrouped
1149− -> NP (Aliased (Expression params '[table ::: columns] 'Ungrouped)) results
1150− -> Manipulation schema params results
1151−upsertIntoReturning table inserts updates wh results =
1152− UnsafeManipulation . mconcat $
1153− [ "INSERT INTO "
1154− , renderAlias table
1155− , " (" <> ByteString.intercalate ", " aliases
1156− , ") VALUES ("
1157− , ByteString.intercalate ", " values
1158− , ") ON CONFLICT UPDATE "
1159− , renderAlias table
1160− , " SET "
1161− , ByteString.intercalate ", " . catMaybes . hcollapse $
1162− hmap (K . renderUpdateExpression) updates
1163− , " WHERE ", renderExpression wh
1164− , " RETURNING ", renderList results
1165− , ";"
1166− ] where
1167− aliases = hcollapse $ hmap
1168− (\ (_ `As` name) -> K (renderAlias name))
1169− inserts
1170− values = hcollapse $ hmap
1171− (\ (expression `As` _) -> K (renderExpression expression))
1172− inserts
1173− renderList
1174− = ByteString.intercalate ", "
1175− . hcollapse
1176− . hmap (K . renderAliased renderExpression)
1094+update table columns wh returning = UnsafeManipulation $
1095+ "UPDATE"
1096+ <+> renderAlias table
1097+ <+> "SET"
1098+ <+> renderCommaSeparatedMaybe renderUpdateExpression columns
1099+ <+> "WHERE" <+> renderExpression wh
1100+ <> renderReturningClause returning
11771101
11781102{-----------------------------------------
11791103DELETE statements
@@ -1184,8 +1108,41 @@ deleteFrom
11841108 => Alias table
11851109 -> Condition params '[table ::: columns] 'Ungrouped
11861110 -> Manipulation schema params '[]
1187−deleteFrom table wh = UnsafeManipulation $ mconcat
1188− [ "DELETE FROM "
1189− , renderAlias table
1190− , " WHERE ", renderExpression wh, ";"
1191− ]
1111+deleteFrom table wh = UnsafeManipulation $
1112+ "DELETE FROM" <+> renderAlias table
1113+ <+> "WHERE" <+> renderExpression wh <> ";"
1114+
1115+{-----------------------------------------
1116+render helper functions
1117+-----------------------------------------}
1118+
1119+parenthesized :: ByteString -> ByteString
1120+parenthesized str = "(" <> str <> ")"
1121+
1122+(<+>) :: ByteString -> ByteString -> ByteString
1123+str1 <+> str2 = str1 <> " " <> str2
1124+
1125+commaSeparated :: [ByteString] -> ByteString
1126+commaSeparated = ByteString.intercalate ", "
1127+
1128+renderCommaSeparated
1129+ :: SListI xs
1130+ => (forall x. expression x -> ByteString)
1131+ -> NP expression xs -> ByteString
1132+renderCommaSeparated render
1133+ = commaSeparated
1134+ . hcollapse
1135+ . hmap (K . render)
1136+
1137+renderCommaSeparatedMaybe
1138+ :: SListI xs
1139+ => (forall x. expression x -> Maybe ByteString)
1140+ -> NP expression xs -> ByteString
1141+renderCommaSeparatedMaybe render
1142+ = commaSeparated
1143+ . catMaybes
1144+ . hcollapse
1145+ . hmap (K . render)
1146+
1147+renderSymbol :: KnownSymbol str => Proxy# str -> ByteString
1148+renderSymbol p = fromString $ symbolVal' p
squeel-postgresql/test/Squeel/PostgreSQL/StatementSpec.hs+79−61
@@ -26,52 +26,54 @@ spec = do
2626 it "correctly renders a simple SELECT query" $ do
2727 let
2828 statement :: Query Tables '[] SumAndCol1
29− statement = select
30− ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
29+ statement =
30+ select ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
3131 (from (Table (#table1 `As` #table1)) & where_ (#col1 >* #col2))
3232 statement `queryRenders`
33− "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (col1 > col2);"
33+ "SELECT (col1 + col2) AS sum, col1 AS col1\
34+ \ FROM table1 AS table1 WHERE (col1 > col2);"
3435 it "combines WHEREs using AND" $ do
3536 let
3637 statement :: Query Tables '[] SumAndCol1
37− statement = select
38− ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
38+ statement =
39+ select ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
3940 (from (Table (#table1 `As` #table1)) & where_ true & where_ false)
4041 statement `queryRenders`
41− "SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 WHERE (TRUE AND FALSE);"
42+ "SELECT (col1 + col2) AS sum, col1 AS col1\
43+ \ FROM table1 AS table1 WHERE (TRUE AND FALSE);"
4244 it "performs sub SELECTs" $ do
4345 let
44− selection = select
45− ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
46− (from (Table (#table1 `As` #table1)))
4746 statement :: Query Tables '[] SumAndCol1
48− statement = selectStar (from (Subquery (selection `As` #sub)))
47+ statement =
48+ selectStar (from (Subquery
49+ (select ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
50+ (from (Table (#table1 `As` #table1))) `As` #sub)))
4951 statement `queryRenders`
50− "SELECT * FROM SELECT (col1 + col2) AS sum, col1 AS col1 FROM table1 AS table1 AS sub;"
52+ "SELECT * FROM\
53+ \ SELECT (col1 + col2) AS sum, col1 AS col1\
54+ \ FROM table1 AS table1 AS sub;"
5155 it "does LIMIT clauses" $ do
5256 let
5357 statement :: Query Tables '[] Columns
54− statement = selectStar
55− (from (Table (#table1 `As` #table1)) & limit 1)
58+ statement = selectStar (from (Table (#table1 `As` #table1)) & limit 1)
5659 statement `queryRenders` "SELECT * FROM table1 AS table1 LIMIT 1;"
5760 it "should use the minimum of given LIMITs" $ do
5861 let
5962 statement :: Query Tables '[] Columns
60− statement = selectStar
61− (from (Table (#table1 `As` #table1)) & limit 1 & limit 2)
62− statement `queryRenders`
63− "SELECT * FROM table1 AS table1 LIMIT 1;"
63+ statement =
64+ selectStar (from (Table (#table1 `As` #table1)) & limit 1 & limit 2)
65+ statement `queryRenders` "SELECT * FROM table1 AS table1 LIMIT 1;"
6466 it "should render parameters using $ signs" $ do
6567 let
6668 statement :: Query Tables '[ 'Required ('NotNull 'PGBool)] Columns
67− statement = selectStar
68− (from (Table (#table1 `As` #table1)) & where_ param1)
69+ statement =
70+ selectStar (from (Table (#table1 `As` #table1)) & where_ param1)
6971 statement `queryRenders` "SELECT * FROM table1 AS table1 WHERE $1;"
7072 it "does OFFSET clauses" $ do
7173 let
7274 statement :: Query Tables '[] Columns
73− statement = selectStar
74− (from (Table (#table1 `As` #table1)) & offset 1)
75+ statement =
76+ selectStar (from (Table (#table1 `As` #table1)) & offset 1)
7577 statement `queryRenders` "SELECT * FROM table1 AS table1 OFFSET 1;"
7678 it "should use the sum of given OFFSETs" $ do
7779 let
@@ -82,67 +84,81 @@ spec = do
8284 it "should render GROUP BY and HAVING clauses" $ do
8385 let
8486 statement :: Query Tables '[] SumAndCol1
85− statement = select
86− (sum_ #col2 `As` #sum :* #col1 `As` #col1 :* Nil)
87+ statement =
88+ select (sum_ #col2 `As` #sum :* #col1 `As` #col1 :* Nil)
8789 ( from (Table (#table1 `As` #table1))
8890 & group (By (#table1,#col1) :* Nil)
8991 & having ((#col1 + sum_ #col2) >* 1) )
9092 statement `queryRenders`
91− "SELECT\
92− \ sum(col2) AS sum, col1 AS col1\
93+ "SELECT sum(col2) AS sum, col1 AS col1\
9394 \ FROM table1 AS table1\
9495 \ GROUP BY table1.col1\
9596 \ HAVING ((col1 + sum(col2)) > 1);"
9697 it "correctly renders simple INSERTs" $ do
9798 let
9899 statement :: Manipulation Tables '[] '[]
99− statement = insertInto #table1 $ 2 `As` #col1 :* 4 `As` #col2 :* Nil
100+ statement =
101+ into #table1 (insertRow $ 2 `As` #col1 :* 4 `As` #col2 :* Nil)
102+ Conflict ReturningNil
100103 statement `manipulationRenders`
101104 "INSERT INTO table1 (col1, col2) VALUES (2, 4);"
102105 it "correctly renders returning INSERTs" $ do
103106 let
104107 statement :: Manipulation Tables '[] SumAndCol1
105− statement = insertIntoReturning #table1
106− (2 `As` #col1 :* 4 `As` #col2 :* Nil)
107− ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
108+ statement =
109+ into #table1 (insertRow $ 2 `As` #col1 :* 4 `As` #col2 :* Nil)
110+ Conflict
111+ (Returning $ (#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
108112 statement `manipulationRenders`
109− "INSERT INTO table1 (col1, col2) VALUES (2, 4) RETURNING (col1 + col2) AS sum, col1 AS col1;"
113+ "INSERT INTO table1 (col1, col2) VALUES (2, 4)\
114+ \ RETURNING (col1 + col2) AS sum, col1 AS col1;"
110115 it "correctly renders simple UPDATEs" $ do
111116 let
112117 statement :: Manipulation Tables '[] '[]
113− statement = update #table1
114− (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
115− (#col1 /=* #col2)
118+ statement =
119+ update #table1 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
120+ (#col1 /=* #col2) ReturningNil
116121 statement `manipulationRenders`
117− "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
122+ "UPDATE table1 SET col1 = 2\
123+ \ WHERE (col1 <> col2);"
118124 it "correctly renders returning UPDATEs" $ do
119125 let
120126 statement :: Manipulation Tables '[] SumAndCol1
121− statement = updateReturning #table1
122− (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
123− (#col1 /=* #col2)
124− ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
127+ statement =
128+ update #table1 (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
129+ (#col1 /=* #col2)
130+ (Returning $ (#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
125131 statement `manipulationRenders`
126− "UPDATE table1 SET col1 = 2 WHERE (col1 <> col2) RETURNING (col1 + col2) AS sum, col1 AS col1;"
132+ "UPDATE table1 SET col1 = 2\
133+ \ WHERE (col1 <> col2)\
134+ \ RETURNING (col1 + col2) AS sum, col1 AS col1;"
127135 it "correctly renders upsert INSERTs" $ do
128136 let
129137 statement :: Manipulation Tables '[] '[]
130− statement = upsertInto #table1
131− (2 `As` #col1 :* 4 `As` #col2 :* Nil)
132− (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
133− (#col1 /=* #col2)
138+ statement =
139+ into #table1 (insertRow $ 2 `As` #col1 :* 4 `As` #col2 :* Nil)
140+ (OnConflictDoUpdate
141+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil) (#col1 /=* #col2))
142+ ReturningNil
134143 statement `manipulationRenders`
135− "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2);"
144+ "INSERT INTO table1 (col1, col2) VALUES (2, 4)\
145+ \ ON CONFLICT DO UPDATE\
146+ \ SET col1 = 2 WHERE (col1 <> col2);"
136147 it "correctly renders returning upsert INSERTs" $ do
137148 let
138149 statement :: Manipulation Tables '[] SumAndCol1
139− statement = upsertIntoReturning #table1
140− (2 `As` #col1 :* 4 `As` #col2 :* Nil)
141− (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
142− (#col1 /=* #col2)
143− ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
150+ statement =
151+ into #table1 (insertRow $ 2 `As` #col1 :* 4 `As` #col2 :* Nil)
152+ (OnConflictDoUpdate
153+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
154+ (#col1 /=* #col2))
155+ (Returning $ (#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
144156 statement `manipulationRenders`
145− "INSERT INTO table1 (col1, col2) VALUES (2, 4) ON CONFLICT UPDATE table1 SET col1 = 2 WHERE (col1 <> col2) RETURNING (col1 + col2) AS sum, col1 AS col1;"
157+ "INSERT INTO table1 (col1, col2) VALUES (2, 4)\
158+ \ ON CONFLICT DO UPDATE\
159+ \ SET col1 = 2\
160+ \ WHERE (col1 <> col2)\
161+ \ RETURNING (col1 + col2) AS sum, col1 AS col1;"
146162 it "correctly renders DELETEs" $ do
147163 let
148164 statement :: Manipulation Tables '[] '[]
@@ -152,8 +168,9 @@ spec = do
152168 it "should be safe against SQL injection in literal text" $ do
153169 let
154170 statement :: Manipulation StudentsTable '[] '[]
155− statement = insertInto #students $
156− "Robert'); DROP TABLE students;" `As` #name :* Nil
171+ statement = into #students
172+ (insertRow $ "Robert'); DROP TABLE students;" `As` #name :* Nil)
173+ Conflict ReturningNil
157174 statement `manipulationRenders`
158175 "INSERT INTO students (name) VALUES (E'Robert''); DROP TABLE students;');"
159176 describe "JOINs" $ do
@@ -209,18 +226,19 @@ spec = do
209226 \ CROSS JOIN orders AS orders2;"
210227 it "should render CREATE TABLE statements" $ do
211228 createTable #table1
212− ( (int4 & notNull) `As` #col1
213− :* (int4 & notNull) `As` #col2
214− :* Nil)
229+ ((int4 & notNull) `As` #col1 :* (int4 & notNull) `As` #col2 :* Nil)
215230 `definitionRenders`
216− "CREATE TABLE table1 (col1 int4 NOT NULL, col2 int4 NOT NULL);"
231+ "CREATE TABLE table1\
232+ \ (col1 int4 NOT NULL, col2 int4 NOT NULL);"
217233 createTable #table2
218− ( serial `As` #col1
219− :* text `As` #col2
220− :* (int8 & notNull & default_ 8) `As` #col3
221− :* Nil)
234+ ( serial `As` #col1 :*
235+ text `As` #col2 :*
236+ (int8 & notNull & default_ 8) `As` #col3 :* Nil )
222237 `definitionRenders`
223− "CREATE TABLE table2 (col1 serial, col2 text, col3 int8 NOT NULL DEFAULT 8);"
238+ "CREATE TABLE table2\
239+ \ (col1 serial,\
240+ \ col2 text,\
241+ \ col3 int8 NOT NULL DEFAULT 8);"
224242 it "should render DROP TABLE statements" $ do
225243 let
226244 statement :: Definition Tables '[]