squeal-postgresql 0.2.1.0 → 0.3.0.0

raw patch · 14 files changed

+2229/−1314 lines, 14 filesdep +binary-parserdep +bytestring-strict-builderPVP ok

version bump matches the API change (PVP)

Dependencies added: binary-parser, bytestring-strict-builder

API changes (from Hackage documentation)

Files

• exe/Example.hs +11/−11
• squeal-postgresql.cabal +4/−2
• src/Squeal/PostgreSQL.hs +207/−202
• src/Squeal/PostgreSQL/Binary.hs +271/−13
• src/Squeal/PostgreSQL/Definition.hs +563/−271
• src/Squeal/PostgreSQL/Expression.hs +482/−436
• src/Squeal/PostgreSQL/Manipulation.hs +107/−112
• src/Squeal/PostgreSQL/Migration.hs +34/−36
• src/Squeal/PostgreSQL/PQ.hs +17/−15
• src/Squeal/PostgreSQL/Pool.hs +3/−4
• src/Squeal/PostgreSQL/Query.hs +148/−103
• src/Squeal/PostgreSQL/Render.hs +14/−2
• src/Squeal/PostgreSQL/Schema.hs +363/−95
• src/Squeal/PostgreSQL/Transaction.hs +5/−12

@@ -25,36 +25,36 @@ import qualified GHC.Generics as GHC  type Schema =-  '[ "users" :::+  '[ "users" ::: 'Table (        '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>        '[ "id" ::: 'Def :=> 'NotNull 'PGint4         , "name" ::: 'NoDef :=> 'NotNull 'PGtext         , "vec" ::: 'NoDef :=> 'NotNull ('PGvararray 'PGint2)-        ]-   , "emails" :::+        ])+   , "emails" ::: 'Table (        '[  "pk_emails" ::: 'PrimaryKey '["id"]         , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]         ] :=>        '[ "id" ::: 'Def :=> 'NotNull 'PGint4         , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4         , "email" ::: 'NoDef :=> 'Null 'PGtext-        ]+        ])    ]  setup :: Definition '[] Schema setup =    createTable #users     ( serial `As` #id :*-      (text & notNull) `As` #name :*-      (vararray int2 & notNull) `As` #vec :* Nil )-    ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil )+      (text & notNullable) `As` #name :*+      (vararray int2 & notNullable) `As` #vec :* Nil )+    ( primaryKey #id `As` #pk_users :* Nil )   >>>   createTable #emails     ( serial `As` #id :*-      (int & notNull) `As` #user_id :*-      text `As` #email :* Nil )-    ( primaryKey (Column #id :* Nil) `As` #pk_emails :*-      foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)+      (int & notNullable) `As` #user_id :*+      (text & nullable) `As` #email :* Nil )+    ( primaryKey #id `As` #pk_emails :*+      foreignKey #user_id #users #id         OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )  teardown :: Definition Schema '[]

@@ -1,5 +1,5 @@ name: squeal-postgresql-version: 0.2.1.0+version: 0.3.0.0 synopsis: Squeal PostgreSQL Library description: Squeal is a type-safe embedding of PostgreSQL in Haskell homepage: https://github.com/morphismtech/squeal@@ -34,11 +34,13 @@     Squeal.PostgreSQL.Schema     Squeal.PostgreSQL.Transaction   default-language: Haskell2010-  ghc-options: -Wall -fprint-explicit-kinds+  ghc-options: -Wall   build-depends:       aeson >= 1.2.4.0     , base >= 4.10.1.0 && < 5.0+    , binary-parser >= 0.5.5     , bytestring >= 0.10.8.2+    , bytestring-strict-builder >= 0.4.5     , deepseq >= 1.4.3.0     , generics-sop >= 0.3.2.0     , lifted-base >= 0.2.3.12

