a00c12b · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

commons & schemas

a00c12bEitan Chatav8 years ago

squeal-postgresql/exe/Example.hs+8−4

compare with dev

unifiedsplit

@@ -6,6 +6,8 @@

6 , OverloadedStrings

7 , OverloadedLists

8 , TypeApplications

9+ , TypeFamilies

10+ , TypeInType

9 , TypeOperators

11 , TypeOperators

10#-}

12#-}

@@ -41,9 +43,11 @@ type Schema =

41 ])

43 ])

42 ]

44 ]

44−type DB = '["public" ::: Schema]

46+type family Schemas0 :: SchemasType where Schemas0 = '["public" ::: '[]]

47+type family Schemas :: SchemasType where Schemas = '["public" ::: Schema]

48+type DB = '[] :=> Schemas

46−setup :: Definition '["public" ::: '[]] DB

50+setup :: Definition Schemas0 Schemas

47setup =

51setup =

48 createTable #users

52 createTable #users

49 ( serial `as` #id :*

53 ( serial `as` #id :*

@@ -59,7 +63,7 @@ setup =

59 foreignKey #user_id #users #id

63 foreignKey #user_id #users #id

60 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

64 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )

62−teardown :: Definition DB '["public" ::: '[]]

66+teardown :: Definition Schemas Schemas0

63teardown = dropTable #emails >>> dropTable #users

67teardown = dropTable #emails >>> dropTable #users

65insertUser :: Manipulation DB '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]

69insertUser :: Manipulation DB '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]

@@ -97,7 +101,7 @@ users =

97 , User "Carole" (Just "carole@hotmail.com") [Just 3]

101 , User "Carole" (Just "carole@hotmail.com") [Just 3]

98 ]

102 ]

103

100−session :: (MonadBase IO pq, MonadPQ DB pq) => pq ()

104+session :: (MonadBase IO pq, MonadPQ Schemas pq) => pq ()

101session = do

105session = do

102 liftBase $ Char8.putStrLn "manipulating"

106 liftBase $ Char8.putStrLn "manipulating"

103 idResults <- traversePrepared insertUser ([(userName user, userVec user) | user <- users])

107 idResults <- traversePrepared insertUser ([(userName user, userVec user) | user <- users])

squeal-postgresql/src/Squeal/PostgreSQL.hs+1−1

@@ -51,7 +51,7 @@ type DB = '[ "public" ::: Schema ]

52Notice the use of type operators.

54−`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `DBType`, a `SchemumType`,

54+`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `SchemasType`, a `SchemumType`,

55a `TableConstraint` or a `ColumnType`. It is intended to connote Haskell's @::@

56operator.

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+96−96

@@ -110,12 +110,12 @@ statements

110-- database, like a `createTable`, `dropTable`, or `alterTable` command.

111-- `Definition`s may be composed using the `>>>` operator.

112newtype Definition

113− (db0 :: DBType)

113+ (schemas0 :: SchemasType)

114− (db1 :: DBType)

114+ (schemas1 :: SchemasType)

115 = UnsafeDefinition { renderDefinition :: ByteString }

116 deriving (GHC.Generic,Show,Eq,Ord,NFData)

117

118−instance RenderSQL (Definition db0 db1) where

118+instance RenderSQL (Definition schemas0 schemas1) where

119 renderSQL = renderDefinition

120

121instance Category Definition where

@@ -130,14 +130,14 @@ CREATE statements

130createSchema

131 :: KnownSymbol sch

132 => Alias sch

