on dev help sign in
work it through (partly) in definitions
371a13eEitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+56−51
@@ -108,12 +108,12 @@ statements
108-- database, like a `createTable`, `dropTable`, or `alterTable` command.
108-- database, like a `createTable`, `dropTable`, or `alterTable` command.
109-- `Definition`s may be composed using the `>>>` operator.
109-- `Definition`s may be composed using the `>>>` operator.
110newtype Definition
110newtype Definition
111− (schema0 :: SchemaType)
111+ (db0 :: DBType)
112− (schema1 :: SchemaType)
112+ (db1 :: DBType)
113 = UnsafeDefinition { renderDefinition :: ByteString }
113 = UnsafeDefinition { renderDefinition :: ByteString }
114 deriving (GHC.Generic,Show,Eq,Ord,NFData)
114 deriving (GHC.Generic,Show,Eq,Ord,NFData)
115
115
116−instance RenderSQL (Definition schema0 schema1) where
116+instance RenderSQL (Definition db0 db1) where
117 renderSQL = renderDefinition
117 renderSQL = renderDefinition
118
118
119instance Category Definition where
119instance Category Definition where
@@ -144,17 +144,20 @@ in printSQL setup
144CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
144CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
145-}
145-}
146createTable
146createTable
147− :: ( KnownSymbol table
147+ :: ( KnownSymbol sch
148+ , KnownSymbol tab
148 , columns ~ (col ': cols)
149 , columns ~ (col ': cols)
149 , SOP.SListI columns
150 , SOP.SListI columns
150 , SOP.SListI constraints
151 , SOP.SListI constraints
152+ , Has sch db0 schema0
151− , schema1 ~ Create table ('Table (constraints :=> columns)) schema0 )
153+ , schema1 ~ Create table ('Table (constraints :=> columns)) schema0
154+ , db1 ~ Alter sch schema1 db0 )
152− => Alias table -- ^ the name of the table to add
155+ => QualifiedAlias sch tab -- ^ the name of the table to add
153 -> NP (Aliased (ColumnTypeExpression schema0)) columns
156 -> NP (Aliased (ColumnTypeExpression schema0)) columns
154 -- ^ the names and datatype of each column
157 -- ^ the names and datatype of each column
155 -> NP (Aliased (TableConstraintExpression schema1 table)) constraints
158 -> NP (Aliased (TableConstraintExpression schema1 table)) constraints
156 -- ^ constraints that must hold for the table
159 -- ^ constraints that must hold for the table
157− -> Definition schema0 schema1
160+ -> Definition db0 db1
158createTable tab columns constraints = UnsafeDefinition $
161createTable tab columns constraints = UnsafeDefinition $
159 "CREATE TABLE" <+> renderCreation tab columns constraints
162 "CREATE TABLE" <+> renderCreation tab columns constraints
160
163
@@ -182,31 +185,32 @@ in printSQL setup
182CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);
185CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);
183-}
186-}
184createTableIfNotExists
187createTableIfNotExists
185− :: ( Has table schema ('Table (constraints :=> columns))
188+ :: ( HasQualified sch tab db schema ('Table (constraints :=> columns))
186 , SOP.SListI columns
189 , SOP.SListI columns
187 , SOP.SListI constraints )
190 , SOP.SListI constraints )
188− => Alias table -- ^ the name of the table to add
191+ => QualifiedAlias sch tab -- ^ the name of the table to add
189 -> NP (Aliased (ColumnTypeExpression schema)) columns
192 -> NP (Aliased (ColumnTypeExpression schema)) columns
190 -- ^ the names and datatype of each column
193 -- ^ the names and datatype of each column
191 -> NP (Aliased (TableConstraintExpression schema table)) constraints
194 -> NP (Aliased (TableConstraintExpression schema table)) constraints
192 -- ^ constraints that must hold for the table
195 -- ^ constraints that must hold for the table
193− -> Definition schema schema
196+ -> Definition db db
194createTableIfNotExists tab columns constraints = UnsafeDefinition $
197createTableIfNotExists tab columns constraints = UnsafeDefinition $
195 "CREATE TABLE IF NOT EXISTS"
198 "CREATE TABLE IF NOT EXISTS"
196 <+> renderCreation tab columns constraints
199 <+> renderCreation tab columns constraints
197
200
198-- helper function for `createTable` and `createTableIfNotExists`
201-- helper function for `createTable` and `createTableIfNotExists`
199renderCreation
202renderCreation
200− :: ( KnownSymbol table
203+ :: ( KnownSymbol sch
204+ , KnownSymbol tab
201 , SOP.SListI columns
205 , SOP.SListI columns
202 , SOP.SListI constraints )
206 , SOP.SListI constraints )
203− => Alias table -- ^ the name of the table to add
207+ => QualifiedAlias sch tab -- ^ the name of the table to add
204 -> NP (Aliased (ColumnTypeExpression schema0)) columns
208 -> NP (Aliased (ColumnTypeExpression schema0)) columns
205 -- ^ the names and datatype of each column
209 -- ^ the names and datatype of each column
206 -> NP (Aliased (TableConstraintExpression schema1 table)) constraints
210 -> NP (Aliased (TableConstraintExpression schema1 table)) constraints
207 -- ^ constraints that must hold for the table
211 -- ^ constraints that must hold for the table
208 -> ByteString
212 -> ByteString
209−renderCreation tab columns constraints = renderAlias tab
213+renderCreation tab columns constraints = renderQualifiedAlias tab
210 <+> parenthesized
214 <+> parenthesized
211 ( renderCommaSeparated renderColumnDef columns
215 ( renderCommaSeparated renderColumnDef columns
212 <> ( case constraints of
216 <> ( case constraints of
@@ -512,10 +516,10 @@ DROP statements
512-- >>> printSQL definition
516-- >>> printSQL definition
513-- DROP TABLE "muh_table";
517-- DROP TABLE "muh_table";
514dropTable
518dropTable
515− :: Has table schema ('Table t)
519+ :: HasQualified sch tab db schema ('Table table)
516− => Alias table -- ^ table to remove
520+ => QualifiedAlias sch tab -- ^ table to remove
517− -> Definition schema (Drop table schema)
521+ -> Definition db (Alter sch (Drop tab schema) db)
518−dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderAlias tab <> ";"
522+dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderQualifiedAlias tab <> ";"
519
523
520{-----------------------------------------
524{-----------------------------------------
521ALTER statements
525ALTER statements
@@ -523,13 +527,13 @@ ALTER statements
523
527
524-- | `alterTable` changes the definition of a table from the schema.
528-- | `alterTable` changes the definition of a table from the schema.
525alterTable
529alterTable
526− :: KnownSymbol alias
530+ :: HasQualified sch tab db schema ('Table table0)
527− => Alias alias -- ^ table to alter
531+ => QualifiedAlias sch tab -- ^ table to alter
528− -> AlterTable alias table schema -- ^ alteration to perform
532+ -> AlterTable tab table1 schema -- ^ alteration to perform
529− -> Definition schema (Alter alias ('Table table) schema)
533+ -> Definition db (Alter sch (Alter tab ('Table table1) schema) db)
530alterTable tab alteration = UnsafeDefinition $
534alterTable tab alteration = UnsafeDefinition $
531 "ALTER TABLE"
535 "ALTER TABLE"
532− <+> renderAlias tab
536+ <+> renderQualifiedAlias tab
533 <+> renderAlterTable alteration
537 <+> renderAlterTable alteration
534 <> ";"
538 <> ";"
535
539
@@ -805,13 +809,13 @@ alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty
805-- :}
809-- :}
806-- CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";
810-- CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";
807createView
811createView
808− :: KnownSymbol view
812+ :: (KnownSymbol sch, KnownSymbol vw)
809− => Alias view -- ^ the name of the view to add
813+ => QualifiedAlias sch vw -- ^ the name of the view to add
810− -> Query schema '[] row
814+ -> Query schema '[] view
811 -- ^ query
815 -- ^ query
812− -> Definition schema (Create view ('View row) schema)
816+ -> Definition db (Alter sch (Create vw ('View view) schema) db)
813createView alias query = UnsafeDefinition $
817createView alias query = UnsafeDefinition $
814− "CREATE" <+> "VIEW" <+> renderAlias alias <+> "AS"
818+ "CREATE" <+> "VIEW" <+> renderQualifiedAlias alias <+> "AS"
815 <+> renderQuery query <> ";"
819 <+> renderQuery query <> ";"
816
820
817-- | Drop a view.
821-- | Drop a view.
@@ -827,24 +831,24 @@ createView alias query = UnsafeDefinition $
827-- :}
831-- :}
828-- DROP VIEW "bc";
832-- DROP VIEW "bc";
829dropView
833dropView
830− :: Has view schema ('View v)
834+ :: HasQualified sch vw db schema ('View view)
831− => Alias view -- ^ view to remove
835+ => QualifiedAlias sch vw -- ^ view to remove
832− -> Definition schema (Drop view schema)
836+ -> Definition db (Alter sch (Drop vw schema) db)
833−dropView v = UnsafeDefinition $ "DROP VIEW" <+> renderAlias v <> ";"
837+dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderQualifiedAlias vw <> ";"
834
838
835-- | Enumerated types are created using the `createTypeEnum` command, for example
839-- | Enumerated types are created using the `createTypeEnum` command, for example
836--
840--
837-- >>> printSQL $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy")
841-- >>> printSQL $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy")
838-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');
842-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');
839createTypeEnum
843createTypeEnum
840− :: (KnownSymbol enum, SOP.All KnownSymbol labels)
844+ :: (KnownSymbol enum, Has sch db schema, SOP.All KnownSymbol labels)
841− => Alias enum
845+ => QualifiedAlias sch enum
842 -- ^ name of the user defined enumerated type
846 -- ^ name of the user defined enumerated type
843 -> NP PGlabel labels
847 -> NP PGlabel labels
844 -- ^ labels of the enumerated type
848 -- ^ labels of the enumerated type
845− -> Definition schema (Create enum ('Typedef ('PGenum labels)) schema)
849+ -> Definition db (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) db)
846createTypeEnum enum labels = UnsafeDefinition $
850createTypeEnum enum labels = UnsafeDefinition $
847− "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+> "ENUM" <+>
851+ "CREATE" <+> "TYPE" <+> renderQualifiedAlias enum <+> "AS" <+> "ENUM" <+>
848 parenthesized (commaSeparated (renderLabels labels)) <> ";"
852 parenthesized (commaSeparated (renderLabels labels)) <> ";"
849
853
850-- | Enumerated types can also be generated from a Haskell type, for example
854-- | Enumerated types can also be generated from a Haskell type, for example
@@ -855,14 +859,14 @@ createTypeEnum enum labels = UnsafeDefinition $
855-- >>> printSQL $ createTypeEnumFrom @Schwarma #schwarma
859-- >>> printSQL $ createTypeEnumFrom @Schwarma #schwarma
856-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');
860-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');
857createTypeEnumFrom
861createTypeEnumFrom
858− :: forall hask enum schema.
862+ :: forall hask sch enum db schema.
859 ( SOP.Generic hask
863 ( SOP.Generic hask
860 , SOP.All KnownSymbol (LabelsPG hask)
864 , SOP.All KnownSymbol (LabelsPG hask)
861 , KnownSymbol enum
865 , KnownSymbol enum
862− )
866+ , Has sch db schema )
863− => Alias enum
867+ => QualifiedAlias sch enum
864 -- ^ name of the user defined enumerated type
868 -- ^ name of the user defined enumerated type
865− -> Definition schema (Create enum ('Typedef (PG (Enumerated hask))) schema)
869+ -> Definition db (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) db)
866createTypeEnumFrom enum = createTypeEnum enum
870createTypeEnumFrom enum = createTypeEnum enum
867 (SOP.hpure label :: NP PGlabel (LabelsPG hask))
871 (SOP.hpure label :: NP PGlabel (LabelsPG hask))
868
872
@@ -885,14 +889,14 @@ in printSQL setup
885CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
889CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
886-}
890-}
887createTypeComposite
891createTypeComposite
888− :: (KnownSymbol ty, SOP.SListI fields)
892+ :: (KnownSymbol ty, Has sch db schema, SOP.SListI fields)
889− => Alias ty
893+ => QualifiedAlias sch ty
890 -- ^ name of the user defined composite type
894 -- ^ name of the user defined composite type
891 -> NP (Aliased (TypeExpression schema)) fields
895 -> NP (Aliased (TypeExpression schema)) fields
892 -- ^ list of attribute names and data types
896 -- ^ list of attribute names and data types
893− -> Definition schema (Create ty ('Typedef ('PGcomposite fields)) schema)
897+ -> Definition db (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) db)
894createTypeComposite ty fields = UnsafeDefinition $
898createTypeComposite ty fields = UnsafeDefinition $
895− "CREATE" <+> "TYPE" <+> renderAlias ty <+> "AS" <+> parenthesized
899+ "CREATE" <+> "TYPE" <+> renderQualifiedAlias ty <+> "AS" <+> parenthesized
896 (renderCommaSeparated renderField fields) <> ";"
900 (renderCommaSeparated renderField fields) <> ";"
897 where
901 where
898 renderField :: Aliased (TypeExpression schema) x -> ByteString
902 renderField :: Aliased (TypeExpression schema) x -> ByteString
@@ -907,12 +911,13 @@ createTypeComposite ty fields = UnsafeDefinition $
907-- >>> printSQL $ createTypeCompositeFrom @Complex #complex
911-- >>> printSQL $ createTypeCompositeFrom @Complex #complex
908-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
912-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
909createTypeCompositeFrom
913createTypeCompositeFrom
910− :: forall hask ty schema.
914+ :: forall hask sch ty db schema.
911 ( SOP.All (FieldTyped schema) (RowPG hask)
915 ( SOP.All (FieldTyped schema) (RowPG hask)
912− , KnownSymbol ty )
916+ , KnownSymbol ty
913− => Alias ty
917+ , Has sch db schema )
918+ => QualifiedAlias sch ty
914 -- ^ name of the user defined composite type
919 -- ^ name of the user defined composite type
915− -> Definition schema (Create ty ( 'Typedef (PG (Composite hask))) schema)
920+ -> Definition db (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) db)
916createTypeCompositeFrom ty = createTypeComposite ty
921createTypeCompositeFrom ty = createTypeComposite ty
917 (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schema)) fieldtype
922 (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schema)) fieldtype
918 :: NP (Aliased (TypeExpression schema)) (RowPG hask))
923 :: NP (Aliased (TypeExpression schema)) (RowPG hask))
@@ -931,11 +936,11 @@ instance (KnownSymbol alias, PGTyped schema ty)
931-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))] '[])
936-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))] '[])
932-- DROP TYPE "schwarma";
937-- DROP TYPE "schwarma";
933dropType
938dropType
934− :: Has tydef schema ('Typedef ty)
939+ :: HasQualified sch td db schema ('Typedef ty)
935− => Alias tydef
940+ => QualifiedAlias sch td
936 -- ^ name of the user defined type
941 -- ^ name of the user defined type
937− -> Definition schema (Drop tydef schema)
942+ -> Definition db (Alter sch (Drop td schema) db)
938−dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderAlias tydef <> ";"
943+dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderQualifiedAlias tydef <> ";"
939
944
940-- | `ColumnTypeExpression`s are used in `createTable` commands.
945-- | `ColumnTypeExpression`s are used in `createTable` commands.
941newtype ColumnTypeExpression (schema :: SchemaType) (ty :: ColumnType)
946newtype ColumnTypeExpression (schema :: SchemaType) (ty :: ColumnType)