@@ -9,29 +9,21 @@
9-- First, we need some language extensions because Squeal uses modern GHC
9-- First, we need some language extensions because Squeal uses modern GHC
10-- features.
10-- features.
12−-- > {-# LANGUAGE
12+-- >>> :set -XDataKinds -XDeriveGeneric -XOverloadedLabels
13−-- > DataKinds
13+-- >>> :set -XOverloadedStrings -XTypeApplications -XTypeOperators
15−-- > , OverloadedLabels
16−-- > , OverloadedStrings
17−-- > , TypeApplications
21−-- Here comes the @Main@ module and imports.
15+-- We'll need some imports.
23−-- > module Main (main) where
17+-- >>> import Control.Monad (void)
25−-- > import Control.Monad.Base (liftBase)
18+-- >>> import Control.Monad.Base (liftBase)
26−-- > import Data.Int (Int32)
19+-- >>> import Data.Int (Int32)
27−-- > import Data.Text (Text)
20+-- >>> import Data.Text (Text)
29−-- > import Squeal.PostgreSQL
21+-- >>> import Squeal.PostgreSQL
31-- We'll use generics to easily convert between Haskell and PostgreSQL values.
23-- We'll use generics to easily convert between Haskell and PostgreSQL values.
33−-- > import qualified Generics.SOP as SOP
25+-- >>> import qualified Generics.SOP as SOP
34−-- > import qualified GHC.Generics as GHC
26+-- >>> import qualified GHC.Generics as GHC
36-- The first step is to define the schema of our database. This is where
28-- The first step is to define the schema of our database. This is where
37-- we use @DataKinds@ and @TypeOperators@. The schema consists of a type-level
29-- we use @DataKinds@ and @TypeOperators@. The schema consists of a type-level
@@ -42,17 +34,23 @@
42-- @NULL@ and whether or not inserts and updates can use a @DEFAULT@. For our
34-- @NULL@ and whether or not inserts and updates can use a @DEFAULT@. For our
43-- schema, we'll define two tables, a users table and an emails table.
35-- schema, we'll define two tables, a users table and an emails table.
45−-- > type Schema =
38+-- type Schema =
46−-- > '[ "users" :::
39+-- '[ "users" :::
40+-- '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
47−-- > '[ "id" ::: 'Def :=> 'NotNull 'PGint4
41+-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4
48−-- > , "name" ::: 'NoDef :=> 'NotNull 'PGtext
42+-- , "name" ::: 'NoDef :=> 'NotNull 'PGtext
50−-- > , "emails" :::
44+-- , "emails" :::
45+-- '[ "pk_emails" ::: 'PrimaryKey '["id"]
46+-- , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
51−-- > '[ "id" ::: 'Def :=> 'NotNull 'PGint4
48+-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4
52−-- > , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
49+-- , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
53−-- > , "email" ::: 'NoDef :=> 'Null 'PGtext
50+-- , "email" ::: 'NoDef :=> 'Null 'PGtext
57-- Next, we'll write `Definition`s to set up and tear down the schema. In
55-- Next, we'll write `Definition`s to set up and tear down the schema. In
58-- Squeal, a `Definition` is a `createTable`, `alterTable` or `dropTable`
56-- Squeal, a `Definition` is a `createTable`, `alterTable` or `dropTable`
@@ -61,29 +59,41 @@
61-- `>>>`. Here and in the rest of our commands we make use of overloaded
59-- `>>>`. Here and in the rest of our commands we make use of overloaded
62-- labels to refer to named tables and columns in our schema.
60-- labels to refer to named tables and columns in our schema.
64−-- > setup :: Definition '[] Schema
64+-- setup :: Definition '[] Schema
65−-- > setup =
65+-- setup =
66−-- > createTable #users
66+-- createTable #users
67−-- > ( serial `As` #id :*
67+-- ( serial `As` #id :*
68−-- > (text & notNull) `As` #name :*
68+-- (text & notNull) `As` #name :* Nil )
69−-- > (vararray int2 & notNull) `As` #vec :* Nil )
70−-- > ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil )
69+-- ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil ) >>>
72−-- > createTable #emails
70+-- createTable #emails
73−-- > ( serial `As` #id :*
71+-- ( serial `As` #id :*
74−-- > (int & notNull) `As` #user_id :*
72+-- (int & notNull) `As` #user_id :*
75−-- > text `As` #email :* Nil )
73+-- text `As` #email :* Nil )
76−-- > ( primaryKey (Column #id :* Nil) `As` #pk_emails :*
74+-- ( primaryKey (Column #id :* Nil) `As` #pk_emails :*
77−-- > foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)
75+-- foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)
78−-- > OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )
76+-- OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )
79+-- We can easily see the generated SQL is unsuprising looking.
81+-- >>> renderDefinition setup
82+-- "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);"
80-- Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.
84-- Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.
81-- In our `createTable` commands we included `TableConstraint`s to define
85-- In our `createTable` commands we included `TableConstraint`s to define
82-- primary and foreign keys, making them somewhat complex. Our tear down
86-- primary and foreign keys, making them somewhat complex. Our tear down
83-- `Definition` is simpler.
87-- `Definition` is simpler.
85−-- > teardown :: Definition Schema '[]
91+-- teardown :: Definition Schema '[]
86−-- > teardown = dropTable #emails >>> dropTable #users
92+-- teardown = dropTable #emails >>> dropTable #users
95+-- >>> renderDefinition teardown
96+-- "DROP TABLE emails; DROP TABLE users;"
88-- Next, we'll write `Manipulation`s to insert data into our two tables.
98-- Next, we'll write `Manipulation`s to insert data into our two tables.
89-- A `Manipulation` is a `insertInto`, `update` or `deleteFrom` command and
99-- A `Manipulation` is a `insertInto`, `update` or `deleteFrom` command and
@@ -96,31 +106,49 @@
96-- the emails table. Take a careful look at the type and definition of both
106-- the emails table. Take a careful look at the type and definition of both
97-- of our inserts.
107-- of our inserts.
99−-- > insertUser :: Manipulation Schema
111+-- insertUser :: Manipulation Schema '[ 'NotNull 'PGtext ]
100−-- > '[ 'NotNull 'PGtext] '[ "fromOnly" ::: 'NotNull 'PGint4 ]
112+-- '[ "fromOnly" ::: 'NotNull 'PGint4 ]
101−-- > insertUser = insertInto #users
113+-- insertUser = insertRow #users
102−-- > ( Values (def `As` #id :* param @1 `As` #name :* Nil) [] )
114+-- (Default `As` #id :* Set (param @1) `As` #name :* Nil)
103−-- > OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))
115+-- OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))
105−-- > insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
120+-- insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
106−-- > insertEmail = insertInto #emails ( Values
121+-- insertEmail = insertRow #emails
107−-- > ( def `As` #id :*
122+-- ( Default `As` #id :*
108−-- > param @1 `As` #user_id :*
123+-- Set (param @1) `As` #user_id :*
109−-- > param @2 `As` #email :* Nil) [] )
124+-- Set (param @2) `As` #email :* Nil )
110−-- > OnConflictDoNothing (Returning Nil)
125+-- OnConflictDoNothing (Returning Nil)
128+-- >>> renderManipulation insertUser
129+-- "INSERT INTO users (id, name) VALUES (DEFAULT, ($1 :: text)) ON CONFLICT DO NOTHING RETURNING id AS fromOnly;"
130+-- >>> renderManipulation insertEmail
131+-- "INSERT INTO emails (id, user_id, email) VALUES (DEFAULT, ($1 :: int4), ($2 :: text)) ON CONFLICT DO NOTHING;"
112-- Next we write a `Query` to retrieve users from the database. We're not
133-- Next we write a `Query` to retrieve users from the database. We're not
113-- interested in the ids here, just the usernames and email addresses. We
134-- interested in the ids here, just the usernames and email addresses. We
114-- need to use an inner join to get the right result. A `Query` is like a
135-- need to use an inner join to get the right result. A `Query` is like a
115-- `Manipulation` with the same kind of type parameters.
136-- `Manipulation` with the same kind of type parameters.
117−-- > getUsers :: Query Schema '[]
140+-- getUsers :: Query Schema '[]
118−-- > '["userName" ::: 'NotNull 'PGtext, "userEmail" ::: 'Null 'PGtext]
141+-- '[ "userName" ::: 'NotNull 'PGtext
142+-- , "userEmail" ::: 'Null 'PGtext ]
119−-- > getUsers = select
143+-- getUsers = select
120−-- > (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)
144+-- (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)
121−-- > ( from (Table (#users `As` #u)
145+-- ( from (table (#users `As` #u)
122−-- > & InnerJoin (Table (#emails `As` #e))
146+-- & innerJoin (table (#emails `As` #e))
123−-- > (#u ! #id .== #e ! #user_id)) )
147+-- (#u ! #id .== #e ! #user_id)) )
150+-- >>> renderQuery getUsers
151+-- "SELECT u.name AS userName, e.email AS userEmail FROM users AS u INNER JOIN emails AS e ON (u.id = e.user_id)"
125-- Now that we've defined the SQL side of things, we'll need a Haskell type
153-- Now that we've defined the SQL side of things, we'll need a Haskell type
126-- for users. We give the type `Generics.SOP.Generic` and
154-- for users. We give the type `Generics.SOP.Generic` and
@@ -128,19 +156,21 @@
128-- we receive when we run @getUsers@. Notice that the record fields of the
156-- we receive when we run @getUsers@. Notice that the record fields of the
129-- @User@ type match the column names of @getUsers@.
157-- @User@ type match the column names of @getUsers@.
131−-- > data User = User { userName :: Text, userEmail :: Maybe Text }
159+-- >>> data User = User { userName :: Text, userEmail :: Maybe Text } deriving (Show, GHC.Generic)
132−-- > deriving (Show, GHC.Generic)
133−-- > instance SOP.Generic User
160+-- >>> instance SOP.Generic User
134−-- > instance SOP.HasDatatypeInfo User
161+-- >>> instance SOP.HasDatatypeInfo User
136-- Let's also create some users to add to the database.
163-- Let's also create some users to add to the database.
138−-- > users :: [User]
167+-- users :: [User]
139−-- > users =
168+-- users =
140−-- > [ User "Alice" (Just "alice@gmail.com")
169+-- [ User "Alice" (Just "alice@gmail.com")
141−-- > , User "Bob" Nothing
170+-- , User "Bob" Nothing
142−-- > , User "Carole" (Just "carole@hotmail.com")
171+-- , User "Carole" (Just "carole@hotmail.com")
145-- Now we can put together all the pieces into a program. The program
175-- Now we can put together all the pieces into a program. The program
146-- connects to the database, sets up the schema, inserts the user data
176-- connects to the database, sets up the schema, inserts the user data
@@ -149,21 +179,26 @@
149-- the changing schema information through by using the indexed `PQ` monad
179-- the changing schema information through by using the indexed `PQ` monad
150-- transformer and when the schema doesn't change we can use `Monad` and
180-- transformer and when the schema doesn't change we can use `Monad` and
151-- `MonadPQ` functionality.
181-- `MonadPQ` functionality.
153−-- > main :: IO ()
183+-- >>> :{
154−-- > main = void $
184+-- let
155−-- > withConnection "host=localhost port=5432 dbname=exampledb" . runPQ $
185+-- session :: PQ Schema Schema IO ()
157−-- > & pqThen session
158−-- > & thenDefine teardown
160−-- > session = do
186+-- session = do
161−-- > idResults <- traversePrepared insertUser (Only . userName <$> users)
187+-- idResults <- traversePrepared insertUser (Only . userName <$> users)
162−-- > ids <- traverse (fmap fromOnly . getRow (RowNumber 0)) idResults
188+-- ids <- traverse (fmap fromOnly . getRow (RowNumber 0)) idResults
163−-- > traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))
189+-- traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))
164−-- > usersResult <- runQuery getUsers
190+-- usersResult <- runQuery getUsers
165−-- > usersRows <- getRows usersResult
191+-- usersRows <- getRows usersResult
166−-- > liftBase $ print (usersRows :: [User])
192+-- liftBase $ print (usersRows :: [User])
196+-- void . withConnection "host=localhost port=5432 dbname=exampledb" $
199+-- & thenDefine teardown
201+-- [User {userName = "Alice", userEmail = Just "alice@gmail.com"},User {userName = "Bob", userEmail = Nothing},User {userName = "Carole", userEmail = Just "carole@hotmail.com"}]
168module Squeal.PostgreSQL
203module Squeal.PostgreSQL
169 ( module Squeal.PostgreSQL.Binary
204 ( module Squeal.PostgreSQL.Binary