133− -> Definition db (Create sch '[] db)

133+ -> Definition schemas (Create sch '[] schemas)

134createSchema sch = UnsafeDefinition $

135 "CREATE" <+> "SCHEMA" <+> renderAlias sch <> ";"

136

137createSchemaIfNotExists

138− :: (KnownSymbol sch, Has sch db schema)

138+ :: (KnownSymbol sch, Has sch schemas schema)

139 => Alias sch

140− -> Definition db db

140+ -> Definition schemas schemas

141createSchemaIfNotExists sch = UnsafeDefinition $

142 "CREATE" <+> "SCHEMA" <+> "IF" <+> "NOT" <+> "EXISTS"

143 <+> renderAlias sch <> ";"

@@ -166,14 +166,14 @@ createTable

166 , columns ~ (col ': cols)

167 , SOP.SListI columns

168 , SOP.SListI constraints

169− , Has sch db0 schema0

169+ , Has sch schemas0 schema0

170− , db1 ~ Alter sch (Create tab ('Table (constraints :=> columns)) schema0) db0 )

170+ , schemas1 ~ Alter sch (Create tab ('Table (constraints :=> columns)) schema0) schemas0 )

171 => QualifiedAlias sch tab -- ^ the name of the table to add

172− -> NP (Aliased (ColumnTypeExpression db0)) columns

172+ -> NP (Aliased (ColumnTypeExpression schemas0)) columns

173 -- ^ the names and datatype of each column

174− -> NP (Aliased (TableConstraintExpression sch tab db1)) constraints

174+ -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints

175 -- ^ constraints that must hold for the table

176− -> Definition db0 db1

176+ -> Definition schemas0 schemas1

177createTable tab columns constraints = UnsafeDefinition $

178 "CREATE TABLE" <+> renderCreation tab columns constraints

179

@@ -201,16 +201,16 @@ in printSQL setup

201CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);

202-}

203createTableIfNotExists

204− :: ( Has sch db schema

204+ :: ( Has sch schemas schema

205 , Has tab schema ('Table (constraints :=> columns))

206 , SOP.SListI columns

207 , SOP.SListI constraints )

208 => QualifiedAlias sch tab -- ^ the name of the table to add

209− -> NP (Aliased (ColumnTypeExpression db)) columns

209+ -> NP (Aliased (ColumnTypeExpression schemas)) columns

210 -- ^ the names and datatype of each column

211− -> NP (Aliased (TableConstraintExpression sch tab db)) constraints

211+ -> NP (Aliased (TableConstraintExpression sch tab schemas)) constraints

212 -- ^ constraints that must hold for the table

213− -> Definition db db

213+ -> Definition schemas schemas

214createTableIfNotExists tab columns constraints = UnsafeDefinition $

215 "CREATE TABLE IF NOT EXISTS"

216 <+> renderCreation tab columns constraints

@@ -222,9 +222,9 @@ renderCreation

222 , SOP.SListI columns

223 , SOP.SListI constraints )

224 => QualifiedAlias sch tab -- ^ the name of the table to add

225− -> NP (Aliased (ColumnTypeExpression db0)) columns

225+ -> NP (Aliased (ColumnTypeExpression schemas0)) columns

226 -- ^ the names and datatype of each column

227− -> NP (Aliased (TableConstraintExpression sch tab db1)) constraints

227+ -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints

228 -- ^ constraints that must hold for the table

229 -> ByteString

230renderCreation tab columns constraints = renderQualifiedAlias tab

@@ -236,11 +236,11 @@ renderCreation tab columns constraints = renderQualifiedAlias tab

236 renderCommaSeparated renderConstraint constraints ) )

237 <> ";"

238 where

239− renderColumnDef :: Aliased (ColumnTypeExpression db) x -> ByteString

239+ renderColumnDef :: Aliased (ColumnTypeExpression schemas) x -> ByteString

240 renderColumnDef (ty `As` column) =

241 renderAlias column <+> renderColumnTypeExpression ty

242 renderConstraint

243− :: Aliased (TableConstraintExpression sch tab db) constraint

243+ :: Aliased (TableConstraintExpression sch tab schemas) constraint

244 -> ByteString

245 renderConstraint (constraint `As` alias) =

246 "CONSTRAINT" <+> renderAlias alias <+> renderTableConstraintExpression constraint

@@ -260,7 +260,7 @@ renderCreation tab columns constraints = renderQualifiedAlias tab

260newtype TableConstraintExpression

261 (sch :: Symbol)

262 (tab :: Symbol)

263− (db :: DBType)

263+ (schemas :: SchemasType)

264 (constraint :: TableConstraint)

265 = UnsafeTableConstraintExpression

266 { renderTableConstraintExpression :: ByteString }

@@ -291,14 +291,14 @@ let

291CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));

292-}

293check

294− :: ( Has sch db schema

294+ :: ( Has sch schemas schema

295 , Has tab schema ('Table table)

296 , HasAll aliases (TableToRow table) subcolumns )

297 => NP Alias aliases

298 -- ^ specify the subcolumns which are getting checked

299− -> (forall t. Condition db '[t ::: subcolumns] 'Ungrouped '[])

299+ -> (forall t. Condition ('[] :=> schemas) '[t ::: subcolumns] 'Ungrouped '[])

300 -- ^ a closed `Condition` on those subcolumns

301− -> TableConstraintExpression sch tab db ('Check aliases)

301+ -> TableConstraintExpression sch tab schemas ('Check aliases)

302check _cols condition = UnsafeTableConstraintExpression $

303 "CHECK" <+> parenthesized (renderExpression condition)

304

@@ -326,12 +326,12 @@ let

326CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));

327-}

328unique

329− :: ( Has sch db schema

329+ :: ( Has sch schemas schema

330 , Has tab schema('Table table)

331 , HasAll aliases (TableToRow table) subcolumns )

332 => NP Alias aliases

333 -- ^ specify subcolumns which together are unique for each row

334− -> TableConstraintExpression sch tab db ('Unique aliases)

334+ -> TableConstraintExpression sch tab schemas ('Unique aliases)

335unique columns = UnsafeTableConstraintExpression $

336 "UNIQUE" <+> parenthesized (commaSeparated (renderAliases columns))

337

@@ -361,13 +361,13 @@ let

361CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));

362-}

363primaryKey

364− :: ( Has sch db schema

364+ :: ( Has sch schemas schema

365 , Has tab schema ('Table table)

366 , HasAll aliases (TableToColumns table) subcolumns

367 , AllNotNull subcolumns )

368 => NP Alias aliases

369 -- ^ specify the subcolumns which together form a primary key.

370− -> TableConstraintExpression sch tab db ('PrimaryKey aliases)

370+ -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)

371primaryKey columns = UnsafeTableConstraintExpression $

372 "PRIMARY KEY" <+> parenthesized (commaSeparated (renderAliases columns))

373

@@ -445,7 +445,7 @@ in printSQL setup

445CREATE TABLE "employees" ("id" serial, "name" text NOT NULL, "employer_id" integer NULL, CONSTRAINT "employees_pk" PRIMARY KEY ("id"), CONSTRAINT "employees_employer_fk" FOREIGN KEY ("employer_id") REFERENCES "employees" ("id") ON DELETE CASCADE ON UPDATE CASCADE);

446-}

447foreignKey

448− :: (ForeignKeyed db sch schema child parent

448+ :: (ForeignKeyed schemas sch schema child parent

449 table reftable

450 columns refcolumns

451 constraints cols

@@ -460,7 +460,7 @@ foreignKey

460 -- ^ what to do when reference is deleted

461 -> OnUpdateClause

462 -- ^ what to do when reference is updated

463− -> TableConstraintExpression sch child db

463+ -> TableConstraintExpression sch child schemas

464 ('ForeignKey columns parent refcolumns)

465foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $

466 "FOREIGN KEY" <+> parenthesized (commaSeparated (renderAliases keys))

@@ -470,7 +470,7 @@ foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $

470 <+> renderOnUpdateClause onupd

471

472-- | A constraint synonym between types involved in a foreign key constraint.

473−type ForeignKeyed db

473+type ForeignKeyed schemas

474 sch

475 schema

476 child parent

@@ -478,7 +478,7 @@ type ForeignKeyed db

478 columns refcolumns

479 constraints cols

480 reftys tys =

481− ( Has sch db schema

481+ ( Has sch schemas schema

482 , Has child schema ('Table table)

483 , Has parent schema ('Table reftable)

484 , HasAll columns (TableToColumns table) tys

@@ -541,10 +541,10 @@ DROP statements

541-- >>> printSQL definition

542-- DROP TABLE "muh_table";

543dropTable

544− :: ( Has sch db schema

544+ :: ( Has sch schemas schema

545 , Has tab schema ('Table table))

546 => QualifiedAlias sch tab -- ^ table to remove

547− -> Definition db (Alter sch (Drop tab schema) db)

547+ -> Definition schemas (Alter sch (Drop tab schema) schemas)

548dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderQualifiedAlias tab <> ";"

549

550{-----------------------------------------

@@ -553,10 +553,10 @@ ALTER statements

553

554-- | `alterTable` changes the definition of a table from the schema.

555alterTable

556− :: (Has sch db schema, Has tab schema ('Table table0))

556+ :: (Has sch schemas schema, Has tab schema ('Table table0))

557 => QualifiedAlias sch tab -- ^ table to alter

558− -> AlterTable sch tab db table1 -- ^ alteration to perform

558+ -> AlterTable sch tab schemas table1 -- ^ alteration to perform

559− -> Definition db (Alter sch (Alter tab ('Table table1) schema) db)

559+ -> Definition schemas (Alter sch (Alter tab ('Table table1) schema) schemas)

560alterTable tab alteration = UnsafeDefinition $

561 "ALTER TABLE"

562 <+> renderQualifiedAlias tab

@@ -581,7 +581,7 @@ alterTableRename table0 table1 = UnsafeDefinition $

581newtype AlterTable

582 (sch :: Symbol)

583 (tab :: Symbol)

584− (db :: DBType)

584+ (schemas :: SchemasType)

585 (table :: TableType) =

586 UnsafeAlterTable {renderAlterTable :: ByteString}

587 deriving (GHC.Generic,Show,Eq,Ord,NFData)

@@ -599,14 +599,14 @@ newtype AlterTable

599-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0));

600addConstraint

601 :: ( KnownSymbol alias

602− , Has sch db schema

602+ , Has sch schemas schema

603 , Has tab schema ('Table table0)

604 , table0 ~ (constraints :=> columns)

605 , table1 ~ (Create alias constraint constraints :=> columns) )

606 => Alias alias

607− -> TableConstraintExpression sch tab db constraint

607+ -> TableConstraintExpression sch tab schemas constraint

608 -- ^ constraint to add

609− -> AlterTable sch tab db table1

609+ -> AlterTable sch tab schemas table1

610addConstraint alias constraint = UnsafeAlterTable $

611 "ADD" <+> "CONSTRAINT" <+> renderAlias alias

612 <+> renderTableConstraintExpression constraint

@@ -624,13 +624,13 @@ addConstraint alias constraint = UnsafeAlterTable $

624-- ALTER TABLE "tab" DROP CONSTRAINT "positive";

625dropConstraint

626 :: ( KnownSymbol constraint

627− , Has sch db schema

627+ , Has sch schemas schema

628 , Has tab schema ('Table table0)

629 , table0 ~ (constraints :=> columns)

630 , table1 ~ (Drop constraint constraints :=> columns) )

631 => Alias constraint

632 -- ^ constraint to drop

633− -> AlterTable sch tab db table1

633+ -> AlterTable sch tab schemas table1

634dropConstraint constraint = UnsafeAlterTable $

635 "DROP" <+> "CONSTRAINT" <+> renderAlias constraint

636

@@ -664,12 +664,12 @@ class AddColumn ty where

664 -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL;

665 addColumn

666 :: ( KnownSymbol column

667− , Has sch db schema

667+ , Has sch schemas schema

668 , Has tab schema ('Table table0)

669 , table0 ~ (constraints :=> columns) )

670 => Alias column -- ^ column to add

671− -> ColumnTypeExpression db ty -- ^ type of the new column

671+ -> ColumnTypeExpression schemas ty -- ^ type of the new column

672− -> AlterTable sch tab db (constraints :=> Create column ty columns)

672+ -> AlterTable sch tab schemas (constraints :=> Create column ty columns)

673 addColumn column ty = UnsafeAlterTable $

674 "ADD COLUMN" <+> renderAlias column <+> renderColumnTypeExpression ty

675instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)

@@ -693,12 +693,12 @@ instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)

693-- ALTER TABLE "tab" DROP COLUMN "col2";

694dropColumn

695 :: ( KnownSymbol column

696− , Has sch db schema

696+ , Has sch schemas schema

697 , Has tab schema ('Table table0)

698 , table0 ~ (constraints :=> columns)

699 , table1 ~ (constraints :=> Drop column columns) )

700 => Alias column -- ^ column to remove

701− -> AlterTable sch tab db table1

701+ -> AlterTable sch tab schemas table1

702dropColumn column = UnsafeAlterTable $

703 "DROP COLUMN" <+> renderAlias column

704

@@ -716,32 +716,32 @@ dropColumn column = UnsafeAlterTable $

716renameColumn

717 :: ( KnownSymbol column0

718 , KnownSymbol column1

719− , Has sch db schema

719+ , Has sch schemas schema

720 , Has tab schema ('Table table0)

721 , table0 ~ (constraints :=> columns)

722 , table1 ~ (constraints :=> Rename column0 column1 columns) )

723 => Alias column0 -- ^ column to rename

724 -> Alias column1 -- ^ what to rename the column

725− -> AlterTable sch tab db table1

725+ -> AlterTable sch tab schemas table1

726renameColumn column0 column1 = UnsafeAlterTable $

727 "RENAME COLUMN" <+> renderAlias column0 <+> "TO" <+> renderAlias column1

728

729-- | An `alterColumn` alters a single column.

730alterColumn

731 :: ( KnownSymbol column

732− , Has sch db schema

732+ , Has sch schemas schema

733 , Has tab schema ('Table table0)

734 , table0 ~ (constraints :=> columns)

735 , Has column columns ty0

736 , tables1 ~ (constraints :=> Alter column ty1 columns))

737 => Alias column -- ^ column to alter

738− -> AlterColumn db ty0 ty1 -- ^ alteration to perform

738+ -> AlterColumn schemas ty0 ty1 -- ^ alteration to perform

739− -> AlterTable sch tab db table1

739+ -> AlterTable sch tab schemas table1

740alterColumn column alteration = UnsafeAlterTable $

741 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration

742

743-- | An `AlterColumn` describes the alteration to perform on a single column.

744−newtype AlterColumn (db :: DBType) (ty0 :: ColumnType) (ty1 :: ColumnType) =

744+newtype AlterColumn (schemas :: SchemasType) (ty0 :: ColumnType) (ty1 :: ColumnType) =

745 UnsafeAlterColumn {renderAlterColumn :: ByteString}

746 deriving (GHC.Generic,Show,Eq,Ord,NFData)

747

@@ -759,8 +759,8 @@ newtype AlterColumn (db :: DBType) (ty0 :: ColumnType) (ty1 :: ColumnType) =

759-- :}

760-- ALTER TABLE "tab" ALTER COLUMN "col" SET DEFAULT 5;

761setDefault

762− :: Expression db '[] 'Ungrouped '[] ty -- ^ default value to set

762+ :: Expression ('[] :=> schemas) '[] 'Ungrouped '[] ty -- ^ default value to set

763− -> AlterColumn db (constraint :=> ty) ('Def :=> ty)

763+ -> AlterColumn schemas (constraint :=> ty) ('Def :=> ty)

764setDefault expression = UnsafeAlterColumn $

765 "SET DEFAULT" <+> renderExpression expression

766

@@ -775,7 +775,7 @@ setDefault expression = UnsafeAlterColumn $

775-- in printSQL definition

776-- :}

777-- ALTER TABLE "tab" ALTER COLUMN "col" DROP DEFAULT;

778−dropDefault :: AlterColumn db ('Def :=> ty) ('NoDef :=> ty)

778+dropDefault :: AlterColumn schemas ('Def :=> ty) ('NoDef :=> ty)

779dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

780

781-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.

@@ -792,7 +792,7 @@ dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"

792-- :}

793-- ALTER TABLE "tab" ALTER COLUMN "col" SET NOT NULL;

794setNotNull

795− :: AlterColumn db (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)

795+ :: AlterColumn schemas (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)

796setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

797

798-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.

@@ -807,7 +807,7 @@ setNotNull = UnsafeAlterColumn $ "SET NOT NULL"

807-- :}

808-- ALTER TABLE "tab" ALTER COLUMN "col" DROP NOT NULL;

809dropNotNull

810− :: AlterColumn db (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)

810+ :: AlterColumn schemas (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)

811dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

812

813-- | An `alterType` converts a column to a different data type.

@@ -824,7 +824,7 @@ dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"

824-- in printSQL definition

825-- :}

826-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;

827−alterType :: ColumnTypeExpression db ty -> AlterColumn db ty0 ty

827+alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty

828alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty

829

830{- | Create a view.

@@ -842,10 +842,10 @@ in printSQL definition

842CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";

843-}

844createView

845− :: (KnownSymbol sch, KnownSymbol vw, Has sch db schema)

845+ :: (KnownSymbol sch, KnownSymbol vw, Has sch schemas schema)

846 => QualifiedAlias sch vw -- ^ the name of the view to add

847− -> Query db '[] view -- ^ query

847+ -> Query ('[] :=> schemas) '[] view -- ^ query

848− -> Definition db (Alter sch (Create vw ('View view) schema) db)

848+ -> Definition schemas (Alter sch (Create vw ('View view) schema) schemas)

849createView alias query = UnsafeDefinition $

850 "CREATE" <+> "VIEW" <+> renderQualifiedAlias alias <+> "AS"

851 <+> renderQuery query <> ";"

@@ -863,9 +863,9 @@ createView alias query = UnsafeDefinition $

863-- :}

864-- DROP VIEW "bc";

865dropView

866− :: (Has sch db schema, Has vw schema ('View view))

866+ :: (Has sch schemas schema, Has vw schema ('View view))

867 => QualifiedAlias sch vw -- ^ view to remove

868− -> Definition db (Alter sch (Drop vw schema) db)

868+ -> Definition schemas (Alter sch (Drop vw schema) schemas)

869dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderQualifiedAlias vw <> ";"

870

871-- | Enumerated types are created using the `createTypeEnum` command, for example

@@ -873,12 +873,12 @@ dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderQualifiedAlias vw <> ";"

873-- >>> printSQL $ (createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") :: Definition '["public" ::: '[]] '["public" ::: '["mood" ::: 'Typedef ('PGenum '["sad","ok","happy"])]])

874-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');

875createTypeEnum

876− :: (KnownSymbol enum, Has sch db schema, SOP.All KnownSymbol labels)

876+ :: (KnownSymbol enum, Has sch schemas schema, SOP.All KnownSymbol labels)

877 => QualifiedAlias sch enum

878 -- ^ name of the user defined enumerated type

879 -> NP PGlabel labels

880 -- ^ labels of the enumerated type

881− -> Definition db (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) db)

881+ -> Definition schemas (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) schemas)

882createTypeEnum enum labels = UnsafeDefinition $

883 "CREATE" <+> "TYPE" <+> renderQualifiedAlias enum <+> "AS" <+> "ENUM" <+>

884 parenthesized (commaSeparated (renderLabels labels)) <> ";"

@@ -897,14 +897,14 @@ createTypeEnum enum labels = UnsafeDefinition $

897-- :}

898-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');

899createTypeEnumFrom

900− :: forall hask sch enum db schema.

900+ :: forall hask sch enum schemas schema.

901 ( SOP.Generic hask

902 , SOP.All KnownSymbol (LabelsPG hask)

903 , KnownSymbol enum

904− , Has sch db schema )

904+ , Has sch schemas schema )

905 => QualifiedAlias sch enum

906 -- ^ name of the user defined enumerated type

907− -> Definition db (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) db)

907+ -> Definition schemas (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) schemas)

908createTypeEnumFrom enum = createTypeEnum enum

909 (SOP.hpure label :: NP PGlabel (LabelsPG hask))

910

@@ -927,17 +927,17 @@ in printSQL setup

927CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);

928-}

929createTypeComposite

930− :: (KnownSymbol ty, Has sch db schema, SOP.SListI fields)

930+ :: (KnownSymbol ty, Has sch schemas schema, SOP.SListI fields)

931 => QualifiedAlias sch ty

932 -- ^ name of the user defined composite type

933− -> NP (Aliased (TypeExpression db)) fields

933+ -> NP (Aliased (TypeExpression schemas)) fields

934 -- ^ list of attribute names and data types

935− -> Definition db (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) db)

935+ -> Definition schemas (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) schemas)

936createTypeComposite ty fields = UnsafeDefinition $

937 "CREATE" <+> "TYPE" <+> renderQualifiedAlias ty <+> "AS" <+> parenthesized

938 (renderCommaSeparated renderField fields) <> ";"

939 where

940− renderField :: Aliased (TypeExpression db) x -> ByteString

940+ renderField :: Aliased (TypeExpression schemas) x -> ByteString

941 renderField (typ `As` alias) =

942 renderAlias alias <+> renderTypeExpression typ

943

@@ -956,21 +956,21 @@ createTypeComposite ty fields = UnsafeDefinition $

956-- :}

957-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);

958createTypeCompositeFrom

959− :: forall hask sch ty db schema.

959+ :: forall hask sch ty schemas schema.

960− ( SOP.All (FieldTyped db) (RowPG hask)

960+ ( SOP.All (FieldTyped schemas) (RowPG hask)

961 , KnownSymbol ty

962− , Has sch db schema )

962+ , Has sch schemas schema )

963 => QualifiedAlias sch ty

964 -- ^ name of the user defined composite type

965− -> Definition db (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) db)

965+ -> Definition schemas (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) schemas)

966createTypeCompositeFrom ty = createTypeComposite ty

967− (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped db)) fieldtype

967+ (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schemas)) fieldtype

968− :: NP (Aliased (TypeExpression db)) (RowPG hask))

968+ :: NP (Aliased (TypeExpression schemas)) (RowPG hask))

969

970−class FieldTyped db ty where

970+class FieldTyped schemas ty where

971− fieldtype :: Aliased (TypeExpression db) ty

971+ fieldtype :: Aliased (TypeExpression schemas) ty

972−instance (KnownSymbol alias, PGTyped db ty)

972+instance (KnownSymbol alias, PGTyped schemas ty)

973− => FieldTyped db (alias ::: ty) where

973+ => FieldTyped schemas (alias ::: ty) where

974 fieldtype = pgtype `As` Alias

975

976-- | Drop a type.

@@ -981,54 +981,54 @@ instance (KnownSymbol alias, PGTyped db ty)

981-- >>> printSQL (dropType #schwarma :: Definition '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]] '["public" ::: '[]])

982-- DROP TYPE "schwarma";

983dropType

984− :: (Has sch db schema, Has td schema ('Typedef ty))

984+ :: (Has sch schemas schema, Has td schema ('Typedef ty))

985 => QualifiedAlias sch td

986 -- ^ name of the user defined type

987− -> Definition db (Alter sch (Drop td schema) db)

987+ -> Definition schemas (Alter sch (Drop td schema) schemas)

988dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderQualifiedAlias tydef <> ";"

989

990-- | `ColumnTypeExpression`s are used in `createTable` commands.

991−newtype ColumnTypeExpression (db :: DBType) (ty :: ColumnType)

991+newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)

992 = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }

993 deriving (GHC.Generic,Show,Eq,Ord,NFData)

994

995-- | used in `createTable` commands as a column constraint to note that

996-- @NULL@ may be present in a column

997nullable

998− :: TypeExpression db (nullity ty)

998+ :: TypeExpression schemas (nullity ty)

999− -> ColumnTypeExpression db ('NoDef :=> 'Null ty)

999+ -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)

1000nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"

1001

1002-- | used in `createTable` commands as a column constraint to ensure

1003-- @NULL@ is not present in a column

1004notNullable

1005− :: TypeExpression db (nullity ty)

1005+ :: TypeExpression schemas (nullity ty)

1006− -> ColumnTypeExpression db ('NoDef :=> 'NotNull ty)

1006+ -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)

1007notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

1008

1009-- | used in `createTable` commands as a column constraint to give a default

1010default_

1011− :: Expression db '[] 'Ungrouped '[] ty

1011+ :: Expression ('[] :=> schemas) '[] 'Ungrouped '[] ty

1012− -> ColumnTypeExpression db ('NoDef :=> ty)

1012+ -> ColumnTypeExpression schemas ('NoDef :=> ty)

1013− -> ColumnTypeExpression db ('Def :=> ty)

1013+ -> ColumnTypeExpression schemas ('Def :=> ty)

1014default_ x ty = UnsafeColumnTypeExpression $

1015 renderColumnTypeExpression ty <+> "DEFAULT" <+> renderExpression x

1016

1017-- | not a true type, but merely a notational convenience for creating

1018-- unique identifier columns with type `PGint2`

1019serial2, smallserial

1020− :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint2)

1020+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)

1021serial2 = UnsafeColumnTypeExpression "serial2"

1022smallserial = UnsafeColumnTypeExpression "smallserial"

1023-- | not a true type, but merely a notational convenience for creating

1024-- unique identifier columns with type `PGint4`

1025serial4, serial

1026− :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint4)

1026+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)

1027serial4 = UnsafeColumnTypeExpression "serial4"

1028serial = UnsafeColumnTypeExpression "serial"

1029-- | not a true type, but merely a notational convenience for creating

1030-- unique identifier columns with type `PGint8`

1031serial8, bigserial

1032− :: ColumnTypeExpression db ('Def :=> 'NotNull 'PGint8)

1032+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)

1033serial8 = UnsafeColumnTypeExpression "serial8"

1034bigserial = UnsafeColumnTypeExpression "bigserial"

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+23−24

@@ -238,7 +238,6 @@ refer to the out-of-line data values.

238-}

239class KnownNat n => HasParameter

240 (n :: Nat)

241− (db :: DBType)

242 (params :: [NullityType])

241 (params :: [NullityType])

243 (ty :: NullityType)

242 (ty :: NullityType)

244 | n params -> ty where

243 | n params -> ty where

@@ -248,14 +247,14 @@ class KnownNat n => HasParameter

248 -- >>> printSQL expr

247 -- >>> printSQL expr

249 -- ($1 :: int4)

248 -- ($1 :: int4)

250 parameter

249 parameter

251− :: TypeExpression db ty

250+ :: TypeExpression schemas ty

252− -> Expression db from grouping params ty

251+ -> Expression (commons :=> schemas) from grouping params ty

253 parameter ty = UnsafeExpression $ parenthesized $

252 parameter ty = UnsafeExpression $ parenthesized $

254 "$" <> renderNat @n <+> "::"

253 "$" <> renderNat @n <+> "::"

255 <+> renderTypeExpression ty

254 <+> renderTypeExpression ty

256−instance {-# OVERLAPPING #-} HasParameter 1 db (ty1:tys) ty1

255+instance {-# OVERLAPPING #-} HasParameter 1 (ty1:tys) ty1

257−instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) db params ty)

256+instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)

258− => HasParameter n db (ty' : params) ty

257+ => HasParameter n (ty' : params) ty

259

258

260-- | `param` takes a `Nat` using type application and for basic types,

259-- | `param` takes a `Nat` using type application and for basic types,

261-- infers a `TypeExpression`.

260-- infers a `TypeExpression`.

@@ -264,9 +263,9 @@ instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) db params ty)

264-- >>> printSQL expr

263-- >>> printSQL expr

265-- ($1 :: int4)

264-- ($1 :: int4)

266param

265param

267− :: forall n db params from grouping ty

266+ :: forall n commons schemas params from grouping ty

268− . (PGTyped db ty, HasParameter n db params ty)

267+ . (PGTyped schemas ty, HasParameter n params ty)

269− => Expression db from grouping params ty -- ^ param

268+ => Expression (commons :=> schemas) from grouping params ty -- ^ param

270param = parameter @n pgtype

269param = parameter @n pgtype

271

270

272instance (HasUnique table from columns, Has column columns ty)

271instance (HasUnique table from columns, Has column columns ty)

@@ -486,13 +485,13 @@ row exprs = UnsafeExpression $ "ROW" <> parenthesized

486-- >>> printSQL $ i & field #complex #imaginary

485-- >>> printSQL $ i & field #complex #imaginary

487-- (ROW(0, 1)::"complex")."imaginary"

486-- (ROW(0, 1)::"complex")."imaginary"

488field

487field

489− :: ( Has sch db schema

488+ :: ( Has sch schemas schema

490 , Has tydef schema ('Typedef ('PGcomposite row))

489 , Has tydef schema ('Typedef ('PGcomposite row))

491 , Has field row ty)

490 , Has field row ty)

492 => QualifiedAlias sch tydef -- ^ row type

491 => QualifiedAlias sch tydef -- ^ row type

493 -> Alias field -- ^ field name

492 -> Alias field -- ^ field name

494− -> Expression db from grouping params ('NotNull ('PGcomposite row))

493+ -> Expression (commons :=> schemas) from grouping params ('NotNull ('PGcomposite row))

495− -> Expression db from grouping params ty

494+ -> Expression (commons :=> schemas) from grouping params ty

496field td fld expr = UnsafeExpression $

495field td fld expr = UnsafeExpression $

497 parenthesized (renderExpression expr <> "::" <> renderQualifiedAlias td)

496 parenthesized (renderExpression expr <> "::" <> renderQualifiedAlias td)

498 <> "." <> renderAlias fld

497 <> "." <> renderAlias fld

@@ -633,11 +632,11 @@ atan2_ y x = UnsafeExpression $

633-- | >>> printSQL $ true & cast int4

632-- | >>> printSQL $ true & cast int4

634-- (TRUE :: int4)

633-- (TRUE :: int4)

635cast

634cast

636− :: TypeExpression db ty1

635+ :: TypeExpression schemas ty1

637 -- ^ type to cast as

636 -- ^ type to cast as

638− -> Expression db from grouping params ty0

637+ -> Expression (commons :=> schemas) from grouping params ty0

639 -- ^ value to convert

638 -- ^ value to convert

640− -> Expression db from grouping params ty1

639+ -> Expression (commons :=> schemas) from grouping params ty1

641cast ty x = UnsafeExpression $ parenthesized $

640cast ty x = UnsafeExpression $ parenthesized $

642 renderExpression x <+> "::" <+> renderTypeExpression ty

641 renderExpression x <+> "::" <+> renderTypeExpression ty

643

642

@@ -1090,14 +1089,14 @@ Table 9.45: JSON creation functions

1090-- | Literal binary JSON

1089-- | Literal binary JSON

1091jsonbLit

1090jsonbLit

1092 :: JSON.ToJSON x

1091 :: JSON.ToJSON x

1093− => x -> Expression db from grouping params (nullity 'PGjsonb)

1092+ => x -> Expression (commons :=> schemas) from grouping params (nullity 'PGjsonb)

1094jsonbLit = cast jsonb . UnsafeExpression

1093jsonbLit = cast jsonb . UnsafeExpression

1095 . singleQuotedUtf8 . toStrict . JSON.encode

1094 . singleQuotedUtf8 . toStrict . JSON.encode

1096

1095

1097-- | Literal JSON

1096-- | Literal JSON

1098jsonLit

1097jsonLit

1099 :: JSON.ToJSON x

1098 :: JSON.ToJSON x

1100− => x -> Expression db from grouping params (nullity 'PGjson)

1099+ => x -> Expression (commons :=> schemas) from grouping params (nullity 'PGjson)

1101jsonLit = cast json . UnsafeExpression

1100jsonLit = cast json . UnsafeExpression

1102 . singleQuotedUtf8 . toStrict . JSON.encode

1101 . singleQuotedUtf8 . toStrict . JSON.encode

1103

1102

@@ -1610,31 +1609,31 @@ type expressions

1610-----------------------------------------}

1609-----------------------------------------}

1611

1610

1612-- | `TypeExpression`s are used in `cast`s and `createTable` commands.

1611-- | `TypeExpression`s are used in `cast`s and `createTable` commands.

1613−newtype TypeExpression (db :: DBType) (ty :: NullityType)

1612+newtype TypeExpression (schemas :: SchemasType) (ty :: NullityType)

1614 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

1613 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

1615 deriving (GHC.Generic,Show,Eq,Ord,NFData)

1614 deriving (GHC.Generic,Show,Eq,Ord,NFData)

1616

1615

1617-- | The enum or composite type in a `Typedef` can be expressed by its alias.

1616-- | The enum or composite type in a `Typedef` can be expressed by its alias.

1618typedef

1617typedef

1619− :: (Has sch db schema, Has td schema ('Typedef ty))

1618+ :: (Has sch schemas schema, Has td schema ('Typedef ty))

1620 => QualifiedAlias sch td

1619 => QualifiedAlias sch td

1621− -> TypeExpression db (nullity ty)

1620+ -> TypeExpression schemas (nullity ty)

1622typedef = UnsafeTypeExpression . renderQualifiedAlias

1621typedef = UnsafeTypeExpression . renderQualifiedAlias

1623

1622

1624-- | The composite type corresponding to a `Table` definition can be expressed

1623-- | The composite type corresponding to a `Table` definition can be expressed

1625-- by its alias.

1624-- by its alias.

1626typetable

1625typetable

1627− :: (Has sch db schema, Has tab schema ('Table table))

1626+ :: (Has sch schemas schema, Has tab schema ('Table table))

1628 => QualifiedAlias sch tab

1627 => QualifiedAlias sch tab

1629− -> TypeExpression db (nullity ('PGcomposite (TableToRow table)))

1628+ -> TypeExpression schemas (nullity ('PGcomposite (TableToRow table)))

1630typetable = UnsafeTypeExpression . renderQualifiedAlias

1629typetable = UnsafeTypeExpression . renderQualifiedAlias

1631

1630

1632-- | The composite type corresponding to a `View` definition can be expressed

1631-- | The composite type corresponding to a `View` definition can be expressed

1633-- by its alias.

1632-- by its alias.

1634typeview

1633typeview

1635− :: (Has sch db schema, Has vw schema ('View view))

1634+ :: (Has sch schemas schema, Has vw schema ('View view))

1636 => QualifiedAlias sch vw

1635 => QualifiedAlias sch vw

1637− -> TypeExpression db (nullity ('PGcomposite view))

1636+ -> TypeExpression schemas (nullity ('PGcomposite view))

1638typeview = UnsafeTypeExpression . renderQualifiedAlias

1637typeview = UnsafeTypeExpression . renderQualifiedAlias

1639

1638

1640-- | logical Boolean (true/false)

1639-- | logical Boolean (true/false)

squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+20−10

@@ -230,7 +230,8 @@ INSERT statements

230insertRows

231 :: ( SOP.SListI columns

232 , SOP.SListI results

233+ , db ~ (commons :=> schemas)

233− , Has sch db schema

234+ , Has sch schemas schema

234 , Has tab schema ('Table table)

235 , Has tab schema ('Table table)

235 , row ~ TableToRow table

236 , row ~ TableToRow table

236 , columns ~ TableToColumns table )

237 , columns ~ TableToColumns table )

@@ -262,7 +263,8 @@ insertRows tab rw rws conflict returning = UnsafeManipulation $

262insertRow

263insertRow

263 :: ( SOP.SListI columns

264 :: ( SOP.SListI columns

264 , SOP.SListI results

265 , SOP.SListI results

266+ , db ~ (commons :=> schemas)

265− , Has sch db schema

267+ , Has sch schemas schema

266 , Has tab schema ('Table table)

268 , Has tab schema ('Table table)

267 , row ~ TableToRow table

269 , row ~ TableToRow table

268 , columns ~ TableToColumns table )

270 , columns ~ TableToColumns table )

@@ -277,7 +279,8 @@ insertRow tab rw = insertRows tab rw []

277-- | Insert multiple rows returning `Nil` and raising an error on conflicts.

279-- | Insert multiple rows returning `Nil` and raising an error on conflicts.

278insertRows_

280insertRows_

279 :: ( SOP.SListI columns

281 :: ( SOP.SListI columns

282+ , db ~ (commons :=> schemas)

280− , Has sch db schema

283+ , Has sch schemas schema

281 , Has tab schema ('Table table)

284 , Has tab schema ('Table table)

282 , columns ~ TableToColumns table )

285 , columns ~ TableToColumns table )

283 => QualifiedAlias sch tab -- ^ table to insert into

286 => QualifiedAlias sch tab -- ^ table to insert into

@@ -290,7 +293,8 @@ insertRows_ tab rw rws =

290-- | Insert a single row returning `Nil` and raising an error on conflicts.

293-- | Insert a single row returning `Nil` and raising an error on conflicts.

291insertRow_

294insertRow_

292 :: ( SOP.SListI columns

295 :: ( SOP.SListI columns

296+ , db ~ (commons :=> schemas)

293− , Has sch db schema

297+ , Has sch schemas schema

294 , Has tab schema ('Table table)

298 , Has tab schema ('Table table)

295 , columns ~ TableToColumns table )

299 , columns ~ TableToColumns table )

296 => QualifiedAlias sch tab -- ^ table to insert into

300 => QualifiedAlias sch tab -- ^ table to insert into

@@ -302,7 +306,8 @@ insertRow_ tab rw = insertRow tab rw OnConflictDoRaise (Returning Nil)

302insertQuery

306insertQuery

303 :: ( SOP.SListI columns

307 :: ( SOP.SListI columns

304 , SOP.SListI results

308 , SOP.SListI results

309+ , db ~ (commons :=> schemas)

305− , Has sch db schema

310+ , Has sch schemas schema

306 , Has tab schema ('Table table)

311 , Has tab schema ('Table table)

307 , row ~ TableToRow table

312 , row ~ TableToRow table

308 , columns ~ TableToColumns table )

313 , columns ~ TableToColumns table )

@@ -321,7 +326,8 @@ insertQuery tab query conflict returning = UnsafeManipulation $

321-- | Insert a `Query` returning `Nil` and raising an error on conflicts.

326-- | Insert a `Query` returning `Nil` and raising an error on conflicts.

322insertQuery_

327insertQuery_

323 :: ( SOP.SListI columns

328 :: ( SOP.SListI columns

329+ , db ~ (commons :=> schemas)

324− , Has sch db schema

330+ , Has sch schemas schema

325 , Has tab schema ('Table table)

331 , Has tab schema ('Table table)

326 , columns ~ TableToColumns table )

332 , columns ~ TableToColumns table )

327 => QualifiedAlias sch tab -- ^ table to insert into

333 => QualifiedAlias sch tab -- ^ table to insert into

@@ -431,7 +437,8 @@ UPDATE statements

431update

437update

432 :: ( SOP.SListI columns

438 :: ( SOP.SListI columns

433 , SOP.SListI results

439 , SOP.SListI results

440+ , db ~ (commons :=> schemas)

434− , Has sch db schema

441+ , Has sch schemas schema

435 , Has tab schema ('Table table)

442 , Has tab schema ('Table table)

436 , row ~ TableToRow table

443 , row ~ TableToRow table

437 , columns ~ TableToColumns table )

444 , columns ~ TableToColumns table )

@@ -463,7 +470,8 @@ update tab columns wh returning = UnsafeManipulation $

463-- | Update a row returning `Nil`.

470-- | Update a row returning `Nil`.

464update_

471update_

465 :: ( SOP.SListI columns

472 :: ( SOP.SListI columns

473+ , db ~ (commons :=> schemas)

466− , Has sch db schema

474+ , Has sch schemas schema

467 , Has tab schema ('Table table)

475 , Has tab schema ('Table table)

468 , row ~ TableToRow table

476 , row ~ TableToRow table

469 , columns ~ TableToColumns table )

477 , columns ~ TableToColumns table )

@@ -482,7 +490,8 @@ DELETE statements

482-- | Delete rows of a table.

490-- | Delete rows of a table.

483deleteFrom

491deleteFrom

484 :: ( SOP.SListI results

492 :: ( SOP.SListI results

493+ , db ~ (commons :=> schemas)

485− , Has sch db schema

494+ , Has sch schemas schema

486 , Has tab schema ('Table table)

495 , Has tab schema ('Table table)

487 , row ~ TableToRow table

496 , row ~ TableToRow table

488 , columns ~ TableToColumns table )

497 , columns ~ TableToColumns table )

@@ -498,7 +507,8 @@ deleteFrom tab wh returning = UnsafeManipulation $

498

507

499-- | Delete rows returning `Nil`.

508-- | Delete rows returning `Nil`.

500deleteFrom_

509deleteFrom_

510+ :: ( db ~ (commons :=> schemas)

501− :: ( Has sch db schema

511+ , Has sch schemas schema

502 , Has tab schema ('Table table)

512 , Has tab schema ('Table table)

503 , row ~ TableToRow table

513 , row ~ TableToRow table

504 , columns ~ TableToColumns table )

514 , columns ~ TableToColumns table )

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+38−38

@@ -68,8 +68,8 @@ Now that we have a couple migrations we can chain them together.

68>>> :{

69let

70 numMigrations

71− :: Has "migrations" db MigrationsSchema

71+ :: Has "migrations" schemas MigrationsSchema

72− => PQ db db IO ()

72+ => PQ schemas schemas IO ()

73 numMigrations = do

74 result <- runQuery (selectStar (from (table (#migrations ! #schema_migrations `as` #m))))

75 num <- ntuples result

@@ -77,7 +77,7 @@ let

77:}

79>>> :{

80−withConnection "host=localhost port=5432 dbname=exampledb" $

80+withConnection "host=localhost port=5432 schemasname=exampleschemas" $

81 manipulate (UnsafeManipulation "SET client_min_messages TO WARNING;")

82 -- suppress notices

83 & pqThen (migrateUp migrations)

@@ -124,11 +124,11 @@ import Squeal.PostgreSQL

124

125-- | A `Migration` should contain an inverse pair of

126-- `up` and `down` instructions and a unique `name`.

127−data Migration io db0 db1 = Migration

127+data Migration io schemas0 schemas1 = Migration

128 { name :: Text -- ^ The `name` of a `Migration`.

129 -- Each `name` in a `Migration` should be unique.

130− , up :: PQ db0 db1 io () -- ^ The `up` instruction of a `Migration`.

130+ , up :: PQ schemas0 schemas1 io () -- ^ The `up` instruction of a `Migration`.

131− , down :: PQ db1 db0 io () -- ^ The `down` instruction of a `Migration`.

131+ , down :: PQ schemas1 schemas0 io () -- ^ The `down` instruction of a `Migration`.

132 }

133

134-- | Run `Migration`s by creating the `MigrationsTable`

@@ -137,10 +137,10 @@ data Migration io db0 db1 = Migration

137-- execute the `Migration` and insert its row in the `MigrationsTable`.

138migrateUp

139 :: MonadBaseControl IO io

140− => AlignedList (Migration io) db0 db1 -- ^ migrations to run

140+ => AlignedList (Migration io) schemas0 schemas1 -- ^ migrations to run

141 -> PQ

142− ("migrations" ::: MigrationsSchema ': db0)

142+ ("migrations" ::: MigrationsSchema ': schemas0)

143− ("migrations" ::: MigrationsSchema ': db1)

143+ ("migrations" ::: MigrationsSchema ': schemas1)

144 io ()

145migrateUp migration =

146 define createMigrations

@@ -150,10 +150,10 @@ migrateUp migration =

150

151 upMigrations

152 :: MonadBaseControl IO io

153− => AlignedList (Migration io) db0 db1

153+ => AlignedList (Migration io) schemas0 schemas1

154 -> PQ

155− ("migrations" ::: MigrationsSchema ': db0)

155+ ("migrations" ::: MigrationsSchema ': schemas0)

156− ("migrations" ::: MigrationsSchema ': db1)

156+ ("migrations" ::: MigrationsSchema ': schemas1)

157 io ()

158 upMigrations = \case

159 Done -> return ()

@@ -161,9 +161,9 @@ migrateUp migration =

161

162 upMigration

163 :: MonadBase IO io

164− => Migration io db0 db1 -> PQ

164+ => Migration io schemas0 schemas1 -> PQ

165− ("migrations" ::: MigrationsSchema ': db0)

165+ ("migrations" ::: MigrationsSchema ': schemas0)

166− ("migrations" ::: MigrationsSchema ': db1)

166+ ("migrations" ::: MigrationsSchema ': schemas1)

167 io ()

168 upMigration step =

169 queryExecuted step

@@ -178,9 +178,9 @@ migrateUp migration =

178

179 queryExecuted

180 :: MonadBase IO io

181− => Migration io db0 db1 -> PQ

181+ => Migration io schemas0 schemas1 -> PQ

182− ("migrations" ::: MigrationsSchema ': db0)

182+ ("migrations" ::: MigrationsSchema ': schemas0)

183− ("migrations" ::: MigrationsSchema ': db0)

183+ ("migrations" ::: MigrationsSchema ': schemas0)

184 io Row

185 queryExecuted step = do

186 result <- runQueryParams selectMigration (Only (name step))

@@ -193,10 +193,10 @@ migrateUp migration =

193-- rewind the `Migration` and delete its row in the `MigrationsTable`.

194migrateDown

195 :: MonadBaseControl IO io

196− => AlignedList (Migration io) db0 db1 -- ^ migrations to rewind

196+ => AlignedList (Migration io) schemas0 schemas1 -- ^ migrations to rewind

197 -> PQ

198− ("migrations" ::: MigrationsSchema ': db1)

198+ ("migrations" ::: MigrationsSchema ': schemas1)

199− ("migrations" ::: MigrationsSchema ': db0)

199+ ("migrations" ::: MigrationsSchema ': schemas0)

200 io ()

201migrateDown migrations =

202 define createMigrations

@@ -206,9 +206,9 @@ migrateDown migrations =

206

207 downMigrations

208 :: MonadBaseControl IO io

209− => AlignedList (Migration io) db0 db1 -> PQ

209+ => AlignedList (Migration io) schemas0 schemas1 -> PQ

210− ("migrations" ::: MigrationsSchema ': db1)

210+ ("migrations" ::: MigrationsSchema ': schemas1)

211− ("migrations" ::: MigrationsSchema ': db0)

211+ ("migrations" ::: MigrationsSchema ': schemas0)

212 io ()

213 downMigrations = \case

214 Done -> return ()

@@ -216,9 +216,9 @@ migrateDown migrations =

216

217 downMigration

218 :: MonadBase IO io

219− => Migration io db0 db1 -> PQ

219+ => Migration io schemas0 schemas1 -> PQ

220− ("migrations" ::: MigrationsSchema ': db1)

220+ ("migrations" ::: MigrationsSchema ': schemas1)

221− ("migrations" ::: MigrationsSchema ': db0)

221+ ("migrations" ::: MigrationsSchema ': schemas0)

222 io ()

223 downMigration step =

224 queryExecuted step

@@ -233,9 +233,9 @@ migrateDown migrations =

233

234 queryExecuted

235 :: MonadBase IO io

236− => Migration io db0 db1 -> PQ

236+ => Migration io schemas0 schemas1 -> PQ

237− ("migrations" ::: MigrationsSchema ': db1)

237+ ("migrations" ::: MigrationsSchema ': schemas1)

238− ("migrations" ::: MigrationsSchema ': db1)

238+ ("migrations" ::: MigrationsSchema ': schemas1)

239 io Row

240 queryExecuted step = do

241 result <- runQueryParams selectMigration (Only (name step))

@@ -262,8 +262,8 @@ type MigrationsSchema = '["schema_migrations" ::: 'Table MigrationsTable]

262

263-- | Creates a `MigrationsTable` if it does not already exist.

264createMigrations

265− :: Has "migrations" db MigrationsSchema

265+ :: Has "migrations" schemas MigrationsSchema

266− => Definition db db

266+ => Definition schemas schemas

267createMigrations =

268 createSchemaIfNotExists #migrations >>>

269 createTableIfNotExists (#migrations ! #schema_migrations)

@@ -274,23 +274,23 @@ createMigrations =

274

275-- | Inserts a `Migration` into the `MigrationsTable`

276insertMigration

277− :: Has "migrations" db MigrationsSchema

277+ :: Has "migrations" schemas MigrationsSchema

278− => Manipulation db '[ 'NotNull 'PGtext] '[]

278+ => Manipulation ('[] :=> schemas) '[ 'NotNull 'PGtext] '[]

279insertMigration = insertRow_ (#migrations ! #schema_migrations)

280 ( Set (param @1) `as` #name :*

281 Default `as` #executed_at )

282

283-- | Deletes a `Migration` from the `MigrationsTable`

284deleteMigration

285− :: Has "migrations" db MigrationsSchema

285+ :: Has "migrations" schemas MigrationsSchema

286− => Manipulation db '[ 'NotNull 'PGtext ] '[]

286+ => Manipulation ('[] :=> schemas) '[ 'NotNull 'PGtext ] '[]

287deleteMigration = deleteFrom_ (#migrations ! #schema_migrations) (#name .== param @1)

288

289-- | Selects a `Migration` from the `MigrationsTable`, returning

290-- the time at which it was executed.

291selectMigration

292− :: Has "migrations" db MigrationsSchema

292+ :: Has "migrations" schemas MigrationsSchema

293− => Query db '[ 'NotNull 'PGtext ]

293+ => Query ('[] :=> schemas) '[ 'NotNull 'PGtext ]

294 '[ "executed_at" ::: 'NotNull 'PGtimestamptz ]

295selectMigration = select

296 (#executed_at `as` #executed_at)

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+88−88

@@ -11,7 +11,7 @@ a `Definition` and `MonadPQ` for executing a `Manipulation` or `Query`,

11and a `PQ` type with instances for them.

13Using Squeal in your application will come down to defining

14−the @db@ of your database and including @PQ db db@ in your

14+the @schemas@ of your database and including @PQ schemas schemas@ in your

15application's monad transformer stack, giving it an instance of `MonadPQ`.

17This module also provides functions for retrieving rows from the `LibPQ.Result`

@@ -124,28 +124,28 @@ To specify the schema you wish to connect with, use type application.

124>>> type Schema = '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint2]]

125>>> :set -XTypeApplications

126>>> :set -XOverloadedStrings

127−>>> conn <- connectdb @Schema "host=localhost port=5432 dbname=exampledb"

127+>>> conn <- connectdbs @Schema "host=localhost port=5432 schemasname=exampleschemas"

128

129Note that, for now, squeal doesn't offer any protection from connecting

130with the wrong schema!

131-}

132connectdb

133− :: forall db io

133+ :: forall schemas io

134 . MonadBase IO io

135 => ByteString -- ^ conninfo

136− -> io (K LibPQ.Connection db)

136+ -> io (K LibPQ.Connection schemas)

137connectdb = fmap K . liftBase . LibPQ.connectdb

138

139-- | Closes the connection to the server.

140−finish :: MonadBase IO io => K LibPQ.Connection db -> io ()

140+finish :: MonadBase IO io => K LibPQ.Connection schemas -> io ()

141finish = liftBase . LibPQ.finish . unK

142

143−-- | Do `connectdb` and `finish` before and after a computation.

143+-- | Do `connectdbs` and `finish` before and after a computation.

144withConnection

145− :: forall db0 db1 io x

145+ :: forall schemas0 schemas1 io x

146 . MonadBaseControl IO io

147 => ByteString

148− -> PQ db0 db1 io x

148+ -> PQ schemas0 schemas1 io x

149 -> io x

150withConnection connString action = do

151 K x <- bracket (connectdb connString) finish (unPQ action)

@@ -153,20 +153,20 @@ withConnection connString action = do

153

154-- | Safely `lowerConnection` to a smaller schema.

155lowerConnection

156− :: K LibPQ.Connection (schema ': db)

156+ :: K LibPQ.Connection (schema ': schemas)

157− -> K LibPQ.Connection db

157+ -> K LibPQ.Connection schemas

158lowerConnection (K conn) = K conn

159

160-- | We keep track of the schema via an Atkey indexed state monad transformer,

161-- `PQ`.

162newtype PQ

163− (db0 :: DBType)

163+ (schemas0 :: SchemasType)

164− (db1 :: DBType)

164+ (schemas1 :: SchemasType)

165 (m :: Type -> Type)

166 (x :: Type) =

167− PQ { unPQ :: K LibPQ.Connection db0 -> m (K x db1) }

167+ PQ { unPQ :: K LibPQ.Connection schemas0 -> m (K x schemas1) }

168

169−instance Monad m => Functor (PQ db0 db1 m) where

169+instance Monad m => Functor (PQ schemas0 schemas1 m) where

170 fmap f (PQ pq) = PQ $ \ conn -> do

171 K x <- pq conn

172 return $ K (f x)

@@ -174,9 +174,9 @@ instance Monad m => Functor (PQ db0 db1 m) where

174-- | Run a `PQ` and keep the result and the `Connection`.

175runPQ

176 :: Functor m

177− => PQ db0 db1 m x

177+ => PQ schemas0 schemas1 m x

178− -> K LibPQ.Connection db0

178+ -> K LibPQ.Connection schemas0

179− -> m (x, K LibPQ.Connection db1)

179+ -> m (x, K LibPQ.Connection schemas1)

180runPQ (PQ pq) conn = (\ x -> (unK x, K (unK conn))) <$> pq conn

181 -- K x <- pq conn

182 -- return (x, K (unK conn))

@@ -184,16 +184,16 @@ runPQ (PQ pq) conn = (\ x -> (unK x, K (unK conn))) <$> pq conn

184-- | Execute a `PQ` and discard the result but keep the `Connection`.

185execPQ

186 :: Functor m

187− => PQ db0 db1 m x

187+ => PQ schemas0 schemas1 m x

188− -> K LibPQ.Connection db0

188+ -> K LibPQ.Connection schemas0

189− -> m (K LibPQ.Connection db1)

189+ -> m (K LibPQ.Connection schemas1)

190execPQ (PQ pq) conn = mapKK (\ _ -> unK conn) <$> pq conn

191

192-- | Evaluate a `PQ` and discard the `Connection` but keep the result.

193evalPQ

194 :: Functor m

195− => PQ db0 db1 m x

195+ => PQ schemas0 schemas1 m x

196− -> K LibPQ.Connection db0

196+ -> K LibPQ.Connection schemas0

197 -> m x

198evalPQ (PQ pq) conn = unK <$> pq conn

199

@@ -208,53 +208,53 @@ class IndexedMonadTransPQ pq where

208 -- | indexed analog of `<*>`

209 pqAp

210 :: Monad m

211− => pq db0 db1 m (x -> y)

211+ => pq schemas0 schemas1 m (x -> y)

212− -> pq db1 db2 m x

212+ -> pq schemas1 schemas2 m x

213− -> pq db0 db2 m y

213+ -> pq schemas0 schemas2 m y

214

215 -- | indexed analog of `join`

216 pqJoin

217 :: Monad m

218− => pq db0 db1 m (pq db1 db2 m y)

218+ => pq schemas0 schemas1 m (pq schemas1 schemas2 m y)

219− -> pq db0 db2 m y

219+ -> pq schemas0 schemas2 m y

220 pqJoin pq = pq & pqBind id

221

222 -- | indexed analog of `=<<`

223 pqBind

224 :: Monad m

225− => (x -> pq db1 db2 m y)

225+ => (x -> pq schemas1 schemas2 m y)

226− -> pq db0 db1 m x

226+ -> pq schemas0 schemas1 m x

227− -> pq db0 db2 m y

227+ -> pq schemas0 schemas2 m y

228

229 -- | indexed analog of flipped `>>`

230 pqThen

231 :: Monad m

232− => pq db1 db2 m y

232+ => pq schemas1 schemas2 m y

233− -> pq db0 db1 m x

233+ -> pq schemas0 schemas1 m x

234− -> pq db0 db2 m y

234+ -> pq schemas0 schemas2 m y

235 pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)

236

237 -- | indexed analog of `<=<`

238 pqAndThen

239 :: Monad m

240− => (y -> pq db1 db2 m z)

240+ => (y -> pq schemas1 schemas2 m z)

241− -> (x -> pq db0 db1 m y)

241+ -> (x -> pq schemas0 schemas1 m y)

242− -> x -> pq db0 db2 m z

242+ -> x -> pq schemas0 schemas2 m z

243 pqAndThen g f x = pqBind g (f x)

244

245 -- | Safely embed a computation in a larger schema.

246 pqEmbed

247 :: Monad m

248− => pq db0 db1 m x

248+ => pq schemas0 schemas1 m x

249− -> pq (schema ': db0) (schema : db1) m x

249+ -> pq (schema ': schemas0) (schema : schemas1) m x

250

251 -- | Run a `Definition` with `LibPQ.exec`, we expect that libpq obeys the law

252 --

253 -- @define statement1 & pqThen (define statement2) = define (statement1 >>> statement2)@

254 define

255 :: MonadBase IO io

256− => Definition db0 db1

256+ => Definition schemas0 schemas1

257− -> pq db0 db1 io (K LibPQ.Result '[])

257+ -> pq schemas0 schemas1 io (K LibPQ.Result '[])

258

259instance IndexedMonadTransPQ PQ where

260

@@ -312,66 +312,66 @@ To define an instance, you can minimally define only `manipulateParams`,

312a default instance.

313

314-}

315−class Monad pq => MonadPQ db pq | pq -> db where

315+class Monad pq => MonadPQ schemas pq | pq -> schemas where

316 manipulateParams

317 :: ToParams x params

318− => Manipulation db params ys

318+ => Manipulation ('[] :=> schemas) params ys

319 -- ^ `insertRows`, `update` or `deleteFrom`

320 -> x -> pq (K LibPQ.Result ys)

321 default manipulateParams

322− :: (MonadTrans t, MonadPQ db pq1, pq ~ t pq1)

322+ :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)

323 => ToParams x params

324− => Manipulation db params ys

324+ => Manipulation ('[] :=> schemas) params ys

325 -- ^ `insertRows`, `update` or `deleteFrom`

326 -> x -> pq (K LibPQ.Result ys)

327 manipulateParams manipulation params = lift $

328 manipulateParams manipulation params

329

330− manipulate :: Manipulation db '[] ys -> pq (K LibPQ.Result ys)

330+ manipulate :: Manipulation ('[] :=> schemas) '[] ys -> pq (K LibPQ.Result ys)

331 manipulate statement = manipulateParams statement ()

332

333 runQueryParams

334 :: ToParams x params

335− => Query db params ys

335+ => Query ('[] :=> schemas) params ys

336 -- ^ `select` and friends

337 -> x -> pq (K LibPQ.Result ys)

338 runQueryParams = manipulateParams . queryStatement

339

340 runQuery

341− :: Query db '[] ys

341+ :: Query ('[] :=> schemas) '[] ys

342 -- ^ `select` and friends

343 -> pq (K LibPQ.Result ys)

344 runQuery q = runQueryParams q ()

345

346 traversePrepared

347 :: (ToParams x params, Traversable list)

348− => Manipulation db params ys

348+ => Manipulation ('[] :=> schemas) params ys

349 -- ^ `insertRows`, `update`, or `deleteFrom`, and friends

350 -> list x -> pq (list (K LibPQ.Result ys))

351 default traversePrepared

352− :: (MonadTrans t, MonadPQ db pq1, pq ~ t pq1)

352+ :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)

353 => (ToParams x params, Traversable list)

354− => Manipulation db params ys -> list x -> pq (list (K LibPQ.Result ys))

354+ => Manipulation ('[] :=> schemas) params ys -> list x -> pq (list (K LibPQ.Result ys))

355 traversePrepared manipulation params = lift $

356 traversePrepared manipulation params

357

358 forPrepared

359 :: (ToParams x params, Traversable list)

360 => list x

361− -> Manipulation db params ys

361+ -> Manipulation ('[] :=> schemas) params ys

362 -- ^ `insertRows`, `update` or `deleteFrom`

363 -> pq (list (K LibPQ.Result ys))

364 forPrepared = flip traversePrepared

365

366 traversePrepared_

367 :: (ToParams x params, Foldable list)

368− => Manipulation db params '[]

368+ => Manipulation ('[] :=> schemas) params '[]

369 -- ^ `insertRows`, `update` or `deleteFrom`

370 -> list x -> pq ()

371 default traversePrepared_

372− :: (MonadTrans t, MonadPQ db pq1, pq ~ t pq1)

372+ :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)

373 => (ToParams x params, Foldable list)

374− => Manipulation db params '[]

374+ => Manipulation ('[] :=> schemas) params '[]

375 -- ^ `insertRows`, `update` or `deleteFrom`

376 -> list x -> pq ()

377 traversePrepared_ manipulation params = lift $

@@ -380,22 +380,22 @@ class Monad pq => MonadPQ db pq | pq -> db where

380 forPrepared_

381 :: (ToParams x params, Foldable list)

382 => list x

383− -> Manipulation db params '[]

383+ -> Manipulation ('[] :=> schemas) params '[]

384 -- ^ `insertRows`, `update` or `deleteFrom`

385 -> pq ()

386 forPrepared_ = flip traversePrepared_

387

388 liftPQ :: (LibPQ.Connection -> IO a) -> pq a

389 default liftPQ

390− :: (MonadTrans t, MonadPQ db pq1, pq ~ t pq1)

390+ :: (MonadTrans t, MonadPQ schemas pq1, pq ~ t pq1)

391 => (LibPQ.Connection -> IO a) -> pq a

392 liftPQ = lift . liftPQ

393

394−instance (MonadBase IO io, db0 ~ db, db1 ~ db)

394+instance (MonadBase IO io, schemas0 ~ schemas, schemas1 ~ schemas)

395− => MonadPQ db (PQ db0 db1 io) where

395+ => MonadPQ schemas (PQ schemas0 schemas1 io) where

396

397 manipulateParams

398− (UnsafeManipulation q :: Manipulation db ps ys) (params :: x) =

398+ (UnsafeManipulation q :: Manipulation ('[] :=> schemas) ps ys) (params :: x) =

399 PQ $ \ (K conn) -> do

400 let

401 toParam' encoding =

@@ -411,7 +411,7 @@ instance (MonadBase IO io, db0 ~ db, db1 ~ db)

411 return $ K (K result)

412

413 traversePrepared

414− (UnsafeManipulation q :: Manipulation db xs ys) (list :: list x) =

414+ (UnsafeManipulation q :: Manipulation ('[] :=> schemas) xs ys) (list :: list x) =

415 PQ $ \ (K conn) -> liftBase $ do

416 let temp = "temporary_statement"

417 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

@@ -438,7 +438,7 @@ instance (MonadBase IO io, db0 ~ db, db1 ~ db)

438 return (K results)

439

440 traversePrepared_

441− (UnsafeManipulation q :: Manipulation db xs '[]) (list :: list x) =

441+ (UnsafeManipulation q :: Manipulation ('[] :=> schemas) xs '[]) (list :: list x) =

442 PQ $ \ (K conn) -> liftBase $ do

443 let temp = "temporary_statement"

444 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

@@ -466,56 +466,56 @@ instance (MonadBase IO io, db0 ~ db, db1 ~ db)

466 y <- liftBase $ pq conn

467 return (K y)

468

469−instance MonadPQ db m => MonadPQ db (IdentityT m)

469+instance MonadPQ schemas m => MonadPQ schemas (IdentityT m)

470−instance MonadPQ db m => MonadPQ db (ReaderT r m)

470+instance MonadPQ schemas m => MonadPQ schemas (ReaderT r m)

471−instance MonadPQ db m => MonadPQ db (Strict.StateT s m)

471+instance MonadPQ schemas m => MonadPQ schemas (Strict.StateT s m)

472−instance MonadPQ db m => MonadPQ db (Lazy.StateT s m)

472+instance MonadPQ schemas m => MonadPQ schemas (Lazy.StateT s m)

473−instance (Monoid w, MonadPQ db m) => MonadPQ db (Strict.WriterT w m)

473+instance (Monoid w, MonadPQ schemas m) => MonadPQ schemas (Strict.WriterT w m)

474−instance (Monoid w, MonadPQ db m) => MonadPQ db (Lazy.WriterT w m)

474+instance (Monoid w, MonadPQ schemas m) => MonadPQ schemas (Lazy.WriterT w m)

475−instance MonadPQ db m => MonadPQ db (MaybeT m)

475+instance MonadPQ schemas m => MonadPQ schemas (MaybeT m)

476−instance MonadPQ db m => MonadPQ db (ExceptT e m)

476+instance MonadPQ schemas m => MonadPQ schemas (ExceptT e m)

477−instance (Monoid w, MonadPQ db m) => MonadPQ db (Strict.RWST r w s m)

477+instance (Monoid w, MonadPQ schemas m) => MonadPQ schemas (Strict.RWST r w s m)

478−instance (Monoid w, MonadPQ db m) => MonadPQ db (Lazy.RWST r w s m)

478+instance (Monoid w, MonadPQ schemas m) => MonadPQ schemas (Lazy.RWST r w s m)

479−instance MonadPQ db m => MonadPQ db (ContT r m)

479+instance MonadPQ schemas m => MonadPQ schemas (ContT r m)

480−

480+

481−instance (Monad m, db0 ~ db1)

481+instance (Monad m, schemas0 ~ schemas1)

482− => Applicative (PQ db0 db1 m) where

482+ => Applicative (PQ schemas0 schemas1 m) where

483 pure x = PQ $ \ _conn -> pure (K x)

484 (<*>) = pqAp

485

486−instance (Monad m, db0 ~ db1)

486+instance (Monad m, schemas0 ~ schemas1)

487− => Monad (PQ db0 db1 m) where

487+ => Monad (PQ schemas0 schemas1 m) where

488 return = pure

489 (>>=) = flip pqBind

490

491−instance db0 ~ db1 => MFunctor (PQ db0 db1) where

491+instance schemas0 ~ schemas1 => MFunctor (PQ schemas0 schemas1) where

492 hoist f (PQ pq) = PQ (f . pq)

493

494−instance db0 ~ db1 => MonadTrans (PQ db0 db1) where

494+instance schemas0 ~ schemas1 => MonadTrans (PQ schemas0 schemas1) where

495 lift m = PQ $ \ _conn -> do

496 x <- m

497 return (K x)

498

499−instance db0 ~ db1 => MMonad (PQ db0 db1) where

499+instance schemas0 ~ schemas1 => MMonad (PQ schemas0 schemas1) where

500 embed f (PQ pq) = PQ $ \ conn -> do

501 evalPQ (f (pq conn)) conn

502

503−instance (MonadBase b m, db0 ~ db1)

503+instance (MonadBase b m, schemas0 ~ schemas1)

504− => MonadBase b (PQ db0 db1 m) where

504+ => MonadBase b (PQ schemas0 schemas1 m) where

505 liftBase = lift . liftBase

506

507-- | A snapshot of the state of a `PQ` computation.

508−type PQRun db =

508+type PQRun schemas =

509− forall m x. Monad m => PQ db db m x -> m (K x db)

509+ forall m x. Monad m => PQ schemas schemas m x -> m (K x schemas)

510

511-- | Helper function in defining `MonadBaseControl` instance for `PQ`.

512−pqliftWith :: Functor m => (PQRun db -> m a) -> PQ db db m a

512+pqliftWith :: Functor m => (PQRun schemas -> m a) -> PQ schemas schemas m a

513pqliftWith f = PQ $ \ conn ->

514 fmap K (f $ \ pq -> unPQ pq conn)

515

516−instance (MonadBaseControl b m, db0 ~ db1)

516+instance (MonadBaseControl b m, schemas0 ~ schemas1)

517− => MonadBaseControl b (PQ db0 db1 m) where

517+ => MonadBaseControl b (PQ schemas0 schemas1 m) where

518− type StM (PQ db0 db1 m) x = StM m (K x db0)

518+ type StM (PQ schemas0 schemas1 m) x = StM m (K x schemas0)

519 liftBaseWith f =

520 pqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run

521 restoreM = PQ . const . restoreM

squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+18−18

@@ -41,7 +41,7 @@ import Generics.SOP (K(..))

41import Squeal.PostgreSQL.PQ

42import Squeal.PostgreSQL.Schema

44−{- | `PoolPQ` @db@ should be a drop-in replacement for `PQ` @db db@.

44+{- | `PoolPQ` @schemas@ should be a drop-in replacement for `PQ` @schemas schemas@.

46Typical use case would be to create your pool using `createConnectionPool` and run anything that requires the pool connection with it.

@@ -63,8 +63,8 @@ Here's a simplified example:

63> liftIO $ runPoolPQ (insertOne) pool

65-}

66−newtype PoolPQ (db :: DBType) m x =

66+newtype PoolPQ (schemas :: SchemasType) m x =

67− PoolPQ { runPoolPQ :: Pool (K Connection db) -> m x }

67+ PoolPQ { runPoolPQ :: Pool (K Connection schemas) -> m x }

68 deriving Functor

70-- | Create a striped pool of connections.

@@ -86,12 +86,12 @@ createConnectionPool

86 -> Int

87 -- ^ Maximum number of connections to keep open per stripe. The smallest acceptable value is 1.

88 -- Requests for connections will block if this limit is reached on a single stripe, even if other stripes have idle connections available.

89− -> io (Pool (K Connection db))

89+ -> io (Pool (K Connection schemas))

90createConnectionPool conninfo stripes idle maxResrc = liftBase $

91 createPool (connectdb conninfo) finish stripes idle maxResrc

93-- | `Applicative` instance for `PoolPQ`.

94−instance Monad m => Applicative (PoolPQ db m) where

94+instance Monad m => Applicative (PoolPQ schemas m) where

95 pure x = PoolPQ $ \ _ -> pure x

96 PoolPQ f <*> PoolPQ x = PoolPQ $ \ pool -> do

97 f' <- f pool

@@ -99,55 +99,55 @@ instance Monad m => Applicative (PoolPQ db m) where

99 return $ f' x'

100

101-- | `Monad` instance for `PoolPQ`.

102−instance Monad m => Monad (PoolPQ db m) where

102+instance Monad m => Monad (PoolPQ schemas m) where

103 return = pure

104 PoolPQ x >>= f = PoolPQ $ \ pool -> do

105 x' <- x pool

106 runPoolPQ (f x') pool

107

108-- | `MonadTrans` instance for `PoolPQ`.

109−instance MonadTrans (PoolPQ db) where

109+instance MonadTrans (PoolPQ schemas) where

110 lift m = PoolPQ $ \ _pool -> m

111

112-- | `MonadBase` instance for `PoolPQ`.

113−instance MonadBase b m => MonadBase b (PoolPQ db m) where

113+instance MonadBase b m => MonadBase b (PoolPQ schemas m) where

114 liftBase = lift . liftBase

115

116-- | `MonadPQ` instance for `PoolPQ`.

117−instance MonadBaseControl IO io => MonadPQ db (PoolPQ db io) where

117+instance MonadBaseControl IO io => MonadPQ schemas (PoolPQ schemas io) where

118 manipulateParams manipulation params = PoolPQ $ \ pool -> do

119 withResource pool $ \ conn -> do

120− (K result :: K (K Result ys) db) <- flip unPQ conn $

120+ (K result :: K (K Result ys) schemas) <- flip unPQ conn $

121 manipulateParams manipulation params

122 return result

123 traversePrepared manipulation params = PoolPQ $ \ pool ->

124 withResource pool $ \ conn -> do

125− (K result :: K (list (K Result ys)) db) <- flip unPQ conn $

125+ (K result :: K (list (K Result ys)) schemas) <- flip unPQ conn $

126 traversePrepared manipulation params

127 return result

128 traversePrepared_ manipulation params = PoolPQ $ \ pool -> do

129 withResource pool $ \ conn -> do

130− (_ :: K () db) <- flip unPQ conn $

130+ (_ :: K () schemas) <- flip unPQ conn $

131 traversePrepared_ manipulation params

132 return ()

133 liftPQ m = PoolPQ $ \ pool ->

134 withResource pool $ \ conn -> do

135− (K result :: K result db) <- flip unPQ conn $

135+ (K result :: K result schemas) <- flip unPQ conn $

136 liftPQ m

137 return result

138

139-- | A snapshot of the state of a `PoolPQ` computation.

140−type PoolPQRun db =

140+type PoolPQRun schemas =

141− forall m x. Monad m => PoolPQ db m x -> m x

141+ forall m x. Monad m => PoolPQ schemas m x -> m x

142

143-- | Helper function in defining `MonadBaseControl` instance for `PoolPQ`.

144−poolpqliftWith :: Functor m => (PoolPQRun db -> m a) -> PoolPQ db m a

144+poolpqliftWith :: Functor m => (PoolPQRun schemas -> m a) -> PoolPQ schemas m a

145poolpqliftWith f = PoolPQ $ \ pool ->

146 (f $ \ pq -> runPoolPQ pq pool)

147

148-- | `MonadBaseControl` instance for `PoolPQ`.

149−instance MonadBaseControl b m => MonadBaseControl b (PoolPQ db m) where

149+instance MonadBaseControl b m => MonadBaseControl b (PoolPQ schemas m) where

150− type StM (PoolPQ db m) x = StM m x

150+ type StM (PoolPQ schemas m) x = StM m x

151 liftBaseWith f =

152 poolpqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run

153 restoreM = PoolPQ . const . restoreM

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+54−48

@@ -757,9 +757,9 @@ jsonbObjectKeys = unsafeSetOfFunction "jsonb_object_keys"

757

758unsafePopulateFunction

759 :: ByteString

760− -> TypeExpression db (nullity ('PGcomposite row))

760+ -> TypeExpression schemas (nullity ('PGcomposite row))

761− -> Expression db '[] 'Ungrouped params ty

761+ -> Expression (commons :=> schemas) '[] 'Ungrouped params ty

762− -> Query db params row

762+ -> Query (commons :=> schemas) params row

763unsafePopulateFunction fun ty expr = UnsafeQuery $

764 "SELECT * FROM " <> fun <> "("

765 <> "null::" <> renderTypeExpression ty <> ", "

@@ -768,42 +768,42 @@ unsafePopulateFunction fun ty expr = UnsafeQuery $

768-- | Expands the JSON expression to a row whose columns match the record

769-- type defined by the given table.

770jsonPopulateRecord

771− :: TypeExpression db (nullity ('PGcomposite row)) -- ^ row type

771+ :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type

772− -> Expression db '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

772+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

773− -> Query db params row

773+ -> Query (commons :=> schemas) params row

774jsonPopulateRecord = unsafePopulateFunction "json_populate_record"

775

776-- | Expands the binary JSON expression to a row whose columns match the record

777-- type defined by the given table.

778jsonbPopulateRecord

779− :: TypeExpression db (nullity ('PGcomposite row)) -- ^ row type

779+ :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type

780− -> Expression db '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

780+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

781− -> Query db params row

781+ -> Query (commons :=> schemas) params row

782jsonbPopulateRecord = unsafePopulateFunction "jsonb_populate_record"

783

784-- | Expands the outermost array of objects in the given JSON expression to a

785-- set of rows whose columns match the record type defined by the given table.

786jsonPopulateRecordSet

787− :: TypeExpression db (nullity ('PGcomposite row)) -- ^ row type

787+ :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type

788− -> Expression db '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array

788+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array

789− -> Query db params row

789+ -> Query (commons :=> schemas) params row

790jsonPopulateRecordSet = unsafePopulateFunction "json_populate_record_set"

791

792-- | Expands the outermost array of objects in the given binary JSON expression

793-- to a set of rows whose columns match the record type defined by the given

794-- table.

795jsonbPopulateRecordSet

796− :: TypeExpression db (nullity ('PGcomposite row)) -- ^ row type

796+ :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type

797− -> Expression db '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array

797+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array

798− -> Query db params row

798+ -> Query (commons :=> schemas) params row

799jsonbPopulateRecordSet = unsafePopulateFunction "jsonb_populate_record_set"

800

801unsafeRecordFunction

802 :: (SListI record, json `In` PGJsonType)

803 => ByteString

804− -> Expression db '[] 'Ungrouped params (nullity json)

804+ -> Expression (commons :=> schemas) '[] 'Ungrouped params (nullity json)

805− -> NP (Aliased (TypeExpression db)) record

805+ -> NP (Aliased (TypeExpression schemas)) record

806− -> Query db params record

806+ -> Query (commons :=> schemas) params record

807unsafeRecordFunction fun expr types = UnsafeQuery $

808 "SELECT * FROM " <> fun <> "("

809 <> renderExpression expr <> ")"

@@ -816,33 +816,33 @@ unsafeRecordFunction fun expr types = UnsafeQuery $

816-- | Builds an arbitrary record from a JSON object.

817jsonToRecord

818 :: SListI record

819− => Expression db '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

819+ => Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjson) -- ^ json object

820− -> NP (Aliased (TypeExpression db)) record -- ^ record types

820+ -> NP (Aliased (TypeExpression schemas)) record -- ^ record types

821− -> Query db params record

821+ -> Query (commons :=> schemas) params record

822jsonToRecord = unsafeRecordFunction "json_to_record"

823

824-- | Builds an arbitrary record from a binary JSON object.

825jsonbToRecord

826 :: SListI record

827− => Expression db '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

827+ => Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb object

828− -> NP (Aliased (TypeExpression db)) record -- ^ record types

828+ -> NP (Aliased (TypeExpression schemas)) record -- ^ record types

829− -> Query db params record

829+ -> Query (commons :=> schemas) params record

830jsonbToRecord = unsafeRecordFunction "jsonb_to_record"

831

832-- | Builds an arbitrary set of records from a JSON array of objects.

833jsonToRecordSet

834 :: SListI record

835− => Expression db '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array

835+ => Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjson) -- ^ json array

836− -> NP (Aliased (TypeExpression db)) record -- ^ record types

836+ -> NP (Aliased (TypeExpression schemas)) record -- ^ record types

837− -> Query db params record

837+ -> Query (commons :=> schemas) params record

838jsonToRecordSet = unsafeRecordFunction "json_to_record_set"

839

840-- | Builds an arbitrary set of records from a binary JSON array of objects.

841jsonbToRecordSet

842 :: SListI record

843− => Expression db '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array

843+ => Expression (commons :=> schemas) '[] 'Ungrouped params (nullity 'PGjsonb) -- ^ jsonb array

844− -> NP (Aliased (TypeExpression db)) record -- ^ record types

844+ -> NP (Aliased (TypeExpression schemas)) record -- ^ record types

845− -> Query db params record

845+ -> Query (commons :=> schemas) params record

846jsonbToRecordSet = unsafeRecordFunction "jsonb_to_record_set"

847

848{-----------------------------------------

@@ -859,9 +859,9 @@ newtype FromClause db params from

859

860-- | A real `table` is a table from the database.

861table

862− :: (Has sch db schema, Has tab schema ('Table table))

862+ :: (Has sch schemas schema, Has tab schema ('Table table))

863 => Aliased (QualifiedAlias sch) (alias ::: tab)

864− -> FromClause db params '[alias ::: TableToRow table]

864+ -> FromClause (commons :=> schemas) params '[alias ::: TableToRow table]

865table (tab `As` alias) = UnsafeFromClause $

866 renderQualifiedAlias tab <+> "AS" <+> renderAlias alias

867

@@ -873,9 +873,9 @@ subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery)

873

874-- | `view` derives a table from a `View`.

875view

876− :: (Has sch db schema, Has vw schema ('View view))

876+ :: (Has sch schemas schema, Has vw schema ('View view))

877 => Aliased (QualifiedAlias sch) (alias ::: vw)

878− -> FromClause db params '[alias ::: view]

878+ -> FromClause (commons :=> schemas) params '[alias ::: view]

879view (vw `As` alias) = UnsafeFromClause $

880 renderQualifiedAlias vw <+> "AS" <+> renderAlias alias

881

@@ -1365,18 +1365,25 @@ data CommonTableExpression statement

1365 (db0 :: DBType)

1366 (db1 :: DBType) where

1367 CommonTableExpression

1368− :: ( Has "public" db schema

1369− , Alter "public" (alias ::: 'View cte ': schema) db ~ db1 )

1370− => Aliased (statement db params) (alias ::: cte)

1368+ :: Aliased (statement (commons :=> schemas) params) (cte ::: common)

1371− -> CommonTableExpression statement params db db1

1369+ -> CommonTableExpression statement params

1370+ (commons :=> schemas) ((cte ::: common ': commons) :=> schemas)

1372−-- instance

1371+instance

1373−-- ( KnownSymbol vw

1372+ ( KnownSymbol cte

1374−-- , Has "public" db schema

1373+ , db0 ~ (commons :=> schemas)

1375−-- , Alter "public" (vw ::: 'View cte ': schema) db ~ db1

1374+ , db1 ~ ((cte ::: common ': commons) :=> schemas)

1375+ ) => Aliasable cte

1376+ (statement db0 params common)

1377+ (CommonTableExpression statement params db0 db1) where

1378+ statement `as` cte = CommonTableExpression (statement `as` cte)

1379+instance

1380+ ( KnownSymbol cte

1381+ , db0 ~ (commons :=> schemas)

1382+ , db1 ~ ((cte ::: common ': commons) :=> schemas)

1376−-- ) => Aliasable vw

1383+ ) => Aliasable cte

1377−-- (statement db params cte)

1384+ (statement db0 params common)

1378−-- (CommonTableExpression statement params db db1) where

1385+ (AlignedList (CommonTableExpression statement params) db0 db1) where

1379−-- statement `as` vw = CommonTableExpression (statement `as` vw)

1386+ statement `as` cte = single (statement `as` cte)

1380-- instance

1387-- instance

1381-- ( KnownSymbol vw

1388-- ( KnownSymbol vw

1382-- , Has "public" db schema

1389-- , Has "public" db schema

@@ -1410,8 +1417,7 @@ renderCommonTableExpressions renderStatement cte ctes =

1410-- defining temporary tables that exist just for one query.

1417-- defining temporary tables that exist just for one query.

1411class With statement where

1418class With statement where

1412 with

1419 with

1413− :: Has "public" db0 schema0

1414− => AlignedList (CommonTableExpression statement params) db0 db1

1420+ :: AlignedList (CommonTableExpression statement params) db0 db1

1415 -- ^ common table expressions

1421 -- ^ common table expressions

1416 -> statement db1 params row

1422 -> statement db1 params row

1417 -- ^ larger query

1423 -- ^ larger query

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+4−1

@@ -54,6 +54,7 @@ module Squeal.PostgreSQL.Schema

54 , TableType

55 , SchemumType (..)

56 , SchemaType

57+ , SchemasType

57 , DBType

58 , DBType

58 -- * Constraints

59 -- * Constraints

59 , (:=>)

60 , (:=>)

@@ -683,7 +684,9 @@ type family Schema :: SchemaType where

683-}

684-}

684type SchemaType = [(Symbol,SchemumType)]

685type SchemaType = [(Symbol,SchemumType)]

685

686

686−type DBType = [(Symbol,SchemaType)]

687+type SchemasType = [(Symbol,SchemaType)]

688+

689+type DBType = (FromType,SchemasType)

687

690

688-- | `IsPGlabel` looks very much like the `IsLabel` class. Whereas

691-- | `IsPGlabel` looks very much like the `IsLabel` class. Whereas

689-- the overloaded label, `fromLabel` is used for column references,

692-- the overloaded label, `fromLabel` is used for column references,

squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+9−9

@@ -52,7 +52,7 @@ import Squeal.PostgreSQL.Schema

53-- | Run a schema invariant computation `transactionally`.

54transactionally

55− :: (MonadBaseControl IO tx, MonadPQ db tx)

55+ :: (MonadBaseControl IO tx, MonadPQ schemas tx)

56 => TransactionMode

57 -> tx x -- ^ run inside a transaction

58 -> tx x

@@ -64,30 +64,30 @@ transactionally mode tx = mask $ \restore -> do

65-- | Run a schema invariant computation `transactionally_` in `defaultMode`.

66transactionally_

67− :: (MonadBaseControl IO tx, MonadPQ db tx)

67+ :: (MonadBaseControl IO tx, MonadPQ schemas tx)

68 => tx x -- ^ run inside a transaction

69 -> tx x

70transactionally_ = transactionally defaultMode

72-- | @BEGIN@ a transaction.

73−begin :: MonadPQ db tx => TransactionMode -> tx (K Result ('[] :: RowType))

73+begin :: MonadPQ schemas tx => TransactionMode -> tx (K Result ('[] :: RowType))

74begin mode = manipulate . UnsafeManipulation $

75 "BEGIN" <+> renderTransactionMode mode <> ";"

77-- | @COMMIT@ a schema invariant transaction.

78−commit :: MonadPQ db tx => tx (K Result ('[] :: RowType))

78+commit :: MonadPQ schemas tx => tx (K Result ('[] :: RowType))

79commit = manipulate $ UnsafeManipulation "COMMIT;"

81-- | @ROLLBACK@ a schema invariant transaction.

82−rollback :: MonadPQ db tx => tx (K Result ('[] :: RowType))

82+rollback :: MonadPQ schemas tx => tx (K Result ('[] :: RowType))

83rollback = manipulate $ UnsafeManipulation "ROLLBACK;"

85-- | Run a schema changing computation `transactionallySchema`.

86transactionallySchema

87 :: MonadBaseControl IO io

88 => TransactionMode

89− -> PQ db0 db1 io x

89+ -> PQ schemas0 schemas1 io x

90− -> PQ db0 db1 io x

90+ -> PQ schemas0 schemas1 io x

91transactionallySchema mode u = PQ $ \ conn -> mask $ \ restore -> do

92 _ <- liftBase . LibPQ.exec (unK conn) $

93 "BEGIN" <+> renderTransactionMode mode <> ";"

@@ -99,8 +99,8 @@ transactionallySchema mode u = PQ $ \ conn -> mask $ \ restore -> do

99-- | Run a schema changing computation `transactionallySchema_` in `DefaultMode`.

100transactionallySchema_

101 :: MonadBaseControl IO io

102− => PQ db0 db1 io x

102+ => PQ schemas0 schemas1 io x

103− -> PQ db0 db1 io x

103+ -> PQ schemas0 schemas1 io x

104transactionallySchema_ = transactionallySchema defaultMode

105

106-- | The available transaction characteristics are the transaction `IsolationLevel`,