@@ -23,13 +23,14 @@
2323 , UndecidableInstances
2424#-}
2525
26−module Squeal.PostgreSQL.Statement
26+module Squeal.PostgreSQL.Expression
2727 ( -- * Column Expressions
2828 Expression (UnsafeExpression, renderExpression)
2929 , HasParameter (param)
3030 , HasColumn (getColumn)
3131 , Column (Column)
3232 , renderColumn
33+ , GroupedBy (getGroup1, getGroup2)
3334 -- ** Default
3435 , def
3536 , unDef
@@ -99,28 +100,6 @@ module Squeal.PostgreSQL.Statement
99100 -- * Tables
100101 , Table (UnsafeTable, renderTable)
101102 , HasTable (getTable)
102− -- ** Froms and Joins
103− , FromClause (..)
104− , renderFromClause
105− -- ** Table Expressions
106− , TableExpression (..)
107− , renderTableExpression
108− , from
109− , where_
110− , group
111− , having
112− , orderBy
113− , limit
114− , offset
115− , By (By, By2)
116− , renderBy
117− , GroupByClause (NoGroups, Group)
118− , renderGroupByClause
119− , HavingClause (NoHaving, Having)
120− , renderHavingClause
121− , GroupedBy (getGroup1, getGroup2)
122− , SortExpression (..)
123− , renderSortExpression
124103 -- * TypeExpression
125104 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)
126105 , PGTyped (pgtype)
@@ -160,62 +139,6 @@ module Squeal.PostgreSQL.Statement
160139 , jsonb
161140 , notNull
162141 , default_
163− -- * Statements
164− -- ** Queries
165− , Query (UnsafeQuery, renderQuery)
166− , select
167− , selectDistinct
168− , selectStar
169− , selectDistinctStar
170− , selectDotStar
171− , selectDistinctDotStar
172− , union
173− , unionAll
174− , intersect
175− , intersectAll
176− , except
177− , exceptAll
178− -- ** Data Definition Language
179− , Definition (UnsafeDefinition, renderDefinition)
180− , createTable
181− , TableConstraint (UnsafeTableConstraint, renderTableConstraint)
182− , check
183− , unique
184− , primaryKey
185− , foreignKey
186− , OnDelete (OnDeleteNoAction, OnDeleteRestrict, OnDeleteCascade)
187− , renderOnDelete
188− , OnUpdate (OnUpdateNoAction, OnUpdateRestrict, OnUpdateCascade)
189− , renderOnUpdate
190− , dropTable
191− , alterTable
192− , alterTableRename
193− , AlterTable (UnsafeAlterTable, renderAlterTable)
194− , addColumnDefault
195− , addColumnNull
196− , dropColumn
197− , renameColumn
198− , alterColumn
199− , AlterColumn (UnsafeAlterColumn, renderAlterColumn)
200− , setDefault
201− , dropDefault
202− , setNotNull
203− , dropNotNull
204− , alterType
205− -- ** Data Manipulation Language
206− , Manipulation (UnsafeManipulation, renderManipulation)
207− , queryStatement
208− , insertInto
209− , ValuesClause (Values, ValuesQuery)
210− , renderValuesClause
211− , ReturningClause (ReturningStar, Returning)
212− , renderReturningClause
213− , ConflictClause (Conflict, OnConflictDoNothing, OnConflictDoUpdate)
214− , renderConflictClause
215− , UpdateExpression (Same, Set)
216− , renderUpdateExpression
217− , update
218− , deleteFrom
219142 -- * Re-export
220143 , (&)
221144 , NP ((:*), Nil)
@@ -225,22 +148,18 @@ import Control.Category
225148import Control.DeepSeq
226149import Data.ByteString (ByteString)
227150import Data.Data (Data)
228−import Data.Foldable
229151import Data.Function ((&))
230−import Data.Maybe
231152import Data.Monoid hiding (All)
232153import Data.Ratio
233154import Data.String
234−import Data.Word
235155import Generics.SOP hiding (from)
236−import GHC.Exts
237156import GHC.OverloadedLabels
238157import GHC.TypeLits
239158import Prelude hiding (id, (.))
240159
241160import qualified GHC.Generics as GHC
242−import qualified Data.ByteString as ByteString
243161
162+import Squeal.PostgreSQL.Prettyprint
244163import Squeal.PostgreSQL.Schema
245164
246165{-----------------------------------------
@@ -322,6 +241,46 @@ deriving instance Show (Column columns columnty)
322241deriving instance Eq (Column columns columnty)
323242deriving instance Ord (Column columns columnty)
324243
244+renderColumn :: Column columns columnty -> ByteString
245+renderColumn (Column column) = renderAlias column
246+
247+class (KnownSymbol table, KnownSymbol column)
248+ => GroupedBy table column bys where
249+ getGroup1
250+ :: (HasUnique table tables columns, HasColumn column columns ty)
251+ => Alias column
252+ -> Expression params tables ('Grouped bys) ty
253+ getGroup1 column = UnsafeExpression $ renderAlias column
254+ getGroup2
255+ :: (HasTable table tables columns, HasColumn column columns ty)
256+ => Alias table
257+ -> Alias column
258+ -> Expression params tables ('Grouped bys) ty
259+ getGroup2 table column = UnsafeExpression $
260+ renderAlias table <> "." <> renderAlias column
261+instance {-# OVERLAPPING #-} (KnownSymbol table, KnownSymbol column)
262+ => GroupedBy table column ('(table,column) ': bys)
263+instance {-# OVERLAPPABLE #-}
264+ ( KnownSymbol table
265+ , KnownSymbol column
266+ , GroupedBy table column bys
267+ ) => GroupedBy table column (tabcol ': bys)
268+
269+instance
270+ ( HasUnique table tables columns
271+ , HasColumn column columns ty
272+ , GroupedBy table column bys
273+ ) => IsLabel column
274+ (Expression params tables ('Grouped bys) ty) where
275+ fromLabel = getGroup1 (Alias @column)
276+
277+instance
278+ ( HasTable table tables columns
279+ , HasColumn column columns ty
280+ , GroupedBy table column bys
281+ ) => IsTableColumn table column
282+ (Expression params tables ('Grouped bys) ty) where (!) = getGroup2
283+
325284-- | >>> renderExpression def
326285-- "DEFAULT"
327286def :: Expression params '[] 'Ungrouped ('Optional (nullity ty))
@@ -667,138 +626,10 @@ localTimestamp
667626 :: Expression params tables grouping ('Required (nullity 'PGtimestamp))
668627localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
669628
670−data SortExpression params tables grouping where
671− Asc
672− :: Expression params tables grouping ('Required ('NotNull ty))
673− -> SortExpression params tables grouping
674− Desc
675− :: Expression params tables grouping ('Required ('NotNull ty))
676− -> SortExpression params tables grouping
677− AscNullsFirst
678− :: Expression params tables grouping ('Required ('Null ty))
679− -> SortExpression params tables grouping
680− AscNullsLast
681− :: Expression params tables grouping ('Required ('Null ty))
682− -> SortExpression params tables grouping
683− DescNullsFirst
684− :: Expression params tables grouping ('Required ('Null ty))
685− -> SortExpression params tables grouping
686− DescNullsLast
687− :: Expression params tables grouping ('Required ('Null ty))
688− -> SortExpression params tables grouping
689−deriving instance Show (SortExpression params tables grouping)
690−
691−renderSortExpression :: SortExpression params tables grouping -> ByteString
692−renderSortExpression = \case
693− Asc expression -> renderExpression expression <+> "ASC"
694− Desc expression -> renderExpression expression <+> "DESC"
695− AscNullsFirst expression -> renderExpression expression
696− <+> "ASC NULLS FIRST"
697− DescNullsFirst expression -> renderExpression expression
698− <+> "DESC NULLS FIRST"
699− AscNullsLast expression -> renderExpression expression <+> "ASC NULLS LAST"
700− DescNullsLast expression -> renderExpression expression <+> "DESC NULLS LAST"
701−
702−
703629{-----------------------------------------
704630aggregation
705631-----------------------------------------}
706632
707−data By
708− (tables :: TablesType)
709− (by :: (Symbol,Symbol)) where
710− By
711− :: (HasUnique table tables columns, HasColumn column columns ty)
712− => Alias column
713− -> By tables '(table, column)
714− By2
715− :: (HasTable table tables columns, HasColumn column columns ty)
716− => (Alias table, Alias column)
717− -> By tables '(table, column)
718−deriving instance Show (By tables by)
719−deriving instance Eq (By tables by)
720−deriving instance Ord (By tables by)
721−
722−renderBy :: By tables tabcolty -> ByteString
723−renderBy = \case
724− By column -> renderAlias column
725− By2 (table, column) -> renderAlias table <> "." <> renderAlias column
726−
727−data GroupByClause tables grouping where
728− NoGroups :: GroupByClause tables 'Ungrouped
729− Group
730− :: SListI bys
731− => NP (By tables) bys
732− -> GroupByClause tables ('Grouped bys)
733−
734−renderGroupByClause :: GroupByClause tables grouping -> ByteString
735−renderGroupByClause = \case
736− NoGroups -> ""
737− Group Nil -> ""
738− Group bys -> " GROUP BY" <+> renderCommaSeparated renderBy bys
739−
740−data HavingClause params tables grouping where
741− NoHaving :: HavingClause params tables 'Ungrouped
742− Having
743− :: [Condition params tables ('Grouped bys)]
744− -> HavingClause params tables ('Grouped bys)
745−deriving instance Show (HavingClause params tables grouping)
746−deriving instance Eq (HavingClause params tables grouping)
747−deriving instance Ord (HavingClause params tables grouping)
748−
749−renderHavingClause :: HavingClause params tables grouping -> ByteString
750−renderHavingClause = \case
751− NoHaving -> ""
752− Having [] -> ""
753− Having conditions ->
754− " HAVING" <+> commaSeparated (renderExpression <$> conditions)
755−
756−class (KnownSymbol table, KnownSymbol column)
757− => GroupedBy table column bys where
758− getGroup1
759− :: (HasUnique table tables columns, HasColumn column columns ty)
760− => Alias column
761− -> Expression params tables ('Grouped bys) ty
762− getGroup1 column = UnsafeExpression $ renderAlias column
763− getGroup2
764− :: (HasTable table tables columns, HasColumn column columns ty)
765− => Alias table
766− -> Alias column
767− -> Expression params tables ('Grouped bys) ty
768− getGroup2 table column = UnsafeExpression $
769− renderAlias table <> "." <> renderAlias column
770−instance {-# OVERLAPPING #-} (KnownSymbol table, KnownSymbol column)
771− => GroupedBy table column ('(table,column) ': bys)
772−instance {-# OVERLAPPABLE #-}
773− ( KnownSymbol table
774− , KnownSymbol column
775− , GroupedBy table column bys
776− ) => GroupedBy table column (tabcol ': bys)
777−
778−instance
779− ( HasUnique table tables columns
780− , HasColumn column columns ty
781− , GroupedBy table column bys
782− ) => IsLabel column
783− (Expression params tables ('Grouped bys) ty) where
784− fromLabel = getGroup1 (Alias @column)
785−
786−instance
787− ( HasTable table tables columns
788− , HasColumn column columns ty
789− , GroupedBy table column bys
790− ) => IsTableColumn table column
791− (Expression params tables ('Grouped bys) ty) where (!) = getGroup2
792−
793−-- data AllOrDistinct = All | Distinct
794−-- deriving (GHC.Generic,Show,Eq,Ord,Data)
795−-- instance NFData AllOrDistinct
796−
797−-- renderAllOrDistinct :: AllOrDistinct -> ByteString
798−-- renderAllOrDistinct = \case
799−-- All -> "ALL"
800−-- Distinct -> "DISTINCT"
801−
802633unsafeAggregate, unsafeAggregateDistinct
803634 :: ByteString
804635 -> Expression params tables 'Ungrouped ('Required xty)
@@ -913,149 +744,6 @@ instance HasTable table schema columns
913744 => IsLabel table (Table schema columns) where
914745 fromLabel = getTable (Alias @table)
915746
916−data FromClause params schema tables where
917− Table
918− :: Aliased (Table schema) table
919− -> FromClause params schema '[table]
920− Subquery
921− :: Aliased (Query schema params) table
922− -> FromClause params schema '[table]
923− CrossJoin
924− :: FromClause params schema right
925− -> FromClause params schema left
926− -> FromClause params schema (Join left right)
927− InnerJoin
928− :: FromClause params schema right
929− -> Condition params (Join left right) 'Ungrouped
930− -> FromClause params schema left
931− -> FromClause params schema (Join left right)
932− LeftOuterJoin
933− :: FromClause params schema right
934− -> Condition params (Join left right) 'Ungrouped
935− -> FromClause params schema left
936− -> FromClause params schema (Join left (NullifyTables right))
937− RightOuterJoin
938− :: FromClause params schema right
939− -> Condition params (Join left right) 'Ungrouped
940− -> FromClause params schema left
941− -> FromClause params schema (Join (NullifyTables left) right)
942− FullOuterJoin
943− :: FromClause params schema right
944− -> Condition params (Join left right) 'Ungrouped
945− -> FromClause params schema left
946− -> FromClause params schema
947− (Join (NullifyTables left) (NullifyTables right))
948−
949−renderFromClause :: FromClause params schema tables -> ByteString
950−renderFromClause = \case
951− Table table -> renderAliased renderTable table
952− Subquery selection -> renderAliased (parenthesized . renderQuery) selection
953− CrossJoin right left ->
954− renderFromClause left <+> "CROSS JOIN" <+> renderFromClause right
955− InnerJoin right on left -> renderJoin "INNER JOIN" right on left
956− LeftOuterJoin right on left -> renderJoin "LEFT OUTER JOIN" right on left
957− RightOuterJoin right on left -> renderJoin "RIGHT OUTER JOIN" right on left
958− FullOuterJoin right on left -> renderJoin "FULL OUTER JOIN" right on left
959− where
960− renderJoin op right on left =
961− renderFromClause left <+> op <+> renderFromClause right
962− <+> "ON" <+> renderExpression on
963−
964−data TableExpression
965− (params :: [ColumnType])
966− (schema :: TablesType)
967− (tables :: TablesType)
968− (grouping :: Grouping)
969− = TableExpression
970− { fromClause :: FromClause params schema tables
971− , whereClause :: [Condition params tables 'Ungrouped]
972− , groupByClause :: GroupByClause tables grouping
973− , havingClause :: HavingClause params tables grouping
974− , orderByClause :: [SortExpression params tables grouping]
975− , limitClause :: [Word64]
976− , offsetClause :: [Word64]
977− }
978−
979−renderTableExpression
980− :: TableExpression params schema tables grouping
981− -> ByteString
982−renderTableExpression
983− (TableExpression tables whs' grps' hvs' srts' lims' offs') = mconcat
984− [ "FROM ", renderFromClause tables
985− , renderWheres whs'
986− , renderGroupByClause grps'
987− , renderHavingClause hvs'
988− , renderSorts srts'
989− , renderLimits lims'
990− , renderOffsets offs'
991− ]
992− where
993− renderWheres = \case
994− [] -> ""
995− wh:[] -> " WHERE" <+> renderExpression wh
996− wh:whs -> " WHERE" <+> renderExpression (foldr (&&*) wh whs)
997− renderSorts = \case
998− [] -> ""
999− srts -> " SORT BY"
1000− <+> commaSeparated (renderSortExpression <$> srts)
1001− renderLimits = \case
1002− [] -> ""
1003− lims -> " LIMIT" <+> fromString (show (minimum lims))
1004− renderOffsets = \case
1005− [] -> ""
1006− offs -> " OFFSET" <+> fromString (show (sum offs))
1007−
1008−from
1009− :: FromClause params schema tables
1010− -> TableExpression params schema tables 'Ungrouped
1011−from tables = TableExpression tables [] NoGroups NoHaving [] [] []
1012−
1013−where_
1014− :: Condition params tables 'Ungrouped
1015− -> TableExpression params schema tables grouping
1016− -> TableExpression params schema tables grouping
1017−where_ wh tables = tables {whereClause = wh : whereClause tables}
1018−
1019−group
1020− :: SListI bys
1021− => NP (By tables) bys
1022− -> TableExpression params schema tables 'Ungrouped
1023− -> TableExpression params schema tables ('Grouped bys)
1024−group bys tables = TableExpression
1025− { fromClause = fromClause tables
1026− , whereClause = whereClause tables
1027− , groupByClause = Group bys
1028− , havingClause = Having []
1029− , orderByClause = []
1030− , limitClause = limitClause tables
1031− , offsetClause = offsetClause tables
1032− }
1033−
1034−having
1035− :: Condition params tables ('Grouped bys)
1036− -> TableExpression params schema tables ('Grouped bys)
1037− -> TableExpression params schema tables ('Grouped bys)
1038−having hv tables = tables
1039− { havingClause = case havingClause tables of Having hvs -> Having (hv:hvs) }
1040−
1041−orderBy
1042− :: [SortExpression params tables grouping]
1043− -> TableExpression params schema tables grouping
1044− -> TableExpression params schema tables grouping
1045−orderBy srts tables = tables {orderByClause = orderByClause tables ++ srts}
1046−
1047−limit
1048− :: Word64
1049− -> TableExpression params schema tables grouping
1050− -> TableExpression params schema tables grouping
1051−limit lim tables = tables {limitClause = lim : limitClause tables}
1052−
1053−offset
1054− :: Word64
1055− -> TableExpression params schema tables grouping
1056− -> TableExpression params schema tables grouping
1057−offset off tables = tables {offsetClause = off : offsetClause tables}
1058−
1059747{-----------------------------------------
1060748type expressions
1061749-----------------------------------------}
@@ -1181,494 +869,3 @@ instance PGTyped 'PGinterval where pgtype = interval
1181869instance PGTyped 'PGuuid where pgtype = uuid
1182870instance PGTyped 'PGjson where pgtype = json
1183871instance PGTyped 'PGjsonb where pgtype = jsonb
1184−
1185−{-----------------------------------------
1186−statements
1187−-----------------------------------------}
1188−
1189−newtype Definition
1190− (schema0 :: TablesType)
1191− (schema1 :: TablesType)
1192− = UnsafeDefinition { renderDefinition :: ByteString }
1193− deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1194−
1195−instance Category Definition where
1196− id = UnsafeDefinition ";"
1197− ddl1 . ddl0 = UnsafeDefinition $
1198− renderDefinition ddl0 <+> renderDefinition ddl1
1199−
1200−newtype Manipulation
1201− (schema :: TablesType)
1202− (params :: [ColumnType])
1203− (columns :: ColumnsType)
1204− = UnsafeManipulation { renderManipulation :: ByteString }
1205− deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1206−
1207−newtype Query
1208− (schema :: TablesType)
1209− (params :: [ColumnType])
1210− (columns :: ColumnsType)
1211− = UnsafeQuery { renderQuery :: ByteString }
1212− deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1213−
1214−queryStatement
1215− :: Query schema params columns
1216− -> Manipulation schema params columns
1217−queryStatement q = UnsafeManipulation $ renderQuery q <> ";"
1218−
1219−union, unionAll, intersect, intersectAll, except, exceptAll
1220− :: Query schema params columns
1221− -> Query schema params columns
1222− -> Query schema params columns
1223−q1 `union` q2 = UnsafeQuery $
1224− parenthesized (renderQuery q1)
1225− <+> "UNION"
1226− <+> parenthesized (renderQuery q2)
1227−q1 `unionAll` q2 = UnsafeQuery $
1228− parenthesized (renderQuery q1)
1229− <+> "UNION" <+> "ALL"
1230− <+> parenthesized (renderQuery q2)
1231−q1 `intersect` q2 = UnsafeQuery $
1232− parenthesized (renderQuery q1)
1233− <+> "INTERSECT"
1234− <+> parenthesized (renderQuery q2)
1235−q1 `intersectAll` q2 = UnsafeQuery $
1236− parenthesized (renderQuery q1)
1237− <+> "INTERSECT" <+> "ALL"
1238− <+> parenthesized (renderQuery q2)
1239−q1 `except` q2 = UnsafeQuery $
1240− parenthesized (renderQuery q1)
1241− <+> "EXCEPT"
1242− <+> parenthesized (renderQuery q2)
1243−q1 `exceptAll` q2 = UnsafeQuery $
1244− parenthesized (renderQuery q1)
1245− <+> "EXCEPT" <+> "ALL"
1246− <+> parenthesized (renderQuery q2)
1247−
1248−{-----------------------------------------
1249−SELECT statements
1250−-----------------------------------------}
1251−
1252−select
1253− :: SListI columns
1254− => NP (Aliased (Expression params tables grouping)) (column ': columns)
1255− -> TableExpression params schema tables grouping
1256− -> Query schema params (column ': columns)
1257−select list tabs = UnsafeQuery $
1258− "SELECT"
1259− <+> renderCommaSeparated (renderAliased renderExpression) list
1260− <+> renderTableExpression tabs
1261−
1262−selectDistinct
1263− :: SListI columns
1264− => NP (Aliased (Expression params tables grouping)) (column ': columns)
1265− -> TableExpression params schema tables grouping
1266− -> Query schema params (column ': columns)
1267−selectDistinct list tabs = UnsafeQuery $
1268− "SELECT DISTINCT"
1269− <+> renderCommaSeparated (renderAliased renderExpression) list
1270− <+> renderTableExpression tabs
1271−
1272−selectStar
1273− :: HasUnique table tables columns
1274− => TableExpression params schema tables 'Ungrouped
1275− -> Query schema params columns
1276−selectStar tabs = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression tabs
1277−
1278−selectDistinctStar
1279− :: HasUnique table tables columns
1280− => TableExpression params schema tables 'Ungrouped
1281− -> Query schema params columns
1282−selectDistinctStar tabs = UnsafeQuery $
1283− "SELECT DISTINCT" <+> "*" <+> renderTableExpression tabs
1284−
1285−selectDotStar
1286− :: HasTable table tables columns
1287− => Alias table
1288− -> TableExpression params schema tables 'Ungrouped
1289− -> Query schema params columns
1290−selectDotStar table tables = UnsafeQuery $
1291− "SELECT" <+> renderAlias table <> ".*" <+> renderTableExpression tables
1292−
1293−selectDistinctDotStar
1294− :: HasTable table tables columns
1295− => Alias table
1296− -> TableExpression params schema tables 'Ungrouped
1297− -> Query schema params columns
1298−selectDistinctDotStar table tables = UnsafeQuery $
1299− "SELECT DISTINCT" <+> renderAlias table <> ".*"
1300− <+> renderTableExpression tables
1301−
1302−{-----------------------------------------
1303−CREATE statements
1304−-----------------------------------------}
1305−
1306−createTable
1307− :: (KnownSymbol table, SListI columns)
1308− => Alias table
1309− -> NP (Aliased TypeExpression) (column ': columns)
1310− -> [TableConstraint schema (column ': columns)]
1311− -> Definition schema (Create table (column ': columns) schema)
1312−createTable table columns constraints = UnsafeDefinition $
1313− "CREATE TABLE" <+> renderAlias table
1314− <+> parenthesized
1315− ( renderCommaSeparated renderColumnDef columns
1316− <> renderConstraints constraints )
1317− <> ";"
1318− where
1319− renderColumnDef :: Aliased TypeExpression x -> ByteString
1320− renderColumnDef (ty `As` column) =
1321− renderAlias column <+> renderTypeExpression ty
1322− renderConstraints :: [TableConstraint schema columns] -> ByteString
1323− renderConstraints = \case
1324− [] -> ""
1325− _ -> ", " <> commaSeparated (renderTableConstraint <$> constraints)
1326−
1327−newtype TableConstraint
1328− (schema :: TablesType)
1329− (columns :: ColumnsType)
1330− = UnsafeTableConstraint { renderTableConstraint :: ByteString }
1331− deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1332−
1333−check
1334− :: Condition '[] '[table ::: columns] 'Ungrouped
1335− -> TableConstraint schema columns
1336−check condition = UnsafeTableConstraint $
1337− "CHECK" <+> parenthesized (renderExpression condition)
1338−
1339−renderColumn :: Column columns columnty -> ByteString
1340−renderColumn (Column column) = renderAlias column
1341−
1342−unique
1343− :: SListI subcolumns
1344− => NP (Column columns) subcolumns
1345− -> TableConstraint schema columns
1346−unique columns = UnsafeTableConstraint $
1347− "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)
1348−
1349−primaryKey
1350− :: (SListI subcolumns, AllNotNull subcolumns)
1351− => NP (Column columns) subcolumns
1352− -> TableConstraint schema columns
1353−primaryKey columns = UnsafeTableConstraint $
1354− "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
1355−
1356−foreignKey
1357− :: ( HasTable reftable schema refcolumns
1358− , SameTypes subcolumns refsubcolumns
1359− , NotAllNull subcolumns
1360− , SListI subcolumns
1361− , SListI refsubcolumns)
1362− => NP (Column columns) subcolumns
1363− -> Alias reftable
1364− -> NP (Column refcolumns) refsubcolumns
1365− -> OnDelete
1366− -> OnUpdate
1367− -> TableConstraint schema columns
1368−foreignKey columns reftable refcolumns onDelete onUpdate =
1369− UnsafeTableConstraint $
1370− "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
1371− <+> "REFERENCES" <+> renderAlias reftable
1372− <+> parenthesized (renderCommaSeparated renderColumn refcolumns)
1373− <+> renderOnDelete onDelete
1374− <+> renderOnUpdate onUpdate
1375−
1376−data OnDelete
1377− = OnDeleteNoAction
1378− | OnDeleteRestrict
1379− | OnDeleteCascade
1380− deriving (GHC.Generic,Show,Eq,Ord,Data)
1381−instance NFData OnDelete
1382−
1383−renderOnDelete :: OnDelete -> ByteString
1384−renderOnDelete = \case
1385− OnDeleteNoAction -> "ON DELETE NO ACTION"
1386− OnDeleteRestrict -> "ON DELETE RESTRICT"
1387− OnDeleteCascade -> "ON DELETE CASCADE"
1388−
1389−data OnUpdate
1390− = OnUpdateNoAction
1391− | OnUpdateRestrict
1392− | OnUpdateCascade
1393− deriving (GHC.Generic,Show,Eq,Ord,Data)
1394−instance NFData OnUpdate
1395−
1396−renderOnUpdate :: OnUpdate -> ByteString
1397−renderOnUpdate = \case
1398− OnUpdateNoAction -> "ON UPDATE NO ACTION"
1399− OnUpdateRestrict -> "ON UPDATE RESTRICT"
1400− OnUpdateCascade -> "ON UPDATE CASCADE"
1401−
1402−{-----------------------------------------
1403−DROP statements
1404−-----------------------------------------}
1405−
1406−dropTable
1407− :: KnownSymbol table
1408− => Alias table
1409− -> Definition schema (Drop table schema)
1410−dropTable table = UnsafeDefinition $ "DROP TABLE" <+> renderAlias table <> ";"
1411−
1412−{-----------------------------------------
1413−ALTER statements
1414−-----------------------------------------}
1415−
1416−alterTable
1417− :: HasTable table schema columns0
1418− => Alias table
1419− -> AlterTable columns0 columns1
1420− -> Definition schema (Alter table schema columns1)
1421−alterTable table alteration = UnsafeDefinition $
1422− "ALTER TABLE"
1423− <+> renderAlias table
1424− <+> renderAlterTable alteration
1425− <> ";"
1426−
1427−alterTableRename
1428− :: (KnownSymbol table0, KnownSymbol table1)
1429− => Alias table0
1430− -> Alias table1
1431− -> Definition schema (Rename table0 table1 schema)
1432−alterTableRename table0 table1 = UnsafeDefinition $
1433− "ALTER TABLE" <+> renderAlias table0
1434− <+> "RENAME TO" <+> renderAlias table1 <> ";"
1435−
1436−newtype AlterTable
1437− (columns0 :: ColumnsType)
1438− (columns1 :: ColumnsType) =
1439− UnsafeAlterTable {renderAlterTable :: ByteString}
1440− deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1441−
1442−addColumnDefault
1443− :: KnownSymbol column
1444− => Alias column
1445− -> TypeExpression ('Optional ty)
1446− -> AlterTable columns (Create column ('Optional ty) columns)
1447−addColumnDefault column ty = UnsafeAlterTable $
1448− "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty
1449−
1450−addColumnNull
1451− :: KnownSymbol column
1452− => Alias column
1453− -> TypeExpression ('Required ('Null ty))
1454− -> AlterTable columns (Create column ('Required ('Null ty)) columns)
1455−addColumnNull column ty = UnsafeAlterTable $
1456− "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty
1457−
1458−dropColumn
1459− :: KnownSymbol column
1460− => Alias column
1461− -> AlterTable columns (Drop column columns)
1462−dropColumn column = UnsafeAlterTable $
1463− "DROP COLUMN" <+> renderAlias column
1464−
1465−renameColumn
1466− :: (KnownSymbol column0, KnownSymbol column1)
1467− => Alias column0
1468− -> Alias column1
1469− -> AlterTable columns (Rename column0 column1 columns)
1470−renameColumn column0 column1 = UnsafeAlterTable $
1471− "RENAME COLUMN" <+> renderAlias column0 <+> "TO" <+> renderAlias column1
1472−
1473−alterColumn
1474− :: (KnownSymbol column, HasColumn column columns ty0)
1475− => Alias column
1476− -> AlterColumn ty0 ty1
1477− -> AlterTable columns (Alter column columns ty1)
1478−alterColumn column alteration = UnsafeAlterTable $
1479− "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration
1480−
1481−newtype AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =
1482− UnsafeAlterColumn {renderAlterColumn :: ByteString}
1483− deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)
1484−
1485−setDefault
1486− :: Expression '[] '[] 'Ungrouped ('Required ty)
1487− -> AlterColumn ('Required ty) ('Optional ty)
1488−setDefault expression = UnsafeAlterColumn $
1489− "SET DEFAULT" <+> renderExpression expression
1490−
1491−dropDefault :: AlterColumn ('Optional ty) ('Required ty)
1492−dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
1493−
1494−setNotNull
1495− :: AlterColumn (optionality ('Null ty)) (optionality ('NotNull ty))
1496−setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
1497−
1498−dropNotNull
1499− :: AlterColumn (optionality ('NotNull ty)) (optionality ('Null ty))
1500−dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
1501−
1502−alterType
1503− :: TypeExpression (optionality (nullity ty1))
1504− -> AlterColumn (optionality (nullity ty0)) (optionality (nullity ty1))
1505−alterType ty = UnsafeAlterColumn $ "TYPE " <> renderTypeExpression ty
1506−
1507−{-----------------------------------------
1508−INSERT statements
1509−-----------------------------------------}
1510−
1511−insertInto
1512− :: (SListI columns, SListI results, HasTable table schema columns)
1513− => Alias table
1514− -> ValuesClause schema params columns
1515− -> ConflictClause params columns
1516− -> ReturningClause params columns results
1517− -> Manipulation schema params results
1518−insertInto table insert conflict returning = UnsafeManipulation $
1519− "INSERT" <+> "INTO" <+> renderAlias table
1520− <+> renderValuesClause insert
1521− <> renderConflictClause conflict
1522− <> renderReturningClause returning
1523−
1524−data ValuesClause
1525− (schema :: TablesType)
1526− (params :: [ColumnType])
1527− (columns :: ColumnsType)
1528− = Values
1529− (NP (Aliased (Expression params '[] 'Ungrouped)) columns)
1530− [NP (Aliased (Expression params '[] 'Ungrouped)) columns]
1531− | ValuesQuery (Query schema params columns)
1532−
1533−renderValuesClause
1534− :: SListI columns
1535− => ValuesClause schema params columns
1536− -> ByteString
1537−renderValuesClause = \case
1538− Values row rows ->
1539− parenthesized (renderCommaSeparated renderAliasPart row)
1540− <+> "VALUES"
1541− <+> commaSeparated
1542− (parenthesized . renderCommaSeparated renderValuePart <$> row:rows)
1543− where
1544− renderAliasPart, renderValuePart
1545− :: Aliased (Expression params '[] 'Ungrouped) ty -> ByteString
1546− renderAliasPart (_ `As` name) = renderAlias name
1547− renderValuePart (value `As` _) = renderExpression value
1548− ValuesQuery q -> renderQuery q
1549−
1550−data ReturningClause
1551− (params :: [ColumnType])
1552− (columns :: ColumnsType)
1553− (results :: ColumnsType)
1554− where
1555− ReturningStar :: ReturningClause params columns columns
1556− Returning
1557− :: NP
1558− (Aliased (Expression params '[table ::: columns] 'Ungrouped))
1559− results
1560− -> ReturningClause params columns results
1561−
1562−renderReturningClause
1563− :: SListI results
1564− => ReturningClause params columns results
1565− -> ByteString
1566−renderReturningClause = \case
1567− ReturningStar -> " RETURNING *;"
1568− Returning Nil -> ";"
1569− Returning results -> " RETURNING"
1570− <+> renderCommaSeparated (renderAliased renderExpression) results <> ";"
1571−
1572−data ConflictClause params columns where
1573− Conflict :: ConflictClause params columns
1574− OnConflictDoNothing :: ConflictClause params columns
1575− OnConflictDoUpdate
1576− :: NP (Aliased (UpdateExpression params columns)) columns
1577− -> Maybe (Condition params '[table ::: columns] 'Ungrouped)
1578− -> ConflictClause params columns
1579−
1580−renderConflictClause
1581− :: SListI columns
1582− => ConflictClause params columns
1583− -> ByteString
1584−renderConflictClause = \case
1585− Conflict -> ""
1586− OnConflictDoNothing -> " ON CONFLICT DO NOTHING"
1587− OnConflictDoUpdate updates whMaybe
1588− -> " ON CONFLICT DO UPDATE SET"
1589− <+> renderCommaSeparatedMaybe renderUpdateExpression updates
1590− <> case whMaybe of
1591− Nothing -> ""
1592− Just wh -> " WHERE" <+> renderExpression wh
1593−
1594−{-----------------------------------------
1595−UPDATE statements
1596−-----------------------------------------}
1597−
1598−data UpdateExpression params columns ty
1599− = Same
1600− | Set (forall table. Expression params '[table ::: columns] 'Ungrouped ty)
1601−deriving instance Show (UpdateExpression params columns ty)
1602−deriving instance Eq (UpdateExpression params columns ty)
1603−deriving instance Ord (UpdateExpression params columns ty)
1604−
1605−renderUpdateExpression
1606− :: Aliased (UpdateExpression params columns) column
1607− -> Maybe ByteString
1608−renderUpdateExpression = \case
1609− Same `As` _ -> Nothing
1610− Set expression `As` column -> Just $
1611− renderAlias column <+> "=" <+> renderExpression expression
1612−
1613−update
1614− :: (HasTable table schema columns, SListI columns, SListI results)
1615− => Alias table
1616− -> NP (Aliased (UpdateExpression params columns)) columns
1617− -> Condition params '[tab ::: columns] 'Ungrouped
1618− -> ReturningClause params columns results
1619− -> Manipulation schema params results
1620−update table columns wh returning = UnsafeManipulation $
1621− "UPDATE"
1622− <+> renderAlias table
1623− <+> "SET"
1624− <+> renderCommaSeparatedMaybe renderUpdateExpression columns
1625− <+> "WHERE" <+> renderExpression wh
1626− <> renderReturningClause returning
1627−
1628−{-----------------------------------------
1629−DELETE statements
1630−-----------------------------------------}
1631−
1632−deleteFrom
1633− :: HasTable table schema columns
1634− => Alias table
1635− -> Condition params '[table ::: columns] 'Ungrouped
1636− -> Manipulation schema params '[]
1637−deleteFrom table wh = UnsafeManipulation $
1638− "DELETE FROM" <+> renderAlias table
1639− <+> "WHERE" <+> renderExpression wh <> ";"
1640−
1641−{-----------------------------------------
1642−render helper functions
1643−-----------------------------------------}
1644−
1645−parenthesized :: ByteString -> ByteString
1646−parenthesized str = "(" <> str <> ")"
1647−
1648−(<+>) :: ByteString -> ByteString -> ByteString
1649−str1 <+> str2 = str1 <> " " <> str2
1650−
1651−commaSeparated :: [ByteString] -> ByteString
1652−commaSeparated = ByteString.intercalate ", "
1653−
1654−renderCommaSeparated
1655− :: SListI xs
1656− => (forall x. expression x -> ByteString)
1657− -> NP expression xs -> ByteString
1658−renderCommaSeparated render
1659− = commaSeparated
1660− . hcollapse
1661− . hmap (K . render)
1662−
1663−renderCommaSeparatedMaybe
1664− :: SListI xs
1665− => (forall x. expression x -> Maybe ByteString)
1666− -> NP expression xs -> ByteString
1667−renderCommaSeparatedMaybe render
1668− = commaSeparated
1669− . catMaybes
1670− . hcollapse
1671− . hmap (K . render)
1672−
1673−renderNat :: KnownNat n => proxy n -> ByteString
1674−renderNat (_ :: proxy n) = fromString (show (natVal' (proxy# :: Proxy# n)))