squeal-postgresql 0.3.0.0 → 0.3.1.0
raw patch · 10 files changed
+188/−127 lines, 10 filesdep +profunctors
Dependencies added: profunctors
Files
- exe/Example.hs +17/−17
- squeal-postgresql.cabal +2/−1
- src/Squeal/PostgreSQL.hs +16/−16
- src/Squeal/PostgreSQL/Binary.hs +3/−3
- src/Squeal/PostgreSQL/Definition.hs +59/−34
- src/Squeal/PostgreSQL/Expression.hs +1/−1
- src/Squeal/PostgreSQL/Manipulation.hs +14/−14
- src/Squeal/PostgreSQL/Migration.hs +16/−16
- src/Squeal/PostgreSQL/Query.hs +37/−22
- src/Squeal/PostgreSQL/Schema.hs +23/−3
exe/Example.hs view
@@ -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) }
squeal-postgresql.cabal view
@@ -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
src/Squeal/PostgreSQL.hs view
@@ -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)) ) :}
src/Squeal/PostgreSQL/Binary.hs view
@@ -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.
src/Squeal/PostgreSQL/Definition.hs view
@@ -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
src/Squeal/PostgreSQL/Expression.hs view
@@ -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
src/Squeal/PostgreSQL/Manipulation.hs view
@@ -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
src/Squeal/PostgreSQL/Migration.hs view
@@ -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))
src/Squeal/PostgreSQL/Query.hs view
@@ -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`.
src/Squeal/PostgreSQL/Schema.hs view
@@ -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