Haskell Relational Record

Examples

View project on GitHub

Preparing

We assume that you have read both quick start and tutorial.

Schema of examples

We use the bank example in Learning SQL. Its support page provides a script to create the tables of the bank examples for MySQL. We modified it for SQLite and created a DB file called “examples.db” in the top directory of “relational-record-examples”. We deeply thank Alan Beaulieu, the author of “Learning SQL”.

Here is a list of tables copied from page 34 of “Learning SQL”:

  • Account – a particular product opened for a particular customer
  • Business – a corporate customer (subtype of the Customer table)
  • Customer – a person or corporation known to the bank
  • Department – a group of bank employees implementing a particular banking function
  • Employee – a person working for the bank
  • Individual – a noncorporate customer (subtype of the Customer table)
  • Officer – a person allowed to transact business for a corporate customer
  • Product – a banking function offered to customers
  • Product_type – a group of products having similar function
  • Transaction – a change made to an account balance

The most of the following examples come from “Learning SQL”, too. HRR code examples are found in “src/examples.hs”.

SELECT

Descending sort order

SQL:

SELECT account_id, product_cd, open_date, avail_balance
FROM account
ORDER BY avail_balance DESC;

HRR:

account_3_7_1 :: Relation () Account2
account_3_7_1 = relation $ do
  a <- query account
  desc $ a ! Account.availBalance'
  return $ Account2 |$| a ! Account.accountId'
                    |*| a ! Account.productCd'
                    |*| a ! Account.openDate'
                    |*| a ! Account.availBalance'

data Account2 = Account2
  { a2AccountId :: Int
  , a2ProductCd :: String
  , a2OpenDate :: Day
  , a2AvailBalance :: Maybe Double
  } deriving (Show, Generic)

$(makeRelationalRecord ''Account2)

Generated SQL:

SELECT ALL T0.account_id AS f0,
           T0.product_cd AS f1,
           T0.open_date AS f2,
           T0.avail_balance AS f3
FROM MAIN.account T0
ORDER BY T0.avail_balance DESC

The order by clause

SQL:

SELECT open_emp_id, product_cd
FROM account
ORDER BY open_emp_id, product_cd;

HRR:

account_3_7 :: Relation () (Maybe Int64, String)
account_3_7 = relation $ do
  a <- query account
  let proj = (,) |$| a ! Account.openEmpId'
                 |*| a ! Account.productCd'
  asc proj
  return proj

Generated SQL:

SELECT ALL T0.open_emp_id AS f0,
           T0.product_cd AS f1
FROM MAIN.account T0
ORDER BY T0.open_emp_id ASC, T0.product_cd ASC

Sorting with column numbers

For backwards compatibility with the SQL92 version of standard, you can use numbers instead of names to specify the columns that should be sorted. With HRR you cannot use numbers for such purpose.

SQL:

SELECT emp_id, title, start_date, fname, lname
FROM employee
ORDER BY 2,5;

HRR: constructing new records in Applicative-like style.

employee_3_7_3 :: Relation () Employee1
employee_3_7_3 = relation $ do
  e <- query employee
  asc $ e ! Employee.title'
  asc $ e ! Employee.lname'
  return $ Employee1 |$| e ! Employee.empId'
                     |*| e ! Employee.title'
                     |*| e ! Employee.startDate'
                     |*| e ! Employee.fname'
                     |*| e ! Employee.lname'

data Employee1 = Employee1
  { e1EmpId :: Int64
  , e1Title :: Maybe String
  , e1StartDate :: Day
  , e1Fname :: String
  , e1Lname' :: String
  } deriving (Show)

$(makeRelationalRecord ''Employee1)

Generated SQL:

SELECT ALL T0.emp_id AS f0,
           T0.title AS f1,
           T0.start_date AS f2,
           T0.fname AS f3,
           T0.lname AS f4
FROM MAIN.employee T0
ORDER BY T0.title ASC, T0.lname ASC

Using the is null operator and the date literal

HRR supports date literal of the SQL standard, such like Date ‘2003-01-01’. However, SQLite has its own date literal without Date keyword, like this: ‘2003-01-01’. So, you have to define a function to support SQLite’s date literal. Here we define unsafeSQLiteDayValue function for that.

SQL:

SELECT *
FROM employee
WHERE end_date IS NULL AND (title = 'Teller' OR start_date < '2003-01-01');

HRR:

employee_4_1_2 :: Relation () Employee
employee_4_1_2 = relation $ do
  e <- query employee
  wheres $ isNothing (e ! Employee.endDate')
  wheres $ e ! Employee.title' .=. just (value "Teller")
     `or'` e ! Employee.startDate' .<. unsafeSQLiteDayValue "2003-01-01"
  return e

unsafeSQLiteDayValue :: SqlProjectable p => String -> p Day
unsafeSQLiteDayValue = unsafeProjectSqlTerms . showConstantTermsSQL

Generated SQL:

SELECT ALL T0.emp_id AS f0,
           T0.fname AS f1,
           T0.lname AS f2,
           T0.start_date AS f3,
           T0.end_date AS f4,
           T0.superior_emp_id AS f5,
           T0.dept_id AS f6,
           T0.title AS f7,
           T0.assigned_branch_id AS f8
FROM MAIN.employee T0
WHERE ((T0.end_date IS NULL) AND ((T0.title = 'Teller') OR (T0.start_date < '2003-01-01')))

Another way, use a placeholder instead of a date literal. There is no need to define a helper function:

employee_4_1_2P :: Relation Day Employee
employee_4_1_2P = relation' . placeholder $ \ph -> do
  e <- query employee
  wheres $ isNothing (e ! Employee.endDate')
  wheres $ e ! Employee.title' .=. just (value "Teller")
     `or'` e ! Employee.startDate' .<. ph
  return e

NOTE: The variable representing placeholders must be used exactly once. It is programmers’ responsibility to follow this rule. If you don’t, you will suffer from strange behaviors.

Generated SQL:

SELECT ALL T0.emp_id AS f0,
           T0.fname AS f1,
           T0.lname AS f2,
           T0.start_date AS f3,
           T0.end_date AS f4,
           T0.superior_emp_id AS f5,
           T0.dept_id AS f6,
           T0.title AS f7,
           T0.assigned_branch_id AS f8
FROM MAIN.employee T0
WHERE ((T0.end_date IS NULL) AND ((T0.title = 'Teller') OR (T0.start_date < ?)))

Range condition with the between operator

SQL:

SELECT emp_id, fname, lname, start_date FROM employee
WHERE start_date
BETWEEN date('2001-01-01') AND date('2002-12-31');

HRR:

employee_4_3_2 :: Relation () Employee2
employee_4_3_2 = relation $ do
  e <- query employee
  wheres $ e ! Employee.startDate' .>=. unsafeSQLiteDayValue "2001-01-01"
  wheres $ e ! Employee.startDate' .<=. unsafeSQLiteDayValue "2003-01-01"
  return $ Employee2 |$| e ! Employee.empId'
                     |*| e ! Employee.fname'
                     |*| e ! Employee.lname'
                     |*| e ! Employee.startDate'

data Employee2 = Employee2
  { e2EmpId :: Int64
  , e2Fname :: String
  , e2Lname :: String
  , e2StartDate :: Day
  } deriving (Show)

$(makeRelationalRecord ''Employee2)

Generated SQL:

SELECT ALL T0.emp_id AS f0,
           T0.fname AS f1,
           T0.lname AS f2,
           T0.start_date AS f3
FROM MAIN.employee T0
WHERE ((T0.start_date >= '2001-01-01') AND (T0.start_date <= '2003-01-01'))

HRR with structured placeholder:

employee_4_3_2P :: Relation (Day,Day) Employee2
employee_4_3_2P = relation' . placeholder $ \ph -> do
  e <- query employee
  let date = e ! Employee.startDate'
  wheres $ date .>=. ph ! fst'
  wheres $ date .<=. ph ! snd'
  return $ Employee2 |$| e ! Employee.empId'
                     |*| e ! Employee.fname'
                     |*| e ! Employee.lname'
                     |*| date

NOTE: The variable representing placeholders must be used in the right order. It is programmers’ responsibility to follow this rule. If you don’t, you will suffer from strange behaviors.

Generated SQL:

SELECT ALL T0.emp_id AS f0,
           T0.fname AS f1,
           T0.lname AS f2,
           T0.start_date AS f3
FROM MAIN.employee T0
WHERE ((T0.start_date >= ?) AND (T0.start_date <= ?))

Membership conditions

SQL:

SELECT account_id, product_cd, cust_id, avail_balance
FROM account
WHERE product_cd IN ('CHK', 'SAV', 'CD', 'MM');

HRR: returning raw rows.

account_4_3_3a :: Relation () Account
account_4_3_3a = relation $ do
  a <- query account
  wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"]
  return a

Generated SQL:

SELECT ALL T0.account_id AS f0,
           T0.product_cd AS f1,
           T0.cust_id AS f2,
           T0.open_date AS f3,
           T0.close_date AS f4,
           T0.last_activity_date AS f5,
           T0.status AS f6,
           T0.open_branch_id AS f7,
           T0.open_emp_id AS f8,
           T0.avail_balance AS f9,
           T0.pending_balance AS f10
FROM MAIN.account T0
WHERE (T0.product_cd IN ('CHK', 'SAV', 'CD', 'MM'))

HRR: constructing new records in Applicative-like style.

data Account1 = Account1
  { a1AccountId :: Int64
  , a1ProductCd :: String
  , a1CustId :: Int64
  , a1AvailBalance :: Maybe Double
  } deriving (Show)

$(makeRelationalRecord ''Account1)

account_4_3_3aR :: Relation () Account1
account_4_3_3aR = relation $ do
  a  <- query account
  wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"]
  return $ Account1 |$| a ! Account.accountId'
                    |*| a ! Account.productCd'
                    |*| a ! Account.custId'
                    |*| a ! Account.availBalance'

Generated SQL:

SELECT ALL T0.account_id AS f0,
           T0.product_cd AS f1,
           T0.cust_id AS f2,
           T0.avail_balance AS f3
FROM MAIN.account T0
WHERE (T0.product_cd IN ('CHK', 'SAV', 'CD', 'MM'))

Subquery

SQL:

SELECT account_id, product_cd, cust_id, avail_balance
FROM account
WHERE account_id = (SELECT MAX(account_id)
                    FROM account);

HRR:

account_9_1 :: Relation () Account1
account_9_1 = relation $ do
  a  <- query account
  ma <- queryScalar $ aggregatedUnique account Account.accountId' max'
  wheres $ just (a ! Account.accountId') .=. flattenMaybe ma
  return $ Account1 |$| a ! Account.accountId'
                    |*| a ! Account.productCd'
                    |*| a ! Account.custId'
                    |*| a ! Account.availBalance'

Generated SQL:

SELECT ALL T0.account_id AS f0,
           T0.product_cd AS f1,
           T0.cust_id AS f2,
           T0.avail_balance AS f3
FROM MAIN.account T0
WHERE (T0.account_id = (SELECT ALL MAX (T1.account_id) AS f0
                        FROM MAIN.account T1))

Membership conditions using subqueries

SQL:

SELECT account_id, product_cd, cust_id, avail_balance
FROM account
WHERE product_cd IN (SELECT product_cd
                     FROM product
                     WHERE product_type_cd = 'ACCOUNT');

HRR:

product_4_3_3b :: Relation String String
product_4_3_3b = relation' . placeholder $ \ph -> do
  p <- query product
  wheres $ p ! Product.productTypeCd' .=. ph
  return $ p ! Product.productCd'

account_4_3_3b :: Relation String Account
account_4_3_3b = relation' $ do
  a <- query account
  (phProductCd,p) <- queryList' product_4_3_3b
  wheres $ a ! Account.productCd' `in'` p
  return (phProductCd, a)

account_4_3_3bR :: Relation String Account1
account_4_3_3bR = relation' $ do
  a <- query account
  (phProductCd,p) <- queryList' product_4_3_3b
  wheres $ a ! Account.productCd' `in'` p
  let ar = Account1 |$| a ! Account.accountId'
                    |*| a ! Account.productCd'
                    |*| a ! Account.custId'
                    |*| a ! Account.availBalance'
  return (phProductCd, ar)

Using type holders:

run conn "ACCOUNT" account_4_3_3bR

Generated SQL:

SELECT ALL T0.account_id AS f0,
           T0.product_cd AS f1,
           T0.cust_id AS f2,
           T0.open_date AS f3,
           T0.close_date AS f4,
           T0.last_activity_date AS f5,
           T0.status AS f6,
           T0.open_branch_id AS f7,
           T0.open_emp_id AS f8,
           T0.avail_balance AS f9,
           T0.pending_balance AS f10
FROM MAIN.account T0
WHERE (T0.product_cd IN (SELECT ALL T1.product_cd AS f0
                         FROM MAIN.product T1
                         WHERE (T1.product_type_cd = ?)))

Membership conditions using not in

SQL:

SELECT account_id, product_cd, cust_id, avail_balance
FROM account
WHERE product_cd NOT IN ('CHK', 'SAV', 'CD', 'MM');

HRR:

account_4_3_3c :: Relation () Account
account_4_3_3c = relation $ do
  a  <- query account
  wheres $ not' (a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"])
  return a

Generated SQL:

SELECT ALL T0.account_id AS f0,
           T0.product_cd AS f1,
           T0.cust_id AS f2,
           T0.open_date AS f3,
           T0.close_date AS f4,
           T0.last_activity_date AS f5,
           T0.status AS f6,
           T0.open_branch_id AS f7,
           T0.open_emp_id AS f8,
           T0.avail_balance AS f9,
           T0.pending_balance AS f10
FROM MAIN.account T0
WHERE (NOT (T0.product_cd IN ('CHK', 'SAV', 'CD', 'MM')))

Joins

The combinations of query and queryMaybe express inner joins, left outer joins, right outer joins, and full outer joins.

Inner join

SQL:

SELECT e.fname, e.lname, d.name
FROM employee e INNER JOIN department d
USING (dept_id);

HRR:

join_5_1_2aT :: Relation () ((String, String), String)
join_5_1_2aT = relation $ do
  e <- query employee
  d <- query department
  on $ e ! Employee.deptId' .=. just (d ! Department.deptId')
  return $ e ! Employee.fname' >< e ! Employee.lname' >< d ! Department.name'

Generated SQL:

SELECT ALL T0.fname AS f0,
           T0.lname AS f1,
           T1.name AS f2
FROM MAIN.employee T0 INNER JOIN MAIN.department T1
ON (T0.dept_id = T1.dept_id)

Left outer join

SQL:

SELECT a.account_id, a.cust_id, i.fname, i.lname
  FROM account a LEFT OUTER JOIN individual i
    ON a.cust_id = i.cust_id

HRR:

account_LeftOuterJoin :: Relation () Account4
account_LeftOuterJoin = relation $ do
  a <- query account
  i <- queryMaybe individual
  on $ just (a ! Account.custId') .=. i ?! Individual.custId'
  return $ Account4 |$| a ! Account.accountId'
                    |*| a ! Account.custId'
                    |*| i ?! Individual.fname'
                    |*| i ?! Individual.lname'

data Account4 = Account4
  { a4AccountId :: Int64
  , a4CustId :: Int64
  , a4Fname :: Maybe String
  , a4Lname :: Maybe String
  } deriving (Show)

$(makeRelationalRecord ''Account4)

Generated SQL:

SELECT ALL T0.account_id AS f0,
           T0.cust_id AS f1,
           T1.fname AS f2,
           T1.lname AS f3
FROM MAIN.account T0 LEFT JOIN MAIN.individual T1
ON (T0.cust_id = T1.cust_id)

Right outer join

SQL:

SELECT c.cust_id, b.name
  FROM customer c RIGHT OUTER JOIN business b
    ON c.cust_id = b.cust_id

HRR:

business_RightOuterJoin :: Relation () (Maybe Int64, String)
business_RightOuterJoin = relation $ do
  c <- queryMaybe customer
  b <- query business
  on $ c ?! Customer.custId' .=. just (b ! Business.custId')
  return (c ?! Customer.custId' >< b ! Business.name')

Generated SQL:

SELECT ALL T0.cust_id AS f0,
           T1.name AS f1
FROM MAIN.customer T0 RIGHT JOIN MAIN.business T1
ON (T0.cust_id = T1.cust_id)

Note: A function using right-out-join can be defined, but unfortunately SQLite3 does not support it.

Complex join

SQL:

SELECT a.account_id, a.cust_id, a.open_date, a.product_cd
FROM account a INNER JOIN employee e ON a.open_emp_id = e.emp_id
INNER JOIN branch b ON e.assigned_branch_id = b.branch_id
WHERE e.start_date <= date('2004-01-01') AND
     (e.title = 'Teller' OR e.title = 'Head Teller') AND
     b.name = 'Woburn Branch';

HRR:

join_5_1_3 :: Relation () Account3
join_5_1_3 = relation $ do
  a <- query account
  e <- query employee
  on $ a ! Account.openEmpId' .=. just (e ! Employee.empId')

  b <- query branch
  on $ e ! Employee.assignedBranchId' .=. just (b ! Branch.branchId')

  wheres $ e ! Employee.startDate' .<=. unsafeSQLiteDayValue "2004-01-01"
  wheres $ e ! Employee.title' .=. just (value "Teller")
     `or'` e ! Employee.title' .=. just (value "Head Teller")
  wheres $ b ! Branch.name' .=. value "Woburn Branch"

  return $ Account3 |$| a ! Account.accountId'
                    |*| a ! Account.custId'
                    |*| a ! Account.openDate'
                    |*| a ! Account.productCd'

