@@ -9,29 +9,21 @@
99-- First, we need some language extensions because Squeal uses modern GHC
1010-- features.
1111--
12−-- > {-# LANGUAGE
13−-- > DataKinds
14−-- > , DeriveGeneric
15−-- > , OverloadedLabels
16−-- > , OverloadedStrings
17−-- > , TypeApplications
18−-- > , TypeOperators
19−-- > #-}
12+-- >>> :set -XDataKinds -XDeriveGeneric -XOverloadedLabels
13+-- >>> :set -XOverloadedStrings -XTypeApplications -XTypeOperators
2014--
21−-- Here comes the @Main@ module and imports.
15+-- We'll need some imports.
2216--
23−-- > module Main (main) where
24−-- >
25−-- > import Control.Monad.Base (liftBase)
26−-- > import Data.Int (Int32)
27−-- > import Data.Text (Text)
28−-- >
29−-- > import Squeal.PostgreSQL
17+-- >>> import Control.Monad (void)
18+-- >>> import Control.Monad.Base (liftBase)
19+-- >>> import Data.Int (Int32)
20+-- >>> import Data.Text (Text)
21+-- >>> import Squeal.PostgreSQL
3022--
3123-- We'll use generics to easily convert between Haskell and PostgreSQL values.
3224--
33−-- > import qualified Generics.SOP as SOP
34−-- > import qualified GHC.Generics as GHC
25+-- >>> import qualified Generics.SOP as SOP
26+-- >>> import qualified GHC.Generics as GHC
3527--
3628-- The first step is to define the schema of our database. This is where
3729-- we use @DataKinds@ and @TypeOperators@. The schema consists of a type-level
@@ -42,17 +34,23 @@
4234-- @NULL@ and whether or not inserts and updates can use a @DEFAULT@. For our
4335-- schema, we'll define two tables, a users table and an emails table.
4436--
45−-- > type Schema =
46−-- > '[ "users" :::
47−-- > '[ "id" ::: 'Def :=> 'NotNull 'PGint4
48−-- > , "name" ::: 'NoDef :=> 'NotNull 'PGtext
49−-- > ]
50−-- > , "emails" :::
51−-- > '[ "id" ::: 'Def :=> 'NotNull 'PGint4
52−-- > , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
53−-- > , "email" ::: 'NoDef :=> 'Null 'PGtext
54−-- > ]
55−-- > ]
37+-- >>> :{
38+-- type Schema =
39+-- '[ "users" :::
40+-- '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
41+-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4
42+-- , "name" ::: 'NoDef :=> 'NotNull 'PGtext
43+-- ]
44+-- , "emails" :::
45+-- '[ "pk_emails" ::: 'PrimaryKey '["id"]
46+-- , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
47+-- ] :=>
48+-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4
49+-- , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
50+-- , "email" ::: 'NoDef :=> 'Null 'PGtext
51+-- ]
52+-- ]
53+-- :}
5654--
5755-- Next, we'll write `Definition`s to set up and tear down the schema. In
5856-- Squeal, a `Definition` is a `createTable`, `alterTable` or `dropTable`
@@ -61,29 +59,41 @@
6159-- `>>>`. Here and in the rest of our commands we make use of overloaded
6260-- labels to refer to named tables and columns in our schema.
6361--
64−-- > setup :: Definition '[] Schema
65−-- > setup =
66−-- > createTable #users
67−-- > ( serial `As` #id :*
68−-- > (text & notNull) `As` #name :*
69−-- > (vararray int2 & notNull) `As` #vec :* Nil )
70−-- > ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil )
71−-- > >>>
72−-- > createTable #emails
73−-- > ( serial `As` #id :*
74−-- > (int & notNull) `As` #user_id :*
75−-- > text `As` #email :* Nil )
76−-- > ( primaryKey (Column #id :* Nil) `As` #pk_emails :*
77−-- > foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)
78−-- > OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )
62+-- >>> :{
63+-- let
64+-- setup :: Definition '[] Schema
65+-- setup =
66+-- createTable #users
67+-- ( serial `As` #id :*
68+-- (text & notNull) `As` #name :* Nil )
69+-- ( primaryKey (Column #id :* Nil) `As` #pk_users :* Nil ) >>>
70+-- createTable #emails
71+-- ( serial `As` #id :*
72+-- (int & notNull) `As` #user_id :*
73+-- text `As` #email :* Nil )
74+-- ( primaryKey (Column #id :* Nil) `As` #pk_emails :*
75+-- foreignKey (Column #user_id :* Nil) #users (Column #id :* Nil)
76+-- OnDeleteCascade OnUpdateCascade `As` #fk_user_id :* Nil )
77+-- :}
78+--
79+-- We can easily see the generated SQL is unsuprising looking.
80+--
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);"
7983--
8084-- Notice that @setup@ starts with an empty schema @'[]@ and produces @Schema@.
8185-- In our `createTable` commands we included `TableConstraint`s to define
8286-- primary and foreign keys, making them somewhat complex. Our tear down
8387-- `Definition` is simpler.
8488--
85−-- > teardown :: Definition Schema '[]
86−-- > teardown = dropTable #emails >>> dropTable #users
89+-- >>> :{
90+-- let
91+-- teardown :: Definition Schema '[]
92+-- teardown = dropTable #emails >>> dropTable #users
93+-- :}
94+--
95+-- >>> renderDefinition teardown
96+-- "DROP TABLE emails; DROP TABLE users;"
8797--
8898-- Next, we'll write `Manipulation`s to insert data into our two tables.
8999-- A `Manipulation` is a `insertInto`, `update` or `deleteFrom` command and
@@ -96,31 +106,49 @@
96106-- the emails table. Take a careful look at the type and definition of both
97107-- of our inserts.
98108--
99−-- > insertUser :: Manipulation Schema
100−-- > '[ 'NotNull 'PGtext] '[ "fromOnly" ::: 'NotNull 'PGint4 ]
101−-- > insertUser = insertInto #users
102−-- > ( Values (def `As` #id :* param @1 `As` #name :* Nil) [] )
103−-- > OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))
104−-- >
105−-- > insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
106−-- > insertEmail = insertInto #emails ( Values
107−-- > ( def `As` #id :*
108−-- > param @1 `As` #user_id :*
109−-- > param @2 `As` #email :* Nil) [] )
110−-- > OnConflictDoNothing (Returning Nil)
109+-- >>> :{
110+-- let
111+-- insertUser :: Manipulation Schema '[ 'NotNull 'PGtext ]
112+-- '[ "fromOnly" ::: 'NotNull 'PGint4 ]
113+-- insertUser = insertRow #users
114+-- (Default `As` #id :* Set (param @1) `As` #name :* Nil)
115+-- OnConflictDoNothing (Returning (#id `As` #fromOnly :* Nil))
116+-- :}
117+--
118+-- >>> :{
119+-- let
120+-- insertEmail :: Manipulation Schema '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]
121+-- insertEmail = insertRow #emails
122+-- ( Default `As` #id :*
123+-- Set (param @1) `As` #user_id :*
124+-- Set (param @2) `As` #email :* Nil )
125+-- OnConflictDoNothing (Returning Nil)
126+-- :}
127+--
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;"
111132--
112133-- Next we write a `Query` to retrieve users from the database. We're not
113134-- interested in the ids here, just the usernames and email addresses. We
114135-- need to use an inner join to get the right result. A `Query` is like a
115136-- `Manipulation` with the same kind of type parameters.
116137--
117−-- > getUsers :: Query Schema '[]
118−-- > '["userName" ::: 'NotNull 'PGtext, "userEmail" ::: 'Null 'PGtext]
119−-- > getUsers = select
120−-- > (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)
121−-- > ( from (Table (#users `As` #u)
122−-- > & InnerJoin (Table (#emails `As` #e))
123−-- > (#u ! #id .== #e ! #user_id)) )
138+-- >>> :{
139+-- let
140+-- getUsers :: Query Schema '[]
141+-- '[ "userName" ::: 'NotNull 'PGtext
142+-- , "userEmail" ::: 'Null 'PGtext ]
143+-- getUsers = select
144+-- (#u ! #name `As` #userName :* #e ! #email `As` #userEmail :* Nil)
145+-- ( from (table (#users `As` #u)
146+-- & innerJoin (table (#emails `As` #e))
147+-- (#u ! #id .== #e ! #user_id)) )
148+-- :}
149+--
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)"
124152--
125153-- Now that we've defined the SQL side of things, we'll need a Haskell type
126154-- for users. We give the type `Generics.SOP.Generic` and
@@ -128,19 +156,21 @@
128156-- we receive when we run @getUsers@. Notice that the record fields of the
129157-- @User@ type match the column names of @getUsers@.
130158--
131−-- > data User = User { userName :: Text, userEmail :: Maybe Text }
132−-- > deriving (Show, GHC.Generic)
133−-- > instance SOP.Generic User
134−-- > instance SOP.HasDatatypeInfo User
159+-- >>> data User = User { userName :: Text, userEmail :: Maybe Text } deriving (Show, GHC.Generic)
160+-- >>> instance SOP.Generic User
161+-- >>> instance SOP.HasDatatypeInfo User
135162--
136163-- Let's also create some users to add to the database.
137164--
138−-- > users :: [User]
139−-- > users =
140−-- > [ User "Alice" (Just "alice@gmail.com")
141−-- > , User "Bob" Nothing
142−-- > , User "Carole" (Just "carole@hotmail.com")
143−-- > ]
165+-- >>> :{
166+-- let
167+-- users :: [User]
168+-- users =
169+-- [ User "Alice" (Just "alice@gmail.com")
170+-- , User "Bob" Nothing
171+-- , User "Carole" (Just "carole@hotmail.com")
172+-- ]
173+-- :}
144174--
145175-- Now we can put together all the pieces into a program. The program
146176-- connects to the database, sets up the schema, inserts the user data
@@ -149,21 +179,26 @@
149179-- the changing schema information through by using the indexed `PQ` monad
150180-- transformer and when the schema doesn't change we can use `Monad` and
151181-- `MonadPQ` functionality.
152−--
153−-- > main :: IO ()
154−-- > main = void $
155−-- > withConnection "host=localhost port=5432 dbname=exampledb" . runPQ $
156−-- > define setup
157−-- > & pqThen session
158−-- > & thenDefine teardown
159−-- > where
160−-- > session = do
161−-- > idResults <- traversePrepared insertUser (Only . userName <$> users)
162−-- > ids <- traverse (fmap fromOnly . getRow (RowNumber 0)) idResults
163−-- > traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))
164−-- > usersResult <- runQuery getUsers
165−-- > usersRows <- getRows usersResult
166−-- > liftBase $ print (usersRows :: [User])
182+--
183+-- >>> :{
184+-- let
185+-- session :: PQ Schema Schema IO ()
186+-- session = do
187+-- idResults <- traversePrepared insertUser (Only . userName <$> users)
188+-- ids <- traverse (fmap fromOnly . getRow (RowNumber 0)) idResults
189+-- traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))
190+-- usersResult <- runQuery getUsers
191+-- usersRows <- getRows usersResult
192+-- liftBase $ print (usersRows :: [User])
193+-- :}
194+--
195+-- >>> :{
196+-- void . withConnection "host=localhost port=5432 dbname=exampledb" $
197+-- define setup
198+-- & pqThen session
199+-- & thenDefine teardown
200+-- :}
201+-- [User {userName = "Alice", userEmail = Just "alice@gmail.com"},User {userName = "Bob", userEmail = Nothing},User {userName = "Carole", userEmail = Just "carole@hotmail.com"}]
167202
168203module Squeal.PostgreSQL
169204 ( module Squeal.PostgreSQL.Binary