@@ -1,206 +1,211 @@--- | Module: Squeal.PostgreSQL--- Description: Squeel export module--- Copyright: (c) Eitan Chatav, 2017--- Maintainer: eitan@morphism.tech--- Stability: experimental------ Squeal is a deep embedding of [PostgreSQL](https://www.postgresql.org) in Haskell.--- Let's see an example!------ First, we need some language extensions because Squeal uses modern GHC--- features.------ >>> :set -XDataKinds -XDeriveGeneric -XOverloadedLabels--- >>> :set -XOverloadedStrings -XTypeApplications -XTypeOperators--- --- We'll need some imports.------ >>> import Control.Monad (void)--- >>> import Control.Monad.Base (liftBase)--- >>> import Data.Int (Int32)--- >>> import Data.Text (Text)--- >>> import Squeal.PostgreSQL------ We'll use generics to easily convert between Haskell and PostgreSQL values.------ >>> import qualified Generics.SOP as SOP--- >>> import qualified GHC.Generics as GHC------ The first step is to define the schema of our database. This is where--- we use @DataKinds@ and @TypeOperators@.------ >>> :{--- type Schema =---   '[ "users" :::---        '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>---        '[ "id"   :::   'Def :=> 'NotNull 'PGint4---         , "name" ::: 'NoDef :=> 'NotNull 'PGtext---         ]---    , "emails" :::---        '[ "pk_emails"  ::: 'PrimaryKey '["id"]---         , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]---         ] :=>---        '[ "id"      :::   'Def :=> 'NotNull 'PGint4---         , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4---         , "email"   ::: 'NoDef :=>    'Null 'PGtext---         ]---    ]--- :}------ Notice the use of type operators. `:::` is used--- to pair an alias `Symbol` with either a `TableType` or a `ColumnType`.--- `:=>` is used to pair a `TableConstraint`s with a `ColumnsType`,--- yielding a `TableType`, or to pair a `ColumnConstraint` with a `NullityType`,--- yielding a `ColumnType`.------ Next, we'll write `Definition`s to set up and tear down the schema. In--- Squeal, a `Definition` is a `createTable`, `alterTable` or `dropTable`--- command and has two type parameters, corresponding to the schema--- before being run and the schema after. We can compose definitions using--- `>>>`. Here and in the rest of our commands we make use of overloaded--- labels to refer to named tables and columns in our schema.------ >>> :{--- let---   setup :: Definition '[] Schema---   setup = ---    createTable #users---      ( serial `As` #id :*---        (text & notNull) `As` #name :* Nil )---      ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil ) >>>---    createTable #emails---      ( serial `As` #id :*---        (int & notNull) `As` #user_id :*---        text `As` #email :* Nil )---      ( primaryKey (Column #id :* Nil) `As` #pk_emails :*---        foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)---          OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )--- :}------ We can easily see the generated SQL is unsuprising looking.------ >>> renderDefinition setup--- "CREATE TABLE \"users\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_users\" PRIMARY KEY (\"id\")); CREATE TABLE \"emails\" (\"id\" serial, \"user_id\" int NOT NULL, \"email\" text, CONSTRAINT \"pk_emails\" PRIMARY KEY (\"id\"), CONSTRAINT \"fk_user_id\" FOREIGN KEY (\"user_id\") REFERENCES \"users\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"------ Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.--- In our `createTable` commands we included `TableConstraint`s to define--- primary and foreign keys, making them somewhat complex. Our tear down--- `Definition` is simpler.------ >>> :{--- let---   teardown :: Definition Schema '[]---   teardown = dropTable #emails >>> dropTable #users--- :}------ >>> renderDefinition teardown--- "DROP TABLE \"emails\"; DROP TABLE \"users\";"------ Next, we'll write `Manipulation`s to insert data into our two tables.--- A `Manipulation` is an `insertRow` (or other inserts), `update`--- or `deleteFrom` command and--- has three type parameters, the schema it refers to, a list of parameters--- it can take as input, and a list of columns it produces as output. When--- we insert into the users table, we will need a parameter for the @name@--- field but not for the @id@ field. Since it's optional, we can use a default--- value. However, since the emails table refers to the users table, we will--- need to retrieve the user id that the insert generates and insert it into--- the emails table. Take a careful look at the type and definition of both--- of our inserts.------ >>> :{--- 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))--- :}------ >>> :{--- 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 )---     OnConflictDoNothing (Returning Nil)--- :}------ >>> renderManipulation insertUser--- "INSERT INTO \"users\" (\"id\", \"name\") VALUES (DEFAULT, ($1 :: text)) ON CONFLICT DO NOTHING RETURNING \"id\" AS \"fromOnly\";"--- >>> renderManipulation insertEmail--- "INSERT INTO \"emails\" (\"id\", \"user_id\", \"email\") VALUES (DEFAULT, ($1 :: int4), ($2 :: text)) ON CONFLICT DO NOTHING;"------ Next we write a `Query` to retrieve users from the database. We're not--- interested in the ids here, just the usernames and email addresses. We--- need to use an inner join to get the right result. A `Query` is like a--- `Manipulation` with the same kind of type parameters.------ >>> :{--- let---   getUsers :: Query Schema '[]---     '[ "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 ! #id .== #e ! #user_id)) )--- :}------ >>> renderQuery getUsers--- "SELECT \"u\".\"name\" AS \"userName\", \"e\".\"email\" AS \"userEmail\" FROM \"users\" AS \"u\" INNER JOIN \"emails\" AS \"e\" ON (\"u\".\"id\" = \"e\".\"user_id\")"------ Now that we've defined the SQL side of things, we'll need a Haskell type--- for users. We give the type `Generics.SOP.Generic` and--- `Generics.SOP.HasDatatypeInfo` instances so that we can decode the rows--- we receive when we run @getUsers@. Notice that the record fields of the--- @User@ type match the column names of @getUsers@.--- --- >>> data User = User { userName :: Text, userEmail :: Maybe Text } deriving (Show, GHC.Generic)--- >>> instance SOP.Generic User--- >>> instance SOP.HasDatatypeInfo User------ Let's also create some users to add to the database.------ >>> :{--- let---   users :: [User]---   users = ---     [ User "Alice" (Just "alice@gmail.com")---     , User "Bob" Nothing---     , User "Carole" (Just "carole@hotmail.com")---     ]--- :}------ Now we can put together all the pieces into a program. The program--- connects to the database, sets up the schema, inserts the user data--- (using prepared statements as an optimization), queries the user--- data and prints it out and finally closes the connection. We can thread--- the changing schema information through by using the indexed `PQ` monad--- transformer and when the schema doesn't change we can use `Monad` and--- `MonadPQ` functionality.------ >>> :{--- let---   session :: PQ Schema Schema IO ()---   session = do---     idResults <- traversePrepared insertUser (Only . userName <$> users)---     ids <- traverse (fmap fromOnly . getRow 0) idResults---     traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))---     usersResult <- runQuery getUsers---     usersRows <- getRows usersResult---     liftBase $ print (usersRows :: [User])--- :}------ >>> :{--- void . withConnection "host=localhost port=5432 dbname=exampledb" $---   define setup---   & pqThen session---   & pqThen (define teardown)--- :}--- [User {userName = "Alice", userEmail = Just "alice@gmail.com"},User {userName = "Bob", userEmail = Nothing},User {userName = "Carole", userEmail = Just "carole@hotmail.com"}]+{-|+Module: Squeal.PostgreSQL+Description: Squeel export module+Copyright: (c) Eitan Chatav, 2017+Maintainer: eitan@morphism.tech+Stability: experimental +Squeal is a deep embedding of [PostgreSQL](https://www.postgresql.org) in Haskell.+Let's see an example!++First, we need some language extensions because Squeal uses modern GHC+features.++>>> :set -XDataKinds -XDeriveGeneric -XOverloadedLabels+>>> :set -XOverloadedStrings -XTypeApplications -XTypeOperators+ +We'll need some imports.++>>> import Control.Monad (void)+>>> import Control.Monad.Base (liftBase)+>>> import Data.Int (Int32)+>>> import Data.Text (Text)+>>> import Squeal.PostgreSQL+>>> import Squeal.PostgreSQL.Render++We'll use generics to easily convert between Haskell and PostgreSQL values.++>>> import qualified Generics.SOP as SOP+>>> import qualified GHC.Generics as GHC++The first step is to define the schema of our database. This is where+we use @DataKinds@ and @TypeOperators@.++>>> :{+type Schema =+  '[ "users" ::: 'Table (+      '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>+      '[ "id"   :::   'Def :=> 'NotNull 'PGint4+       , "name" ::: 'NoDef :=> 'NotNull 'PGtext+       ])+  , "emails" ::: 'Table (+      '[ "pk_emails"  ::: 'PrimaryKey '["id"]+       , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]+       ] :=>+      '[ "id"      :::   'Def :=> 'NotNull 'PGint4+       , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4+       , "email"   ::: 'NoDef :=>    'Null 'PGtext+       ])+  ]+:}++Notice the use of type operators.++`:::` is used to pair an alias `GHC.TypeLits.Symbol` with a `SchemumType`,+a `TableConstraint` or a `ColumnType`. It is intended to connote Haskell's @::@+operator.++`:=>` is used to pair `TableConstraints` with a `ColumnsType`,+yielding a `TableType`, or to pair a `ColumnConstraint` with a `NullityType`,+yielding a `ColumnType`. It is intended to connote Haskell's @=>@ operator++Next, we'll write `Definition`s to set up and tear down the schema. In+Squeal, a `Definition` like `createTable`, `alterTable` or `dropTable` +has two type parameters, corresponding to the schema+before being run and the schema after. We can compose definitions using `>>>`.+Here and in the rest of our commands we make use of overloaded+labels to refer to named tables and columns in our schema.++>>> :{+let+  setup :: Definition '[] Schema+  setup = +    createTable #users+      ( serial `As` #id :*+        (text & notNullable) `As` #name :* Nil )+      ( primaryKey #id `As` #pk_users :* Nil ) >>>+    createTable #emails+      ( serial `As` #id :*+        (int & notNullable) `As` #user_id :*+        (text & nullable) `As` #email :* Nil )+      ( primaryKey #id `As` #pk_emails :*+        foreignKey #user_id #users #id+          OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )+:}++We can easily see the generated SQL is unsurprising looking.++>>> printSQL setup+CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));+CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);++Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.+In our `createTable` commands we included `TableConstraint`s to define+primary and foreign keys, making them somewhat complex. Our @teardown@+`Definition` is simpler.++>>> :{+let+  teardown :: Definition Schema '[]+  teardown = dropTable #emails >>> dropTable #users+:}++>>> printSQL teardown+DROP TABLE "emails";+DROP TABLE "users";++Next, we'll write `Manipulation`s to insert data into our two tables.+A `Manipulation` like `insertRow`, `update` or `deleteFrom`+has three type parameters, the schema it refers to, a list of parameters+it can take as input, and a list of columns it produces as output. When+we insert into the users table, we will need a parameter for the @name@+field but not for the @id@ field. Since it's serial, we can use a default+value. However, since the emails table refers to the users table, we will+need to retrieve the user id that the insert generates and insert it into+the emails table. Take a careful look at the type and definition of both+of our inserts.++>>> :{+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))+:}++>>> :{+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 )+    OnConflictDoNothing (Returning Nil)+:}++>>> printSQL insertUser+INSERT INTO "users" ("id", "name") VALUES (DEFAULT, ($1 :: text)) ON CONFLICT DO NOTHING RETURNING "id" AS "fromOnly"+>>> printSQL insertEmail+INSERT INTO "emails" ("id", "user_id", "email") VALUES (DEFAULT, ($1 :: int4), ($2 :: text)) ON CONFLICT DO NOTHING++Next we write a `Query` to retrieve users from the database. We're not+interested in the ids here, just the usernames and email addresses. We+need to use an inner join to get the right result. A `Query` is like a+`Manipulation` with the same kind of type parameters.++>>> :{+let+  getUsers :: Query Schema '[]+    '[ "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 ! #id .== #e ! #user_id)) )+:}++>>> printSQL getUsers+SELECT "u"."name" AS "userName", "e"."email" AS "userEmail" FROM "users" AS "u" INNER JOIN "emails" AS "e" ON ("u"."id" = "e"."user_id")++Now that we've defined the SQL side of things, we'll need a Haskell type+for users. We give the type `Generics.SOP.Generic` and+`Generics.SOP.HasDatatypeInfo` instances so that we can decode the rows+we receive when we run @getUsers@. Notice that the record fields of the+@User@ type match the column names of @getUsers@.+ +>>> data User = User { userName :: Text, userEmail :: Maybe Text } deriving (Show, GHC.Generic)+>>> instance SOP.Generic User+>>> instance SOP.HasDatatypeInfo User++Let's also create some users to add to the database.++>>> :{+let+  users :: [User]+  users = +    [ User "Alice" (Just "alice@gmail.com")+    , User "Bob" Nothing+    , User "Carole" (Just "carole@hotmail.com")+    ]+:}++Now we can put together all the pieces into a program. The program+connects to the database, sets up the schema, inserts the user data+(using prepared statements as an optimization), queries the user+data and prints it out and finally closes the connection. We can thread+the changing schema information through by using the indexed `PQ` monad+transformer and when the schema doesn't change we can use `Monad` and+`MonadPQ` functionality.++>>> :{+let+  session :: PQ Schema Schema IO ()+  session = do+    idResults <- traversePrepared insertUser (Only . userName <$> users)+    ids <- traverse (fmap fromOnly . getRow 0) idResults+    traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))+    usersResult <- runQuery getUsers+    usersRows <- getRows usersResult+    liftBase $ print (usersRows :: [User])+in+  void . withConnection "host=localhost port=5432 dbname=exampledb" $+    define setup+    & pqThen session+    & pqThen (define teardown)+:}+[User {userName = "Alice", userEmail = Just "alice@gmail.com"},User {userName = "Bob", userEmail = Nothing},User {userName = "Carole", userEmail = Just "carole@hotmail.com"}]+-} module Squeal.PostgreSQL   ( module Squeal.PostgreSQL.Binary   , module Squeal.PostgreSQL.Definition

@@ -5,13 +5,131 @@ Maintainer: eitan@morphism.tech Stability: experimental -Binary encoding and decoding between Haskell and PostgreSQL types.+This module provides binary encoding and decoding between Haskell and PostgreSQL types.++Instances are governed by the `Generic` and `HasDatatypeInfo` typeclasses, so you absolutely+do not need to define your own instances to decode retrieved rows into Haskell values or+to encode Haskell values into statement parameters.++>>> import Data.Int (Int16)+>>> import Data.Text (Text)++>>> data Row = Row { col1 :: Int16, col2 :: Text } deriving (Eq, GHC.Generic)+>>> instance Generic Row+>>> instance HasDatatypeInfo Row++>>> import Control.Monad (void)+>>> import Control.Monad.Base (liftBase)+>>> import Squeal.PostgreSQL++>>> :{+let+  query :: Query '[]+    '[ 'NotNull 'PGint2, 'NotNull 'PGtext]+    '["col1" ::: 'NotNull 'PGint2, "col2" ::: 'NotNull 'PGtext]+  query = values_ (param @1 `As` #col1 :* param @2 `As` #col2 :* Nil)+:}++>>> :{+let+  roundtrip :: IO ()+  roundtrip = void . withConnection "host=localhost port=5432 dbname=exampledb" $ do+    result <- runQueryParams query (2 :: Int16, "hi" :: Text)+    Just row <- firstRow result+    liftBase . print $ row == Row 2 "hi"+:}++>>> roundtrip+True++In addition to being able to encode and decode basic Haskell types like `Int16` and `Text`,+Squeal permits you to encode and decode Haskell types which are equivalent to+Postgres enumerated and composite types.++Enumerated (enum) types are data types that comprise a static, ordered set of values.+They are equivalent to Haskell algebraic data types whose constructors are nullary.+An example of an enum type might be the days of the week,+or a set of status values for a piece of data.++>>> data Schwarma = Beef | Lamb | Chicken deriving (Show, GHC.Generic)+>>> instance Generic Schwarma+>>> instance HasDatatypeInfo Schwarma++A composite type represents the structure of a row or record;+it is essentially just a list of field names and their data types. They are almost+equivalent to Haskell record types. However, because of the potential presence of @NULL@+all the record fields must be `Maybe`s of basic types.++>>> data Person = Person {name :: Maybe Text, age :: Maybe Int32} deriving (Show, GHC.Generic)+>>> instance Generic Person+>>> instance HasDatatypeInfo Person++We can create the equivalent Postgres types directly from their Haskell types.++>>> :{+type Schema =+  '[ "schwarma" ::: 'Typedef (EnumFrom Schwarma)+   , "person" ::: 'Typedef (CompositeFrom Person)+   ]+:}++>>> :{+let+  setup :: Definition '[] Schema+  setup =+    createTypeEnumFrom @Schwarma #schwarma >>>+    createTypeCompositeFrom @Person #person+:}++Then we can perform roundtrip queries;++>>> :{+let+  querySchwarma :: Query Schema+    '[ 'NotNull (EnumFrom Schwarma)]+    '["fromOnly" ::: 'NotNull (EnumFrom Schwarma)]+  querySchwarma = values_ (parameter @1 #schwarma `As` #fromOnly :* Nil)+:}++>>> :{+let+  queryPerson :: Query Schema+    '[ 'NotNull (CompositeFrom Person)]+    '["fromOnly" ::: 'NotNull (CompositeFrom Person)]+  queryPerson = values_ (parameter @1 #person `As` #fromOnly :* Nil)+:}++And finally drop the types.++>>> :{+let+  teardown :: Definition Schema '[]+  teardown = dropType #schwarma >>> dropType #person+:}++Now let's run it.++>>> :{+let+  session = do+    result1 <- runQueryParams querySchwarma (Only Chicken)+    Just (Only schwarma) <- firstRow result1+    liftBase $ print (schwarma :: Schwarma)+    result2 <- runQueryParams queryPerson (Only (Person (Just "Faisal") (Just 24)))+    Just (Only person) <- firstRow result2+    liftBase $ print (person :: Person)+in+  void . withConnection "host=localhost port=5432 dbname=exampledb" $+    define setup+    & pqThen session+    & pqThen (define teardown)+:}+Chicken+Person {name = Just "Faisal", age = Just 24} -}  {-# LANGUAGE-    ConstraintKinds-  , DataKinds-  , DefaultSignatures+    AllowAmbiguousTypes   , DeriveFoldable   , DeriveFunctor   , DeriveGeneric@@ -20,11 +138,9 @@   , FlexibleInstances   , GADTs   , LambdaCase-  , KindSignatures   , MultiParamTypeClasses   , ScopedTypeVariables   , TypeApplications-  , TypeFamilies   , TypeInType   , TypeOperators   , UndecidableInstances@@ -43,9 +159,12 @@   , Only (..)   ) where +import BinaryParser+import ByteString.StrictBuilder import Data.Aeson hiding (Null) import Data.Int import Data.Kind+import Data.Monoid hiding (All) import Data.Scientific import Data.Time import Data.UUID.Types@@ -56,7 +175,7 @@ import Network.IP.Addr  import qualified Data.ByteString.Lazy as Lazy-import qualified Data.ByteString as Strict hiding (unpack)+import qualified Data.ByteString as Strict hiding (pack, unpack) import qualified Data.Text.Lazy as Lazy import qualified Data.Text as Strict import qualified Data.Vector as Vector@@ -119,9 +238,83 @@   => ToParam (Vector (Maybe x)) ('PGvararray pg) where     toParam = K . Encoding.nullableArray_vector       (oid @pg) (unK . toParam @x @pg)+instance+  ( IsEnumType x+  , HasDatatypeInfo x+  , LabelsFrom x ~ labels+  ) => ToParam x ('PGenum labels) where+    toParam =+      let+        gshowConstructor :: NP ConstructorInfo xss -> SOP I xss -> String+        gshowConstructor Nil _ = ""+        gshowConstructor (constructor :* _) (SOP (Z _)) =+          constructorName constructor+        gshowConstructor (_ :* constructors) (SOP (S xs)) =+          gshowConstructor constructors (SOP xs)+      in+        K . Encoding.text_strict+        . Strict.pack+        . gshowConstructor (constructorInfo (datatypeInfo (Proxy @x)))+        . from+instance+  ( SListI fields+  , MapMaybes xs+  , IsProductType x (Maybes xs)+  , AllZip ToAliasedParam xs fields+  , FieldNamesFrom x ~ AliasesOf fields+  , All HasAliasedOid fields+  ) => ToParam x ('PGcomposite fields) where+    toParam =+      let --- | A `ToColumnParam` constraint lifts the `ToParam` encoding --- of a `Type` to a `ColumnType`, encoding `Maybe`s to `Null`s. You should+        encoders = htrans (Proxy @ToAliasedParam) toAliasedParam++        composite+          :: All HasAliasedOid row+          => NP (K (Maybe Encoding.Encoding)) row+          -> K Encoding.Encoding ('PGcomposite row)+        composite fields = K $+          -- <number of fields: 4 bytes>+          -- [for each field]+          --  <OID of field's type: sizeof(Oid) bytes>+          --  [if value is NULL]+          --    <-1: 4 bytes>+          --  [else]+          --    <length of value: 4 bytes>+          --    <value: <length> bytes>+          --  [end if]+          -- [end for]+          int32BE (fromIntegral (lengthSList (Proxy @xs))) <>+            let+              each+                :: HasAliasedOid field+                => K (Maybe Encoding.Encoding) field+                -> Encoding.Encoding+              each (K field :: K (Maybe Encoding.Encoding) field) =+                word32BE (aliasedOid @field)+                <> case field of+                  Nothing -> int64BE (-1)+                  Just value ->+                    int32BE (fromIntegral (builderLength value))+                    <> value+            in+              hcfoldMap (Proxy @HasAliasedOid) each fields++      in+        composite . encoders . unMaybes . unZ . unSOP . from++class HasAliasedOid (field :: (Symbol, PGType)) where aliasedOid :: Word32+instance HasOid ty => HasAliasedOid (alias ::: ty) where aliasedOid = oid @ty++class ToAliasedParam (x :: Type) (field :: (Symbol, PGType)) where+  toAliasedParam :: Maybe x -> K (Maybe Encoding.Encoding) field+instance ToParam x ty => ToAliasedParam x (alias ::: ty) where+  toAliasedParam = \case+    Nothing -> K Nothing+    Just x -> K . Just . unK $ toParam @x @ty x++-- | A `ToColumnParam` constraint lifts the `ToParam` encoding+-- of a `Type` to a `NullityType`, encoding `Maybe`s to `Null`s. You should -- not define instances of `ToColumnParam`, just use the provided instances. class ToColumnParam (x :: Type) (ty :: NullityType) where   -- | >>> toColumnParam @Int16 @('NotNull 'PGint2) 0@@ -201,9 +394,74 @@   fromValue _ = Decoding.array     (Decoding.dimensionArray Vector.replicateM       (Decoding.nullableValueArray (fromValue (Proxy @pg))))+instance+  ( IsEnumType y+  , HasDatatypeInfo y+  , LabelsFrom y ~ labels+  ) => FromValue ('PGenum labels) y where+    fromValue _ =+      let+        greadConstructor+          :: All ((~) '[]) xss+          => NP ConstructorInfo xss+          -> String+          -> Maybe (SOP I xss)+        greadConstructor Nil _ = Nothing+        greadConstructor (constructor :* constructors) name =+          if name == constructorName constructor+            then Just (SOP (Z Nil))+            else SOP . S . unSOP <$> greadConstructor constructors name+      in+        Decoding.enum+        $ fmap to+        . greadConstructor (constructorInfo (datatypeInfo (Proxy @y)))+        . Strict.unpack +instance+  ( SListI fields+  , MapMaybes ys+  , IsProductType y (Maybes ys)+  , AllZip FromAliasedValue fields ys+  , FieldNamesFrom y ~ AliasesOf fields+  ) => FromValue ('PGcomposite fields) y where+    fromValue =+      let+        decoders+          :: forall pgs zs proxy+          . AllZip FromAliasedValue pgs zs+          => proxy ('PGcomposite pgs)+          -> NP Decoding.Value zs+        decoders _ = htrans (Proxy @FromAliasedValue) fromAliasedValue+          (hpure Proxy :: NP Proxy pgs)++        composite fields = do+        -- <number of fields: 4 bytes>+        -- [for each field]+        --  <OID of field's type: sizeof(Oid) bytes>+        --  [if value is NULL]+        --    <-1: 4 bytes>+        --  [else]+        --    <length of value: 4 bytes>+        --    <value: <length> bytes>+        --  [end if]+        -- [end for]+          unitOfSize 4+          let+            each field = do+              unitOfSize 4+              len <- sized 4 Decoding.int+              if len == -1 then return Nothing else Just <$> sized len field+          htraverse' each fields++      in fmap (to . SOP . Z . maybes) . composite . decoders++class FromAliasedValue (pg :: (Symbol,PGType)) (y :: Type) where+  fromAliasedValue :: proxy pg -> Decoding.Value y+instance FromValue pg y => FromAliasedValue (alias ::: pg) y where+  fromAliasedValue _ = fromValue (Proxy @pg)+ -- | A `FromColumnValue` constraint lifts the `FromValue` parser--- to a decoding of a @(Symbol, ColumnType)@ to a `Type`,+-- to a decoding of a @(Symbol, NullityType)@ to a `Type`, -- decoding `Null`s to `Maybe`s. You should not define instances for -- `FromColumnValue`, just use the provided instances. class FromColumnValue (colty :: (Symbol,NullityType)) (y :: Type) where@@ -220,10 +478,10 @@   => FromColumnValue (column ::: ('NotNull pg)) y where     fromColumnValue = \case       K Nothing -> error "fromColumnValue: saw NULL when expecting NOT NULL"-      K (Just bytes) ->+      K (Just bs) ->         let           errOrValue =-            Decoding.valueParser (fromValue @pg @y Proxy) bytes+            Decoding.valueParser (fromValue @pg @y Proxy) bs           err str = error $ "fromColumnValue: " ++ Strict.unpack str         in           either err id errOrValue@@ -257,7 +515,7 @@   ( SListI results   , IsProductType y ys   , AllZip FromColumnValue results ys-  , SameFields (DatatypeInfoOf y) results+  , FieldNamesFrom y ~ AliasesOf results   ) => FromRow results y where     fromRow       = to . SOP . Z . htrans (Proxy @FromColumnValue) (I . fromColumnValue)

@@ -9,35 +9,33 @@ -}  {-# LANGUAGE-    ConstraintKinds-  , DataKinds-  , DeriveDataTypeable+    AllowAmbiguousTypes+  , ConstraintKinds   , DeriveGeneric   , FlexibleContexts   , FlexibleInstances   , GADTs   , GeneralizedNewtypeDeriving-  , KindSignatures   , LambdaCase   , MultiParamTypeClasses   , OverloadedStrings   , RankNTypes   , ScopedTypeVariables-  , StandaloneDeriving   , TypeApplications   , TypeInType   , TypeOperators+  , UndecidableSuperClasses #-}  module Squeal.PostgreSQL.Definition-  (  -- * Definition+  ( -- * Definition     Definition (UnsafeDefinition, renderDefinition)   , (>>>)-    -- * Create+    -- * Tables+    -- ** Create   , createTable   , createTableIfNotExists   , TableConstraintExpression (..)-  , Column (..)   , check   , unique   , primaryKey@@ -47,9 +45,9 @@   , renderOnDeleteClause   , OnUpdateClause (OnUpdateNoAction, OnUpdateRestrict, OnUpdateCascade)   , renderOnUpdateClause-    -- * Drop+    -- ** Drop   , dropTable-    -- * Alter+    -- ** Alter   , alterTable   , alterTableRename   , AlterTable (UnsafeAlterTable, renderAlterTable)@@ -65,6 +63,26 @@   , setNotNull   , dropNotNull   , alterType+    -- * Views+  , createView+  , dropView+    -- * Types+  , createTypeEnum+  , createTypeEnumFrom+  , createTypeComposite+  , createTypeCompositeFrom+  , dropType+    -- * Columns+  , ColumnTypeExpression (..)+  , nullable+  , notNullable+  , default_+  , serial2+  , smallserial+  , serial4+  , serial+  , serial8+  , bigserial   ) where  import Control.Category@@ -78,6 +96,7 @@ import qualified GHC.Generics as GHC  import Squeal.PostgreSQL.Expression+import Squeal.PostgreSQL.Query import Squeal.PostgreSQL.Render import Squeal.PostgreSQL.Schema @@ -89,67 +108,76 @@ -- database, like a `createTable`, `dropTable`, or `alterTable` command. -- `Definition`s may be composed using the `>>>` operator. newtype Definition-  (schema0 :: TablesType)-  (schema1 :: TablesType)+  (schema0 :: SchemaType)+  (schema1 :: SchemaType)   = UnsafeDefinition { renderDefinition :: ByteString }   deriving (GHC.Generic,Show,Eq,Ord,NFData) +instance RenderSQL (Definition schema0 schema1) where+  renderSQL = renderDefinition+ instance Category Definition where   id = UnsafeDefinition ";"   ddl1 . ddl0 = UnsafeDefinition $-    renderDefinition ddl0 <+> renderDefinition ddl1+    renderDefinition ddl0 <> "\n" <> renderDefinition ddl1  {----------------------------------------- CREATE statements -----------------------------------------} --- | `createTable` adds a table to the schema.------ >>> :set -XOverloadedLabels--- >>> :{--- renderDefinition $---   createTable #tab (int `As` #a :* real `As` #b :* Nil) Nil--- :}--- "CREATE TABLE \"tab\" (\"a\" int, \"b\" real);"+{- | `createTable` adds a table to the schema.++>>> :set -XOverloadedLabels+>>> :{+printSQL $+  createTable #tab ((int & nullable) `As` #a :* (real & nullable) `As` #b :* Nil) Nil+:}+CREATE TABLE "tab" ("a" int NULL, "b" real NULL);+-} createTable   :: ( KnownSymbol table      , columns ~ (col ': cols)      , SOP.SListI columns-     , SOP.SListI constraints )+     , SOP.SListI constraints+     , schema1 ~ Create table ('Table (constraints :=> columns)) schema0 )   => Alias table -- ^ the name of the table to add-  -> NP (Aliased TypeExpression) columns+  -> NP (Aliased (ColumnTypeExpression schema0)) columns     -- ^ the names and datatype of each column-  -> NP (Aliased (TableConstraintExpression schema columns)) constraints+  -> NP (Aliased (TableConstraintExpression schema1 table)) constraints     -- ^ constraints that must hold for the table-  -> Definition schema (Create table (constraints :=> columns) schema)-createTable table columns constraints = UnsafeDefinition $-  "CREATE TABLE" <+> renderCreation table columns constraints+  -> Definition schema0 schema1+createTable tab columns constraints = UnsafeDefinition $+  "CREATE TABLE" <+> renderCreation tab columns constraints --- | `createTableIfNotExists` creates a table if it doesn't exist, but does not add it to the schema.--- Instead, the schema already has the table so if the table did not yet exist, the schema was wrong.--- `createTableIfNotExists` fixes this. Interestingly, this property makes it an idempotent in the `Category` `Definition`.------ >>> :set -XOverloadedLabels -XTypeApplications--- >>> type Table = '[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGfloat4]--- >>> type Schema = '["tab" ::: Table]--- >>> :{--- renderDefinition---   (createTableIfNotExists #tab (int `As` #a :* real `As` #b :* Nil) Nil :: Definition Schema Schema)--- :}--- "CREATE TABLE IF NOT EXISTS \"tab\" (\"a\" int, \"b\" real);"+{-| `createTableIfNotExists` creates a table if it doesn't exist, but does not add it to the schema.+Instead, the schema already has the table so if the table did not yet exist, the schema was wrong.+`createTableIfNotExists` fixes this. Interestingly, this property makes it an idempotent in+the `Category` of `Definition`s.++>>> :set -XOverloadedLabels -XTypeApplications+>>> 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+in printSQL setup+:}+CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);+-} createTableIfNotExists-  :: ( Has table schema (constraints :=> columns)+  :: ( Has table schema ('Table (constraints :=> columns))      , SOP.SListI columns      , SOP.SListI constraints )   => Alias table -- ^ the name of the table to add-  -> NP (Aliased TypeExpression) columns+  -> NP (Aliased (ColumnTypeExpression schema)) columns     -- ^ the names and datatype of each column-  -> NP (Aliased (TableConstraintExpression schema columns)) constraints+  -> NP (Aliased (TableConstraintExpression schema table)) constraints     -- ^ constraints that must hold for the table   -> Definition schema schema-createTableIfNotExists table columns constraints = UnsafeDefinition $+createTableIfNotExists tab columns constraints = UnsafeDefinition $   "CREATE TABLE IF NOT EXISTS"-  <+> renderCreation table columns constraints+  <+> renderCreation tab columns constraints  -- helper function for `createTable` and `createTableIfNotExists` renderCreation@@ -157,12 +185,12 @@      , SOP.SListI columns      , SOP.SListI constraints )   => Alias table -- ^ the name of the table to add-  -> NP (Aliased TypeExpression) columns+  -> NP (Aliased (ColumnTypeExpression schema0)) columns     -- ^ the names and datatype of each column-  -> NP (Aliased (TableConstraintExpression schema columns)) constraints+  -> NP (Aliased (TableConstraintExpression schema1 table)) constraints     -- ^ constraints that must hold for the table   -> ByteString-renderCreation table columns constraints = renderAlias table+renderCreation tab columns constraints = renderAlias tab   <+> parenthesized     ( renderCommaSeparated renderColumnDef columns       <> ( case constraints of@@ -171,9 +199,9 @@                renderCommaSeparated renderConstraint constraints ) )   <> ";"   where-    renderColumnDef :: Aliased TypeExpression x -> ByteString+    renderColumnDef :: Aliased (ColumnTypeExpression schema) x -> ByteString     renderColumnDef (ty `As` column) =-      renderAlias column <+> renderTypeExpression ty+      renderAlias column <+> renderColumnTypeExpression ty     renderConstraint       :: Aliased (TableConstraintExpression schema columns) constraint       -> ByteString@@ -193,156 +221,226 @@ -- violate a constraint, an error is raised. This applies -- even if the value came from the default value definition. newtype TableConstraintExpression-  (schema :: TablesType)-  (columns :: ColumnsType)+  (schema :: SchemaType)+  (table :: Symbol)   (tableConstraint :: TableConstraint)     = UnsafeTableConstraintExpression     { renderTableConstraintExpression :: ByteString }     deriving (GHC.Generic,Show,Eq,Ord,NFData) --- | @Column columns column@ is a witness that `column` is in `columns`. -data Column-  (columns :: ColumnsType)-  (column :: (Symbol,ColumnType))-  where-    Column-      :: Has column columns ty-      => Alias column-      -> Column columns (column ::: ty)+{-| A `check` constraint is the most generic `TableConstraint` type.+It allows you to specify that the value in a certain column must satisfy+a Boolean (truth-value) expression. --- | Render a `Column`.-renderColumn :: Column columns column -> ByteString-renderColumn (Column column) = renderAlias column+>>> :{+type Schema = '[+  "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[+    "a" ::: 'NoDef :=> 'NotNull 'PGint4,+    "b" ::: 'NoDef :=> 'NotNull 'PGint4+  ])]+:} --- | A `check` constraint is the most generic `TableConstraint` type.--- It allows you to specify that the value in a certain column must satisfy--- a Boolean (truth-value) expression.------ >>> :{--- renderDefinition $---   createTable #tab---     ( (int & notNull) `As` #a :*---       (int & notNull) `As` #b :* Nil )---     ( check (Column #a :* Column #b :* Nil) (#a .> #b) `As` #inequality :* Nil )--- :}--- "CREATE TABLE \"tab\" (\"a\" int NOT NULL, \"b\" int NOT NULL, CONSTRAINT \"inequality\" CHECK ((\"a\" > \"b\")));"+>>> :{+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 )+:}++>>> printSQL definition+CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));+-} check-  :: NP (Column columns) subcolumns-  -> Condition '[table ::: ColumnsToRelation subcolumns] 'Ungrouped '[]-  -- ^ condition to check-  -> TableConstraintExpression schema columns ('Check (AliasesOf subcolumns))+  :: ( Has alias schema ('Table table)+     , HasAll aliases (TableToRelation table) subcolumns )+  => NP Alias aliases+  -- ^ specify the subcolumns which are getting checked+  -> (forall tab. Condition schema '[tab ::: subcolumns] 'Ungrouped '[])+  -- ^ a closed `Condition` on those subcolumns+  -> TableConstraintExpression schema alias ('Check aliases) check _cols condition = UnsafeTableConstraintExpression $   "CHECK" <+> parenthesized (renderExpression condition) --- | A `unique` constraint ensure that the data contained in a column,--- or a group of columns, is unique among all the rows in the table.------ >>> :{--- renderDefinition $---   createTable #tab---     ( int `As` #a :*---       int `As` #b :* Nil )---     ( unique (Column #a :* Column #b :* Nil) `As` #uq_a_b :* Nil )--- :}--- "CREATE TABLE \"tab\" (\"a\" int, \"b\" int, CONSTRAINT \"uq_a_b\" UNIQUE (\"a\", \"b\"));"+{-| A `unique` constraint ensure that the data contained in a column,+or a group of columns, is unique among all the rows in the table.++>>> :{+type Schema = '[+  "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[+    "a" ::: 'NoDef :=> 'Null 'PGint4,+    "b" ::: 'NoDef :=> 'Null 'PGint4+  ])]+:}++>>> :{+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 )+:}++>>> printSQL definition+CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));+-} unique-  :: SOP.SListI subcolumns-  => NP (Column columns) subcolumns-  -- ^ unique column or group of columns-  -> TableConstraintExpression schema columns ('Unique (AliasesOf subcolumns))+  :: ( Has alias schema ('Table table)+     , HasAll aliases (TableToRelation table) subcolumns )+  => NP Alias aliases+  -- ^ specify subcolumns which together are unique for each row+  -> TableConstraintExpression schema alias ('Unique aliases) unique columns = UnsafeTableConstraintExpression $-  "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)+  "UNIQUE" <+> parenthesized (commaSeparated (renderAliases columns)) --- | A `primaryKey` constraint indicates that a column, or group of columns,--- can be used as a unique identifier for rows in the table.--- This requires that the values be both unique and not null.------ >>> :{--- renderDefinition $---   createTable #tab---     ( serial `As` #id :*---       (text & notNull) `As` #name :* Nil )---     ( primaryKey (Column #id :* Nil) `As` #pk_id :* Nil )--- :}--- "CREATE TABLE \"tab\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_id\" PRIMARY KEY (\"id\"));"+{-| A `primaryKey` constraint indicates that a column, or group of columns,+can be used as a unique identifier for rows in the table.+This requires that the values be both unique and not null.++>>> :{+type Schema = '[+  "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[+    "id" ::: 'Def :=> 'NotNull 'PGint4,+    "name" ::: 'NoDef :=> 'NotNull 'PGtext+  ])]+:}++>>> :{+let+  definition :: Definition '[] Schema+  definition = createTable #tab+    ( serial `As` #id :*+      (text & notNullable) `As` #name :* Nil )+    ( primaryKey #id `As` #pk_id :* Nil )+:}++>>> printSQL definition+CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));+-} primaryKey-  :: (SOP.SListI subcolumns, AllNotNull subcolumns)-  => NP (Column columns) subcolumns-  -- ^ identifying column or group of columns-  -> TableConstraintExpression schema columns ('PrimaryKey (AliasesOf subcolumns))+  :: ( Has alias schema ('Table table)+     , HasAll aliases (TableToColumns table) subcolumns+     , AllNotNull subcolumns )+  => NP Alias aliases+  -- ^ specify the subcolumns which together form a primary key.+  -> TableConstraintExpression schema alias ('PrimaryKey aliases) primaryKey columns = UnsafeTableConstraintExpression $-  "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)+  "PRIMARY KEY" <+> parenthesized (commaSeparated (renderAliases columns)) --- | A `foreignKey` specifies that the values in a column--- (or a group of columns) must match the values appearing in some row of--- another table. We say this maintains the referential integrity--- between two related tables.------ >>> :{--- type Schema =---   '[ "users" :::---        '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>---        '[ "id" ::: 'Def :=> 'NotNull 'PGint4---         , "name" ::: 'NoDef :=> 'NotNull 'PGtext---         ]---    , "emails" :::---        '[  "pk_emails" ::: 'PrimaryKey '["id"]---         , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]---         ] :=>---        '[ "id" ::: 'Def :=> 'NotNull 'PGint4---         , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4---         , "email" ::: 'NoDef :=> 'Null 'PGtext---         ]---    ]--- :}------ >>> :{--- let---   setup :: Definition '[] Schema---   setup = ---    createTable #users---      ( serial `As` #id :*---        (text & notNull) `As` #name :* Nil )---      ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil ) >>>---    createTable #emails---      ( serial `As` #id :*---        (int & notNull) `As` #user_id :*---        text `As` #email :* Nil )---      ( primaryKey (Column #id :* Nil) `As` #pk_emails :*---        foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)---          OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )--- in renderDefinition setup--- :}--- "CREATE TABLE \"users\" (\"id\" serial, \"name\" text NOT NULL, CONSTRAINT \"pk_users\" PRIMARY KEY (\"id\")); CREATE TABLE \"emails\" (\"id\" serial, \"user_id\" int NOT NULL, \"email\" text, CONSTRAINT \"pk_emails\" PRIMARY KEY (\"id\"), CONSTRAINT \"fk_user_id\" FOREIGN KEY (\"user_id\") REFERENCES \"users\" (\"id\") ON DELETE CASCADE ON UPDATE CASCADE);"+{-| A `foreignKey` specifies that the values in a column+(or a group of columns) must match the values appearing in some row of+another table. We say this maintains the referential integrity+between two related tables.++>>> :{+type Schema =+  '[ "users" ::: 'Table (+       '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>+       '[ "id" ::: 'Def :=> 'NotNull 'PGint4+        , "name" ::: 'NoDef :=> 'NotNull 'PGtext+        ])+   , "emails" ::: 'Table (+       '[  "pk_emails" ::: 'PrimaryKey '["id"]+        , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]+        ] :=>+       '[ "id" ::: 'Def :=> 'NotNull 'PGint4+        , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4+        , "email" ::: 'NoDef :=> 'Null 'PGtext+        ])+   ]+:}++>>> :{+let+  setup :: Definition '[] Schema+  setup =+   createTable #users+     ( serial `As` #id :*+       (text & notNullable) `As` #name :* Nil )+     ( primaryKey #id `As` #pk_users :* Nil ) >>>+   createTable #emails+     ( serial `As` #id :*+       (int & notNullable) `As` #user_id :*+       (text & nullable) `As` #email :* Nil )+     ( primaryKey #id `As` #pk_emails :*+       foreignKey #user_id #users #id+         OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )+in printSQL setup+:}+CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));+CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);++A `foreignKey` can even be a table self-reference.++>>> :{+type Schema =+  '[ "employees" ::: 'Table (+       '[ "employees_pk"          ::: 'PrimaryKey '["id"]+        , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "employees" '["id"]+        ] :=>+       '[ "id"          :::   'Def :=> 'NotNull 'PGint4+        , "name"        ::: 'NoDef :=> 'NotNull 'PGtext+        , "employer_id" ::: 'NoDef :=>    'Null 'PGint4+        ])+   ]+:}++>>> :{+let+  setup :: Definition '[] Schema+  setup =+   createTable #employees+     ( serial `As` #id :*+       (text & notNullable) `As` #name :*+       (integer & nullable) `As` #employer_id :* Nil )+     ( primaryKey #id `As` #employees_pk :*+       foreignKey #employer_id #employees #id+         OnDeleteCascade OnUpdateCascade `As` #employees_employer_fk :* Nil )+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);+-} foreignKey-  :: ForeignKeyed schema table reftable subcolumns refsubcolumns-  => NP (Column columns) subcolumns+  :: (ForeignKeyed schema child parent+        table reftable+        columns refcolumns+        constraints cols+        reftys tys )+  => NP Alias columns   -- ^ column or columns in the table-  -> Alias table+  -> Alias parent   -- ^ reference table-  -> NP (Column (TableToColumns reftable)) refsubcolumns+  -> NP Alias refcolumns   -- ^ reference column or columns in the reference table   -> OnDeleteClause   -- ^ what to do when reference is deleted   -> OnUpdateClause   -- ^ what to do when reference is updated-  -> TableConstraintExpression schema columns-      ('ForeignKey (AliasesOf subcolumns) table (AliasesOf refsubcolumns))-foreignKey columns reftable refcolumns onDelete onUpdate =-  UnsafeTableConstraintExpression $-    "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)-    <+> "REFERENCES" <+> renderAlias reftable-    <+> parenthesized (renderCommaSeparated renderColumn refcolumns)-    <+> renderOnDeleteClause onDelete-    <+> renderOnUpdateClause onUpdate+  -> TableConstraintExpression schema child+      ('ForeignKey columns parent refcolumns)+foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $+  "FOREIGN KEY" <+> parenthesized (commaSeparated (renderAliases keys))+  <+> "REFERENCES" <+> renderAlias parent+  <+> parenthesized (commaSeparated (renderAliases refs))+  <+> renderOnDeleteClause ondel+  <+> renderOnUpdateClause onupd --- | A type synonym for constraints on a table with a foreign key.-type ForeignKeyed schema table reftable subcolumns refsubcolumns-  = ( Has table schema reftable-    , SameTypes subcolumns refsubcolumns-    , AllNotNull subcolumns-    , SOP.SListI subcolumns-    , SOP.SListI refsubcolumns )+-- | A constraint synonym between types involved in a foreign key constraint.+type ForeignKeyed schema+  child parent+  table reftable+  columns refcolumns+  constraints cols+  reftys tys =+    ( Has child schema ('Table table)+    , Has parent schema ('Table reftable)+    , HasAll columns (TableToColumns table) tys+    , reftable ~ (constraints :=> cols)+    , HasAll refcolumns cols reftys+    , SOP.AllZip SamePGType tys reftys+    , Uniquely refcolumns constraints )  -- | `OnDeleteClause` indicates what to do with rows that reference a deleted row. data OnDeleteClause@@ -389,13 +487,19 @@  -- | `dropTable` removes a table from the schema. ----- >>> renderDefinition $ dropTable #muh_table--- "DROP TABLE \"muh_table\";"+-- >>> :{+-- let+--   definition :: Definition '["muh_table" ::: 'Table t] '[]+--   definition = dropTable #muh_table+-- :}+--+-- >>> printSQL definition+-- DROP TABLE "muh_table"; dropTable-  :: KnownSymbol table+  :: Has table schema ('Table t)   => Alias table -- ^ table to remove   -> Definition schema (Drop table schema)-dropTable table = UnsafeDefinition $ "DROP TABLE" <+> renderAlias table <> ";"+dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderAlias tab <> ";"  {----------------------------------------- ALTER statements@@ -403,20 +507,20 @@  -- | `alterTable` changes the definition of a table from the schema. alterTable-  :: Has tab schema table0-  => Alias tab -- ^ table to alter-  -> AlterTable schema table0 table1 -- ^ alteration to perform-  -> Definition schema (Alter tab schema table1)-alterTable table alteration = UnsafeDefinition $+  :: KnownSymbol alias+  => Alias alias -- ^ table to alter+  -> AlterTable alias table schema -- ^ alteration to perform+  -> Definition schema (Alter alias ('Table table) schema)+alterTable tab alteration = UnsafeDefinition $   "ALTER TABLE"-  <+> renderAlias table+  <+> renderAlias tab   <+> renderAlterTable alteration   <> ";"  -- | `alterTableRename` changes the name of a table from the schema. ----- >>> renderDefinition $ alterTableRename #foo #bar--- "ALTER TABLE \"foo\" RENAME TO \"bar\";"+-- >>> printSQL $ alterTableRename #foo #bar+-- ALTER TABLE "foo" RENAME TO "bar"; alterTableRename   :: (KnownSymbol table0, KnownSymbol table1)   => Alias table0 -- ^ table to rename@@ -429,9 +533,9 @@ -- | An `AlterTable` describes the alteration to perform on the columns -- of a table. newtype AlterTable-  (schema :: TablesType)-  (table0 :: TableType)-  (table1 :: TableType) =+  (alias :: Symbol)+  (table :: TableType)+  (schema :: SchemaType) =     UnsafeAlterTable {renderAlterTable :: ByteString}   deriving (GHC.Generic,Show,Eq,Ord,NFData) @@ -440,19 +544,21 @@ -- >>> :{ -- let --   definition :: Definition---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]---     '["tab" ::: '["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]---   definition = alterTable #tab (addConstraint #positive (check (Column #col :* Nil) (#col .> 0)))--- in renderDefinition 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)))+-- in printSQL definition -- :}--- "ALTER TABLE \"tab\" ADD CONSTRAINT \"positive\" CHECK ((\"col\" > 0));"+-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0)); addConstraint-  :: KnownSymbol alias+  :: ( KnownSymbol alias+     , Has tab schema ('Table table0)+     , table0 ~ (constraints :=> columns)+     , table1 ~ (Create alias constraint constraints :=> columns) )   => Alias alias-  -> TableConstraintExpression schema columns constraint+  -> TableConstraintExpression schema tab constraint   -- ^ constraint to add-  -> AlterTable schema (constraints :=> columns)-      (Create alias constraint constraints :=> columns)+  -> AlterTable tab table1 schema addConstraint alias constraint = UnsafeAlterTable $   "ADD" <+> "CONSTRAINT" <+> renderAlias alias     <+> renderTableConstraintExpression constraint@@ -462,19 +568,20 @@ -- >>> :{ -- let --   definition :: Definition---     '["tab" ::: '["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]+--     '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])] --   definition = alterTable #tab (dropConstraint #positive)--- in renderDefinition definition+-- in printSQL definition -- :}--- "ALTER TABLE \"tab\" DROP CONSTRAINT \"positive\";"+-- ALTER TABLE "tab" DROP CONSTRAINT "positive"; dropConstraint-  :: KnownSymbol constraint+  :: ( KnownSymbol constraint+     , Has tab schema ('Table table0)+     , table0 ~ (constraints :=> columns)+     , table1 ~ (Drop constraint constraints :=> columns) )   => Alias constraint   -- ^ constraint to drop-  -> AlterTable schema-      (constraints :=> columns)-      (Drop constraint constraints :=> columns)+  -> AlterTable tab table1 schema dropConstraint constraint = UnsafeAlterTable $   "DROP" <+> "CONSTRAINT" <+> renderAlias constraint @@ -486,34 +593,36 @@   -- >>> :{   -- let   --   definition :: Definition-  --     '["tab" ::: '[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4]]-  --     '["tab" ::: '[] :=>+  --     '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]+  --     '["tab" ::: 'Table ('[] :=>   --        '[ "col1" ::: 'NoDef :=> 'Null 'PGint4-  --         , "col2" ::: 'Def :=> 'Null 'PGtext ]]-  --   definition = alterTable #tab (addColumn #col2 (text & default_ "foo"))-  -- in renderDefinition definition+  --         , "col2" ::: 'Def :=> 'Null 'PGtext ])]+  --   definition = alterTable #tab (addColumn #col2 (text & nullable & default_ "foo"))+  -- in printSQL definition   -- :}-  -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text DEFAULT E'foo';"+  -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL DEFAULT E'foo';   --   -- >>> :{   -- let   --   definition :: Definition-  --     '["tab" ::: '[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4]]-  --     '["tab" ::: '[] :=>+  --     '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]+  --     '["tab" ::: 'Table ('[] :=>   --        '[ "col1" ::: 'NoDef :=> 'Null 'PGint4-  --         , "col2" ::: 'NoDef :=> 'Null 'PGtext ]]-  --   definition = alterTable #tab (addColumn #col2 text)-  -- in renderDefinition definition+  --         , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]+  --   definition = alterTable #tab (addColumn #col2 (text & nullable))+  -- in printSQL definition   -- :}-  -- "ALTER TABLE \"tab\" ADD COLUMN \"col2\" text;"+  -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL;   addColumn-    :: KnownSymbol column+    :: ( KnownSymbol column+       , Has tab schema ('Table table0)+       , table0 ~ (constraints :=> columns)+       , table1 ~ (constraints :=> Create column ty columns) )     => Alias column -- ^ column to add-    -> TypeExpression ty -- ^ type of the new column-    -> AlterTable schema (constraints :=> columns)-        (constraints :=> Create column ty columns)+    -> ColumnTypeExpression schema ty -- ^ type of the new column+    -> AlterTable tab table1 schema   addColumn column ty = UnsafeAlterTable $-    "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty+    "ADD COLUMN" <+> renderAlias column <+> renderColumnTypeExpression ty instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty) instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty) @@ -525,20 +634,21 @@ -- >>> :{ -- let --   definition :: Definition---     '["tab" ::: '[] :=>+--     '["tab" ::: 'Table ('[] :=> --        '[ "col1" ::: 'NoDef :=> 'Null 'PGint4---         , "col2" ::: 'NoDef :=> 'Null 'PGtext ]]---     '["tab" ::: '[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4]]+--         , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]+--     '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])] --   definition = alterTable #tab (dropColumn #col2)--- in renderDefinition definition+-- in printSQL definition -- :}--- "ALTER TABLE \"tab\" DROP COLUMN \"col2\";"+-- ALTER TABLE "tab" DROP COLUMN "col2"; dropColumn-  :: KnownSymbol column+  :: ( KnownSymbol column+     , Has tab schema ('Table table0)+     , table0 ~ (constraints :=> columns)+     , table1 ~ (constraints :=> Drop column columns) )   => Alias column -- ^ column to remove-  -> AlterTable schema-      (constraints :=> columns)-      (DropIfConstraintsInvolve column constraints :=> Drop column columns)+  -> AlterTable tab table1 schema dropColumn column = UnsafeAlterTable $   "DROP COLUMN" <+> renderAlias column @@ -547,33 +657,39 @@ -- >>> :{ -- let --   definition :: Definition---     '["tab" ::: '[] :=> '["foo" ::: 'NoDef :=> 'Null 'PGint4]]---     '["tab" ::: '[] :=> '["bar" ::: 'NoDef :=> 'Null 'PGint4]]+--     '["tab" ::: 'Table ('[] :=> '["foo" ::: 'NoDef :=> 'Null 'PGint4])]+--     '["tab" ::: 'Table ('[] :=> '["bar" ::: 'NoDef :=> 'Null 'PGint4])] --   definition = alterTable #tab (renameColumn #foo #bar)--- in renderDefinition definition+-- in printSQL definition -- :}--- "ALTER TABLE \"tab\" RENAME COLUMN \"foo\" TO \"bar\";"+-- ALTER TABLE "tab" RENAME COLUMN "foo" TO "bar"; renameColumn-  :: (KnownSymbol column0, KnownSymbol column1)+  :: ( KnownSymbol column0+     , KnownSymbol column1+     , Has tab schema ('Table table0)+     , table0 ~ (constraints :=> columns)+     , table1 ~ (constraints :=> Rename column0 column1 columns) )   => Alias column0 -- ^ column to rename   -> Alias column1 -- ^ what to rename the column-  -> AlterTable schema (constraints :=> columns)-      (constraints :=> Rename column0 column1 columns)+  -> AlterTable tab table1 schema renameColumn column0 column1 = UnsafeAlterTable $   "RENAME COLUMN" <+> renderAlias column0  <+> "TO" <+> renderAlias column1  -- | An `alterColumn` alters a single column. alterColumn-  :: (KnownSymbol column, Has column columns ty0)+  :: ( KnownSymbol column+     , Has tab schema ('Table table0)+     , table0 ~ (constraints :=> columns)+     , Has column columns ty0+     , tables1 ~ (constraints :=> Alter column ty1 columns))   => Alias column -- ^ column to alter-  -> AlterColumn ty0 ty1 -- ^ alteration to perform-  -> AlterTable schema (constraints :=> columns)-      (constraints :=> Alter column columns ty1)+  -> AlterColumn schema ty0 ty1 -- ^ alteration to perform+  -> AlterTable tab table1 schema alterColumn column alteration = UnsafeAlterTable $   "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration  -- | An `AlterColumn` describes the alteration to perform on a single column.-newtype AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =+newtype AlterColumn (schema :: SchemaType) (ty0 :: ColumnType) (ty1 :: ColumnType) =   UnsafeAlterColumn {renderAlterColumn :: ByteString}   deriving (GHC.Generic,Show,Eq,Ord,NFData) @@ -584,15 +700,15 @@ -- >>> :{ -- let --   definition :: Definition---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]---     '["tab" ::: '[] :=> '["col" ::: 'Def :=> 'Null 'PGint4]]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])] --   definition = alterTable #tab (alterColumn #col (setDefault 5))--- in renderDefinition definition+-- in printSQL definition -- :}--- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" SET DEFAULT 5;"+-- ALTER TABLE "tab" ALTER COLUMN "col" SET DEFAULT 5; setDefault-  :: Expression '[] 'Ungrouped '[] ty -- ^ default value to set-  -> AlterColumn (constraint :=> ty) ('Def :=> ty)+  :: Expression schema '[] 'Ungrouped '[] ty -- ^ default value to set+  -> AlterColumn schema (constraint :=> ty) ('Def :=> ty) setDefault expression = UnsafeAlterColumn $   "SET DEFAULT" <+> renderExpression expression @@ -601,13 +717,13 @@ -- >>> :{ -- let --   definition :: Definition---     '["tab" ::: '[] :=> '["col" ::: 'Def :=> 'Null 'PGint4]]---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])] --   definition = alterTable #tab (alterColumn #col dropDefault)--- in renderDefinition definition+-- in printSQL definition -- :}--- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" DROP DEFAULT;"-dropDefault :: AlterColumn ('Def :=> ty) ('NoDef :=> ty)+-- ALTER TABLE "tab" ALTER COLUMN "col" DROP DEFAULT;+dropDefault :: AlterColumn schema ('Def :=> ty) ('NoDef :=> ty) dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"  -- | A `setNotNull` adds a @NOT NULL@ constraint to a column.@@ -617,14 +733,14 @@ -- >>> :{ -- let --   definition :: Definition---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])] --   definition = alterTable #tab (alterColumn #col setNotNull)--- in renderDefinition definition+-- in printSQL definition -- :}--- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" SET NOT NULL;"+-- ALTER TABLE "tab" ALTER COLUMN "col" SET NOT NULL; setNotNull-  :: AlterColumn (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)+  :: AlterColumn schema (constraint :=> 'Null ty) (constraint :=> 'NotNull ty) setNotNull = UnsafeAlterColumn $ "SET NOT NULL"  -- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.@@ -632,14 +748,14 @@ -- >>> :{ -- let --   definition :: Definition---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])] --   definition = alterTable #tab (alterColumn #col dropNotNull)--- in renderDefinition definition+-- in printSQL definition -- :}--- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" DROP NOT NULL;"+-- ALTER TABLE "tab" ALTER COLUMN "col" DROP NOT NULL; dropNotNull-  :: AlterColumn (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)+  :: AlterColumn schema (constraint :=> 'NotNull ty) (constraint :=> 'Null ty) dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"  -- | An `alterType` converts a column to a different data type.@@ -649,12 +765,188 @@ -- >>> :{ -- let --   definition :: Definition---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4]]---     '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric]]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]+--     '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])] --   definition =---     alterTable #tab (alterColumn #col (alterType (numeric & notNull)))--- in renderDefinition definition+--     alterTable #tab (alterColumn #col (alterType (numeric & notNullable)))+-- in printSQL definition -- :}--- "ALTER TABLE \"tab\" ALTER COLUMN \"col\" TYPE numeric NOT NULL;"-alterType :: TypeExpression ty -> AlterColumn ty0 ty-alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderTypeExpression ty+-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;+alterType :: ColumnTypeExpression schema ty -> AlterColumn schema ty0 ty+alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty++-- | Create a view.+--+-- >>> :{+-- let+--   definition :: Definition+--     '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]+--     '[ "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)))+-- in printSQL definition+-- :}+-- CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";+createView+  :: KnownSymbol view+  => Alias view -- ^ the name of the view to add+  -> Query schema '[] relation+    -- ^ query+  -> Definition schema (Create view ('View relation) schema)+createView alias query = UnsafeDefinition $+  "CREATE" <+> "VIEW" <+> renderAlias alias <+> "AS"+  <+> renderQuery query <> ";"++-- | Drop a view.+--+-- >>> :{+-- let+--   definition :: Definition+--     '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])+--      , "bc"  ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]+--     '[ "abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]+--   definition = dropView #bc+-- in printSQL definition+-- :}+-- DROP VIEW "bc";+dropView+  :: Has view schema ('View v)+  => Alias view -- ^ view to remove+  -> Definition schema (Drop view schema)+dropView v = UnsafeDefinition $ "DROP VIEW" <+> renderAlias v <> ";"++-- | Enumerated types are created using the `createTypeEnum` command, for example+--+-- >>> printSQL $ createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy" :* Nil)+-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');+createTypeEnum+  :: (KnownSymbol enum, SOP.All KnownSymbol labels)+  => Alias enum+  -- ^ name of the user defined enumerated type+  -> NP PGlabel labels+  -- ^ labels of the enumerated type+  -> Definition schema (Create enum ('Typedef ('PGenum labels)) schema)+createTypeEnum enum labels = UnsafeDefinition $+  "CREATE" <+> "TYPE" <+> renderAlias enum <+> "AS" <+> "ENUM" <+>+  parenthesized (commaSeparated (renderLabels labels)) <> ";"++-- | Enumerated types can also be generated from a Haskell type, for example+--+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic+-- >>> instance SOP.Generic Schwarma+-- >>> instance SOP.HasDatatypeInfo Schwarma+-- >>> printSQL $ createTypeEnumFrom @Schwarma #schwarma+-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');+createTypeEnumFrom+  :: forall hask enum schema.+  ( SOP.Generic hask+  , SOP.All KnownSymbol (LabelsFrom hask)+  , KnownSymbol enum+  )+  => Alias enum+  -- ^ name of the user defined enumerated type+  -> Definition schema (Create enum ('Typedef (EnumFrom hask)) schema)+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+  :: (KnownSymbol ty, SOP.SListI fields)+  => Alias ty+  -- ^ name of the user defined composite type+  -> NP (Aliased (TypeExpression schema)) fields+  -- ^ list of attribute names and data types+  -> Definition schema (Create ty ('Typedef ('PGcomposite fields)) schema)+createTypeComposite ty fields = UnsafeDefinition $+  "CREATE" <+> "TYPE" <+> renderAlias ty <+> "AS" <+> parenthesized+  (renderCommaSeparated renderField fields) <> ";"+  where+    renderField :: Aliased (TypeExpression schema) x -> ByteString+    renderField (typ `As` field) =+      renderAlias field <+> renderTypeExpression typ++-- | Composite types can also be generated from a Haskell type, for example+--+-- >>> data Complex = Complex {real :: Maybe Double, imaginary :: Maybe Double} deriving GHC.Generic+-- >>> instance SOP.Generic Complex+-- >>> instance SOP.HasDatatypeInfo Complex+-- >>> printSQL $ createTypeCompositeFrom @Complex #complex+-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);+createTypeCompositeFrom+  :: forall hask ty schema.+  ( ZipAliased (FieldNamesFrom hask) (FieldTypesFrom hask)+  , SOP.All (PGTyped schema) (FieldTypesFrom hask)+  , KnownSymbol ty+  )+  => Alias ty+  -- ^ name of the user defined composite type+  -> Definition schema (Create ty ( 'Typedef (CompositeFrom hask)) schema)+createTypeCompositeFrom ty = createTypeComposite ty $ zipAs+  (SOP.hpure Alias :: NP Alias (FieldNamesFrom hask))+  (SOP.hcpure (SOP.Proxy :: SOP.Proxy (PGTyped schema)) pgtype+    :: NP (TypeExpression schema) (FieldTypesFrom hask))++-- | Drop a type.+--+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic+-- >>> instance SOP.Generic Schwarma+-- >>> instance SOP.HasDatatypeInfo Schwarma+-- >>> printSQL (dropType #schwarma :: Definition '["schwarma" ::: 'Typedef (EnumFrom Schwarma)] '[])+-- DROP TYPE "schwarma";+dropType+  :: Has tydef schema ('Typedef ty)+  => Alias tydef+  -- ^ name of the user defined type+  -> Definition schema (Drop tydef schema)+dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderAlias tydef <> ";"++-- | `ColumnTypeExpression`s are used in `createTable` commands.+newtype ColumnTypeExpression (schema :: SchemaType) (ty :: ColumnType)+  = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }+  deriving (GHC.Generic,Show,Eq,Ord,NFData)++-- | used in `createTable` commands as a column constraint to note that+-- @NULL@ may be present in a column+nullable+  :: TypeExpression schema ty+  -> ColumnTypeExpression schema ('NoDef :=> 'Null ty)+nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"++-- | used in `createTable` commands as a column constraint to ensure+-- @NULL@ is not present in a column+notNullable+  :: TypeExpression schema ty+  -> ColumnTypeExpression schema (def :=> 'NotNull ty)+notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"++-- | used in `createTable` commands as a column constraint to give a default+default_+  :: Expression schema '[] 'Ungrouped '[] ty+  -> ColumnTypeExpression schema ('NoDef :=> ty)+  -> ColumnTypeExpression schema ('Def :=> ty)+default_ x ty = UnsafeColumnTypeExpression $+  renderColumnTypeExpression ty <+> "DEFAULT" <+> renderExpression x++-- | not a true type, but merely a notational convenience for creating+-- unique identifier columns with type `PGint2`+serial2, smallserial+  :: ColumnTypeExpression schema ('Def :=> 'NotNull 'PGint2)+serial2 = UnsafeColumnTypeExpression "serial2"+smallserial = UnsafeColumnTypeExpression "smallserial"+-- | not a true type, but merely a notational convenience for creating+-- unique identifier columns with type `PGint4`+serial4, serial+  :: ColumnTypeExpression schema ('Def :=> 'NotNull 'PGint4)+serial4 = UnsafeColumnTypeExpression "serial4"+serial = UnsafeColumnTypeExpression "serial"+-- | not a true type, but merely a notational convenience for creating+-- unique identifier columns with type `PGint8`+serial8, bigserial+  :: ColumnTypeExpression schema ('Def :=> 'NotNull 'PGint8)+serial8 = UnsafeColumnTypeExpression "serial8"+bigserial = UnsafeColumnTypeExpression "bigserial"

@@ -11,21 +11,15 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE     AllowAmbiguousTypes-  , DataKinds   , DeriveGeneric-  , DeriveDataTypeable   , FlexibleContexts   , FlexibleInstances   , FunctionalDependencies-  , GADTs   , GeneralizedNewtypeDeriving   , LambdaCase   , MagicHash   , OverloadedStrings-  , PolyKinds-  , RankNTypes   , ScopedTypeVariables-  , StandaloneDeriving   , TypeApplications   , TypeFamilies   , TypeInType@@ -33,21 +27,23 @@   , UndecidableInstances #-} -module Squeal.PostgreSQL.Expression +module Squeal.PostgreSQL.Expression   ( -- * Expression     Expression (UnsafeExpression, renderExpression)-  , HasParameter (param)+  , HasParameter (parameter)+  , param     -- ** Null   , null_-  , unNull+  , notNull   , coalesce   , fromNull   , isNull-  , isn'tNull+  , isNotNull   , matchNull   , nullIf-    -- ** Arrays+    -- ** Collections   , array+  , row     -- ** Functions   , unsafeBinaryOp   , unsafeUnaryOp@@ -97,8 +93,6 @@   , count, countDistinct   , every, everyDistinct   , max_, maxDistinct, min_, minDistinct-    -- * Tables-  , Table (UnsafeTable, renderTable)     -- * Types   , TypeExpression (UnsafeTypeExpression, renderTypeExpression)   , PGTyped (pgtype)@@ -115,12 +109,6 @@   , real   , float8   , doublePrecision-  , serial2-  , smallserial-  , serial4-  , serial-  , serial8-  , bigserial   , text   , char   , character@@ -139,8 +127,6 @@   , jsonb   , vararray   , fixarray-  , notNull-  , default_     -- * Re-export   , (&)   , NP ((:*), Nil)@@ -150,7 +136,7 @@ import Control.DeepSeq import Data.ByteString (ByteString) import Data.Function ((&))-import Data.Monoid hiding (All)+import Data.Semigroup import Data.Ratio import Data.String import Generics.SOP hiding (from)@@ -178,6 +164,7 @@ and other operations. -} newtype Expression+  (schema :: SchemaType)   (relations :: RelationsType)   (grouping :: Grouping)   (params :: [NullityType])@@ -185,6 +172,9 @@     = UnsafeExpression { renderExpression :: ByteString }     deriving (GHC.Generic,Show,Eq,Ord,NFData) +instance RenderSQL (Expression schema relations grouping params ty) where+  renderSQL = renderExpression+ {- | A `HasParameter` constraint is used to indicate a value that is supplied externally to a SQL statement. `Squeal.PostgreSQL.PQ.manipulateParams`,@@ -193,203 +183,302 @@ separately from the SQL command string, in which case `param`s are used to refer to the out-of-line data values. -}-class (PGTyped (PGTypeOf ty), KnownNat n) => HasParameter+class KnownNat n => HasParameter   (n :: Nat)+  (schema :: SchemaType)   (params :: [NullityType])   (ty :: NullityType)   | n params -> ty where-    param :: Expression relations grouping params ty-    param = UnsafeExpression $ parenthesized $+    -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.+    --+    -- >>> let expr = parameter @1 int4 :: Expression sch rels grp '[ 'Null 'PGint4] ('Null 'PGint4)+    -- >>> printSQL expr+    -- ($1 :: int4)+    parameter+      :: TypeExpression schema (PGTypeOf ty)+      -> Expression schema relations grouping params ty+    parameter ty = UnsafeExpression $ parenthesized $       "$" <> renderNat (Proxy @n) <+> "::"-        <+> renderTypeExpression (pgtype @(PGTypeOf ty))-instance {-# OVERLAPPING #-} PGTyped (PGTypeOf ty1)-  => HasParameter 1 (ty1:tys) ty1-instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)-  => HasParameter n (ty' : params) ty+        <+> renderTypeExpression ty+instance {-# OVERLAPPING #-} HasParameter 1 schema (ty1:tys) ty1+instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) schema params ty)+  => HasParameter n schema (ty' : params) ty +-- | `param` takes a `Nat` using type application and for basic types,+-- infers a `TypeExpression`.+--+-- >>> let expr = param @1 :: Expression sch rels grp '[ 'Null 'PGint4] ('Null 'PGint4)+-- >>> printSQL expr+-- ($1 :: int4)+param+  :: forall n schema params relations grouping ty+   . (PGTyped schema (PGTypeOf ty), HasParameter n schema params ty)+  => Expression schema relations grouping params ty -- ^ param+param = parameter @n pgtype+ instance (HasUnique relation relations columns, Has column columns ty)-  => IsLabel column (Expression relations 'Ungrouped params ty) where+  => IsLabel column (Expression schema relations 'Ungrouped params ty) where     fromLabel = UnsafeExpression $ renderAlias (Alias @column)+instance (HasUnique relation relations columns, Has column columns ty)+  => IsLabel column+    (Aliased (Expression schema relations 'Ungrouped params) (column ::: ty)) where+    fromLabel = fromLabel @column `As` Alias @column+instance (HasUnique relation relations columns, Has column columns ty)+  => IsLabel column+    (NP (Aliased (Expression schema relations 'Ungrouped params)) '[column ::: ty]) where+    fromLabel = fromLabel @column :* Nil  instance (Has relation relations columns, Has column columns ty)-  => IsQualified relation column (Expression relations 'Ungrouped params ty) where+  => IsQualified relation column (Expression schema relations 'Ungrouped params ty) where     relation ! column = UnsafeExpression $       renderAlias relation <> "." <> renderAlias column-  +instance (Has relation relations columns, Has column columns ty)+  => IsQualified relation column+    (Aliased (Expression schema relations 'Ungrouped params) (column ::: ty)) where+    relation ! column = relation ! column `As` column+instance (Has relation relations columns, Has column columns ty)+  => IsQualified relation column+    (NP (Aliased (Expression schema relations 'Ungrouped params)) '[column ::: ty]) where+    relation ! column = relation ! column :* Nil+ instance   ( HasUnique relation relations columns   , Has column columns ty   , GroupedBy relation column bys   ) => IsLabel column-    (Expression relations ('Grouped bys) params ty) where+    (Expression schema relations ('Grouped bys) params ty) where       fromLabel = UnsafeExpression $ renderAlias (Alias @column)-   instance+  ( HasUnique relation relations columns+  , Has column columns ty+  , GroupedBy relation column bys+  ) => IsLabel column+    ( Aliased (Expression schema relations ('Grouped bys) params)+      (column ::: ty) ) where+      fromLabel = fromLabel @column `As` Alias @column+instance+  ( HasUnique relation relations columns+  , Has column columns ty+  , GroupedBy relation column bys+  ) => IsLabel column+    ( NP (Aliased (Expression schema relations ('Grouped bys) params))+      '[column ::: ty] ) where+      fromLabel = fromLabel @column :* Nil++instance   ( Has relation relations columns   , Has column columns ty   , GroupedBy relation column bys   ) => IsQualified relation column-    (Expression relations ('Grouped bys) params ty) where+    (Expression schema relations ('Grouped bys) params ty) where       relation ! column = UnsafeExpression $         renderAlias relation <> "." <> renderAlias column+instance+  ( Has relation relations columns+  , Has column columns ty+  , GroupedBy relation column bys+  ) => IsQualified relation column+    (Aliased (Expression schema relations ('Grouped bys) params)+      (column ::: ty)) where+        relation ! column = relation ! column `As` column+instance+  ( Has relation relations columns+  , Has column columns ty+  , GroupedBy relation column bys+  ) => IsQualified relation column+    ( NP (Aliased (Expression schema relations ('Grouped bys) params))+      '[column ::: ty]) where+        relation ! column = relation ! column :* Nil  -- | analagous to `Nothing` ----- >>> renderExpression $ null_--- "NULL"-null_ :: Expression relations grouping params ('Null ty)+-- >>> printSQL null_+-- NULL+null_ :: Expression schema rels grouping params ('Null ty) null_ = UnsafeExpression "NULL"  -- | analagous to `Just` ----- >>> renderExpression $ unNull true--- "TRUE"-unNull-  :: Expression relations grouping params ('NotNull ty)-  -- ^ not @NULL@-  -> Expression relations grouping params ('Null ty)-unNull = UnsafeExpression . renderExpression+-- >>> printSQL $ notNull true+-- TRUE+notNull+  :: Expression schema rels grouping params ('NotNull ty)+  -> Expression schema rels grouping params ('Null ty)+notNull = UnsafeExpression . renderExpression  -- | return the leftmost value which is not NULL ----- >>> renderExpression $ coalesce [null_, unNull true] false--- "COALESCE(NULL, TRUE, FALSE)"+-- >>> printSQL $ coalesce [null_, notNull true] false+-- COALESCE(NULL, TRUE, FALSE) coalesce-  :: [Expression relations grouping params ('Null ty)]+  :: [Expression schema relations grouping params ('Null ty)]   -- ^ @NULL@s may be present-  -> Expression relations grouping params ('NotNull ty)+  -> Expression schema relations grouping params ('NotNull ty)   -- ^ @NULL@ is absent-  -> Expression relations grouping params ('NotNull ty)+  -> Expression schema relations grouping params ('NotNull ty) coalesce nullxs notNullx = UnsafeExpression $   "COALESCE" <> parenthesized (commaSeparated     ((renderExpression <$> nullxs) <> [renderExpression notNullx]))  -- | analagous to `Data.Maybe.fromMaybe` using @COALESCE@ ----- >>> renderExpression $ fromNull true null_--- "COALESCE(NULL, TRUE)"+-- >>> printSQL $ fromNull true null_+-- COALESCE(NULL, TRUE) fromNull-  :: Expression relations grouping params ('NotNull ty)+  :: Expression schema relations grouping params ('NotNull ty)   -- ^ what to convert @NULL@ to-  -> Expression relations grouping params ('Null ty)-  -> Expression relations grouping params ('NotNull ty)+  -> Expression schema relations grouping params ('Null ty)+  -> Expression schema relations grouping params ('NotNull ty) fromNull notNullx nullx = coalesce [nullx] notNullx --- | >>> renderExpression $ null_ & isNull--- "NULL IS NULL"+-- | >>> printSQL $ null_ & isNull+-- NULL IS NULL isNull-  :: Expression relations grouping params ('Null ty)+  :: Expression schema relations grouping params ('Null ty)   -- ^ possibly @NULL@-  -> Condition relations grouping params+  -> Condition schema relations grouping params isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL" --- | >>> renderExpression $ null_ & isn'tNull--- "NULL IS NOT NULL"-isn'tNull-  :: Expression relations grouping params ('Null ty)+-- | >>> printSQL $ null_ & isNotNull+-- NULL IS NOT NULL+isNotNull+  :: Expression schema relations grouping params ('Null ty)   -- ^ possibly @NULL@-  -> Condition relations grouping params-isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"+  -> Condition schema relations grouping params+isNotNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"  -- | analagous to `maybe` using @IS NULL@ ----- >>> renderExpression $ matchNull true not_ null_--- "CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END"+-- >>> printSQL $ matchNull true not_ null_+-- CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END matchNull-  :: Expression relations grouping params (nullty)+  :: Expression schema relations grouping params (nullty)   -- ^ what to convert @NULL@ to-  -> ( Expression relations grouping params ('NotNull ty)-       -> Expression relations grouping params (nullty) )+  -> ( Expression schema relations grouping params ('NotNull ty)+       -> Expression schema relations grouping params (nullty) )   -- ^ function to perform when @NULL@ is absent-  -> Expression relations grouping params ('Null ty)-  -> Expression relations grouping params (nullty)+  -> Expression schema relations grouping params ('Null ty)+  -> Expression schema relations grouping params (nullty) matchNull y f x = ifThenElse (isNull x) y   (f (UnsafeExpression (renderExpression x))) --- | right inverse to `fromNull`, if its arguments are equal then--- `nullIf` gives @NULL@.------ >>> :set -XTypeApplications -XDataKinds--- >>> renderExpression @_ @_ @'[_] $ fromNull false (nullIf false (param @1))--- "COALESCE(NULL IF (FALSE, ($1 :: bool)), FALSE)"+{-| right inverse to `fromNull`, if its arguments are equal then+`nullIf` gives @NULL@.++>>> :set -XTypeApplications -XDataKinds+>>> let expr = nullIf false (param @1) :: Expression schema rels grp '[ 'NotNull 'PGbool] ('Null 'PGbool)+>>> printSQL expr+NULL IF (FALSE, ($1 :: bool))+-} nullIf-  :: Expression relations grouping params ('NotNull ty)+  :: Expression schema relations grouping params ('NotNull ty)   -- ^ @NULL@ is absent-  -> Expression relations grouping params ('NotNull ty)+  -> Expression schema relations grouping params ('NotNull ty)   -- ^ @NULL@ is absent-  -> Expression relations grouping params ('Null ty)+  -> Expression schema relations grouping params ('Null ty) nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized   (renderExpression x <> ", " <> renderExpression y) --- | >>> renderExpression $ array [null_, unNull false, unNull true]--- "ARRAY[NULL, FALSE, TRUE]"+-- | >>> printSQL $ array [null_, notNull false, notNull true]+-- ARRAY[NULL, FALSE, TRUE] array-  :: [Expression relations grouping params ('Null ty)]+  :: [Expression schema relations grouping params ('Null ty)]   -- ^ array elements-  -> Expression relations grouping params (nullity ('PGvararray ty))+  -> Expression schema relations grouping params (nullity ('PGvararray ty)) array xs = UnsafeExpression $   "ARRAY[" <> commaSeparated (renderExpression <$> xs) <> "]" +instance (KnownSymbol label, label `In` labels) => IsPGlabel label+  (Expression schema relations grouping params (nullity ('PGenum labels))) where+  label = UnsafeExpression $ renderLabel (PGlabel @label)++-- | A row constructor is an expression that builds a row value+-- (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)+-- >>> printSQL i+-- ROW(0, 1)+row+  :: SListI (Nulls fields)+  => NP (Aliased (Expression schema relations grouping params)) (Nulls fields)+  -- ^ zero or more expressions for the row field values+  -> Expression schema relations grouping params (nullity ('PGcomposite fields))+row exprs = UnsafeExpression $ "ROW" <> parenthesized+  (renderCommaSeparated (\ (expr `As` _) -> renderExpression expr) exprs)++instance Has field fields ty => IsLabel field+  (   Expression schema relation grouping params (nullity ('PGcomposite fields))+   -> Expression schema relation grouping params ('Null ty) ) where+    fromLabel expr = UnsafeExpression $+      parenthesized (renderExpression expr) <> "." <>+        fromString (symbolVal (Proxy @field))++instance Semigroup+  (Expression schema relations grouping params (nullity ('PGvararray ty))) where+    (<>) = unsafeBinaryOp "||"+ instance Monoid-  (Expression relations grouping params (nullity ('PGvararray ty))) where+  (Expression schema relations grouping params (nullity ('PGvararray ty))) where     mempty = array []-    mappend = unsafeBinaryOp "||"+    mappend = (<>) --- | >>> renderExpression @_ @_ @'[_] $ greatest currentTimestamp [param @1]--- "GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))"+-- | >>> let expr = greatest currentTimestamp [param @1] :: Expression sch rels grp '[ 'NotNull 'PGtimestamptz] ('NotNull 'PGtimestamptz)+-- >>> printSQL expr+-- GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone)) greatest-  :: Expression relations grouping params (nullty)+  :: Expression schema relations grouping params (nullty)   -- ^ needs at least 1 argument-  -> [Expression relations grouping params (nullty)]+  -> [Expression schema relations grouping params (nullty)]   -- ^ or more-  -> Expression relations grouping params (nullty)+  -> Expression schema relations grouping params (nullty) greatest x xs = UnsafeExpression $ "GREATEST("   <> commaSeparated (renderExpression <$> (x:xs)) <> ")" --- | >>> renderExpression $ least currentTimestamp [null_]--- "LEAST(CURRENT_TIMESTAMP, NULL)"+-- | >>> printSQL $ least currentTimestamp [null_]+-- LEAST(CURRENT_TIMESTAMP, NULL) least-  :: Expression relations grouping params (nullty)+  :: Expression schema relations grouping params (nullty)   -- ^ needs at least 1 argument-  -> [Expression relations grouping params (nullty)]+  -> [Expression schema relations grouping params (nullty)]   -- ^ or more-  -> Expression relations grouping params (nullty)+  -> Expression schema relations grouping params (nullty) least x xs = UnsafeExpression $ "LEAST("   <> commaSeparated (renderExpression <$> (x:xs)) <> ")" --- | >>> renderExpression $ unsafeBinaryOp "OR" true false--- "(TRUE OR FALSE)"+-- | >>> printSQL $ unsafeBinaryOp "OR" true false+-- (TRUE OR FALSE) unsafeBinaryOp   :: ByteString   -- ^ operator-  -> Expression relations grouping params (ty0)-  -> Expression relations grouping params (ty1)-  -> Expression relations grouping params (ty2)+  -> Expression schema relations grouping params (ty0)+  -> Expression schema relations grouping params (ty1)+  -> Expression schema relations grouping params (ty2) unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $   renderExpression x <+> op <+> renderExpression y --- | >>> renderExpression $ unsafeUnaryOp "NOT" true--- "(NOT TRUE)"+-- | >>> printSQL $ unsafeUnaryOp "NOT" true+-- (NOT TRUE) unsafeUnaryOp   :: ByteString   -- ^ operator-  -> Expression relations grouping params (ty0)-  -> Expression relations grouping params (ty1)+  -> Expression schema relations grouping params (ty0)+  -> Expression schema relations grouping params (ty1) unsafeUnaryOp op x = UnsafeExpression $ parenthesized $   op <+> renderExpression x --- | >>> renderExpression $ unsafeFunction "f" true--- "f(TRUE)"+-- | >>> printSQL $ unsafeFunction "f" true+-- f(TRUE) unsafeFunction   :: ByteString   -- ^ function-  -> Expression relations grouping params (xty)-  -> Expression relations grouping params (yty)+  -> Expression schema relations grouping params (xty)+  -> Expression schema relations grouping params (yty) unsafeFunction fun x = UnsafeExpression $   fun <> parenthesized (renderExpression x)  instance PGNum ty-  => Num (Expression relations grouping params (nullity ty)) where+  => Num (Expression schema relations grouping params (nullity ty)) where     (+) = unsafeBinaryOp "+"     (-) = unsafeBinaryOp "-"     (*) = unsafeBinaryOp "*"@@ -401,12 +490,12 @@       . show  instance (PGNum ty, PGFloating ty) => Fractional-  (Expression relations grouping params (nullity ty)) where+  (Expression schema relations grouping params (nullity ty)) where     (/) = unsafeBinaryOp "/"     fromRational x = fromInteger (numerator x) / fromInteger (denominator x)  instance (PGNum ty, PGFloating ty) => Floating-  (Expression relations grouping params (nullity ty)) where+  (Expression schema relations grouping params (nullity ty)) where     pi = UnsafeExpression "pi()"     exp = unsafeFunction "exp"     log = unsafeFunction "ln"@@ -429,18 +518,18 @@  -- | >>> :{ -- let---   expression :: Expression relations grouping params (nullity 'PGfloat4)+--   expression :: Expression schema relations grouping params (nullity 'PGfloat4) --   expression = atan2_ pi 2--- in renderExpression expression+-- in printSQL expression -- :}--- "atan2(pi(), 2)"+-- atan2(pi(), 2) atan2_   :: PGFloating float-  => Expression relations grouping params (nullity float)+  => Expression schema relations grouping params (nullity float)   -- ^ numerator-  -> Expression relations grouping params (nullity float)+  -> Expression schema relations grouping params (nullity float)   -- ^ denominator-  -> Expression relations grouping params (nullity float)+  -> Expression schema relations grouping params (nullity float) atan2_ y x = UnsafeExpression $   "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")" @@ -448,14 +537,14 @@ -- represents a run-time type conversion. The cast will succeed only if a -- suitable type conversion operation has been defined. ----- | >>> renderExpression $ true & cast int4--- "(TRUE :: int4)"+-- | >>> printSQL $ true & cast int4+-- (TRUE :: int4) cast-  :: TypeExpression ('NoDef :=> 'Null ty1)+  :: TypeExpression schema ty1   -- ^ type to cast as-  -> Expression relations grouping params (nullity ty0)+  -> Expression schema relations grouping params (nullity ty0)   -- ^ value to convert-  -> Expression relations grouping params (nullity ty1)+  -> Expression schema relations grouping params (nullity ty1) cast ty x = UnsafeExpression $ parenthesized $   renderExpression x <+> "::" <+> renderTypeExpression ty @@ -463,135 +552,135 @@ -- -- >>> :{ -- let---   expression :: Expression relations grouping params (nullity 'PGint2)+--   expression :: Expression schema relations grouping params (nullity 'PGint2) --   expression = 5 `quot_` 2--- in renderExpression expression+-- in printSQL expression -- :}--- "(5 / 2)"+-- (5 / 2) quot_   :: PGIntegral int-  => Expression relations grouping params (nullity int)+  => Expression schema relations grouping params (nullity int)   -- ^ numerator-  -> Expression relations grouping params (nullity int)+  -> Expression schema relations grouping params (nullity int)   -- ^ denominator-  -> Expression relations grouping params (nullity int)+  -> Expression schema relations grouping params (nullity int) quot_ = unsafeBinaryOp "/"  -- | remainder upon integer division -- -- >>> :{ -- let---   expression :: Expression relations grouping params (nullity 'PGint2)+--   expression :: Expression schema relations grouping params (nullity 'PGint2) --   expression = 5 `rem_` 2--- in renderExpression expression+-- in printSQL expression -- :}--- "(5 % 2)"+-- (5 % 2) rem_   :: PGIntegral int-  => Expression relations grouping params (nullity int)+  => Expression schema relations grouping params (nullity int)   -- ^ numerator-  -> Expression relations grouping params (nullity int)+  -> Expression schema relations grouping params (nullity int)   -- ^ denominator-  -> Expression relations grouping params (nullity int)+  -> Expression schema relations grouping params (nullity int) rem_ = unsafeBinaryOp "%"  -- | >>> :{ -- let---   expression :: Expression relations grouping params (nullity 'PGfloat4)+--   expression :: Expression schema relations grouping params (nullity 'PGfloat4) --   expression = trunc pi--- in renderExpression expression+-- in printSQL expression -- :}--- "trunc(pi())"+-- trunc(pi()) trunc   :: PGFloating frac-  => Expression relations grouping params (nullity frac)+  => Expression schema relations grouping params (nullity frac)   -- ^ fractional number-  -> Expression relations grouping params (nullity frac)+  -> Expression schema relations grouping params (nullity frac) trunc = unsafeFunction "trunc"  -- | >>> :{ -- let---   expression :: Expression relations grouping params (nullity 'PGfloat4)+--   expression :: Expression schema relations grouping params (nullity 'PGfloat4) --   expression = round_ pi--- in renderExpression expression+-- in printSQL expression -- :}--- "round(pi())"+-- round(pi()) round_   :: PGFloating frac-  => Expression relations grouping params (nullity frac)+  => Expression schema relations grouping params (nullity frac)   -- ^ fractional number-  -> Expression relations grouping params (nullity frac)+  -> Expression schema relations grouping params (nullity frac) round_ = unsafeFunction "round"  -- | >>> :{ -- let---   expression :: Expression relations grouping params (nullity 'PGfloat4)+--   expression :: Expression schema relations grouping params (nullity 'PGfloat4) --   expression = ceiling_ pi--- in renderExpression expression+-- in printSQL expression -- :}--- "ceiling(pi())"+-- ceiling(pi()) ceiling_   :: PGFloating frac-  => Expression relations grouping params (nullity frac)+  => Expression schema relations grouping params (nullity frac)   -- ^ fractional number-  -> Expression relations grouping params (nullity frac)+  -> Expression schema relations grouping params (nullity frac) ceiling_ = unsafeFunction "ceiling"  -- | A `Condition` is a boolean valued `Expression`. While SQL allows -- conditions to have @NULL@, Squeal instead chooses to disallow @NULL@, -- forcing one to handle the case of @NULL@ explicitly to produce -- a `Condition`.-type Condition relations grouping params =-  Expression relations grouping params ('NotNull 'PGbool)+type Condition schema relations grouping params =+  Expression schema relations grouping params ('NotNull 'PGbool) --- | >>> renderExpression true--- "TRUE"-true :: Condition relations grouping params+-- | >>> printSQL true+-- TRUE+true :: Condition schema relations grouping params true = UnsafeExpression "TRUE" --- | >>> renderExpression false--- "FALSE"-false :: Condition relations grouping params+-- | >>> printSQL false+-- FALSE+false :: Condition schema relations grouping params false = UnsafeExpression "FALSE" --- | >>> renderExpression $ not_ true--- "(NOT TRUE)"+-- | >>> printSQL $ not_ true+-- (NOT TRUE) not_-  :: Condition relations grouping params-  -> Condition relations grouping params+  :: Condition schema relations grouping params+  -> Condition schema relations grouping params not_ = unsafeUnaryOp "NOT" --- | >>> renderExpression $ true .&& false--- "(TRUE AND FALSE)"+-- | >>> printSQL $ true .&& false+-- (TRUE AND FALSE) (.&&)-  :: Condition relations grouping params-  -> Condition relations grouping params-  -> Condition relations grouping params+  :: Condition schema relations grouping params+  -> Condition schema relations grouping params+  -> Condition schema relations grouping params (.&&) = unsafeBinaryOp "AND" --- | >>> renderExpression $ true .|| false--- "(TRUE OR FALSE)"+-- | >>> printSQL $ true .|| false+-- (TRUE OR FALSE) (.||)-  :: Condition relations grouping params-  -> Condition relations grouping params-  -> Condition relations grouping params+  :: Condition schema relations grouping params+  -> Condition schema relations grouping params+  -> Condition schema relations grouping params (.||) = unsafeBinaryOp "OR"  -- | >>> :{ -- let---   expression :: Expression relations grouping params (nullity 'PGint2)+--   expression :: Expression schema relations grouping params (nullity 'PGint2) --   expression = caseWhenThenElse [(true, 1), (false, 2)] 3--- in renderExpression expression+-- in printSQL expression -- :}--- "CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END"+-- CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END caseWhenThenElse-  :: [ ( Condition relations grouping params-       , Expression relations grouping params (ty)+  :: [ ( Condition schema relations grouping params+       , Expression schema relations grouping params (ty)      ) ]   -- ^ whens and thens-  -> Expression relations grouping params (ty)+  -> Expression schema relations grouping params (ty)   -- ^ else-  -> Expression relations grouping params (ty)+  -> Expression schema relations grouping params (ty) caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat   [ "CASE"   , mconcat@@ -607,103 +696,103 @@  -- | >>> :{ -- let---   expression :: Expression relations grouping params (nullity 'PGint2)+--   expression :: Expression schema relations grouping params (nullity 'PGint2) --   expression = ifThenElse true 1 0--- in renderExpression expression+-- in printSQL expression -- :}--- "CASE WHEN TRUE THEN 1 ELSE 0 END"+-- CASE WHEN TRUE THEN 1 ELSE 0 END ifThenElse-  :: Condition relations grouping params-  -> Expression relations grouping params (ty) -- ^ then-  -> Expression relations grouping params (ty) -- ^ else-  -> Expression relations grouping params (ty)+  :: Condition schema relations grouping params+  -> Expression schema relations grouping params (ty) -- ^ then+  -> Expression schema relations grouping params (ty) -- ^ else+  -> Expression schema relations grouping params (ty) ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_  -- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=` -- will produce @NULL@s if one of their arguments is @NULL@. ----- >>> renderExpression $ unNull true .== null_--- "(TRUE = NULL)"+-- >>> printSQL $ notNull true .== null_+-- (TRUE = NULL) (.==)-  :: Expression relations grouping params (nullity ty) -- ^ lhs-  -> Expression relations grouping params (nullity ty) -- ^ rhs-  -> Expression relations grouping params (nullity 'PGbool)+  :: Expression schema relations grouping params (nullity ty) -- ^ lhs+  -> Expression schema relations grouping params (nullity ty) -- ^ rhs+  -> Expression schema relations grouping params (nullity 'PGbool) (.==) = unsafeBinaryOp "=" infix 4 .== --- | >>> renderExpression $ unNull true ./= null_--- "(TRUE <> NULL)"+-- | >>> printSQL $ notNull true ./= null_+-- (TRUE <> NULL) (./=)-  :: Expression relations grouping params (nullity ty) -- ^ lhs-  -> Expression relations grouping params (nullity ty) -- ^ rhs-  -> Expression relations grouping params (nullity 'PGbool)+  :: Expression schema relations grouping params (nullity ty) -- ^ lhs+  -> Expression schema relations grouping params (nullity ty) -- ^ rhs+  -> Expression schema relations grouping params (nullity 'PGbool) (./=) = unsafeBinaryOp "<>" infix 4 ./= --- | >>> renderExpression $ unNull true .>= null_--- "(TRUE >= NULL)"+-- | >>> printSQL $ notNull true .>= null_+-- (TRUE >= NULL) (.>=)-  :: Expression relations grouping params (nullity ty) -- ^ lhs-  -> Expression relations grouping params (nullity ty) -- ^ rhs-  -> Expression relations grouping params (nullity 'PGbool)+  :: Expression schema relations grouping params (nullity ty) -- ^ lhs+  -> Expression schema relations grouping params (nullity ty) -- ^ rhs+  -> Expression schema relations grouping params (nullity 'PGbool) (.>=) = unsafeBinaryOp ">=" infix 4 .>= --- | >>> renderExpression $ unNull true .< null_--- "(TRUE < NULL)"+-- | >>> printSQL $ notNull true .< null_+-- (TRUE < NULL) (.<)-  :: Expression relations grouping params (nullity ty) -- ^ lhs-  -> Expression relations grouping params (nullity ty) -- ^ rhs-  -> Expression relations grouping params (nullity 'PGbool)+  :: Expression schema relations grouping params (nullity ty) -- ^ lhs+  -> Expression schema relations grouping params (nullity ty) -- ^ rhs+  -> Expression schema relations grouping params (nullity 'PGbool) (.<) = unsafeBinaryOp "<" infix 4 .< --- | >>> renderExpression $ unNull true .<= null_--- "(TRUE <= NULL)"+-- | >>> printSQL $ notNull true .<= null_+-- (TRUE <= NULL) (.<=)-  :: Expression relations grouping params (nullity ty) -- ^ lhs-  -> Expression relations grouping params (nullity ty) -- ^ rhs-  -> Expression relations grouping params (nullity 'PGbool)+  :: Expression schema relations grouping params (nullity ty) -- ^ lhs+  -> Expression schema relations grouping params (nullity ty) -- ^ rhs+  -> Expression schema relations grouping params (nullity 'PGbool) (.<=) = unsafeBinaryOp "<=" infix 4 .<= --- | >>> renderExpression $ unNull true .> null_--- "(TRUE > NULL)"+-- | >>> printSQL $ notNull true .> null_+-- (TRUE > NULL) (.>)-  :: Expression relations grouping params (nullity ty) -- ^ lhs-  -> Expression relations grouping params (nullity ty) -- ^ rhs-  -> Expression relations grouping params (nullity 'PGbool)+  :: Expression schema relations grouping params (nullity ty) -- ^ lhs+  -> Expression schema relations grouping params (nullity ty) -- ^ rhs+  -> Expression schema relations grouping params (nullity 'PGbool) (.>) = unsafeBinaryOp ">" infix 4 .> --- | >>> renderExpression currentDate--- "CURRENT_DATE"+-- | >>> printSQL currentDate+-- CURRENT_DATE currentDate-  :: Expression relations grouping params (nullity 'PGdate)+  :: Expression schema relations grouping params (nullity 'PGdate) currentDate = UnsafeExpression "CURRENT_DATE" --- | >>> renderExpression currentTime--- "CURRENT_TIME"+-- | >>> printSQL currentTime+-- CURRENT_TIME currentTime-  :: Expression relations grouping params (nullity 'PGtimetz)+  :: Expression schema relations grouping params (nullity 'PGtimetz) currentTime = UnsafeExpression "CURRENT_TIME" --- | >>> renderExpression currentTimestamp--- "CURRENT_TIMESTAMP"+-- | >>> printSQL currentTimestamp+-- CURRENT_TIMESTAMP currentTimestamp-  :: Expression relations grouping params (nullity 'PGtimestamptz)+  :: Expression schema relations grouping params (nullity 'PGtimestamptz) currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP" --- | >>> renderExpression localTime--- "LOCALTIME"+-- | >>> printSQL localTime+-- LOCALTIME localTime-  :: Expression relations grouping params (nullity 'PGtime)+  :: Expression schema relations grouping params (nullity 'PGtime) localTime = UnsafeExpression "LOCALTIME" --- | >>> renderExpression localTimestamp--- "LOCALTIMESTAMP"+-- | >>> printSQL localTimestamp+-- LOCALTIMESTAMP localTimestamp-  :: Expression relations grouping params (nullity 'PGtimestamp)+  :: Expression schema relations grouping params (nullity 'PGtimestamp) localTimestamp = UnsafeExpression "LOCALTIMESTAMP"  {-----------------------------------------@@ -711,7 +800,7 @@ -----------------------------------------}  instance IsString-  (Expression relations grouping params (nullity 'PGtext)) where+  (Expression schema relations grouping params (nullity 'PGtext)) where     fromString str = UnsafeExpression $       "E\'" <> fromString (escape =<< str) <> "\'"       where@@ -726,33 +815,37 @@           '\\' -> "\\\\"           c -> [c] +instance Semigroup+  (Expression schema relations grouping params (nullity 'PGtext)) where+    (<>) = unsafeBinaryOp "||"+ instance Monoid-  (Expression relations grouping params (nullity 'PGtext)) where+  (Expression schema relations grouping params (nullity 'PGtext)) where     mempty = fromString ""-    mappend = unsafeBinaryOp "||"+    mappend = (<>) --- | >>> renderExpression $ lower "ARRRGGG"--- "lower(E'ARRRGGG')"+-- | >>> printSQL $ lower "ARRRGGG"+-- lower(E'ARRRGGG') lower-  :: Expression relations grouping params (nullity 'PGtext)+  :: Expression schema relations grouping params (nullity 'PGtext)   -- ^ string to lower case-  -> Expression relations grouping params (nullity 'PGtext)+  -> Expression schema relations grouping params (nullity 'PGtext) lower = unsafeFunction "lower" --- | >>> renderExpression $ upper "eeee"--- "upper(E'eeee')"+-- | >>> printSQL $ upper "eeee"+-- upper(E'eeee') upper-  :: Expression relations grouping params (nullity 'PGtext)+  :: Expression schema relations grouping params (nullity 'PGtext)   -- ^ string to upper case-  -> Expression relations grouping params (nullity 'PGtext)+  -> Expression schema relations grouping params (nullity 'PGtext) upper = unsafeFunction "upper" --- | >>> renderExpression $ charLength "four"--- "char_length(E'four')"+-- | >>> printSQL $ charLength "four"+-- char_length(E'four') charLength-  :: Expression relations grouping params (nullity 'PGtext)+  :: Expression schema relations grouping params (nullity 'PGtext)   -- ^ string to measure-  -> Expression relations grouping params (nullity 'PGint4)+  -> Expression schema relations grouping params (nullity 'PGint4) charLength = unsafeFunction "char_length"  -- | The `like` expression returns true if the @string@ matches@@ -762,14 +855,14 @@ -- in pattern stands for (matches) any single character; a percent sign (%) -- matches any sequence of zero or more characters. ----- >>> renderExpression $ "abc" `like` "a%"--- "(E'abc' LIKE E'a%')"+-- >>> printSQL $ "abc" `like` "a%"+-- (E'abc' LIKE E'a%') like-  :: Expression relations grouping params (nullity 'PGtext)+  :: Expression schema relations grouping params (nullity 'PGtext)   -- ^ string-  -> Expression relations grouping params (nullity 'PGtext)+  -> Expression schema relations grouping params (nullity 'PGtext)   -- ^ pattern-  -> Expression relations grouping params (nullity 'PGbool)+  -> Expression schema relations grouping params (nullity 'PGbool) like = unsafeBinaryOp "LIKE"  {-----------------------------------------@@ -779,54 +872,54 @@ -- | escape hatch to define aggregate functions unsafeAggregate   :: ByteString -- ^ aggregate function-  -> Expression relations 'Ungrouped params (xty)-  -> Expression relations ('Grouped bys) params (yty)+  -> Expression schema relations 'Ungrouped params (xty)+  -> Expression schema relations ('Grouped bys) params (yty) unsafeAggregate fun x = UnsafeExpression $ mconcat   [fun, "(", renderExpression x, ")"]  -- | escape hatch to define aggregate functions over distinct values unsafeAggregateDistinct   :: ByteString -- ^ aggregate function-  -> Expression relations 'Ungrouped params (xty)-  -> Expression relations ('Grouped bys) params (yty)+  -> Expression schema relations 'Ungrouped params (xty)+  -> Expression schema relations ('Grouped bys) params (yty) unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat   [fun, "(DISTINCT ", renderExpression x, ")"]  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('Grouped bys) params ('Null 'PGnumeric)+--   expression :: Expression schema '[tab ::: '["col" ::: 'Null 'PGnumeric]] ('Grouped bys) params ('Null 'PGnumeric) --   expression = sum_ #col--- in renderExpression expression+-- in printSQL expression -- :}--- "sum(\"col\")"+-- sum("col") sum_   :: PGNum ty-  => Expression relations 'Ungrouped params (nullity ty)+  => Expression schema relations 'Ungrouped params (nullity ty)   -- ^ what to sum-  -> Expression relations ('Grouped bys) params (nullity ty)+  -> Expression schema relations ('Grouped bys) params (nullity ty) sum_ = unsafeAggregate "sum"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGnumeric]] ('Grouped bys) params (nullity 'PGnumeric)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGnumeric]] ('Grouped bys) params (nullity 'PGnumeric) --   expression = sumDistinct #col--- in renderExpression expression+-- in printSQL expression -- :}--- "sum(DISTINCT \"col\")"+-- sum(DISTINCT "col") sumDistinct   :: PGNum ty-  => Expression relations 'Ungrouped params (nullity ty)+  => Expression schema relations 'Ungrouped params (nullity ty)   -- ^ what to sum-  -> Expression relations ('Grouped bys) params (nullity ty)+  -> Expression schema relations ('Grouped bys) params (nullity ty) sumDistinct = unsafeAggregateDistinct "sum"  -- | A constraint for `PGType`s that you can take averages of and the resulting -- `PGType`. class PGAvg ty avg | ty -> avg where   avg, avgDistinct-    :: Expression relations 'Ungrouped params (nullity ty)+    :: Expression schema relations 'Ungrouped params (nullity ty)     -- ^ what to average-    -> Expression relations ('Grouped bys) params (nullity avg)+    -> Expression schema relations ('Grouped bys) params (nullity avg)   avg = unsafeAggregate "avg"   avgDistinct = unsafeAggregateDistinct "avg" instance PGAvg 'PGint2 'PGnumeric@@ -839,312 +932,281 @@  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4) --   expression = bitAnd #col--- in renderExpression expression+-- in printSQL expression -- :}--- "bit_and(\"col\")"+-- bit_and("col") bitAnd   :: PGIntegral int-  => Expression relations 'Ungrouped params (nullity int)+  => Expression schema relations 'Ungrouped params (nullity int)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity int)+  -> Expression schema relations ('Grouped bys) params (nullity int) bitAnd = unsafeAggregate "bit_and"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4) --   expression = bitOr #col--- in renderExpression expression+-- in printSQL expression -- :}--- "bit_or(\"col\")"+-- bit_or("col") bitOr   :: PGIntegral int-  => Expression relations 'Ungrouped params (nullity int)+  => Expression schema relations 'Ungrouped params (nullity int)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity int)+  -> Expression schema relations ('Grouped bys) params (nullity int) bitOr = unsafeAggregate "bit_or"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4) --   expression = bitAndDistinct #col--- in renderExpression expression+-- in printSQL expression -- :}--- "bit_and(DISTINCT \"col\")"+-- bit_and(DISTINCT "col") bitAndDistinct   :: PGIntegral int-  => Expression relations 'Ungrouped params (nullity int)+  => Expression schema relations 'Ungrouped params (nullity int)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity int)+  -> Expression schema relations ('Grouped bys) params (nullity int) bitAndDistinct = unsafeAggregateDistinct "bit_and"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGint4]] (Grouped bys) params (nullity 'PGint4) --   expression = bitOrDistinct #col--- in renderExpression expression+-- in printSQL expression -- :}--- "bit_or(DISTINCT \"col\")"+-- bit_or(DISTINCT "col") bitOrDistinct   :: PGIntegral int-  => Expression relations 'Ungrouped params (nullity int)+  => Expression schema relations 'Ungrouped params (nullity int)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity int)+  -> Expression schema relations ('Grouped bys) params (nullity int) bitOrDistinct = unsafeAggregateDistinct "bit_or"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool) --   expression = boolAnd #col--- in renderExpression expression+-- in printSQL expression -- :}--- "bool_and(\"col\")"+-- bool_and("col") boolAnd-  :: Expression relations 'Ungrouped params (nullity 'PGbool)+  :: Expression schema relations 'Ungrouped params (nullity 'PGbool)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity 'PGbool)+  -> Expression schema relations ('Grouped bys) params (nullity 'PGbool) boolAnd = unsafeAggregate "bool_and"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool) --   expression = boolOr #col--- in renderExpression expression+-- in printSQL expression -- :}--- "bool_or(\"col\")"+-- bool_or("col") boolOr-  :: Expression relations 'Ungrouped params (nullity 'PGbool)+  :: Expression schema relations 'Ungrouped params (nullity 'PGbool)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity 'PGbool)+  -> Expression schema relations ('Grouped bys) params (nullity 'PGbool) boolOr = unsafeAggregate "bool_or"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool) --   expression = boolAndDistinct #col--- in renderExpression expression+-- in printSQL expression -- :}--- "bool_and(DISTINCT \"col\")"+-- bool_and(DISTINCT "col") boolAndDistinct-  :: Expression relations 'Ungrouped params (nullity 'PGbool)+  :: Expression schema relations 'Ungrouped params (nullity 'PGbool)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity 'PGbool)+  -> Expression schema relations ('Grouped bys) params (nullity 'PGbool) boolAndDistinct = unsafeAggregateDistinct "bool_and"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool) --   expression = boolOrDistinct #col--- in renderExpression expression+-- in printSQL expression -- :}--- "bool_or(DISTINCT \"col\")"+-- bool_or(DISTINCT "col") boolOrDistinct-  :: Expression relations 'Ungrouped params (nullity 'PGbool)+  :: Expression schema relations 'Ungrouped params (nullity 'PGbool)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity 'PGbool)+  -> Expression schema relations ('Grouped bys) params (nullity 'PGbool) boolOrDistinct = unsafeAggregateDistinct "bool_or"  -- | A special aggregation that does not require an input ----- >>> renderExpression countStar--- "count(*)"+-- >>> printSQL countStar+-- count(*) countStar-  :: Expression relations ('Grouped bys) params ('NotNull 'PGint8)+  :: Expression schema relations ('Grouped bys) params ('NotNull 'PGint8) countStar = UnsafeExpression $ "count(*)"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8) --   expression = count #col--- in renderExpression expression+-- in printSQL expression -- :}--- "count(\"col\")"+-- count("col") count-  :: Expression relations 'Ungrouped params ty+  :: Expression schema relations 'Ungrouped params ty   -- ^ what to count-  -> Expression relations ('Grouped bys) params ('NotNull 'PGint8)+  -> Expression schema relations ('Grouped bys) params ('NotNull 'PGint8) count = unsafeAggregate "count"  -- | >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity ty]] (Grouped bys) params ('NotNull 'PGint8) --   expression = countDistinct #col--- in renderExpression expression+-- in printSQL expression -- :}--- "count(DISTINCT \"col\")"+-- count(DISTINCT "col") countDistinct-  :: Expression relations 'Ungrouped params ty+  :: Expression schema relations 'Ungrouped params ty   -- ^ what to count-  -> Expression relations ('Grouped bys) params ('NotNull 'PGint8)+  -> Expression schema relations ('Grouped bys) params ('NotNull 'PGint8) countDistinct = unsafeAggregateDistinct "count"  -- | synonym for `boolAnd` -- -- >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool) --   expression = every #col--- in renderExpression expression+-- in printSQL expression -- :}--- "every(\"col\")"+-- every("col") every-  :: Expression relations 'Ungrouped params (nullity 'PGbool)+  :: Expression schema relations 'Ungrouped params (nullity 'PGbool)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity 'PGbool)+  -> Expression schema relations ('Grouped bys) params (nullity 'PGbool) every = unsafeAggregate "every"  -- | synonym for `boolAndDistinct` -- -- >>> :{ -- let---   expression :: Expression '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool)+--   expression :: Expression schema '[tab ::: '["col" ::: nullity 'PGbool]] (Grouped bys) params (nullity 'PGbool) --   expression = everyDistinct #col--- in renderExpression expression+-- in printSQL expression -- :}--- "every(DISTINCT \"col\")"+-- every(DISTINCT "col") everyDistinct-  :: Expression relations 'Ungrouped params (nullity 'PGbool)+  :: Expression schema relations 'Ungrouped params (nullity 'PGbool)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity 'PGbool)+  -> Expression schema relations ('Grouped bys) params (nullity 'PGbool) everyDistinct = unsafeAggregateDistinct "every"  -- | minimum and maximum aggregation max_, min_, maxDistinct, minDistinct-  :: Expression relations 'Ungrouped params (nullity ty)+  :: Expression schema relations 'Ungrouped params (nullity ty)   -- ^ what to aggregate-  -> Expression relations ('Grouped bys) params (nullity ty)+  -> Expression schema relations ('Grouped bys) params (nullity ty) max_ = unsafeAggregate "max" min_ = unsafeAggregate "min" maxDistinct = unsafeAggregateDistinct "max" minDistinct = unsafeAggregateDistinct "min"  {------------------------------------------tables------------------------------------------}---- | A `Table` from a table expression is a way--- to call a table reference by its alias.-newtype Table-  (schema :: TablesType)-  (columns :: RelationType)-    = UnsafeTable { renderTable :: ByteString }-    deriving (GHC.Generic,Show,Eq,Ord,NFData)-instance-  ( Has alias schema table-  , relation ~ ColumnsToRelation (TableToColumns table)-  ) => IsLabel alias (Table schema relation) where-    fromLabel = UnsafeTable $ renderAlias (Alias @alias)--{----------------------------------------- type expressions -----------------------------------------}  -- | `TypeExpression`s are used in `cast`s and `createTable` commands.-newtype TypeExpression (ty :: ColumnType)+newtype TypeExpression (schema :: SchemaType) (ty :: PGType)   = UnsafeTypeExpression { renderTypeExpression :: ByteString }   deriving (GHC.Generic,Show,Eq,Ord,NFData) +instance (Has alias schema ('Typedef ty))+  => IsLabel alias (TypeExpression schema ty) where+    fromLabel = UnsafeTypeExpression (renderAlias (fromLabel @alias))+ -- | logical Boolean (true/false)-bool :: TypeExpression ('NoDef :=> 'Null 'PGbool)+bool :: TypeExpression schema 'PGbool bool = UnsafeTypeExpression "bool" -- | signed two-byte integer-int2, smallint :: TypeExpression ('NoDef :=> 'Null 'PGint2)+int2, smallint :: TypeExpression schema 'PGint2 int2 = UnsafeTypeExpression "int2" smallint = UnsafeTypeExpression "smallint" -- | signed four-byte integer-int4, int, integer :: TypeExpression ('NoDef :=> 'Null 'PGint4)+int4, int, integer :: TypeExpression schema 'PGint4 int4 = UnsafeTypeExpression "int4" int = UnsafeTypeExpression "int" integer = UnsafeTypeExpression "integer" -- | signed eight-byte integer-int8, bigint :: TypeExpression ('NoDef :=> 'Null 'PGint8)+int8, bigint :: TypeExpression schema 'PGint8 int8 = UnsafeTypeExpression "int8" bigint = UnsafeTypeExpression "bigint" -- | arbitrary precision numeric type-numeric :: TypeExpression ('NoDef :=> 'Null 'PGnumeric)+numeric :: TypeExpression schema 'PGnumeric numeric = UnsafeTypeExpression "numeric" -- | single precision floating-point number (4 bytes)-float4, real :: TypeExpression ('NoDef :=> 'Null 'PGfloat4)+float4, real :: TypeExpression schema 'PGfloat4 float4 = UnsafeTypeExpression "float4" real = UnsafeTypeExpression "real" -- | double precision floating-point number (8 bytes)-float8, doublePrecision :: TypeExpression ('NoDef :=> 'Null 'PGfloat8)+float8, doublePrecision :: TypeExpression schema 'PGfloat8 float8 = UnsafeTypeExpression "float8" doublePrecision = UnsafeTypeExpression "double precision"--- | not a true type, but merely a notational convenience for creating--- unique identifier columns with type `'PGint2`-serial2, smallserial-  :: TypeExpression ('Def :=> 'NotNull 'PGint2)-serial2 = UnsafeTypeExpression "serial2"-smallserial = UnsafeTypeExpression "smallserial"--- | not a true type, but merely a notational convenience for creating--- unique identifier columns with type `'PGint4`-serial4, serial-  :: TypeExpression ('Def :=> 'NotNull 'PGint4)-serial4 = UnsafeTypeExpression "serial4"-serial = UnsafeTypeExpression "serial"--- | not a true type, but merely a notational convenience for creating--- unique identifier columns with type `'PGint8`-serial8, bigserial-  :: TypeExpression ('Def :=> 'NotNull 'PGint8)-serial8 = UnsafeTypeExpression "serial8"-bigserial = UnsafeTypeExpression "bigserial" -- | variable-length character string-text :: TypeExpression ('NoDef :=> 'Null 'PGtext)+text :: TypeExpression schema 'PGtext text = UnsafeTypeExpression "text" -- | fixed-length character string char, character   :: (KnownNat n, 1 <= n)   => proxy n-  -> TypeExpression ('NoDef :=> 'Null ('PGchar n))+  -> TypeExpression schema ('PGchar n) char p = UnsafeTypeExpression $ "char(" <> renderNat p <> ")" character p = UnsafeTypeExpression $  "character(" <> renderNat p <> ")" -- | variable-length character string varchar, characterVarying   :: (KnownNat n, 1 <= n)   => proxy n-  -> TypeExpression ('NoDef :=> 'Null ('PGvarchar n))+  -> TypeExpression schema ('PGvarchar n) varchar p = UnsafeTypeExpression $ "varchar(" <> renderNat p <> ")" characterVarying p = UnsafeTypeExpression $   "character varying(" <> renderNat p <> ")" -- | binary data ("byte array")-bytea :: TypeExpression ('NoDef :=> 'Null 'PGbytea)+bytea :: TypeExpression schema 'PGbytea bytea = UnsafeTypeExpression "bytea" -- | date and time (no time zone)-timestamp :: TypeExpression ('NoDef :=> 'Null 'PGtimestamp)+timestamp :: TypeExpression schema 'PGtimestamp timestamp = UnsafeTypeExpression "timestamp" -- | date and time, including time zone-timestampWithTimeZone :: TypeExpression ('NoDef :=> 'Null 'PGtimestamptz)+timestampWithTimeZone :: TypeExpression schema 'PGtimestamptz timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone" -- | calendar date (year, month, day)-date :: TypeExpression ('NoDef :=> 'Null 'PGdate)+date :: TypeExpression schema 'PGdate date = UnsafeTypeExpression "date" -- | time of day (no time zone)-time :: TypeExpression ('NoDef :=> 'Null 'PGtime)+time :: TypeExpression schema 'PGtime time = UnsafeTypeExpression "time" -- | time of day, including time zone-timeWithTimeZone :: TypeExpression ('NoDef :=> 'Null 'PGtimetz)+timeWithTimeZone :: TypeExpression schema 'PGtimetz timeWithTimeZone = UnsafeTypeExpression "time with time zone" -- | time span-interval :: TypeExpression ('NoDef :=> 'Null 'PGinterval)+interval :: TypeExpression schema 'PGinterval interval = UnsafeTypeExpression "interval" -- | universally unique identifier-uuid :: TypeExpression ('NoDef :=> 'Null 'PGuuid)+uuid :: TypeExpression schema 'PGuuid uuid = UnsafeTypeExpression "uuid" -- | IPv4 or IPv6 host address-inet :: TypeExpression ('NoDef :=> 'Null 'PGinet)+inet :: TypeExpression schema 'PGinet inet = UnsafeTypeExpression "inet" -- | textual JSON data-json :: TypeExpression ('NoDef :=> 'Null 'PGjson)+json :: TypeExpression schema 'PGjson json = UnsafeTypeExpression "json" -- | binary JSON data, decomposed-jsonb :: TypeExpression ('NoDef :=> 'Null 'PGjsonb)+jsonb :: TypeExpression schema 'PGjsonb jsonb = UnsafeTypeExpression "jsonb" -- | variable length array vararray-  :: TypeExpression ('NoDef :=> 'Null pg)-  -> TypeExpression ('NoDef :=> 'Null ('PGvararray pg))+  :: TypeExpression schema pg+  -> TypeExpression schema ('PGvararray pg) vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]" -- | fixed length array --@@ -1153,52 +1215,36 @@ fixarray   :: KnownNat n   => proxy n-  -> TypeExpression ('NoDef :=> 'Null pg)-  -> TypeExpression ('NoDef :=> 'Null ('PGfixarray n pg))+  -> TypeExpression schema pg+  -> TypeExpression schema ('PGfixarray n pg) fixarray p ty = UnsafeTypeExpression $   renderTypeExpression ty <> "[" <> renderNat p <> "]" --- | used in `createTable` commands as a column constraint to ensure--- @NULL@ is not present-notNull-  :: TypeExpression (def :=> 'Null ty)-  -> TypeExpression (def :=> 'NotNull ty)-notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <+> "NOT NULL"---- | used in `createTable` commands as a column constraint to give a default-default_-  :: Expression '[] 'Ungrouped '[] ty-  -> TypeExpression ('NoDef :=> ty)-  -> TypeExpression ('Def :=> ty)-default_ x ty = UnsafeTypeExpression $-  renderTypeExpression ty <+> "DEFAULT" <+> renderExpression x- -- | `pgtype` is a demoted version of a `PGType`-class PGTyped (ty :: PGType) where-  pgtype :: TypeExpression ('NoDef :=> 'Null ty)-instance PGTyped 'PGbool where pgtype = bool-instance PGTyped 'PGint2 where pgtype = int2-instance PGTyped 'PGint4 where pgtype = int4-instance PGTyped 'PGint8 where pgtype = int8-instance PGTyped 'PGnumeric where pgtype = numeric-instance PGTyped 'PGfloat4 where pgtype = float4-instance PGTyped 'PGfloat8 where pgtype = float8-instance PGTyped 'PGtext where pgtype = text+class PGTyped schema (ty :: PGType) where pgtype :: TypeExpression schema ty+instance PGTyped schema 'PGbool where pgtype = bool+instance PGTyped schema 'PGint2 where pgtype = int2+instance PGTyped schema 'PGint4 where pgtype = int4+instance PGTyped schema 'PGint8 where pgtype = int8+instance PGTyped schema 'PGnumeric where pgtype = numeric+instance PGTyped schema 'PGfloat4 where pgtype = float4+instance PGTyped schema 'PGfloat8 where pgtype = float8+instance PGTyped schema 'PGtext where pgtype = text instance (KnownNat n, 1 <= n)-  => PGTyped ('PGchar n) where pgtype = char (Proxy @n)+  => PGTyped schema ('PGchar n) where pgtype = char (Proxy @n) instance (KnownNat n, 1 <= n)-  => PGTyped ('PGvarchar n) where pgtype = varchar (Proxy @n)-instance PGTyped 'PGbytea where pgtype = bytea-instance PGTyped 'PGtimestamp where pgtype = timestamp-instance PGTyped 'PGtimestamptz where pgtype = timestampWithTimeZone-instance PGTyped 'PGdate where pgtype = date-instance PGTyped 'PGtime where pgtype = time-instance PGTyped 'PGtimetz where pgtype = timeWithTimeZone-instance PGTyped 'PGinterval where pgtype = interval-instance PGTyped 'PGuuid where pgtype = uuid-instance PGTyped 'PGjson where pgtype = json-instance PGTyped 'PGjsonb where pgtype = jsonb-instance PGTyped ty => PGTyped ('PGvararray ty) where-  pgtype = vararray (pgtype @ty)-instance (KnownNat n, PGTyped ty) => PGTyped ('PGfixarray n ty) where-  pgtype = fixarray (Proxy @n) (pgtype @ty)+  => PGTyped schema ('PGvarchar n) where pgtype = varchar (Proxy @n)+instance PGTyped schema 'PGbytea where pgtype = bytea+instance PGTyped schema 'PGtimestamp where pgtype = timestamp+instance PGTyped schema 'PGtimestamptz where pgtype = timestampWithTimeZone+instance PGTyped schema 'PGdate where pgtype = date+instance PGTyped schema 'PGtime where pgtype = time+instance PGTyped schema 'PGtimetz where pgtype = timeWithTimeZone+instance PGTyped schema 'PGinterval where pgtype = interval+instance PGTyped schema 'PGuuid where pgtype = uuid+instance PGTyped schema 'PGjson where pgtype = json+instance PGTyped schema 'PGjsonb where pgtype = jsonb+instance PGTyped schema ty => PGTyped schema ('PGvararray ty) where+  pgtype = vararray (pgtype @schema @ty)+instance (KnownNat n, PGTyped schema ty) => PGTyped schema ('PGfixarray n ty) where+  pgtype = fixarray (Proxy @n) (pgtype @schema @ty)

@@ -9,17 +9,13 @@ -}  {-# LANGUAGE-    DataKinds-  , DeriveDataTypeable-  , DeriveGeneric+    DeriveGeneric   , FlexibleContexts   , GADTs   , GeneralizedNewtypeDeriving-  , KindSignatures   , LambdaCase   , OverloadedStrings   , RankNTypes-  , StandaloneDeriving   , TypeInType   , TypeOperators #-}@@ -54,7 +50,6 @@ import Data.ByteString hiding (foldr) import Data.Monoid -import qualified Data.ByteString as ByteString import qualified Generics.SOP as SOP import qualified GHC.Generics as GHC @@ -73,55 +68,55 @@ >>> :{ let   manipulation :: Manipulation-    '[ "tab" ::: '[] :=>+    '[ "tab" ::: 'Table ('[] :=>       '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4-       , "col2" ::: 'Def :=> 'NotNull 'PGint4 ]] '[] '[]+       , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[] '[]   manipulation =     insertRow_ #tab (Set 2 `As` #col1 :* Default `As` #col2 :* Nil)-in renderManipulation manipulation+in printSQL manipulation :}-"INSERT INTO \"tab\" (\"col1\", \"col2\") VALUES (2, DEFAULT);"+INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT)  parameterized insert:  >>> :{ let   manipulation :: Manipulation-    '[ "tab" ::: '[] :=>+    '[ "tab" ::: 'Table ('[] :=>       '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4-       , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]]+       , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]     '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[]   manipulation =     insertRow_ #tab       (Set (param @1) `As` #col1 :* Set (param @2) `As` #col2 :* Nil)-in renderManipulation manipulation+in printSQL manipulation :}-"INSERT INTO \"tab\" (\"col1\", \"col2\") VALUES (($1 :: int4), ($2 :: int4));"+INSERT INTO "tab" ("col1", "col2") VALUES (($1 :: int4), ($2 :: int4))  returning insert:  >>> :{ let   manipulation :: Manipulation-    '[ "tab" ::: '[] :=>+    '[ "tab" ::: 'Table ('[] :=>       '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4-       , "col2" ::: 'Def :=> 'NotNull 'PGint4 ]] '[]+       , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[]     '["fromOnly" ::: 'NotNull 'PGint4]   manipulation =     insertRow #tab (Set 2 `As` #col1 :* Default `As` #col2 :* Nil)       OnConflictDoRaise (Returning (#col1 `As` #fromOnly :* Nil))-in renderManipulation manipulation+in printSQL manipulation :}-"INSERT INTO \"tab\" (\"col1\", \"col2\") VALUES (2, DEFAULT) RETURNING \"col1\" AS \"fromOnly\";"+INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT) RETURNING "col1" AS "fromOnly"  upsert:  >>> :{ let   manipulation :: Manipulation-    '[ "tab" ::: '[] :=>+    '[ "tab" ::: 'Table ('[] :=>       '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4-       , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]]+       , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]     '[] '[ "sum" ::: 'NotNull 'PGint4]   manipulation =     insertRows #tab@@ -131,73 +126,76 @@         (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)         [#col1 .== #col2])       (Returning $ (#col1 + #col2) `As` #sum :* Nil)-in renderManipulation manipulation+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\";"+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"  query insert:  >>> :{ let   manipulation :: Manipulation-    '[ "tab" ::: '[] :=>+    '[ "tab" ::: 'Table ('[] :=>       '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4        , "col2" ::: 'NoDef :=> 'NotNull 'PGint4-       ]-     , "other_tab" ::: '[] :=>+       ])+     , "other_tab" ::: 'Table ('[] :=>       '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4        , "col2" ::: 'NoDef :=> 'NotNull 'PGint4-       ]+       ])      ] '[] '[]-  manipulation = +  manipulation =     insertQuery_ #tab       (selectStar (from (table (#other_tab `As` #t))))-in renderManipulation manipulation+in printSQL manipulation :}-"INSERT INTO \"tab\" SELECT * FROM \"other_tab\" AS \"t\";"+INSERT INTO "tab" SELECT * FROM "other_tab" AS "t"  update:  >>> :{ let   manipulation :: Manipulation-    '[ "tab" ::: '[] :=>+    '[ "tab" ::: 'Table ('[] :=>       '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4-       , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]] '[] '[]+       , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[] '[]   manipulation =     update_ #tab (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)       (#col1 ./= #col2)-in renderManipulation manipulation+in printSQL manipulation :}-"UPDATE \"tab\" SET \"col1\" = 2 WHERE (\"col1\" <> \"col2\");"+UPDATE "tab" SET "col1" = 2 WHERE ("col1" <> "col2")  delete:  >>> :{ let   manipulation :: Manipulation-    '[ "tab" ::: '[] :=>+    '[ "tab" ::: 'Table ('[] :=>       '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4-       , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]] '[]+       , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[]     '[ "col1" ::: 'NotNull 'PGint4      , "col2" ::: 'NotNull 'PGint4 ]   manipulation = deleteFrom #tab (#col1 .== #col2) ReturningStar-in renderManipulation manipulation+in printSQL manipulation :}-"DELETE FROM \"tab\" WHERE (\"col1\" = \"col2\") RETURNING *;"+DELETE FROM "tab" WHERE ("col1" = "col2") RETURNING * -} newtype Manipulation-  (schema :: TablesType)+  (schema :: SchemaType)   (params :: [NullityType])   (columns :: RelationType)     = UnsafeManipulation { renderManipulation :: ByteString }     deriving (GHC.Generic,Show,Eq,Ord,NFData) +instance RenderSQL (Manipulation schema params columns) where+  renderSQL = renderManipulation+ -- | Convert a `Query` into a `Manipulation`. queryStatement   :: Query schema params columns   -> Manipulation schema params columns-queryStatement q = UnsafeManipulation $ renderQuery q <> ";"+queryStatement q = UnsafeManipulation $ renderQuery q  {----------------------------------------- INSERT statements@@ -213,27 +211,27 @@ insertRows   :: ( SOP.SListI columns      , SOP.SListI results-     , Has tab schema table+     , Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to insert into-  -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert-  -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rows to insert-  -> ConflictClause columns params+  -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert+  -> [NP (Aliased (ColumnValue schema '[] params)) columns] -- ^ more rows to insert+  -> ConflictClause schema columns params   -- ^ what to do in case of constraint conflict-  -> ReturningClause columns params results -- ^ results to return+  -> ReturningClause schema columns params results -- ^ results to return   -> Manipulation schema params results-insertRows tab row rows conflict returning = UnsafeManipulation $+insertRows tab rw rws conflict returning = UnsafeManipulation $   "INSERT" <+> "INTO" <+> renderAlias tab-    <+> parenthesized (renderCommaSeparated renderAliasPart row)+    <+> parenthesized (renderCommaSeparated renderAliasPart rw)     <+> "VALUES"     <+> commaSeparated           ( parenthesized-          . renderCommaSeparated renderColumnValuePart <$> row:rows )+          . renderCommaSeparated renderColumnValuePart <$> rw:rws )     <> renderConflictClause conflict     <> renderReturningClause returning     where       renderAliasPart, renderColumnValuePart-        :: Aliased (ColumnValue '[] params) ty -> ByteString+        :: Aliased (ColumnValue schema '[] params) ty -> ByteString       renderAliasPart (_ `As` name) = renderAlias name       renderColumnValuePart (value `As` _) = case value of         Default -> "DEFAULT"@@ -243,49 +241,49 @@ insertRow   :: ( SOP.SListI columns      , SOP.SListI results-     , Has tab schema table+     , Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to insert into-  -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert-  -> ConflictClause columns params+  -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert+  -> ConflictClause schema columns params   -- ^ what to do in case of constraint conflict-  -> ReturningClause columns params results -- ^ results to return+  -> ReturningClause schema columns params results -- ^ results to return   -> Manipulation schema params results-insertRow tab row = insertRows tab row []+insertRow tab rw = insertRows tab rw []  -- | Insert multiple rows returning `Nil` and raising an error on conflicts. insertRows_   :: ( SOP.SListI columns-     , Has tab schema table+     , Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to insert into-  -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert-  -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rows to insert+  -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert+  -> [NP (Aliased (ColumnValue schema '[] params)) columns] -- ^ more rows to insert   -> Manipulation schema params '[]-insertRows_ tab row rows =-  insertRows tab row rows OnConflictDoRaise (Returning Nil)+insertRows_ tab rw rws =+  insertRows tab rw rws OnConflictDoRaise (Returning Nil)  -- | Insert a single row returning `Nil` and raising an error on conflicts. insertRow_   :: ( SOP.SListI columns-     , Has tab schema table+     , Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to insert into-  -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert+  -> NP (Aliased (ColumnValue schema '[] params)) columns -- ^ row to insert   -> Manipulation schema params '[]-insertRow_ tab row = insertRow tab row OnConflictDoRaise (Returning Nil)+insertRow_ tab rw = insertRow tab rw OnConflictDoRaise (Returning Nil)  -- | Insert a `Query`. insertQuery   :: ( SOP.SListI columns      , SOP.SListI results-     , Has tab schema table+     , Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to insert into   -> Query schema params (ColumnsToRelation columns)-  -> ConflictClause columns params+  -> ConflictClause schema columns params   -- ^ what to do in case of constraint conflict-  -> ReturningClause columns params results -- ^ results to return+  -> ReturningClause schema columns params results -- ^ results to return   -> Manipulation schema params results insertQuery tab query conflict returning = UnsafeManipulation $   "INSERT" <+> "INTO" <+> renderAlias tab@@ -296,7 +294,7 @@ -- | Insert a `Query` returning `Nil` and raising an error on conflicts. insertQuery_   :: ( SOP.SListI columns-     , Has tab schema table+     , Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to insert into   -> Query schema params (ColumnsToRelation columns)@@ -304,21 +302,22 @@ insertQuery_ tab query =   insertQuery tab query OnConflictDoRaise (Returning Nil) --- | `ColumnValue`s are values to insert or update in a row+-- | `ColumnValue`s are values to insert or update in a row. -- `Same` updates with the same value.--- `Default` inserts or updates with the @DEFAULT@ value--- `Set` a value to be an `Expression`, relative to the given--- row for an update, and closed for an insert.+-- `Default` inserts or updates with the @DEFAULT@ value.+-- `Set` sets a value to be an `Expression`, which can refer to+-- existing value in the row for an update. data ColumnValue+  (schema :: SchemaType)   (columns :: RelationType)   (params :: [NullityType])   (ty :: ColumnType)   where-    Same :: ColumnValue (column ': columns) params ty-    Default :: ColumnValue columns params ('Def :=> ty)+    Same :: ColumnValue schema (column ': columns) params ty+    Default :: ColumnValue schema columns params ('Def :=> ty)     Set-      :: (forall table. Expression '[table ::: columns] 'Ungrouped params ty)-      -> ColumnValue columns params (constraint :=> ty)+      :: (forall table. Expression schema '[table ::: columns] 'Ungrouped params ty)+      -> ColumnValue schema columns params (constraint :=> ty)  -- | A `ReturningClause` computes and return value(s) based -- on each row actually inserted, updated or deleted. This is primarily@@ -331,46 +330,47 @@ -- in the row. Use @Returning Nil@ in the common case where no return -- values are desired. data ReturningClause+  (schema :: SchemaType)   (columns :: ColumnsType)   (params :: [NullityType])   (results :: RelationType)   where     ReturningStar       :: results ~ ColumnsToRelation columns-      => ReturningClause columns params results+      => ReturningClause schema columns params results     Returning       :: rel ~ ColumnsToRelation columns-      => NP (Aliased (Expression '[table ::: rel] 'Ungrouped params)) results-      -> ReturningClause columns params results+      => NP (Aliased (Expression schema '[table ::: rel] 'Ungrouped params)) results+      -> ReturningClause schema columns params results  -- | Render a `ReturningClause`. renderReturningClause   :: SOP.SListI results-  => ReturningClause params columns results+  => ReturningClause schema params columns results   -> ByteString renderReturningClause = \case-  ReturningStar -> " RETURNING *;"-  Returning Nil -> ";"+  ReturningStar -> " RETURNING *"+  Returning Nil -> ""   Returning results -> " RETURNING"-    <+> renderCommaSeparated (renderAliasedAs renderExpression) results <> ";"+    <+> renderCommaSeparated (renderAliasedAs renderExpression) results  -- | A `ConflictClause` specifies an action to perform upon a constraint -- violation. `OnConflictDoRaise` will raise an error. -- `OnConflictDoNothing` simply avoids inserting a row. -- `OnConflictDoUpdate` updates the existing row that conflicts with the row -- proposed for insertion.-data ConflictClause (columns :: ColumnsType) params where-  OnConflictDoRaise :: ConflictClause columns params-  OnConflictDoNothing :: ConflictClause columns params+data ConflictClause (schema :: SchemaType) (columns :: ColumnsType) params where+  OnConflictDoRaise :: ConflictClause schema columns params+  OnConflictDoNothing :: ConflictClause schema columns params   OnConflictDoUpdate-    :: NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns-    -> [Condition '[table ::: ColumnsToRelation columns] 'Ungrouped params]-    -> ConflictClause columns params+    :: NP (Aliased (ColumnValue schema (ColumnsToRelation columns) params)) columns+    -> [Condition schema '[table ::: ColumnsToRelation columns] 'Ungrouped params]+    -> ConflictClause schema columns params  -- | Render a `ConflictClause`. renderConflictClause   :: SOP.SListI columns-  => ConflictClause columns params+  => ConflictClause schema columns params   -> ByteString renderConflictClause = \case   OnConflictDoRaise -> ""@@ -383,7 +383,7 @@         wh:whs -> " WHERE" <+> renderExpression (foldr (.&&) wh whs)       where         renderUpdate-          :: Aliased (ColumnValue columns params) column+          :: Aliased (ColumnValue schema columns params) column           -> Maybe ByteString         renderUpdate = \case           Same `As` _ -> Nothing@@ -401,14 +401,14 @@ update   :: ( SOP.SListI columns      , SOP.SListI results-     , Has tab schema table+     , Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to update-  -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns+  -> NP (Aliased (ColumnValue schema (ColumnsToRelation columns) params)) columns   -- ^ modified values to replace old values-  -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params+  -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params   -- ^ condition under which to perform update on a row-  -> ReturningClause columns params results -- ^ results to return+  -> ReturningClause schema columns params results -- ^ results to return   -> Manipulation schema params results update tab columns wh returning = UnsafeManipulation $   "UPDATE"@@ -419,7 +419,7 @@   <> renderReturningClause returning   where     renderUpdate-      :: Aliased (ColumnValue columns params) column+      :: Aliased (ColumnValue schema columns params) column       -> Maybe ByteString     renderUpdate = \case       Same `As` _ -> Nothing@@ -431,12 +431,12 @@ -- | Update a row returning `Nil`. update_   :: ( SOP.SListI columns-     , Has tab schema table+     , Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to update-  -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns+  -> NP (Aliased (ColumnValue schema (ColumnsToRelation columns) params)) columns   -- ^ modified values to replace old values-  -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params+  -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params   -- ^ condition under which to perform update on a row   -> Manipulation schema params '[] update_ tab columns wh = update tab columns wh (Returning Nil)@@ -448,12 +448,12 @@ -- | Delete rows of a table. deleteFrom   :: ( SOP.SListI results-     , Has tab schema table+     , Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to delete from-  -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params+  -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params   -- ^ condition under which to delete a row-  -> ReturningClause columns params results -- ^ results to return+  -> ReturningClause schema columns params results -- ^ results to return   -> Manipulation schema params results deleteFrom tab wh returning = UnsafeManipulation $   "DELETE FROM" <+> renderAlias tab@@ -462,10 +462,10 @@  -- | Delete rows returning `Nil`. deleteFrom_-  :: ( Has tab schema table+  :: ( Has tab schema ('Table table)      , columns ~ TableToColumns table )   => Alias tab -- ^ table to delete from-  -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params+  -> Condition schema '[tab ::: ColumnsToRelation columns] 'Ungrouped params   -- ^ condition under which to delete a row   -> Manipulation schema params '[] deleteFrom_ tab wh = deleteFrom tab wh (Returning Nil)@@ -482,18 +482,18 @@ -- -- >>> :{ -- let---   manipulation :: Manipulation '["products" ::: ProductsTable, "products_deleted" ::: ProductsTable] '[ 'NotNull 'PGdate] '[]+--   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 (table (#deleted_rows `As` #t)))))--- in renderManipulation manipulation+--     (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 "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   -- ^ common table expressions-  -> Manipulation (Join (RelationsToTables commons) schema) params results+  -> Manipulation (With commons schema) params results   -> Manipulation schema params results with commons manipulation = UnsafeManipulation $   "WITH" <+> renderCommaSeparated renderCommon commons@@ -504,9 +504,4 @@       -> ByteString     renderCommon (common `As` alias) =       renderAlias alias <+> "AS" <+>-        let-          str = renderManipulation common-          len = ByteString.length str-          str' = ByteString.take (len - 1) str -- remove ';'-        in-          parenthesized str'+        parenthesized (renderManipulation common)

@@ -31,31 +31,31 @@  >>> :{ let-  makeUsers :: Migration IO '[] '["users" ::: UsersTable]+  makeUsers :: Migration IO '[] '["users" ::: 'Table UsersTable]   makeUsers = Migration     { name = "make users table"     , up = void . define $         createTable #users         ( serial `As` #id :*-          (text & notNull) `As` #name :* Nil )-        ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil )+          (text & notNullable) `As` #name :* Nil )+        ( primaryKey #id `As` #pk_users :* Nil )     , down = void . define $ dropTable #users     } :}  >>> :{ let-  makeEmails :: Migration IO '["users" ::: UsersTable]-    '["users" ::: UsersTable, "emails" ::: EmailsTable]+  makeEmails :: Migration IO '["users" ::: 'Table UsersTable]+    '["users" ::: 'Table UsersTable, "emails" ::: 'Table EmailsTable]   makeEmails = Migration     { name = "make emails table"     , up = void . define $         createTable #emails           ( serial `As` #id :*-            (int & notNull) `As` #user_id :*-            text `As` #email :* Nil )-          ( primaryKey (Column #id :* Nil) `As` #pk_emails :*-            foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)+            (int & notNullable) `As` #user_id :*+            (text & nullable) `As` #email :* Nil )+          ( primaryKey #id `As` #pk_emails :*+            foreignKey #user_id #users #id               OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )     , down = void . define $ dropTable #emails     }@@ -68,7 +68,7 @@ >>> :{ let   numMigrations-    :: Has "schema_migrations" schema MigrationsTable+    :: Has "schema_migrations" schema ('Table MigrationsTable)     => PQ schema schema IO ()   numMigrations = do     result <- runQuery (selectStar (from (table (#schema_migrations `As` #m))))@@ -90,9 +90,7 @@ -}  {-# LANGUAGE-    ScopedTypeVariables-  , OverloadedStrings-  , DataKinds+    DataKinds   , GADTs   , LambdaCase   , PolyKinds@@ -162,8 +160,8 @@   :: MonadBaseControl IO io   => AlignedList (Migration io) schema0 schema1 -- ^ migrations to run   -> PQ-    ("schema_migrations" ::: MigrationsTable ': schema0)-    ("schema_migrations" ::: MigrationsTable ': schema1)+    ("schema_migrations" ::: 'Table MigrationsTable ': schema0)+    ("schema_migrations" ::: 'Table MigrationsTable ': schema1)     io () migrateUp migration =   define createMigrations@@ -175,8 +173,8 @@       :: MonadBaseControl IO io       => AlignedList (Migration io) schema0 schema1       -> PQ-        ("schema_migrations" ::: MigrationsTable ': schema0)-        ("schema_migrations" ::: MigrationsTable ': schema1)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema0)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema1)         io ()     upMigrations = \case       Done -> return ()@@ -185,8 +183,8 @@     upMigration       :: MonadBase IO io       => Migration io schema0 schema1 -> PQ-        ("schema_migrations" ::: MigrationsTable ': schema0)-        ("schema_migrations" ::: MigrationsTable ': schema1)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema0)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema1)         io ()     upMigration step =       queryExecuted step@@ -202,8 +200,8 @@     queryExecuted       :: MonadBase IO io       => Migration io schema0 schema1 -> PQ-        ("schema_migrations" ::: MigrationsTable ': schema0)-        ("schema_migrations" ::: MigrationsTable ': schema0)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema0)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema0)         io Row     queryExecuted step = do       result <- runQueryParams selectMigration (Only (name step))@@ -218,8 +216,8 @@   :: MonadBaseControl IO io   => AlignedList (Migration io) schema0 schema1 -- ^ migrations to rewind   -> PQ-    ("schema_migrations" ::: MigrationsTable ': schema1)-    ("schema_migrations" ::: MigrationsTable ': schema0)+    ("schema_migrations" ::: 'Table MigrationsTable ': schema1)+    ("schema_migrations" ::: 'Table MigrationsTable ': schema0)     io () migrateDown migrations =   define createMigrations@@ -230,8 +228,8 @@     downMigrations       :: MonadBaseControl IO io       => AlignedList (Migration io) schema0 schema1 -> PQ-        ("schema_migrations" ::: MigrationsTable ': schema1)-        ("schema_migrations" ::: MigrationsTable ': schema0)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema1)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema0)         io ()     downMigrations = \case       Done -> return ()@@ -240,8 +238,8 @@     downMigration       :: MonadBase IO io       => Migration io schema0 schema1 -> PQ-        ("schema_migrations" ::: MigrationsTable ': schema1)-        ("schema_migrations" ::: MigrationsTable ': schema0)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema1)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema0)         io ()     downMigration step =       queryExecuted step@@ -257,8 +255,8 @@     queryExecuted       :: MonadBase IO io       => Migration io schema0 schema1 -> PQ-        ("schema_migrations" ::: MigrationsTable ': schema1)-        ("schema_migrations" ::: MigrationsTable ': schema1)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema1)+        ("schema_migrations" ::: 'Table MigrationsTable ': schema1)         io Row     queryExecuted step = do       result <- runQueryParams selectMigration (Only (name step))@@ -283,18 +281,18 @@  -- | Creates a `MigrationsTable` if it does not already exist. createMigrations-  :: Has "schema_migrations" schema MigrationsTable+  :: Has "schema_migrations" schema ('Table MigrationsTable)   => Definition schema schema createMigrations =   createTableIfNotExists #schema_migrations-    ( (text & notNull) `As` #name :*-      (timestampWithTimeZone & notNull & default_ currentTimestamp)+    ( (text & notNullable) `As` #name :*+      (timestampWithTimeZone & notNullable & default_ currentTimestamp)         `As` #executed_at :* Nil )-    ( unique (Column #name :* Nil) `As` #migrations_unique_name :* Nil )+    ( unique (#name :* Nil) `As` #migrations_unique_name :* Nil )  -- | Inserts a `Migration` into the `MigrationsTable` insertMigration-  :: Has "schema_migrations" schema MigrationsTable+  :: Has "schema_migrations" schema ('Table MigrationsTable)   => Manipulation schema '[ 'NotNull 'PGtext] '[] insertMigration = insertRow_ #schema_migrations   ( Set (param @1) `As` #name :*@@ -302,14 +300,14 @@  -- | Deletes a `Migration` from the `MigrationsTable` deleteMigration-  :: Has "schema_migrations" schema MigrationsTable+  :: Has "schema_migrations" schema ('Table MigrationsTable)   => Manipulation schema '[ 'NotNull 'PGtext ] '[] deleteMigration = deleteFrom_ #schema_migrations (#name .== param @1)  -- | Selects a `Migration` from the `MigrationsTable`, returning -- the time at which it was executed. selectMigration-  :: Has "schema_migrations" schema MigrationsTable+  :: Has "schema_migrations" schema ('Table MigrationsTable)   => Query schema '[ 'NotNull 'PGtext ]     '[ "executed_at" ::: 'NotNull 'PGtimestamptz ] selectMigration = select

@@ -20,15 +20,10 @@  {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE-    DataKinds-  , DefaultSignatures+    DefaultSignatures   , FunctionalDependencies-  , PolyKinds-  , DeriveFunctor   , FlexibleContexts   , FlexibleInstances-  , MagicHash-  , MultiParamTypeClasses   , OverloadedStrings   , RankNTypes   , ScopedTypeVariables@@ -160,8 +155,8 @@ -- | We keep track of the schema via an Atkey indexed state monad transformer, -- `PQ`. newtype PQ-  (schema0 :: TablesType)-  (schema1 :: TablesType)+  (schema0 :: SchemaType)+  (schema1 :: SchemaType)   (m :: Type -> Type)   (x :: Type) =     PQ { unPQ :: K LibPQ.Connection schema0 -> m (K x schema1) }@@ -171,7 +166,7 @@     K x <- pq conn     return $ K (f x) --- | Run a `PQ` and keep the result and the `Connection`. +-- | Run a `PQ` and keep the result and the `Connection`. runPQ   :: Functor m   => PQ schema0 schema1 m x@@ -181,7 +176,7 @@   -- K x <- pq conn   -- return (x, K (unK conn)) --- | Execute a `PQ` and discard the result but keep the `Connection`. +-- | Execute a `PQ` and discard the result but keep the `Connection`. execPQ   :: Functor m   => PQ schema0 schema1 m x@@ -217,6 +212,7 @@     :: Monad m     => pq schema0 schema1 m (pq schema1 schema2 m y)     -> pq schema0 schema2 m y+  pqJoin pq = pq & pqBind id    -- | indexed analog of `=<<`   pqBind@@ -231,7 +227,16 @@     => pq schema1 schema2 m y     -> pq schema0 schema1 m x     -> pq schema0 schema2 m y+  pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2) +  -- | indexed analog of `<=<`+  pqAndThen+    :: Monad m+    => (y -> pq schema1 schema2 m z)+    -> (x -> pq schema0 schema1 m y)+    -> x -> pq schema0 schema2 m z+  pqAndThen g f x = pqBind g (f x)+   -- | Safely embed a computation in a larger schema.   pqEmbed     :: Monad m@@ -253,14 +258,10 @@     K x' <- x (K (unK conn))     return $ K (f' x') -  pqJoin pq = pq & pqBind id-   pqBind f (PQ x) = PQ $ \ conn -> do     K x' <- x conn     unPQ (f x') (K (unK conn)) -  pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)-   pqEmbed (PQ pq) = PQ $ \ (K conn) -> do     K x <- pq (K conn)     return $ K x@@ -394,7 +395,8 @@         let           toParam' bytes = (LibPQ.invalidOid,bytes,LibPQ.Binary)           params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))-        resultMaybe <- liftBase $ LibPQ.execParams conn q params' LibPQ.Binary+          q' = q <> ";"+        resultMaybe <- liftBase $ LibPQ.execParams conn q' params' LibPQ.Binary         case resultMaybe of           Nothing -> error             "manipulateParams: LibPQ.execParams returned no results"

@@ -9,8 +9,7 @@ -}  {-# LANGUAGE-    DataKinds-  , DeriveFunctor+    DeriveFunctor   , FlexibleContexts   , FlexibleInstances   , MultiParamTypeClasses@@ -43,7 +42,7 @@ import Squeal.PostgreSQL.Schema  -- | `PoolPQ` @schema@ should be a drop-in replacement for `PQ` @schema schema@.-newtype PoolPQ (schema :: TablesType) m x =+newtype PoolPQ (schema :: SchemaType) m x =   PoolPQ { runPoolPQ :: Pool (K Connection schema) -> m x }   deriving Functor @@ -110,7 +109,7 @@       (_ :: K () schema) <- flip unPQ conn $         traversePrepared_ manipulation params       return ()-  liftPQ m = PoolPQ $ \ pool -> +  liftPQ m = PoolPQ $ \ pool ->     withResource pool $ \ conn -> do       (K result :: K result schema) <- flip unPQ conn $         liftPQ m

@@ -9,23 +9,15 @@ -}  {-# LANGUAGE-    DataKinds-  , DeriveDataTypeable-  , DeriveGeneric+    DeriveGeneric   , FlexibleContexts-  , FlexibleInstances   , GADTs   , GeneralizedNewtypeDeriving-  , KindSignatures   , LambdaCase-  , MultiParamTypeClasses   , OverloadedStrings-  , ScopedTypeVariables   , StandaloneDeriving-  , TypeApplications   , TypeInType   , TypeOperators-  , UndecidableInstances #-}  module Squeal.PostgreSQL.Query@@ -44,6 +36,8 @@   , selectDistinctStar   , selectDotStar   , selectDistinctDotStar+  , values+  , values_     -- * Table Expressions   , TableExpression (..)   , renderTableExpression@@ -58,6 +52,7 @@   , FromClause (..)   , table   , subquery+  , view   , crossJoin   , innerJoin   , leftOuterJoin@@ -100,111 +95,111 @@ >>> :{ let   query :: Query-    '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]+    '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]     '[]     '["col" ::: 'Null 'PGint4]-  query = selectStar (from (table (#tab `As` #t)))-in renderQuery query+  query = selectStar (from (table #tab))+in printSQL query :}-"SELECT * FROM \"tab\" AS \"t\""+SELECT * FROM "tab" AS "tab"  restricted query:  >>> :{ let   query :: Query-    '[ "tab" ::: '[] :=>+    '[ "tab" ::: 'Table ('[] :=>        '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4-        , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]]+        , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]     '[]     '[ "sum" ::: 'NotNull 'PGint4      , "col1" ::: 'NotNull 'PGint4 ]-  query = +  query =     select-      ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)-      ( from (table (#tab `As` #t))+      ((#col1 + #col2) `As` #sum :* #col1 :* Nil)+      ( from (table #tab)         & where_ (#col1 .> #col2)         & where_ (#col2 .> 0) )-in renderQuery query+in printSQL query :}-"SELECT (\"col1\" + \"col2\") AS \"sum\", \"col1\" AS \"col1\" FROM \"tab\" AS \"t\" WHERE ((\"col1\" > \"col2\") AND (\"col2\" > 0))"+SELECT ("col1" + "col2") AS "sum", "col1" AS "col1" FROM "tab" AS "tab" WHERE (("col1" > "col2") AND ("col2" > 0))  subquery:  >>> :{ let   query :: Query-    '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]+    '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]     '[]     '["col" ::: 'Null 'PGint4]   query =     selectStar-      (from (subquery (selectStar (from (table (#tab `As` #t))) `As` #sub)))-in renderQuery query+      (from (subquery (selectStar (from (table #tab)) `As` #sub)))+in printSQL query :}-"SELECT * FROM (SELECT * FROM \"tab\" AS \"t\") AS \"sub\""+SELECT * FROM (SELECT * FROM "tab" AS "tab") AS "sub"  limits and offsets:  >>> :{ let   query :: Query-    '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]+    '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]     '[]     '["col" ::: 'Null 'PGint4]   query = selectStar-    (from (table (#tab `As` #t)) & limit 100 & offset 2 & limit 50 & offset 2)-in renderQuery query+    (from (table #tab) & limit 100 & offset 2 & limit 50 & offset 2)+in printSQL query :}-"SELECT * FROM \"tab\" AS \"t\" LIMIT 50 OFFSET 4"+SELECT * FROM "tab" AS "tab" LIMIT 50 OFFSET 4  parameterized query:  >>> :{ let   query :: Query-    '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGfloat8]]+    '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGfloat8])]     '[ 'NotNull 'PGfloat8]     '["col" ::: 'NotNull 'PGfloat8]   query = selectStar-    (from (table (#tab `As` #t)) & where_ (#col .> param @1))-in renderQuery query+    (from (table #tab) & where_ (#col .> param @1))+in printSQL query :}-"SELECT * FROM \"tab\" AS \"t\" WHERE (\"col\" > ($1 :: float8))"+SELECT * FROM "tab" AS "tab" WHERE ("col" > ($1 :: float8))  aggregation query:  >>> :{ let   query :: Query-    '[ "tab" ::: '[] :=>+    '[ "tab" ::: 'Table ('[] :=>        '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4-        , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]]+        , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])]     '[]     '[ "sum" ::: 'NotNull 'PGint4      , "col1" ::: 'NotNull 'PGint4 ]   query =-    select (sum_ #col2 `As` #sum :* #col1 `As` #col1 :* Nil)+    select (sum_ #col2 `As` #sum :* #col1 :* Nil)     ( from (table (#tab `As` #table1))-      & group (By #col1 :* Nil) +      & group (By #col1 :* Nil)       & having (#col1 + sum_ #col2 .> 1) )-in renderQuery query+in printSQL query :}-"SELECT sum(\"col2\") AS \"sum\", \"col1\" AS \"col1\" FROM \"tab\" AS \"table1\" GROUP BY \"col1\" HAVING ((\"col1\" + sum(\"col2\")) > 1)"+SELECT sum("col2") AS "sum", "col1" AS "col1" FROM "tab" AS "table1" GROUP BY "col1" HAVING (("col1" + sum("col2")) > 1)  sorted query:  >>> :{ let   query :: Query-    '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]+    '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]     '[]     '["col" ::: 'Null 'PGint4]   query = selectStar-    (from (table (#tab `As` #t)) & orderBy [#col & AscNullsFirst])-in renderQuery query+    (from (table #tab) & orderBy [#col & AscNullsFirst])+in printSQL query :}-"SELECT * FROM \"tab\" AS \"t\" ORDER BY \"col\" ASC NULLS FIRST"+SELECT * FROM "tab" AS "tab" ORDER BY "col" ASC NULLS FIRST  joins: @@ -212,7 +207,7 @@ >>> :{ let   query :: Query-    '[ "orders" :::+    '[ "orders" ::: 'Table (          '["pk_orders" ::: PrimaryKey '["id"]           ,"fk_customers" ::: ForeignKey '["customer_id"] "customers" '["id"]           ,"fk_shippers" ::: ForeignKey '["shipper_id"] "shippers" '["id"]] :=>@@ -220,17 +215,17 @@           , "price"   ::: 'NoDef :=> 'NotNull 'PGfloat4           , "customer_id" ::: 'NoDef :=> 'NotNull 'PGint4           , "shipper_id"  ::: 'NoDef :=> 'NotNull 'PGint4-          ]-     , "customers" :::+          ])+     , "customers" ::: 'Table (          '["pk_customers" ::: PrimaryKey '["id"]] :=>          '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4           , "name" ::: 'NoDef :=> 'NotNull 'PGtext-          ]-     , "shippers" :::+          ])+     , "shippers" ::: 'Table (          '["pk_shippers" ::: PrimaryKey '["id"]] :=>          '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4           , "name" ::: 'NoDef :=> 'NotNull 'PGtext-          ]+          ])      ]     '[]     '[ "order_price" ::: 'NotNull 'PGfloat4@@ -246,49 +241,50 @@         (#o ! #customer_id .== #c ! #id)       & innerJoin (table (#shippers `As` #s))         (#o ! #shipper_id .== #s ! #id)) )-in renderQuery query+in printSQL query :}-"SELECT \"o\".\"price\" AS \"order_price\", \"c\".\"name\" AS \"customer_name\", \"s\".\"name\" AS \"shipper_name\" FROM \"orders\" AS \"o\" INNER JOIN \"customers\" AS \"c\" ON (\"o\".\"customer_id\" = \"c\".\"id\") INNER JOIN \"shippers\" AS \"s\" ON (\"o\".\"shipper_id\" = \"s\".\"id\")"+SELECT "o"."price" AS "order_price", "c"."name" AS "customer_name", "s"."name" AS "shipper_name" FROM "orders" AS "o" INNER JOIN "customers" AS "c" ON ("o"."customer_id" = "c"."id") INNER JOIN "shippers" AS "s" ON ("o"."shipper_id" = "s"."id")  self-join:  >>> :{ let   query :: Query-    '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]+    '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]     '[]     '["col" ::: 'Null 'PGint4]   query = selectDotStar #t1     (from (table (#tab `As` #t1) & crossJoin (table (#tab `As` #t2))))-in renderQuery query+in printSQL query :}-"SELECT \"t1\".* FROM \"tab\" AS \"t1\" CROSS JOIN \"tab\" AS \"t2\""+SELECT "t1".* FROM "tab" AS "t1" CROSS JOIN "tab" AS "t2"  set operations:  >>> :{ let   query :: Query-    '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]]+    '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]     '[]     '["col" ::: 'Null 'PGint4]   query =-    selectStar (from (table (#tab `As` #t)))+    selectStar (from (table #tab))     `unionAll`-    selectStar (from (table (#tab `As` #t)))-in renderQuery query+    selectStar (from (table #tab))+in printSQL query :}-"(SELECT * FROM \"tab\" AS \"t\") UNION ALL (SELECT * FROM \"tab\" AS \"t\")"+(SELECT * FROM "tab" AS "tab") UNION ALL (SELECT * FROM "tab" AS "tab") -} newtype Query-  (schema :: TablesType)+  (schema :: SchemaType)   (params :: [NullityType])   (columns :: RelationType)     = UnsafeQuery { renderQuery :: ByteString }     deriving (GHC.Generic,Show,Eq,Ord,NFData)+instance RenderSQL (Query schema params columns) where renderSQL = renderQuery  -- | The results of two queries can be combined using the set operation--- `union`. Duplicate rows are eliminated. +-- `union`. Duplicate rows are eliminated. union   :: Query schema params columns   -> Query schema params columns@@ -364,7 +360,7 @@ -- the intermediate table are actually output. select   :: SListI columns-  => NP (Aliased (Expression relations grouping params)) (column ': columns)+  => NP (Aliased (Expression schema relations grouping params)) (column ': columns)   -- ^ select list   -> TableExpression schema params relations grouping   -- ^ intermediate virtual table@@ -378,7 +374,7 @@ -- be subject to the elimination of duplicate rows using `selectDistinct`. selectDistinct   :: SListI columns-  => NP (Aliased (Expression relations 'Ungrouped params)) (column ': columns)+  => NP (Aliased (Expression schema relations 'Ungrouped params)) (column ': columns)   -- ^ select list   -> TableExpression schema params relations 'Ungrouped   -- ^ intermediate virtual table@@ -419,7 +415,7 @@ selectDotStar rel relations = UnsafeQuery $   "SELECT" <+> renderAlias rel <> ".*" <+> renderTableExpression relations --- | A `selectDistinctDotStar` asks for all the columns of a particular table, +-- | A `selectDistinctDotStar` asks for all the columns of a particular table, -- and eliminates duplicate rows. selectDistinctDotStar   :: Has relation relations columns@@ -432,6 +428,45 @@   "SELECT DISTINCT" <+> renderAlias rel <> ".*"   <+> renderTableExpression relations +-- | `values` computes a row value or set of row values+-- specified by value expressions. It is most commonly used+-- to generate a “constant table” within a larger command,+-- 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+-- >>> printSQL query+-- SELECT * FROM (VALUES (1, E'one')) AS t ("a", "b")+values+  :: SListI cols+  => NP (Aliased (Expression schema '[] 'Ungrouped params)) cols+  -> [NP (Aliased (Expression schema '[] 'Ungrouped params)) cols]+  -- ^ When more than one row is specified, all the rows must+  -- must have the same number of elements+  -> Query schema params cols+values rw rws = UnsafeQuery $ "SELECT * FROM"+  <+> parenthesized (+    "VALUES"+    <+> commaSeparated+        ( parenthesized+        . renderCommaSeparated renderValuePart <$> rw:rws )+    ) <+> "AS t"+  <+> parenthesized (renderCommaSeparated renderAliasPart rw)+  where+    renderAliasPart, renderValuePart+      :: Aliased (Expression schema '[] 'Ungrouped params) ty -> ByteString+    renderAliasPart (_ `As` name) = renderAlias name+    renderValuePart (value `As` _) = renderExpression value++-- | `values_` computes a row value or set of row values+-- specified by value expressions.+values_+  :: SListI cols+  => NP (Aliased (Expression schema '[] 'Ungrouped params)) cols+  -- ^ one row of values+  -> Query schema params cols+values_ rw = values rw []+ {----------------------------------------- Table Expressions -----------------------------------------}@@ -443,7 +478,7 @@ -- to a table on disk, a so-called base table, but more complex expressions -- can be used to modify or combine base tables in various ways. data TableExpression-  (schema :: TablesType)+  (schema :: SchemaType)   (params :: [NullityType])   (relations :: RelationsType)   (grouping :: Grouping)@@ -451,7 +486,7 @@     { fromClause :: FromClause schema params relations     -- ^ A table reference that can be a table name, or a derived table such     -- as a subquery, a @JOIN@ construct, or complex combinations of these.-    , whereClause :: [Condition relations 'Ungrouped params]+    , whereClause :: [Condition schema relations 'Ungrouped params]     -- ^ optional search coditions, combined with `.&&`. After the processing     -- of the `fromClause` is done, each row of the derived virtual table     -- is checked against the search condition. If the result of the@@ -467,13 +502,13 @@     -- set of rows having common values into one group row that represents all     -- rows in the group. This is done to eliminate redundancy in the output     -- and/or compute aggregates that apply to these groups.-    , havingClause :: HavingClause relations grouping params+    , havingClause :: HavingClause schema relations grouping params     -- ^ If a table has been grouped using `groupBy`, but only certain groups     -- are of interest, the `havingClause` can be used, much like a     -- `whereClause`, to eliminate groups from the result. Expressions in the     -- `havingClause` can refer both to grouped expressions and to ungrouped     -- expressions (which necessarily involve an aggregate function).-    , orderByClause :: [SortExpression relations grouping params]+    , orderByClause :: [SortExpression schema relations grouping params]     -- ^ The `orderByClause` is for optional sorting. When more than one     -- `SortExpression` is specified, the later (right) values are used to sort     -- rows that are equal according to the earlier (left) values.@@ -532,7 +567,7 @@ -- | A `where_` is an endomorphism of `TableExpression`s which adds a -- search condition to the `whereClause`. where_-  :: Condition relations 'Ungrouped params -- ^ filtering condition+  :: Condition schema relations 'Ungrouped params -- ^ filtering condition   -> TableExpression schema params relations grouping   -> TableExpression schema params relations grouping where_ wh rels = rels {whereClause = wh : whereClause rels}@@ -543,7 +578,7 @@ group   :: SListI bys   => NP (By relations) bys -- ^ grouped columns-  -> TableExpression schema params relations 'Ungrouped +  -> TableExpression schema params relations 'Ungrouped   -> TableExpression schema params relations ('Grouped bys) group bys rels = TableExpression   { fromClause = fromClause rels@@ -558,7 +593,7 @@ -- | A `having` is an endomorphism of `TableExpression`s which adds a -- search condition to the `havingClause`. having-  :: Condition relations ('Grouped bys) params -- ^ having condition+  :: Condition schema relations ('Grouped bys) params -- ^ having condition   -> TableExpression schema params relations ('Grouped bys)   -> TableExpression schema params relations ('Grouped bys) having hv rels = rels@@ -567,7 +602,7 @@ -- | An `orderBy` is an endomorphism of `TableExpression`s which appends an -- ordering to the right of the `orderByClause`. orderBy-  :: [SortExpression relations grouping params] -- ^ sort expressions+  :: [SortExpression schema relations grouping params] -- ^ sort expressions   -> TableExpression schema params relations grouping   -> TableExpression schema params relations grouping orderBy srts rels = rels {orderByClause = orderByClause rels ++ srts}@@ -602,16 +637,26 @@  -- | A real `table` is a table from the schema. table-  :: Aliased (Table schema) table-  -> FromClause schema params '[table]-table = UnsafeFromClause . renderAliasedAs renderTable+  :: Has tab schema ('Table table)+  => Aliased Alias (alias ::: tab)+  -> FromClause schema params '[alias ::: TableToRelation table]+table (tab `As` alias) = UnsafeFromClause $+  renderAlias tab <+> "AS" <+> renderAlias alias  -- | `subquery` derives a table from a `Query`. subquery-  :: Aliased (Query schema params) table-  -> FromClause schema params '[table]+  :: Aliased (Query schema params) rel+  -> FromClause schema params '[rel] subquery = UnsafeFromClause . renderAliasedAs (parenthesized . renderQuery) +-- | `view` derives a table from a `View`.+view+  :: Has view schema ('View rel)+  => Aliased Alias (alias ::: view)+  -> FromClause schema params '[alias ::: rel]+view (vw `As` alias) = UnsafeFromClause $+  renderAlias vw <+> "AS" <+> renderAlias alias+ {- | @left & crossJoin right@. For every possible combination of rows from     @left@ and @right@ (i.e., a Cartesian product), the joined table will contain     a row consisting of all columns in @left@ followed by all columns in @right@.@@ -633,7 +678,7 @@ innerJoin   :: FromClause schema params right   -- ^ right-  -> Condition (Join left right) 'Ungrouped params+  -> Condition schema (Join left right) 'Ungrouped params   -- ^ @on@ condition   -> FromClause schema params left   -- ^ left@@ -650,7 +695,7 @@ leftOuterJoin   :: FromClause schema params right   -- ^ right-  -> Condition (Join left right) 'Ungrouped params+  -> Condition schema (Join left right) 'Ungrouped params   -- ^ @on@ condition   -> FromClause schema params left   -- ^ left@@ -668,7 +713,7 @@ rightOuterJoin   :: FromClause schema params right   -- ^ right-  -> Condition (Join left right) 'Ungrouped params+  -> Condition schema (Join left right) 'Ungrouped params   -- ^ @on@ condition   -> FromClause schema params left   -- ^ left@@ -687,7 +732,7 @@ fullOuterJoin   :: FromClause schema params right   -- ^ right-  -> Condition (Join left right) 'Ungrouped params+  -> Condition schema (Join left right) 'Ungrouped params   -- ^ @on@ condition   -> FromClause schema params left   -- ^ left@@ -751,17 +796,17 @@ -- An `Ungrouped` `TableExpression` may only use `NoHaving` while a `Grouped` -- `TableExpression` must use `Having` whose conditions are combined with -- `.&&`.-data HavingClause relations grouping params where-  NoHaving :: HavingClause relations 'Ungrouped params+data HavingClause schema relations grouping params where+  NoHaving :: HavingClause schema relations 'Ungrouped params   Having-    :: [Condition relations ('Grouped bys) params]-    -> HavingClause relations ('Grouped bys) params-deriving instance Show (HavingClause relations grouping params)-deriving instance Eq (HavingClause relations grouping params)-deriving instance Ord (HavingClause relations grouping params)+    :: [Condition schema relations ('Grouped bys) params]+    -> HavingClause schema relations ('Grouped bys) params+deriving instance Show (HavingClause schema relations grouping params)+deriving instance Eq (HavingClause schema relations grouping params)+deriving instance Ord (HavingClause schema relations grouping params)  -- | Render a `HavingClause`.-renderHavingClause :: HavingClause relations grouping params -> ByteString+renderHavingClause :: HavingClause schema relations grouping params -> ByteString renderHavingClause = \case   NoHaving -> ""   Having [] -> ""@@ -780,29 +825,29 @@ -- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to -- determine whether nulls appear before or after non-null values in the sort -- ordering of a `Null` result column.-data SortExpression relations grouping params where+data SortExpression schema relations grouping params where     Asc-      :: Expression relations grouping params ('NotNull ty)-      -> SortExpression relations grouping params+      :: Expression schema relations grouping params ('NotNull ty)+      -> SortExpression schema relations grouping params     Desc-      :: Expression relations grouping params ('NotNull ty)-      -> SortExpression relations grouping params+      :: Expression schema relations grouping params ('NotNull ty)+      -> SortExpression schema relations grouping params     AscNullsFirst-      :: Expression relations grouping params  ('Null ty)-      -> SortExpression relations grouping params+      :: Expression schema relations grouping params  ('Null ty)+      -> SortExpression schema relations grouping params     AscNullsLast-      :: Expression relations grouping params  ('Null ty)-      -> SortExpression relations grouping params+      :: Expression schema relations grouping params  ('Null ty)+      -> SortExpression schema relations grouping params     DescNullsFirst-      :: Expression relations grouping params  ('Null ty)-      -> SortExpression relations grouping params+      :: Expression schema relations grouping params  ('Null ty)+      -> SortExpression schema relations grouping params     DescNullsLast-      :: Expression relations grouping params  ('Null ty)-      -> SortExpression relations grouping params-deriving instance Show (SortExpression relations grouping params)+      :: Expression schema relations grouping params  ('Null ty)+      -> SortExpression schema relations grouping params+deriving instance Show (SortExpression schema relations grouping params)  -- | Render a `SortExpression`.-renderSortExpression :: SortExpression relations grouping params -> ByteString+renderSortExpression :: SortExpression schema relations grouping params -> ByteString renderSortExpression = \case   Asc expression -> renderExpression expression <+> "ASC"   Desc expression -> renderExpression expression <+> "DESC"

@@ -9,12 +9,12 @@ -}  {-# LANGUAGE-    MagicHash+    FlexibleContexts+  , MagicHash   , OverloadedStrings   , PolyKinds   , RankNTypes   , ScopedTypeVariables-  , TypeApplications #-}  module Squeal.PostgreSQL.Render@@ -26,8 +26,11 @@   , renderCommaSeparated   , renderCommaSeparatedMaybe   , renderNat+  , RenderSQL (..)+  , printSQL   ) where +import Control.Monad.Base import Data.ByteString (ByteString) import Data.Maybe import Data.Monoid ((<>))@@ -36,6 +39,7 @@ import GHC.TypeLits  import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as Char8  -- | Parenthesize a `ByteString`. parenthesized :: ByteString -> ByteString@@ -78,3 +82,11 @@ -- | Render a promoted `Nat`. renderNat :: KnownNat n => proxy n -> ByteString renderNat (_ :: proxy n) = fromString (show (natVal' (proxy# :: Proxy# n)))++-- | A class for rendering SQL+class RenderSQL sql where+  renderSQL :: sql -> ByteString++-- | Print SQL.+printSQL :: (RenderSQL sql, MonadBase IO io) => sql -> io ()+printSQL = liftBase . Char8.putStrLn . renderSQL

@@ -5,32 +5,31 @@ Maintainer: eitan@morphism.tech Stability: experimental -A type-level DSL for kinds of PostgreSQL types, constraints, and aliases.+This module provides a type-level DSL for kinds of Postgres types,+tables, schema, constraints, aliases, enumerated labels, and groupings.+It also defines useful type families to operate on these. Finally,+it defines an embedding of Haskell types into Postgres types. -}  {-# LANGUAGE     AllowAmbiguousTypes   , ConstraintKinds-  , DataKinds   , DeriveAnyClass-  , DeriveDataTypeable   , DeriveGeneric   , FlexibleContexts   , FlexibleInstances   , FunctionalDependencies   , GADTs-  , MagicHash-  , MultiParamTypeClasses   , OverloadedStrings-  , PolyKinds   , RankNTypes   , ScopedTypeVariables   , StandaloneDeriving   , TypeApplications-  , TypeFamilies+  , TypeFamilyDependencies   , TypeInType   , TypeOperators   , UndecidableInstances+  , UndecidableSuperClasses #-}  module Squeal.PostgreSQL.Schema@@ -39,35 +38,47 @@   , HasOid (..)   , NullityType (..)   , ColumnType+    -- * Tables   , ColumnsType   , RelationType   , NilRelation   , RelationsType   , TableType-  , TablesType-  , NilTables-    -- * Grouping-  , Grouping (..)-  , GroupedBy+    -- * Schema+  , SchemumType (..)+  , SchemaType     -- * Constraints   , (:=>)   , ColumnConstraint (..)   , TableConstraint (..)   , TableConstraints   , NilTableConstraints+  , Uniquely     -- * Aliases   , (:::)   , Alias (Alias)   , renderAlias+  , renderAliases   , Aliased (As)   , renderAliasedAs   , AliasesOf+  , ZipAliased (..)   , Has   , HasUnique+  , HasAll   , IsLabel (..)   , IsQualified (..)+    -- * Enumerated Labels+  , IsPGlabel (..)+  , PGlabel (..)+  , renderLabel+  , renderLabels+    -- * Grouping+  , Grouping (..)+  , GroupedBy     -- * Type Families   , Join+  , With   , Create   , Drop   , Alter@@ -79,35 +90,58 @@   , PGFloating   , PGTypeOf   , SameTypes+  , SamePGType   , AllNotNull   , NotAllNull   , NullifyType   , NullifyRelation   , NullifyRelations   , ColumnsToRelation-  , RelationToColumns   , TableToColumns-  , TablesToRelations-  , RelationsToTables+  , TableToRelation   , ConstraintInvolves   , DropIfConstraintsInvolve-    -- * Generics-  , SameField-  , SameFields+    -- * Embedding+  , PG+  , EnumFrom+  , LabelsFrom+  , CompositeFrom+  , FieldNamesFrom+  , FieldTypesFrom+  , ConstructorsOf+  , ConstructorNameOf+  , ConstructorNamesOf+  , FieldsOf+  , FieldNameOf+  , FieldNamesOf+  , FieldTypeOf+  , FieldTypesOf+  , RecordCodeOf+  , MapMaybes (..)+  , Nulls   ) where  import Control.DeepSeq-import Data.ByteString-import Data.Monoid+import Data.Aeson (Value)+import Data.ByteString (ByteString)+import Data.Int (Int16, Int32, Int64)+import Data.Kind+import Data.Monoid hiding (All)+import Data.Scientific (Scientific) import Data.String-import Data.Word+import Data.Text (Text)+import Data.Time+import Data.Word (Word16, Word32, Word64) import Data.Type.Bool-import Generics.SOP (AllZip)-import GHC.Generics (Generic)-import GHC.Exts+import Data.UUID.Types (UUID)+import Generics.SOP import GHC.OverloadedLabels import GHC.TypeLits+import Network.IP.Addr +import qualified Data.ByteString.Lazy as Lazy+import qualified Data.Text.Lazy as Lazy+import qualified GHC.Generics as GHC import qualified Generics.SOP.Type.Metadata as Type  import Squeal.PostgreSQL.Render@@ -141,6 +175,8 @@   | PGjsonb -- ^ binary JSON data, decomposed   | PGvararray PGType -- ^ variable length array   | PGfixarray Nat PGType -- ^ fixed length array+  | PGenum [Symbol]+  | PGcomposite [(Symbol, PGType)]   | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types  -- | The object identifier of a `PGType`.@@ -190,10 +226,7 @@ infixr 7 :=>  -- | The alias operator `:::` is like a promoted version of `As`,--- a type level pair between--- an alias and some type, like a column alias and either a `ColumnType` or--- `NullityType` or a table alias and either a `TableType` or a `RelationType`--- or a constraint alias and a `TableConstraint`.+-- a type level pair between an alias and some type. type (:::) (alias :: Symbol) ty = '(alias,ty) infixr 6 ::: @@ -244,6 +277,15 @@ type family NilTableConstraints :: TableConstraints where   NilTableConstraints = '[] +-- | A `ForeignKey` must reference columns that either are+-- a `PrimaryKey` or form a `Unique` constraint.+type family Uniquely+  (key :: [Symbol])+  (constraints :: TableConstraints) :: Constraint where+    Uniquely key (uq ::: 'Unique key ': constraints) = ()+    Uniquely key (pk ::: 'PrimaryKey key ': constraints) = ()+    Uniquely key (_ ': constraints) = Uniquely key constraints+ -- | `TableType` encodes a row of constraints on a table as well as the types -- of its columns. --@@ -257,31 +299,6 @@ -- :} type TableType = (TableConstraints,ColumnsType) --- | `TablesType` is a row of `TableType`s, thought of as a union.------ >>> :{--- type family Schema :: TablesType where---   Schema =---     '[ "users" :::---          '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>---          '[ "id" ::: 'Def :=> 'NotNull 'PGint4---           , "name" ::: 'NoDef :=> 'NotNull 'PGtext---           , "vec" ::: 'NoDef :=> 'NotNull ('PGvararray 'PGint2)---           ]---      , "emails" :::---          '[  "pk_emails" ::: 'PrimaryKey '["id"]---           , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]---           ] :=>---          '[ "id" ::: 'Def :=> 'NotNull 'PGint4---           , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4---           , "email" ::: 'NoDef :=> 'Null 'PGtext---           ]---      ]--- :}-type TablesType = [(Symbol,TableType)]--- | A monokinded empty `TablesType`.-type family NilTables :: TablesType where NilTables = '[]- -- | `RelationType` is a row of `NullityType` -- -- >>> :{@@ -305,27 +322,13 @@   ColumnsToRelation (column ::: constraint :=> ty ': columns) =     column ::: ty ': ColumnsToRelation columns --- | `RelationToColumns` adds `'NoDef` column constraints.-type family RelationToColumns (relation :: RelationType) :: ColumnsType where-  RelationToColumns '[] = '[]-  RelationToColumns (column ::: ty ': columns) =-    column ::: 'NoDef :=> ty ': RelationToColumns columns- -- | `TableToColumns` removes table constraints. type family TableToColumns (table :: TableType) :: ColumnsType where   TableToColumns (constraints :=> columns) = columns --- | `TablesToRelations` removes both table and column constraints.-type family TablesToRelations (tables :: TablesType) :: RelationsType where-  TablesToRelations '[] = '[]-  TablesToRelations (alias ::: constraint :=> columns ': tables) =-    alias ::: ColumnsToRelation columns ': TablesToRelations tables---- | `RelationsToTables` adds both trivial table and column constraints.-type family RelationsToTables (tables :: RelationsType) :: TablesType where-  RelationsToTables '[] = '[]-  RelationsToTables (alias ::: columns ': relations) =-    alias ::: '[] :=> RelationToColumns columns ': RelationsToTables relations+-- | Convert a table to a relation.+type family TableToRelation (table :: TableType) :: RelationType where+  TableToRelation tab = ColumnsToRelation (TableToColumns tab)  -- | `Grouping` is an auxiliary namespace, created by -- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used@@ -355,15 +358,26 @@ -- >>> #foobar :: Alias "foobar" -- Alias data Alias (alias :: Symbol) = Alias-  deriving (Eq,Generic,Ord,Show,NFData)+  deriving (Eq,GHC.Generic,Ord,Show,NFData) instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where   fromLabel = Alias+instance aliases ~ '[alias] => IsLabel alias (NP Alias aliases) where+  fromLabel = fromLabel :* Nil+instance KnownSymbol alias => RenderSQL (Alias alias) where renderSQL = renderAlias  -- | >>> renderAlias #jimbob -- "\"jimbob\"" renderAlias :: KnownSymbol alias => Alias alias -> ByteString renderAlias = doubleQuoted . fromString . symbolVal +-- | >>> import Generics.SOP (NP(..))+-- >>> renderAliases (#jimbob :* #kandi :* Nil)+-- ["\"jimbob\"","\"kandi\""]+renderAliases+  :: All KnownSymbol aliases => NP Alias aliases -> [ByteString]+renderAliases = hcollapse+  . hcmap (Proxy @KnownSymbol) (K . renderAlias)+ -- | The `As` operator is used to name an expression. `As` is like a demoted -- version of `:::`. --@@ -381,6 +395,9 @@   => Eq (Aliased expression (alias ::: ty)) deriving instance Ord (expression ty)   => Ord (Aliased expression (alias ::: ty))+instance (alias0 ~ alias1, alias0 ~ alias2, KnownSymbol alias2)+  => IsLabel alias0 (Aliased Alias (alias1 ::: alias2)) where+    fromLabel = fromLabel @alias2 `As` fromLabel @alias1  -- | >>> let renderMaybe = fromString . maybe "Nothing" (const "Just") -- >>> renderAliasedAs renderMaybe (Just (3::Int) `As` #an_int)@@ -397,12 +414,43 @@   AliasesOf '[] = '[]   AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys +-- | The `ZipAliased` class provides a type family for zipping+-- `Symbol` lists together with arbitrary lists of the same size,+-- with an associated type family `ZipAs`, together with+-- a method `zipAs` for zipping heterogeneous lists of `Alias`es+-- together with a heterogeneous list of expressions into+-- a heterogeneous list of `Aliased` expressions.+class+  ( SListI (ZipAs ns xs)+  , All KnownSymbol ns+  ) => ZipAliased ns xs where++  type family ZipAs+    (ns :: [Symbol]) (xs :: [k]) = (zs :: [(Symbol,k)]) | zs -> ns xs++  zipAs+    :: NP Alias ns+    -> NP expr xs+    -> NP (Aliased expr) (ZipAs ns xs)++instance ZipAliased '[] '[] where+  type ZipAs '[] '[] = '[]+  zipAs Nil Nil = Nil++instance+  ( KnownSymbol n+  , ZipAliased ns xs+  ) => ZipAliased (n ': ns) (x ': xs) where+  type ZipAs (n ': ns) (x ': xs) = '(n,x) ': ZipAs ns xs+  zipAs (n :* ns) (x :* xs) = x `As` n :* zipAs ns xs+ -- | @HasUnique alias fields field@ is a constraint that proves that -- @fields@ is a singleton of @alias ::: field@. type HasUnique alias fields field = fields ~ '[alias ::: field]  -- | @Has alias fields field@ is a constraint that proves that--- @fields@ has a field of @alias ::: field@.+-- @fields@ has a field of @alias ::: field@, inferring @field@+-- from @alias@ and @fields@. class KnownSymbol alias =>   Has (alias :: Symbol) (fields :: [(Symbol,kind)]) (field :: kind)   | alias fields -> field where@@ -411,6 +459,20 @@ instance {-# OVERLAPPABLE #-} (KnownSymbol alias, Has alias fields field)   => Has alias (field' ': fields) field +-- | `HasAll` extends `Has` to take lists of @aliases@ and @fields@ and infer+-- a list of @subfields@.+class+  ( All KnownSymbol aliases+  ) => HasAll+    (aliases :: [Symbol])+    (fields :: [(Symbol,kind)])+    (subfields :: [(Symbol,kind)])+    | aliases fields -> subfields where+instance {-# OVERLAPPING #-} HasAll '[] fields '[]+instance {-# OVERLAPPABLE #-}+  (Has alias fields field, HasAll aliases fields subfields)+  => HasAll (alias ': aliases) fields (alias ::: field ': subfields)+ -- | Analagous to `IsLabel`, the constraint -- `IsQualified` defines `!` for a column alias qualified -- by a table alias.@@ -456,6 +518,13 @@   SameTypes (column0 ::: def0 :=> ty0 ': columns0) (column1 ::: def1 :=> ty1 ': columns1)     = (ty0 ~ ty1, SameTypes columns0 columns1) +-- | Equality constraint on the underlying `PGType` of two columns.+class SamePGType+  (ty0 :: (Symbol,ColumnType)) (ty1 :: (Symbol,ColumnType)) where+instance ty0 ~ ty1 => SamePGType+  (alias0 ::: def0 :=> nullity0 ty0)+  (alias1 ::: def1 :=> nullity1 ty1)+ -- | `AllNotNull` is a constraint that proves a `ColumnsType` has no @NULL@s. type family AllNotNull (columns :: ColumnsType) :: Constraint where   AllNotNull '[] = ()@@ -497,6 +566,10 @@ -- `Squeal.PostgreSQL.Definition.addColumn`. type family Create alias x xs where   Create alias x '[] = '[alias ::: x]+  Create alias x (alias ::: y ': xs) = TypeError+    ('Text "Create: alias "+    ':<>: 'ShowType alias+    ':<>: 'Text "already in use")   Create alias y (x ': xs) = x ': Create alias y xs  -- | @Drop alias xs@ removes the type associated with @alias@ in @xs@@@ -506,12 +579,12 @@   Drop alias ((alias ::: x) ': xs) = xs   Drop alias (x ': xs) = x ': Drop alias xs --- | @Alter alias xs x@ replaces the type associated with an @alias@ in @xs@+-- | @Alter alias x xs@ replaces the type associated with an @alias@ in @xs@ -- with the type `x` and is used in `Squeal.PostgreSQL.Definition.alterTable` -- and `Squeal.PostgreSQL.Definition.alterColumn`.-type family Alter alias xs x where-  Alter alias ((alias ::: x0) ': xs) x1 = (alias ::: x1) ': xs-  Alter alias (x0 ': xs) x1 = x0 ': Alter alias xs x1+type family Alter alias x xs where+  Alter alias x1 (alias ::: x0 ': xs) = alias ::: x1 ': xs+  Alter alias x1 (x0 ': xs) = x0 ': Alter alias x1 xs  -- type family AddConstraint constraint ty where --   AddConstraint constraint (constraints :=> ty)@@ -533,26 +606,25 @@   Rename alias0 alias1 ((alias0 ::: x0) ': xs) = (alias1 ::: x0) ': xs   Rename alias0 alias1 (x ': xs) = x ': Rename alias0 alias1 xs --- | A `SameField` constraint is an equality constraint on a--- `Generics.SOP.Type.Metadata.FieldInfo` and the column alias in a `:::` pair.-class SameField-  (fieldInfo :: Type.FieldInfo) (fieldty :: (Symbol,NullityType)) where-instance field ~ column => SameField ('Type.FieldInfo field) (column ::: ty)+-- | `MapMaybes` is used in the binary instances of composite types.+class MapMaybes xs where+  type family Maybes (xs :: [Type]) = (mxs :: [Type]) | mxs -> xs+  maybes :: NP Maybe xs -> NP I (Maybes xs)+  unMaybes :: NP I (Maybes xs) -> NP Maybe xs+instance MapMaybes '[] where+  type Maybes '[] = '[]+  maybes Nil = Nil+  unMaybes Nil = Nil+instance MapMaybes xs => MapMaybes (x ': xs) where+  type Maybes (x ': xs) = Maybe x ': Maybes xs+  maybes (x :* xs) = I x :* maybes xs+  unMaybes (I mx :* xs) = mx :* unMaybes xs --- | A `SameFields` constraint proves that a--- `Generics.SOP.Type.Metadata.DatatypeInfo` of a record type has the same--- field names as the column AliasesOf of a `ColumnsType`.-type family SameFields-  (datatypeInfo :: Type.DatatypeInfo) (columns :: RelationType)-    :: Constraint where-  SameFields-    ('Type.ADT _module _datatype '[ 'Type.Record _constructor fields])-    columns-      = AllZip SameField fields columns-  SameFields-    ('Type.Newtype _module _datatype ('Type.Record _constructor fields))-    columns-      = AllZip SameField fields columns+-- | `Nulls` is used to construct a `Squeal.Postgresql.Expression.row`+-- of a composite type.+type family Nulls tys where+  Nulls '[] = '[]+  Nulls (field ::: ty ': tys) = field ::: 'Null ty ': Nulls tys  -- | Check if a `TableConstraint` involves a column type family ConstraintInvolves column constraint where@@ -569,3 +641,199 @@     = If (ConstraintInvolves column constraint)         (DropIfConstraintsInvolve column constraints)         (alias ::: constraint ': DropIfConstraintsInvolve column constraints)++-- | A `SchemumType` is a user-defined type, either a `Table`,+-- `View` or `Typedef`.+data SchemumType+  = Table TableType+  | View RelationType+  | Typedef PGType++-- | The schema of a database consists of a list of aliased,+-- user-defined `SchemumType`s.+type SchemaType = [(Symbol,SchemumType)]++-- | Used in `Squeal.Postgresql.Manipulation.with`.+type family With+  (relations :: RelationsType)+  (schema :: SchemaType)+  :: SchemaType where+    With '[] schema = schema+    With (alias ::: rel ': rels) schema =+      alias ::: 'View rel ': With rels schema++-- | `IsPGlabel` looks very much like the `IsLabel` class. Whereas+-- the overloaded label, `fromLabel` is used for column references,+-- `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+-- | A `PGlabel` unit type with an `IsPGlabel` instance+data PGlabel (label :: Symbol) = PGlabel+-- | Renders a label+renderLabel :: KnownSymbol label => proxy label -> ByteString+renderLabel (_ :: proxy label) =+  "\'" <> fromString (symbolVal (Proxy @label)) <> "\'"+-- | Renders a list of labels+renderLabels+  :: All KnownSymbol labels => NP PGlabel labels -> [ByteString]+renderLabels = hcollapse+  . hcmap (Proxy @KnownSymbol) (K . renderLabel)++-- | The `PG` type family embeds a subset of Haskell types+-- as Postgres basic types.+--+-- >>> :kind! PG LocalTime+-- PG LocalTime :: PGType+-- = 'PGtimestamp+type family PG (hask :: Type) :: PGType where+  PG Bool = 'PGbool+  PG Int16 = 'PGint2+  PG Int32 = 'PGint4+  PG Int64 = 'PGint8+  PG Word16 = 'PGint2+  PG Word32 = 'PGint4+  PG Word64 = 'PGint8+  PG Scientific = 'PGnumeric+  PG Float = 'PGfloat4+  PG Double = 'PGfloat8+  PG Char = 'PGchar 1+  PG Text = 'PGtext+  PG Lazy.Text = 'PGtext+  PG ByteString = 'PGbytea+  PG Lazy.ByteString = 'PGbytea+  PG LocalTime = 'PGtimestamp+  PG UTCTime = 'PGtimestamptz+  PG Day = 'PGdate+  PG TimeOfDay = 'PGtime+  PG (TimeOfDay, TimeZone) = 'PGtimetz+  PG DiffTime = 'PGinterval+  PG UUID = 'PGuuid+  PG (NetAddr IP) = 'PGinet+  PG Value = 'PGjson+  PG ty = TypeError+    ('Text "There is no Postgres basic type for " ':<>: 'ShowType ty)++-- | The `EnumFrom` type family embeds Haskell enum types, ADTs with+-- nullary constructors, as Postgres enum types+--+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic+-- >>> instance Generic Schwarma+-- >>> instance HasDatatypeInfo Schwarma+-- >>> :kind! EnumFrom Schwarma+-- EnumFrom Schwarma :: PGType+-- = 'PGenum '["Beef", "Lamb", "Chicken"]+type family EnumFrom (hask :: Type) :: PGType where+  EnumFrom hask = 'PGenum (LabelsFrom hask)++-- | The `LabelsFrom` type family calculates the constructors of a+-- Haskell enum type.+--+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic+-- >>> instance Generic Schwarma+-- >>> instance HasDatatypeInfo Schwarma+-- >>> :kind! LabelsFrom Schwarma+-- LabelsFrom Schwarma :: [Type.ConstructorName]+-- = '["Beef", "Lamb", "Chicken"]+type family LabelsFrom (hask :: Type) :: [Type.ConstructorName] where+  LabelsFrom hask =+    ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask))++-- | The `CompositeFrom` type family embeds Haskell record types as+-- Postgres composite types, as long as the record fields+-- are `Maybe`s of Haskell types that can be embedded as basic types+-- with the `PG` type family.+--+-- >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic+-- >>> instance Generic Row+-- >>> instance HasDatatypeInfo Row+-- >>> :kind! CompositeFrom Row+-- CompositeFrom Row :: PGType+-- = 'PGcomposite '['("a", 'PGint2), '("b", 'PGtimestamp)]+type family CompositeFrom (hask :: Type) :: PGType where+  CompositeFrom hask =+    'PGcomposite (ZipAs (FieldNamesFrom hask) (FieldTypesFrom hask))++-- | >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic+-- >>> instance Generic Row+-- >>> instance HasDatatypeInfo Row+-- >>> :kind! FieldNamesFrom Row+-- FieldNamesFrom Row :: [Type.FieldName]+-- = '["a", "b"]+type family FieldNamesFrom (hask :: Type) :: [Type.FieldName] where+  FieldNamesFrom hask = FieldNamesOf (FieldsOf (DatatypeInfoOf hask))++-- | >>> data Row = Row { a :: Maybe Int16, b :: Maybe LocalTime } deriving GHC.Generic+-- >>> instance Generic Row+-- >>> instance HasDatatypeInfo Row+-- >>> :kind! FieldTypesFrom Row+-- FieldTypesFrom Row :: [PGType]+-- = '['PGint2, 'PGtimestamp]+type family FieldTypesFrom (hask :: Type) :: [PGType] where+  FieldTypesFrom hask = FieldTypesOf (RecordCodeOf hask (Code hask))++-- | Calculates constructors of a datatype.+type family ConstructorsOf (datatype :: Type.DatatypeInfo)+  :: [Type.ConstructorInfo] where+    ConstructorsOf ('Type.ADT _module _datatype constructors) =+      constructors+    ConstructorsOf ('Type.Newtype _module _datatype constructor) =+      '[constructor]++-- | Calculates the name of a nullary constructor, otherwise+-- generates a type error.+type family ConstructorNameOf (constructors :: Type.ConstructorInfo)+  :: Type.ConstructorName where+    ConstructorNameOf ('Type.Constructor name) = name+    ConstructorNameOf ('Type.Infix name _assoc _fix) = TypeError+      ('Text "ConstructorNameOf error: non-nullary constructor "+        ':<>: 'Text name)+    ConstructorNameOf ('Type.Record name _fields) = TypeError+      ('Text "ConstructorNameOf error: non-nullary constructor "+        ':<>: 'Text name)++-- | Calculate the names of nullary constructors.+type family ConstructorNamesOf (constructors :: [Type.ConstructorInfo])+  :: [Type.ConstructorName] where+    ConstructorNamesOf '[] = '[]+    ConstructorNamesOf (constructor ': constructors) =+      ConstructorNameOf constructor ': ConstructorNamesOf constructors++-- | Calculate the fields of a datatype.+type family FieldsOf (datatype :: Type.DatatypeInfo)+  :: [Type.FieldInfo] where+    FieldsOf ('Type.ADT _module _datatype '[ 'Type.Record _name fields]) =+      fields+    FieldsOf ('Type.Newtype _module _datatype ('Type.Record _name fields)) =+      fields++-- | Calculate the name of a field.+type family FieldNameOf (field :: Type.FieldInfo) :: Type.FieldName where+  FieldNameOf ('Type.FieldInfo name) = name++-- | Calculate the names of fields.+type family FieldNamesOf (fields :: [Type.FieldInfo])+  :: [Type.FieldName] where+    FieldNamesOf '[] = '[]+    FieldNamesOf (field ': fields) = FieldNameOf field ': FieldNamesOf fields++-- | >>> :kind! FieldTypeOf (Maybe Int16)+-- FieldTypeOf (Maybe Int16) :: PGType+-- = 'PGint2+type family FieldTypeOf (maybe :: Type) where+  FieldTypeOf (Maybe hask) = PG hask+  FieldTypeOf ty = TypeError+    ('Text "FieldTypeOf error: non-Maybe type " ':<>: 'ShowType ty)++-- | Calculate the types of fields.+type family FieldTypesOf (fields :: [Type]) where+  FieldTypesOf '[] = '[]+  FieldTypesOf (field ': fields) = FieldTypeOf field ': FieldTypesOf fields++-- | Inspect the code of an algebraic datatype and ensure it's a product,+-- otherwise generate a type error+type family RecordCodeOf (hask :: Type) (code ::[[Type]]) :: [Type] where+  RecordCodeOf _hask '[tys] = tys+  RecordCodeOf hask _tys = TypeError+    ('Text "RecordCodeOf error: non-Record type " ':<>: 'ShowType hask)

@@ -9,16 +9,9 @@ -}  {-# LANGUAGE-    DataKinds-  , EmptyCase-  , FlexibleContexts-  , FlexibleInstances+    FlexibleContexts   , LambdaCase   , OverloadedStrings-  , MultiParamTypeClasses-  , ScopedTypeVariables-  , TypeFamilies-  , TypeInType #-}  module Squeal.PostgreSQL.Transaction@@ -165,22 +158,22 @@   = Serializable   -- ^ Dirty read is not possible.   -- Nonrepeatable read is not possible.-  -- Phantom read is not possible. +  -- Phantom read is not possible.   -- Serialization anomaly is not possible.   | RepeatableRead   -- ^ Dirty read is not possible.   -- Nonrepeatable read is not possible.-  -- Phantom read is not possible. +  -- Phantom read is not possible.   -- Serialization anomaly is possible.   | ReadCommitted   -- ^ Dirty read is not possible.   -- Nonrepeatable read is possible.-  -- Phantom read is possible. +  -- Phantom read is possible.   -- Serialization anomaly is possible.   | ReadUncommitted   -- ^ Dirty read is not possible.   -- Nonrepeatable read is possible.-  -- Phantom read is possible. +  -- Phantom read is possible.   -- Serialization anomaly is possible.   deriving (Show, Eq)