data Account3 = Account3
  { accountId :: Int64
  , custId :: Int64
  , openDate :: Day
  , productCd :: String
  } deriving (Show)

$(makeRelationalRecord ''Account3)

Generated SQL:

SELECT ALL T0.account_id AS f0,
           T0.cust_id AS f1,
           T0.open_date AS f2,
           T0.product_cd AS f3
FROM (MAIN.account T0 INNER JOIN MAIN.employee T1 ON (T0.open_emp_id = T1.emp_id))
                      INNER JOIN MAIN.branch   T2 ON (T1.assigned_branch_id = T2.branch_id)
WHERE ((T1.start_date <= '2004-01-01')
   AND (((T1.title = 'Teller') OR (T1.title = 'Head Teller'))
   AND (T2.name = 'Woburn Branch')))

Self-join

SQL:

SELECT e.fname, e.lname, e_mgr.fname mgr_fname, e_mgr.lname mgr_lname
FROM employee e INNER JOIN employee e_mgr
ON e.superior_emp_id = e_mgr.emp_id

HRR:

selfJoin_5_3aT :: Relation () ((String, String), (String, String))
selfJoin_5_3aT = relation $ do
  e <- query employee
  m <- query employee
  on $ e ! Employee.superiorEmpId' .=. just (m ! Employee.empId')
  let emp = e ! Employee.fname' >< e ! Employee.lname'
  let mgr = m ! Employee.fname' >< m ! Employee.lname'
  return $ emp >< mgr

