diff --git a/exe/Example.hs b/exe/Example.hs --- a/exe/Example.hs +++ b/exe/Example.hs @@ -44,18 +44,18 @@ setup :: Definition '[] Schema setup = createTable #users - ( serial `As` #id :* - (text & notNullable) `As` #name :* - (vararray int2 & notNullable) `As` #vec :* Nil ) - ( primaryKey #id `As` #pk_users :* Nil ) + ( serial `as` #id :* + (text & notNullable) `as` #name :* + (vararray int2 & notNullable) `as` #vec ) + ( primaryKey #id `as` #pk_users ) >>> createTable #emails - ( serial `As` #id :* - (int & notNullable) `As` #user_id :* - (text & nullable) `As` #email :* Nil ) - ( primaryKey #id `As` #pk_emails :* + ( serial `as` #id :* + (int & notNullable) `as` #user_id :* + (text & nullable) `as` #email ) + ( primaryKey #id `as` #pk_emails :* foreignKey #user_id #users #id - OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil ) + OnDeleteCascade OnUpdateCascade `as` #fk_user_id ) teardown :: Definition Schema '[] teardown = dropTable #emails >>> dropTable #users @@ -63,14 +63,14 @@ insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray 'PGint2)] '[ "fromOnly" ::: 'NotNull 'PGint4 ] insertUser = insertRows #users - (Default `As` #id :* Set (param @1) `As` #name :* Set (param @2) `As` #vec :* Nil) [] - OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil)) + (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) [] + OnConflictDoNothing (Returning (#id `as` #fromOnly)) insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[] insertEmail = insertRows #emails - ( Default `As` #id :* - Set (param @1) `As` #user_id :* - Set (param @2) `As` #email :* Nil ) [] + ( Default `as` #id :* + Set (param @1) `as` #user_id :* + Set (param @2) `as` #email ) [] OnConflictDoNothing (Returning Nil) getUsers :: Query Schema '[] @@ -78,9 +78,9 @@ , "userEmail" ::: 'Null 'PGtext , "userVec" ::: 'NotNull ('PGvararray 'PGint2)] getUsers = select - (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* #u ! #vec `As` #userVec :* Nil) - ( from (table (#users `As` #u) - & innerJoin (table (#emails `As` #e)) + (#u ! #name `as` #userName :* #e ! #email `as` #userEmail :* #u ! #vec `as` #userVec) + ( from (table (#users `as` #u) + & innerJoin (table (#emails `as` #e)) (#u ! #id .== #e ! #user_id)) ) data User = User { userName :: Text, userEmail :: Maybe Text, userVec :: Vector (Maybe Int16) } diff --git a/squeal-postgresql.cabal b/squeal-postgresql.cabal --- a/squeal-postgresql.cabal +++ b/squeal-postgresql.cabal @@ -1,5 +1,5 @@ name: squeal-postgresql -version: 0.3.0.0 +version: 0.3.1.0 synopsis: Squeal PostgreSQL Library description: Squeal is a type-safe embedding of PostgreSQL in Haskell homepage: https://github.com/morphismtech/squeal @@ -50,6 +50,7 @@ , network-ip >= 0.3.0.2 , postgresql-binary >= 0.12.1 , postgresql-libpq >= 0.9.4.1 + , profunctors >= 5.2.2 , resource-pool >= 0.2.3.2 , scientific >= 0.3.5.3 , text >= 1.2.3.0 diff --git a/src/Squeal/PostgreSQL.hs b/src/Squeal/PostgreSQL.hs --- a/src/Squeal/PostgreSQL.hs +++ b/src/Squeal/PostgreSQL.hs @@ -71,16 +71,16 @@ setup :: Definition '[] Schema setup = createTable #users - ( serial `As` #id :* - (text & notNullable) `As` #name :* Nil ) - ( primaryKey #id `As` #pk_users :* Nil ) >>> + ( serial `as` #id :* + (text & notNullable) `as` #name ) + ( primaryKey #id `as` #pk_users ) >>> createTable #emails - ( serial `As` #id :* - (int & notNullable) `As` #user_id :* - (text & nullable) `As` #email :* Nil ) - ( primaryKey #id `As` #pk_emails :* + ( serial `as` #id :* + (int & notNullable) `as` #user_id :* + (text & nullable) `as` #email ) + ( primaryKey #id `as` #pk_emails :* foreignKey #user_id #users #id - OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil ) + OnDeleteCascade OnUpdateCascade `as` #fk_user_id ) :} We can easily see the generated SQL is unsurprising looking. @@ -119,17 +119,17 @@ let insertUser :: Manipulation Schema '[ 'NotNull 'PGtext ] '[ "fromOnly" ::: 'NotNull 'PGint4 ] insertUser = insertRow #users - (Default `As` #id :* Set (param @1) `As` #name :* Nil) - OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil)) + (Default `as` #id :* Set (param @1) `as` #name) + OnConflictDoNothing (Returning (#id `as` #fromOnly)) :} >>> :{ let insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[] insertEmail = insertRow #emails - ( Default `As` #id :* - Set (param @1) `As` #user_id :* - Set (param @2) `As` #email :* Nil ) + ( Default `as` #id :* + Set (param @1) `as` #user_id :* + Set (param @2) `as` #email ) OnConflictDoNothing (Returning Nil) :} @@ -149,9 +149,9 @@ '[ "userName" ::: 'NotNull 'PGtext , "userEmail" ::: 'Null 'PGtext ] getUsers = select - (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil) - ( from (table (#users `As` #u) - & innerJoin (table (#emails `As` #e)) + (#u ! #name `as` #userName :* #e ! #email `as` #userEmail) + ( from (table (#users `as` #u) + & innerJoin (table (#emails `as` #e)) (#u ! #id .== #e ! #user_id)) ) :} diff --git a/src/Squeal/PostgreSQL/Binary.hs b/src/Squeal/PostgreSQL/Binary.hs --- a/src/Squeal/PostgreSQL/Binary.hs +++ b/src/Squeal/PostgreSQL/Binary.hs @@ -27,7 +27,7 @@ query :: Query '[] '[ 'NotNull 'PGint2, 'NotNull 'PGtext] '["col1" ::: 'NotNull 'PGint2, "col2" ::: 'NotNull 'PGtext] - query = values_ (param @1 `As` #col1 :* param @2 `As` #col2 :* Nil) + query = values_ (param @1 `as` #col1 :* param @2 `as` #col2) :} >>> :{ @@ -88,7 +88,7 @@ querySchwarma :: Query Schema '[ 'NotNull (EnumFrom Schwarma)] '["fromOnly" ::: 'NotNull (EnumFrom Schwarma)] - querySchwarma = values_ (parameter @1 #schwarma `As` #fromOnly :* Nil) + querySchwarma = values_ (parameter @1 #schwarma `as` #fromOnly) :} >>> :{ @@ -96,7 +96,7 @@ queryPerson :: Query Schema '[ 'NotNull (CompositeFrom Person)] '["fromOnly" ::: 'NotNull (CompositeFrom Person)] - queryPerson = values_ (parameter @1 #person `As` #fromOnly :* Nil) + queryPerson = values_ (parameter @1 #person `as` #fromOnly) :} And finally drop the types. diff --git a/src/Squeal/PostgreSQL/Definition.hs b/src/Squeal/PostgreSQL/Definition.hs --- a/src/Squeal/PostgreSQL/Definition.hs +++ b/src/Squeal/PostgreSQL/Definition.hs @@ -129,9 +129,18 @@ >>> :set -XOverloadedLabels >>> :{ -printSQL $ - createTable #tab ((int & nullable) `As` #a :* (real & nullable) `As` #b :* Nil) Nil +type Table = '[] :=> + '[ "a" ::: 'NoDef :=> 'Null 'PGint4 + , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ] :} + +>>> :{ +let + setup :: Definition '[] '["tab" ::: 'Table Table] + setup = createTable #tab + (nullable int `as` #a :* nullable real `as` #b) Nil +in printSQL setup +:} CREATE TABLE "tab" ("a" int NULL, "b" real NULL); -} createTable @@ -155,12 +164,19 @@ the `Category` of `Definition`s. >>> :set -XOverloadedLabels -XTypeApplications ->>> type Table = '[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGfloat4] +>>> :{ +type Table = '[] :=> + '[ "a" ::: 'NoDef :=> 'Null 'PGint4 + , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ] +:} + >>> type Schema = '["tab" ::: 'Table Table] + >>> :{ let setup :: Definition Schema Schema - setup = createTableIfNotExists #tab ((int & nullable) `As` #a :* (real & nullable) `As` #b :* Nil) Nil + setup = createTableIfNotExists #tab + (nullable int `as` #a :* nullable real `as` #b) Nil in printSQL setup :} CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL); @@ -244,9 +260,9 @@ let definition :: Definition '[] Schema definition = createTable #tab - ( (int & notNullable) `As` #a :* - (int & notNullable) `As` #b :* Nil ) - ( check (#a :* #b :* Nil) (#a .> #b) `As` #inequality :* Nil ) + ( (int & notNullable) `as` #a :* + (int & notNullable) `as` #b ) + ( check (#a :* #b) (#a .> #b) `as` #inequality ) :} >>> printSQL definition @@ -278,9 +294,9 @@ let definition :: Definition '[] Schema definition = createTable #tab - ( (int & nullable) `As` #a :* - (int & nullable) `As` #b :* Nil ) - ( unique (#a :* #b :* Nil) `As` #uq_a_b :* Nil ) + ( (int & nullable) `as` #a :* + (int & nullable) `as` #b ) + ( unique (#a :* #b) `as` #uq_a_b ) :} >>> printSQL definition @@ -311,9 +327,9 @@ let definition :: Definition '[] Schema definition = createTable #tab - ( serial `As` #id :* - (text & notNullable) `As` #name :* Nil ) - ( primaryKey #id `As` #pk_id :* Nil ) + ( serial `as` #id :* + (text & notNullable) `as` #name ) + ( primaryKey #id `as` #pk_id ) :} >>> printSQL definition @@ -357,16 +373,16 @@ setup :: Definition '[] Schema setup = createTable #users - ( serial `As` #id :* - (text & notNullable) `As` #name :* Nil ) - ( primaryKey #id `As` #pk_users :* Nil ) >>> + ( serial `as` #id :* + (text & notNullable) `as` #name ) + ( primaryKey #id `as` #pk_users ) >>> createTable #emails - ( serial `As` #id :* - (int & notNullable) `As` #user_id :* - (text & nullable) `As` #email :* Nil ) - ( primaryKey #id `As` #pk_emails :* + ( serial `as` #id :* + (int & notNullable) `as` #user_id :* + (text & nullable) `as` #email ) + ( primaryKey #id `as` #pk_emails :* foreignKey #user_id #users #id - OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil ) + OnDeleteCascade OnUpdateCascade `as` #fk_user_id ) in printSQL setup :} CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id")); @@ -392,12 +408,12 @@ setup :: Definition '[] Schema setup = createTable #employees - ( serial `As` #id :* - (text & notNullable) `As` #name :* - (integer & nullable) `As` #employer_id :* Nil ) - ( primaryKey #id `As` #employees_pk :* + ( serial `as` #id :* + (text & notNullable) `as` #name :* + (integer & nullable) `as` #employer_id ) + ( primaryKey #id `as` #employees_pk :* foreignKey #employer_id #employees #id - OnDeleteCascade OnUpdateCascade `As` #employees_employer_fk :* Nil ) + OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk ) in printSQL setup :} CREATE 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); @@ -546,7 +562,7 @@ -- definition :: Definition -- '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])] -- '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])] --- definition = alterTable #tab (addConstraint #positive (check (#col :* Nil) (#col .> 0))) +-- definition = alterTable #tab (addConstraint #positive (check #col (#col .> 0))) -- in printSQL definition -- :} -- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0)); @@ -784,7 +800,7 @@ -- '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4]) -- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])] -- definition = --- createView #bc (select (#b :* #c :* Nil) (from (table #abc))) +-- createView #bc (select (#b :* #c) (from (table #abc))) -- in printSQL definition -- :} -- CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc"; @@ -818,7 +834,7 @@ -- | Enumerated types are created using the `createTypeEnum` command, for example -- --- >>> printSQL $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy" :* Nil) +-- >>> printSQL $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") -- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy'); createTypeEnum :: (KnownSymbol enum, SOP.All KnownSymbol labels) @@ -850,11 +866,20 @@ createTypeEnumFrom enum = createTypeEnum enum (SOP.hpure label :: NP PGlabel (LabelsFrom hask)) --- | `createTypeComposite` creates a composite type. The composite type is --- specified by a list of attribute names and data types. --- --- >>> printSQL $ createTypeComposite #complex (float8 `As` #real :* float8 `As` #imaginary :* Nil) --- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8); +{- | `createTypeComposite` creates a composite type. The composite type is +specified by a list of attribute names and data types. + +>>> type PGcomplex = 'PGcomposite '["real" ::: 'PGfloat8, "imaginary" ::: 'PGfloat8] + +>>> :{ +let + setup :: Definition '[] '["complex" ::: 'Typedef PGcomplex] + setup = createTypeComposite #complex + (float8 `as` #real :* float8 `as` #imaginary) +in printSQL setup +:} +CREATE TYPE "complex" AS ("real" float8, "imaginary" float8); +-} createTypeComposite :: (KnownSymbol ty, SOP.SListI fields) => Alias ty diff --git a/src/Squeal/PostgreSQL/Expression.hs b/src/Squeal/PostgreSQL/Expression.hs --- a/src/Squeal/PostgreSQL/Expression.hs +++ b/src/Squeal/PostgreSQL/Expression.hs @@ -396,7 +396,7 @@ -- (also called a composite value) using values for its member fields. -- -- >>> type Complex = PGcomposite '["real" ::: 'PGfloat8, "imaginary" ::: 'PGfloat8] --- >>> let i = row (0 `As` #real :* 1 `As` #imaginary :* Nil) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex) +-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression '[] '[] 'Ungrouped '[] ('NotNull Complex) -- >>> printSQL i -- ROW(0, 1) row diff --git a/src/Squeal/PostgreSQL/Manipulation.hs b/src/Squeal/PostgreSQL/Manipulation.hs --- a/src/Squeal/PostgreSQL/Manipulation.hs +++ b/src/Squeal/PostgreSQL/Manipulation.hs @@ -72,7 +72,7 @@ '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[] '[] manipulation = - insertRow_ #tab (Set 2 `As` #col1 :* Default `As` #col2 :* Nil) + insertRow_ #tab (Set 2 `as` #col1 :* Default `as` #col2) in printSQL manipulation :} INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT) @@ -88,7 +88,7 @@ '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[] manipulation = insertRow_ #tab - (Set (param @1) `As` #col1 :* Set (param @2) `As` #col2 :* Nil) + (Set (param @1) `as` #col1 :* Set (param @2) `as` #col2) in printSQL manipulation :} INSERT INTO "tab" ("col1", "col2") VALUES (($1 :: int4), ($2 :: int4)) @@ -103,8 +103,8 @@ , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[] '["fromOnly" ::: 'NotNull 'PGint4] manipulation = - insertRow #tab (Set 2 `As` #col1 :* Default `As` #col2 :* Nil) - OnConflictDoRaise (Returning (#col1 `As` #fromOnly :* Nil)) + insertRow #tab (Set 2 `as` #col1 :* Default `as` #col2) + OnConflictDoRaise (Returning (#col1 `as` #fromOnly)) in printSQL manipulation :} INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT) RETURNING "col1" AS "fromOnly" @@ -120,12 +120,12 @@ '[] '[ "sum" ::: 'NotNull 'PGint4] manipulation = insertRows #tab - (Set 2 `As` #col1 :* Set 4 `As` #col2 :* Nil) - [Set 6 `As` #col1 :* Set 8 `As` #col2 :* Nil] + (Set 2 `as` #col1 :* Set 4 `as` #col2) + [Set 6 `as` #col1 :* Set 8 `as` #col2] (OnConflictDoUpdate - (Set 2 `As` #col1 :* Same `As` #col2 :* Nil) + (Set 2 `as` #col1 :* Same `as` #col2) [#col1 .== #col2]) - (Returning $ (#col1 + #col2) `As` #sum :* Nil) + (Returning $ (#col1 + #col2) `as` #sum) in printSQL manipulation :} INSERT INTO "tab" ("col1", "col2") VALUES (2, 4), (6, 8) ON CONFLICT DO UPDATE SET "col1" = 2 WHERE ("col1" = "col2") RETURNING ("col1" + "col2") AS "sum" @@ -146,7 +146,7 @@ ] '[] '[] manipulation = insertQuery_ #tab - (selectStar (from (table (#other_tab `As` #t)))) + (selectStar (from (table (#other_tab `as` #t)))) in printSQL manipulation :} INSERT INTO "tab" SELECT * FROM "other_tab" AS "t" @@ -160,7 +160,7 @@ '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[] '[] manipulation = - update_ #tab (Set 2 `As` #col1 :* Same `As` #col2 :* Nil) + update_ #tab (Set 2 `as` #col1 :* Same `as` #col2) (#col1 ./= #col2) in printSQL manipulation :} @@ -484,16 +484,16 @@ -- let -- manipulation :: Manipulation '["products" ::: 'Table ProductsTable, "products_deleted" ::: 'Table ProductsTable] '[ 'NotNull 'PGdate] '[] -- manipulation = with --- (deleteFrom #products (#date .< param @1) ReturningStar `As` #deleted_rows :* Nil) --- (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `As` #t))))) +-- (deleteFrom #products (#date .< param @1) ReturningStar `as` #deleted_rows) +-- (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `as` #t))))) -- in printSQL manipulation -- :} -- WITH "deleted_rows" AS (DELETE FROM "products" WHERE ("date" < ($1 :: date)) RETURNING *) INSERT INTO "products_deleted" SELECT * FROM "deleted_rows" AS "t" with :: SOP.SListI commons - => NP (Aliased (Manipulation schema params)) commons + => NP (Aliased (Manipulation schema params)) (common ': commons) -- ^ common table expressions - -> Manipulation (With commons schema) params results + -> Manipulation (With (common ': commons) schema) params results -> Manipulation schema params results with commons manipulation = UnsafeManipulation $ "WITH" <+> renderCommaSeparated renderCommon commons diff --git a/src/Squeal/PostgreSQL/Migration.hs b/src/Squeal/PostgreSQL/Migration.hs --- a/src/Squeal/PostgreSQL/Migration.hs +++ b/src/Squeal/PostgreSQL/Migration.hs @@ -36,9 +36,9 @@ { name = "make users table" , up = void . define $ createTable #users - ( serial `As` #id :* - (text & notNullable) `As` #name :* Nil ) - ( primaryKey #id `As` #pk_users :* Nil ) + ( serial `as` #id :* + (text & notNullable) `as` #name ) + ( primaryKey #id `as` #pk_users ) , down = void . define $ dropTable #users } :} @@ -51,12 +51,12 @@ { name = "make emails table" , up = void . define $ createTable #emails - ( serial `As` #id :* - (int & notNullable) `As` #user_id :* - (text & nullable) `As` #email :* Nil ) - ( primaryKey #id `As` #pk_emails :* + ( serial `as` #id :* + (int & notNullable) `as` #user_id :* + (text & nullable) `as` #email ) + ( primaryKey #id `as` #pk_emails :* foreignKey #user_id #users #id - OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil ) + OnDeleteCascade OnUpdateCascade `as` #fk_user_id ) , down = void . define $ dropTable #emails } :} @@ -71,7 +71,7 @@ :: Has "schema_migrations" schema ('Table MigrationsTable) => PQ schema schema IO () numMigrations = do - result <- runQuery (selectStar (from (table (#schema_migrations `As` #m)))) + result <- runQuery (selectStar (from (table (#schema_migrations `as` #m)))) num <- ntuples result liftBase $ print num :} @@ -285,18 +285,18 @@ => Definition schema schema createMigrations = createTableIfNotExists #schema_migrations - ( (text & notNullable) `As` #name :* + ( (text & notNullable) `as` #name :* (timestampWithTimeZone & notNullable & default_ currentTimestamp) - `As` #executed_at :* Nil ) - ( unique (#name :* Nil) `As` #migrations_unique_name :* Nil ) + `as` #executed_at ) + ( unique #name `as` #migrations_unique_name ) -- | Inserts a `Migration` into the `MigrationsTable` insertMigration :: Has "schema_migrations" schema ('Table MigrationsTable) => Manipulation schema '[ 'NotNull 'PGtext] '[] insertMigration = insertRow_ #schema_migrations - ( Set (param @1) `As` #name :* - Default `As` #executed_at :* Nil ) + ( Set (param @1) `as` #name :* + Default `as` #executed_at ) -- | Deletes a `Migration` from the `MigrationsTable` deleteMigration @@ -311,6 +311,6 @@ => Query schema '[ 'NotNull 'PGtext ] '[ "executed_at" ::: 'NotNull 'PGtimestamptz ] selectMigration = select - (#executed_at `As` #executed_at :* Nil) - ( from (table (#schema_migrations `As` #m)) + (#executed_at `as` #executed_at) + ( from (table (#schema_migrations `as` #m)) & where_ (#name .== param @1)) diff --git a/src/Squeal/PostgreSQL/Query.hs b/src/Squeal/PostgreSQL/Query.hs --- a/src/Squeal/PostgreSQL/Query.hs +++ b/src/Squeal/PostgreSQL/Query.hs @@ -11,13 +11,17 @@ {-# LANGUAGE DeriveGeneric , FlexibleContexts + , FlexibleInstances , GADTs , GeneralizedNewtypeDeriving , LambdaCase + , MultiParamTypeClasses , OverloadedStrings , StandaloneDeriving + , TypeFamilies , TypeInType , TypeOperators + , UndecidableInstances #-} module Squeal.PostgreSQL.Query @@ -43,7 +47,7 @@ , renderTableExpression , from , where_ - , group + , groupBy , having , orderBy , limit @@ -59,7 +63,7 @@ , rightOuterJoin , fullOuterJoin -- * Grouping - , By (By, By2) + , By (By1, By2) , renderBy , GroupByClause (NoGroups, Group) , renderGroupByClause @@ -116,7 +120,7 @@ , "col1" ::: 'NotNull 'PGint4 ] query = select - ((#col1 + #col2) `As` #sum :* #col1 :* Nil) + ((#col1 + #col2) `as` #sum :* #col1) ( from (table #tab) & where_ (#col1 .> #col2) & where_ (#col2 .> 0) ) @@ -134,7 +138,7 @@ '["col" ::: 'Null 'PGint4] query = selectStar - (from (subquery (selectStar (from (table #tab)) `As` #sub))) + (from (subquery (selectStar (from (table #tab)) `as` #sub))) in printSQL query :} SELECT * FROM (SELECT * FROM "tab" AS "tab") AS "sub" @@ -179,9 +183,9 @@ '[ "sum" ::: 'NotNull 'PGint4 , "col1" ::: 'NotNull 'PGint4 ] query = - select (sum_ #col2 `As` #sum :* #col1 :* Nil) - ( from (table (#tab `As` #table1)) - & group (By #col1 :* Nil) + select (sum_ #col2 `as` #sum :* #col1) + ( from (table (#tab `as` #table1)) + & groupBy #col1 & having (#col1 + sum_ #col2 .> 1) ) in printSQL query :} @@ -233,13 +237,13 @@ , "shipper_name" ::: 'NotNull 'PGtext ] query = select - ( #o ! #price `As` #order_price :* - #c ! #name `As` #customer_name :* - #s ! #name `As` #shipper_name :* Nil ) - ( from (table (#orders `As` #o) - & innerJoin (table (#customers `As` #c)) + ( #o ! #price `as` #order_price :* + #c ! #name `as` #customer_name :* + #s ! #name `as` #shipper_name ) + ( from (table (#orders `as` #o) + & innerJoin (table (#customers `as` #c)) (#o ! #customer_id .== #c ! #id) - & innerJoin (table (#shippers `As` #s)) + & innerJoin (table (#shippers `as` #s)) (#o ! #shipper_id .== #s ! #id)) ) in printSQL query :} @@ -254,7 +258,7 @@ '[] '["col" ::: 'Null 'PGint4] query = selectDotStar #t1 - (from (table (#tab `As` #t1) & crossJoin (table (#tab `As` #t2)))) + (from (table (#tab `as` #t1) & crossJoin (table (#tab `as` #t2)))) in printSQL query :} SELECT "t1".* FROM "tab" AS "t1" CROSS JOIN "tab" AS "t2" @@ -434,7 +438,7 @@ -- but it can be used on its own. -- -- >>> type Row = '["a" ::: 'NotNull 'PGint4, "b" ::: 'NotNull 'PGtext] --- >>> let query = values (1 `As` #a :* "one" `As` #b :* Nil) [] :: Query '[] '[] Row +-- >>> let query = values (1 `as` #a :* "one" `as` #b) [] :: Query '[] '[] Row -- >>> printSQL query -- SELECT * FROM (VALUES (1, E'one')) AS t ("a", "b") values @@ -572,15 +576,15 @@ -> TableExpression schema params relations grouping where_ wh rels = rels {whereClause = wh : whereClause rels} --- | A `group` is a transformation of `TableExpression`s which switches +-- | A `groupBy` is a transformation of `TableExpression`s which switches -- its `Grouping` from `Ungrouped` to `Grouped`. Use @group Nil@ to perform -- a "grand total" aggregation query. -group +groupBy :: SListI bys => NP (By relations) bys -- ^ grouped columns -> TableExpression schema params relations 'Ungrouped -> TableExpression schema params relations ('Grouped bys) -group bys rels = TableExpression +groupBy bys rels = TableExpression { fromClause = fromClause rels , whereClause = whereClause rels , groupByClause = Group bys @@ -754,23 +758,34 @@ data By (relations :: RelationsType) (by :: (Symbol,Symbol)) where - By + By1 :: (HasUnique relation relations columns, Has column columns ty) => Alias column -> By relations '(relation, column) By2 :: (Has relation relations columns, Has column columns ty) - => (Alias relation, Alias column) + => Alias relation + -> Alias column -> By relations '(relation, column) deriving instance Show (By relations by) deriving instance Eq (By relations by) deriving instance Ord (By relations by) +instance (HasUnique rel rels cols, Has col cols ty, by ~ '(rel, col)) + => IsLabel col (By rels by) where fromLabel = By1 fromLabel +instance (HasUnique rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)]) + => IsLabel col (NP (By rels) bys) where fromLabel = By1 fromLabel :* Nil +instance (Has rel rels cols, Has col cols ty, by ~ '(rel, col)) + => IsQualified rel col (By rels by) where (!) = By2 +instance (Has rel rels cols, Has col cols ty, bys ~ '[ '(rel, col)]) + => IsQualified rel col (NP (By rels) bys) where + rel ! col = By2 rel col :* Nil + -- | Renders a `By`. renderBy :: By relations by -> ByteString renderBy = \case - By column -> renderAlias column - By2 (rel, column) -> renderAlias rel <> "." <> renderAlias column + By1 column -> renderAlias column + By2 rel column -> renderAlias rel <> "." <> renderAlias column -- | A `GroupByClause` indicates the `Grouping` of a `TableExpression`. -- A `NoGroups` indicates `Ungrouped` while a `Group` indicates `Grouped`. diff --git a/src/Squeal/PostgreSQL/Schema.hs b/src/Squeal/PostgreSQL/Schema.hs --- a/src/Squeal/PostgreSQL/Schema.hs +++ b/src/Squeal/PostgreSQL/Schema.hs @@ -60,6 +60,7 @@ , renderAlias , renderAliases , Aliased (As) + , Aliasable (as) , renderAliasedAs , AliasesOf , ZipAliased (..) @@ -371,7 +372,7 @@ renderAlias = doubleQuoted . fromString . symbolVal -- | >>> import Generics.SOP (NP(..)) --- >>> renderAliases (#jimbob :* #kandi :* Nil) +-- >>> renderAliases (#jimbob :* #kandi) -- ["\"jimbob\"","\"kandi\""] renderAliases :: All KnownSymbol aliases => NP Alias aliases -> [ByteString] @@ -399,6 +400,23 @@ => IsLabel alias0 (Aliased Alias (alias1 ::: alias2)) where fromLabel = fromLabel @alias2 `As` fromLabel @alias1 +-- | The `Aliasable` class provides a way to scrap your `Nil`s +-- in an `NP` list of `Aliased` expressions. +class KnownSymbol alias => Aliasable alias expression aliased + | aliased -> expression + , aliased -> alias + where as :: expression -> Alias alias -> aliased +instance (alias ~ alias1, KnownSymbol alias) => Aliasable alias + (expression ty) + (Aliased expression (alias1 ::: ty)) + where + as = As +instance (KnownSymbol alias, tys ~ '[alias ::: ty]) => Aliasable alias + (expression ty) + (NP (Aliased expression) tys) + where + expression `as` alias = expression `As` alias :* Nil + -- | >>> let renderMaybe = fromString . maybe "Nothing" (const "Just") -- >>> renderAliasedAs renderMaybe (Just (3::Int) `As` #an_int) -- "Just AS \"an_int\"" @@ -667,8 +685,10 @@ -- `label`s are used for enum terms. A `label` is called with -- type application like `label @"beef"`. class IsPGlabel (label :: Symbol) expr where label :: expr -instance label ~ label' - => IsPGlabel label (PGlabel label') where label = PGlabel +instance label ~ label1 + => IsPGlabel label (PGlabel label1) where label = PGlabel +instance labels ~ '[label] + => IsPGlabel label (NP PGlabel labels) where label = PGlabel :* Nil -- | A `PGlabel` unit type with an `IsPGlabel` instance data PGlabel (label :: Symbol) = PGlabel -- | Renders a label