Generated SQL:

SELECT ALL T0.fname AS f0,
           T0.lname AS f1,
           T1.fname AS f2,
           T1.lname AS f3
FROM MAIN.employee T0 INNER JOIN MAIN.employee T1
ON (T0.superior_emp_id = T1.emp_id)

Sorting compound query results

SQL:

SELECT emp_id, assigned_branch_id
FROM employee
WHERE title = 'Teller'
UNION
SELECT open_emp_id, open_branch_id
FROM account
WHERE product_cd = 'SAV'
ORDER BY emp_id;

HRR:

employee_6_4_1a :: Relation () (Maybe Int64, Maybe Int64)
employee_6_4_1a = relation $ do
  e <- query employee
  wheres $ e ! Employee.title' .=. just (value "Teller")
  return $ just (e ! Employee.empId') >< e ! Employee.assignedBranchId'

account_6_4_1a :: Relation () (Maybe Int64, Maybe Int64)
account_6_4_1a = relation $ do
  a <- query account
  wheres $ a ! Account.productCd' .=. value "SAV"
  return $ a ! Account.openEmpId' >< a ! Account.openBranchId'

union_6_4_1a_Nest :: Relation () (Maybe Int64, Maybe Int64)
union_6_4_1a_Nest = relation $ do
  ea <- query $ employee_6_4_1a `union` account_6_4_1a
  asc $ ea ! fst'
  return ea

Generated SQL:

SELECT ALL T2.f0 AS f0,
           T2.f1 AS f1
FROM (SELECT ALL T0.emp_id AS f0,
                 T0.assigned_branch_id AS f1
      FROM MAIN.employee T0
      WHERE (T0.title = 'Teller')
      UNION
      SELECT ALL T1.open_emp_id AS f0,
                 T1.open_branch_id AS f1
      FROM MAIN.account T1
      WHERE (T1.product_cd = 'SAV')) T2
ORDER BY T2.f0 ASC

HRR:

union_6_4_1a_Flat :: Relation () (Maybe Int64, Maybe Int64)
union_6_4_1a_Flat = relation (do
    e <- query employee
    wheres $ e ! Employee.title' .=. just (value "Teller")
    return $ just (e ! Employee.empId') >< e ! Employee.assignedBranchId'
  ) `union` relation (do
    a <- query account
    wheres $ a ! Account.productCd' .=. value "SAV"
    return $ a ! Account.openEmpId' >< a ! Account.openBranchId'
  )

Generated SQL:

SELECT ALL T0.emp_id AS f0,
           T0.assigned_branch_id AS f1
FROM MAIN.employee T0
WHERE (T0.title = 'Teller')
UNION
SELECT ALL T1.open_emp_id AS f0,
           T1.open_branch_id AS f1
FROM MAIN.account T1
WHERE (T1.product_cd = 'SAV')

Grouping

SQL:

SELECT open_emp_id, COUNT(*) how_many
FROM account
GROUP BY open_emp_id
ORDER BY open_emp_id;

HRR:

group_8_1a :: Relation () (Maybe Int64, Int64)
group_8_1a = aggregateRelation $ do
  a <- query account
  g <- groupBy $ a ! Account.openEmpId'
  asc $ g ! id'
  return $ g >< count (a ! Account.accountId')

Generated SQL:

SELECT ALL T0.open_emp_id AS f0,
           COUNT (T0.account_id) AS f1
FROM MAIN.account T0
GROUP BY T0.open_emp_id
ORDER BY T0.open_emp_id ASC

Correlated Subqueries

SQL:

SELECT c.cust_id, c.cust_type_cd, c.city
FROM customer c
WHERE 2 = (SELECT COUNT(*)
           FROM account a
           WHERE a.cust_id = c.cust_id);

HRR:

customer_9_4 :: Relation () Customer1
customer_9_4 = relation $ do
  c  <- query customer
  ca <- queryScalar $ aggregatedUnique (relation $ do
    a <- query account
    wheres $ a ! Account.custId' .=. c ! Customer.custId'
    return (a ! Account.accountId')
    ) id' count
  wheres $ just (value (2 :: Int64)) .=. ca
  return (customer1 c)

data Customer1 = Customer1
  { c1Custid :: Int64
  , c1CustTypeCd :: String
  , c1City :: Maybe String
  } deriving (Show)

customer1 :: (SqlProjectable (Projection c), ProjectableShowSql (Projection c))
          => Projection c Customer -> Projection c Customer1
customer1 c = Customer1 |$| c ! Customer.custId'
                        |*| c ! Customer.custTypeCd'
                        |*| c ! Customer.city'

$(makeRelationalRecord ''Customer1)

Generated SQL:

SELECT ALL T0.cust_id AS f0,
           T0.cust_type_cd AS f1,
           T0.city AS f2
FROM MAIN.customer T0
WHERE (2 = (SELECT ALL COUNT (T2.f0) AS f0
            FROM (SELECT ALL T1.account_id AS f0
                  FROM MAIN.account T1
                  WHERE (T1.cust_id = T0.cust_id)) T2))

INSERT

Inserting data

SQL:

INSERT INTO branch (branch_id, name, address, city, state, zip)
VALUES (null, 'Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451');

HRR:

insertBranch_s1 :: Insert ()
insertBranch_s1 = derivedInsertValue $ do
  Branch.name'     <-#  value "Headquarters"
  Branch.address'  <-#  value (Just "3882 Main St.")
  Branch.city'     <-#  value (Just "Waltham")
  Branch.state'    <-#  value (Just "MA")
  Branch.zip'      <-#  value (Just "02451")
  return unitPlaceHolder

Generated SQL:

INSERT INTO MAIN.branch (name, address, city, state, zip)
SELECT ALL 'Headquarters' AS f0,
           '3882 Main St.' AS f1,
           'Waltham' AS f2,
           'MA' AS f3, '02451' AS f4

HRR using placeholder:

insertBranch_s1P :: Insert Branch1
insertBranch_s1P = derivedInsert piBranch1

piBranch1 :: Pi Branch Branch1
piBranch1 = Branch1 |$| Branch.name'
                    |*| Branch.address'
                    |*| Branch.city'
                    |*| Branch.state'
                    |*| Branch.zip'

data Branch1 = Branch1
  { b1Name :: String
  , b1Address :: Maybe String
  , b1City :: Maybe String
  , b1State :: Maybe String
  , b1Zip :: Maybe String
  } deriving (Generic)

$(makeRelationalRecord ''Branch1)

Generated SQL:

INSERT INTO MAIN.branch (name, address, city, state, zip)
VALUES (?, ?, ?, ?, ?)

Thanks to generic-programing, it is possible to specify record value directly as SQL row value.

insertBranch_s1R :: Insert ()
insertBranch_s1R = derivedInsertValue $ do
  piBranch1   <-#  value Branch1
                         { b1Name = "Headquarters"
                         , b1Address = Just "3882 Main St."
                         , b1City = Just "Waltham"
                         , b1State = Just "MA"
                         , b1Zip = Just "02451"
                         }
  return unitPlaceHolder
INSERT INTO MAIN.branch (name, address, city, state, zip)
VALUES ('Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451')

Thanks to generic-programing, it is possible to specify tuple type as Pi destination type.

insertBranch_s1PT :: Insert (String, Maybe String, Maybe String, Maybe String, Maybe String)
insertBranch_s1PT = derivedInsert piBranchTuple

piBranchTuple :: Pi Branch (String, Maybe String, Maybe String, Maybe String, Maybe String)
piBranchTuple = (,,,,)
                |$| Branch.name'
                |*| Branch.address'
                |*| Branch.city'
                |*| Branch.state'
                |*| Branch.zip'
INSERT INTO MAIN.branch (name, address, city, state, zip)
VALUES (?, ?, ?, ?, ?)

Inserting data from tables

SQL:

INSERT INTO employee (emp_id, fname, lname, start_date, dept_id, title, assigned_branch_id)
VALUES (null, 'Michael', 'Smith', '2001-06-22',
  (SELECT dept_id FROM department WHERE name = 'Administration'),
  'President',
  (SELECT branch_id FROM branch WHERE name = 'Headquarters'));

HRR:

-- Note: Since the name column of department table is not set with
-- an unique constraint, it is not possible to use queryScalar.
-- The name column of branch table is the same.
insertEmployee_s2 :: InsertQuery ()
insertEmployee_s2 = typedInsertQuery piEmployee3 . relation $ do
  d <- query department
  b <- query branch
  wheres $ d ! Department.name' .=. value "Administration"
  wheres $ b ! Branch.name' .=. value "Headquarters"
  return $ Employee3 |$| value "Michael"
                     |*| value "Smith"
                     |*| unsafeSQLiteDayValue "2001-06-22"
                     |*| just (d ! Department.deptId')
                     |*| value (Just "President")
                     |*| just (b ! Branch.branchId')

-- this is equal to `defineDirectPi [1,2,3,6,7,8]'
piEmployee3 :: Pi Employee Employee3
piEmployee3 = Employee3 |$| Employee.fname'
                        |*| Employee.lname'
                        |*| Employee.startDate'
                        |*| Employee.deptId'
                        |*| Employee.title'
                        |*| Employee.assignedBranchId'

data Employee3 = Employee3
  { e3Fname :: String
  , e3Lname :: String
  , e3StartDate :: Day
  , e3DeptId :: Maybe Int64
  , e3Title :: Maybe String
  , e3AssignedBranchId :: Maybe Int64
  }

$(makeRelationalRecord ''Employee3)

Generated SQL:

INSERT INTO MAIN.employee (fname, lname, start_date, dept_id, title,assigned_branch_id)
SELECT ALL 'Michael' AS f0,
           'Smith' AS f1,
           '2001-06-22' AS f2,
           T0.dept_id AS f3,
           'President' AS f4,
           T1.branch_id AS f5
FROM MAIN.department T0 INNER JOIN MAIN.branch T1 ON (0=0)
WHERE ((T0.name = 'Administration') AND (T1.name = 'Headquarters'))

Unsafe HRR:

-- In the following code we simulate to use queryScalar with using
-- unsafeUnique. By that means we throw away the safety given by HRR
-- and the type system.
insertEmployee_s2U :: InsertQuery ()
insertEmployee_s2U = typedInsertQuery piEmployee3 . relation $ do
  d <- queryScalar . unsafeUnique . relation $ do
    d' <- query department
    wheres $ d' ! Department.name' .=. value "Administration"
    return $ d' ! Department.deptId'
  b <- queryScalar . unsafeUnique . relation $ do
    b' <- query branch
    wheres $ b' ! Branch.name' .=. value "Headquarters"
    return $ b' ! Branch.branchId'
  return $ Employee3 |$| value "Michael"
                     |*| value "Smith"
                     |*| unsafeSQLiteDayValue "2001-06-22"
                     |*| d
                     |*| value (Just "President")
                     |*| b

Generated SQL:

INSERT INTO MAIN.employee (fname, lname, start_date, dept_id, title, assigned_branch_id)
SELECT ALL 'Michael' AS f0,
           'Smith' AS f1,
           '2001-06-22' AS f2,
           (SELECT ALL T0.dept_id AS f0
            FROM MAIN.department T0
            WHERE (T0.name = 'Administration')) AS f3,
           'President' AS f4,
           (SELECT ALL T1.branch_id AS f0
            FROM MAIN.branch T1
            WHERE (T1.name = 'Headquarters')) AS f5

HRR using placeholder:

-- place the definition of Employee4 that contains template-haskell, before
-- insertEmployee_s2P uses the function to be generated.
data Employee4 = Employee4
  { e4Fname :: String
  , e4Lname :: String
  , e4StartDate :: Day
  , e4Title :: Maybe String
  }

$(makeRelationalRecord ''Employee4)

insertEmployee_s2P :: InsertQuery Employee4
insertEmployee_s2P = typedInsertQuery piEmployee3 . relation' $ do
  d <- query department
  b <- query branch
  wheres $ d ! Department.name' .=. value "Administration"
  wheres $ b ! Branch.name' .=. value "Headquarters"
  placeholder $ \ph ->
    return $ Employee3 |$| ph ! e4Fname'
                       |*| ph ! e4Lname'
                       |*| ph ! e4StartDate'
                       |*| just (d ! Department.deptId')
                       |*| ph ! e4Title'
                       |*| just (b ! Branch.branchId')

employee4 :: Employee4
employee4 = Employee4
  { e4Fname = "Michael"
  , e4Lname = "Smith"
  , e4StartDate = read "2001-06-22"
  , e4Title = Just "President"
  }

Generated SQL:

INSERT INTO MAIN.employee (fname, lname, start_date, dept_id, title, assigned_branch_id)
SELECT ALL ? AS f0,
           ? AS f1,
           ? AS f2,
           T0.dept_id AS f3,
           ? AS f4,
           T1.branch_id AS f5
FROM MAIN.department T0 INNER JOIN MAIN.branch T1 ON (0=0)
WHERE ((T0.name = 'Administration') AND (T1.name = 'Headquarters'))

UPDATE

Updating data

SQL:

UPDATE employee
SET lname = 'Bush',
     dept_id = 3
WHERE emp_id = 10;

HRR:

updateEmployee_o3 :: Update ()
updateEmployee_o3 = derivedUpdate $ \proj -> do
  Employee.lname' <-# value "Bush"
  Employee.deptId' <-# just (value 3)
  wheres $ proj ! Employee.empId' .=. value 10
  return unitPlaceHolder

Generated SQL:

UPDATE MAIN.employee
SET lname = 'Bush', dept_id = 3
WHERE (emp_id = 10)

Updating data using correlated subqueries

SQL:

UPDATE account
SET last_activity_date =
   (SELECT MAX(t.txn_date)
    FROM transaction0 t
    WHERE t.account_id = account.account_id)
WHERE EXISTS (SELECT 1
              FROM transaction0 t
              WHERE t.account_id = account.account_id);

HRR:

updateAccount_9_4_2 :: Update ()
updateAccount_9_4_2 = derivedUpdate $ \proj -> do
  ts <- queryScalar $ aggregatedUnique (relation $ do
    t <- query transaction
    wheres $ t ! Transaction.accountId' .=. proj ! Account.accountId'
    return (t ! Transaction.txnDate')
    ) id' max'
  tl <- queryList $ relation $ do
    t <- query transaction
    wheres $ t ! Transaction.accountId' .=. proj ! Account.accountId'
    return (value (1 :: Int64))
  Account.lastActivityDate' <-# (toDay $ flattenMaybe ts)
  wheres $ exists $ tl
  return unitPlaceHolder

toDay :: (SqlProjectable p, ProjectableShowSql p) => p (Maybe LocalTime) -> p (Maybe Day)
toDay dt = unsafeProjectSql $ "date(" ++ unsafeShowSql dt ++ ")"

Generated SQL:

UPDATE MAIN.account
SET last_activity_date =
  date((SELECT ALL MAX (T1.f0) AS f0
        FROM (SELECT ALL T0.txn_date AS f0
             FROM MAIN.transaction0 T0
             WHERE (T0.account_id = account_id)) T1))
WHERE (EXISTS (SELECT ALL 1 AS f0
               FROM MAIN.transaction0 T2
               WHERE (T2.account_id = account_id)))

DELETE

Deleting data

SQL:

DELETE FROM account
WHERE account_id = 2;

HRR:

deleteAccount_o1 :: Delete ()
deleteAccount_o1 = typedDelete tableOfAccount . restriction $ \proj -> do
  wheres $ proj ! Account.accountId' .=. value 2

Generated SQL:

DELETE FROM MAIN.account
WHERE (account_id = 2)

Deleting data with conditions

SQL:

DELETE FROM account
WHERE account_id >= 10 AND account_id <= 20;

HRR:

deleteAccount_o2 :: Delete ()
deleteAccount_o2 = typedDelete tableOfAccount . restriction $ \proj -> do
  wheres $ proj ! Account.accountId' .>=. value 10
  wheres $ proj ! Account.accountId' .<=. value 20

Generated SQL:

DELETE FROM MAIN.account
WHERE ((account_id >= 10) AND (account_id <= 20))

Deleting data using correlated subqueries

SQL:

DELETE FROM department d
WHERE NOT EXISTS (SELECT 1
                  FROM employee e
                  WHERE e.dept_id = d.dept_id);

HRR:

deleteEmployee_9_4_2 :: Delete ()
deleteEmployee_9_4_2 = derivedDelete $ \proj -> do
  el <- queryList $ relation $ do
    e <- query employee
    wheres $ e ! Employee.deptId' .=. just (proj ! Department.deptId')
    return (value (1 :: Int64))
  wheres $ not' . exists $ el
  return unitPlaceHolder

Generated SQL:

DELETE FROM MAIN.department
WHERE (NOT (EXISTS (SELECT ALL 1 AS f0
                   FROM MAIN.employee T0
                   WHERE (T0.dept_id = dept_id))))