diff --git a/lib/Database/Record/TH/SQLite3.hs b/lib/Database/Record/TH/SQLite3.hs --- a/lib/Database/Record/TH/SQLite3.hs +++ b/lib/Database/Record/TH/SQLite3.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} module Database.Record.TH.SQLite3 ( - defineTable + defineTable, ) where import GHC.Generics (Generic) diff --git a/lib/Database/Relational/CustomSQLite3.hs b/lib/Database/Relational/CustomSQLite3.hs new file mode 100644 --- /dev/null +++ b/lib/Database/Relational/CustomSQLite3.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE FlexibleContexts #-} + +module Database.Relational.CustomSQLite3 ( + module Database.HDBC, + module Database.HDBC.Query.TH, + module Database.HDBC.Record, + module Database.HDBC.Session, + module Database.HDBC.Sqlite3, + module Database.Record, + module Database.Custom.SQLite3, + + runRelation, + makeRelationalRecord, + ) where + +import Language.Haskell.TH (Name, Q, Dec) + +import Database.HDBC hiding (execute, finish, run) +import Database.HDBC.Query.TH hiding (makeRelationalRecord) +import Database.HDBC.Record hiding (execute, finish) +import Database.HDBC.Session +import Database.HDBC.Sqlite3 +import Database.Record hiding (unique) +import Database.Custom.SQLite3 + +runRelation :: (ToSql SqlValue p, + IConnection conn, + FromSql SqlValue a) => + conn -> Relation p a -> p -> IO [a] +runRelation conn q p = runQuery conn (relationalQuery q []) p + +makeRelationalRecord :: Name -> Q [Dec] +makeRelationalRecord = makeRelationalRecord' defaultConfig diff --git a/lib/Database/Relational/Query/SQLite3.hs b/lib/Database/Relational/Query/SQLite3.hs deleted file mode 100644 --- a/lib/Database/Relational/Query/SQLite3.hs +++ /dev/null @@ -1,32 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - -module Database.Relational.Query.SQLite3 ( - module Database.HDBC - , module Database.HDBC.Query.TH - , module Database.HDBC.Record - , module Database.HDBC.Session - , module Database.HDBC.Sqlite3 - , module Database.Record - , module Database.Relational - , runRelation - , makeRelationalRecord - ) where - -import Language.Haskell.TH (Name, Q, Dec) - -import Database.HDBC hiding (execute, finish, run) -import Database.HDBC.Query.TH hiding (makeRelationalRecord) -import Database.HDBC.Record hiding (execute, finish) -import Database.HDBC.Session -import Database.HDBC.Sqlite3 -import Database.Record hiding (unique) -import Database.Relational hiding (unique) - -runRelation :: (ToSql SqlValue p, - IConnection conn, - FromSql SqlValue a) => - conn -> Relation p a -> p -> IO [a] -runRelation conn q p = runQuery conn (relationalQuery q) p - -makeRelationalRecord :: Name -> Q [Dec] -makeRelationalRecord = makeRelationalRecord' defaultConfig diff --git a/mains/examples.hs b/mains/examples.hs new file mode 100644 --- /dev/null +++ b/mains/examples.hs @@ -0,0 +1,1357 @@ +{-# OPTIONS_GHC -Wno-unused-top-binds #-} +{-# LANGUAGE MonadComprehensions #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedLabels #-} + +import Database.Relational.CustomSQLite3 +import Database.Relational.OverloadedInstances () + +import GHC.Generics (Generic) +import Prelude hiding (product) +import Data.Int (Int64) +import Data.Time (Day, LocalTime) +import Data.Functor.ProductIsomorphic ((|$|), (|*|)) + +import qualified Account +import Account (Account, account) +import qualified Branch +import Branch (Branch, branch) +import Business (business) +import Customer (Customer, customer) +import Department (Department, department) +import Individual (individual) +--import qualified Officer +--import Officer (Officer, Officer) +import Product (product) +--import qualified ProductType +--import ProductType (ProductType, productType) +import qualified Transaction +import Employee (Employee, employee) + +allAccount :: Relation () Account +allAccount = relation $ query account + +-- | sql/3.7 +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT open_emp_id, product_cd +-- FROM account +-- ORDER BY open_emp_id, product_cd +-- @ +-- +-- 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 +-- @ +-- +account_3_7 :: Relation () (Maybe Int, String) +account_3_7 = relation $ do + a <- query account + let proj = (,) |$| #openEmpId a + |*| #productCd a + asc proj + return proj + +-- | sql/3.7.1 +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT account_id, product_cd, open_date, avail_balance +-- FROM account +-- ORDER BY avail_balance DESC +-- @ +-- +-- 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 +-- @ +-- +account_3_7_1 :: Relation () Account2 +account_3_7_1 = relation $ do + a <- query account + desc $ #availBalance a + return $ Account2 |$| #accountId a + |*| #productCd a + |*| #openDate a + |*| #availBalance a + +data Account2 = Account2 + { a2AccountId :: Int + , a2ProductCd :: String + , a2OpenDate :: Day + , a2AvailBalance :: Maybe Double + } deriving (Show, Generic) + +$(makeRelationalRecord ''Account2) + +-- | sql/3.7.3 +-- +-- 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. +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT emp_id, title, start_date, fname, lname +-- FROM employee +-- ORDER BY 2,5 +-- @ +-- +-- 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 +-- @ +-- +employee_3_7_3 :: Relation () Employee1 +employee_3_7_3 = relation $ do + e <- query employee + asc $ #title e + asc $ #lname e + return $ Employee1 |$| #empId e + |*| #title e + |*| #startDate e + |*| #fname e + |*| #lname e + +data Employee1 = Employee1 + { e1EmpId :: Int + , e1Title :: Maybe String + , e1StartDate :: Day + , e1Fname :: String + , e1Lname' :: String + } deriving (Show, Generic) + +$(makeRelationalRecord ''Employee1) + +-- | sql/4.1.2 +-- +-- 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. +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT * +-- FROM employee +-- WHERE end_date IS NULL AND (title = 'Teller' OR start_date < '2003-01-01') +-- @ +-- +-- Literal version of 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'))) +-- @ +-- +employee_4_1_2 :: Relation () Employee +employee_4_1_2 = relation $ do + e <- query employee + wheres $ isNothing (#endDate e) + wheres $ #title e .=. just (value "Teller") + `or'` #startDate e .<. unsafeSQLiteDayValue "2003-01-01" + return e + +unsafeSQLiteDayValue :: SqlContext c => String -> Record c Day +unsafeSQLiteDayValue = unsafeProjectSqlTerms . showLiteral + +-- | +-- Another way, use a placeholder instead of a date literal. +-- There is no need to define a helper function. +-- +-- Placeholder version of 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 < ?))) +-- @ +-- +employee_4_1_2P :: Relation Day Employee +employee_4_1_2P = relation' . placeholder $ \ph -> do + e <- query employee + wheres $ isNothing (#endDate e) + wheres $ #title e .=. just (value "Teller") + `or'` #startDate e .<. ph + return e + +-- | sql/4.3.2 +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT emp_id, fname, lname, start_date FROM employee +-- WHERE start_date +-- BETWEEN date('2001-01-01') AND date('2002-12-31') +-- @ +-- +-- Literal version of 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')) +-- @ +-- +employee_4_3_2 :: Relation () Employee2 +employee_4_3_2 = relation $ do + e <- query employee + wheres $ #startDate e .>=. unsafeSQLiteDayValue "2001-01-01" + wheres $ #startDate e .<=. unsafeSQLiteDayValue "2003-01-01" + return $ Employee2 |$| #empId e + |*| #fname e + |*| #lname e + |*| #startDate e + +-- | +-- Placeholder version of Generated SQL: +-- +-- 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 <= ?)) +-- @ +-- +-- NOTE: Be careful on the order of the placeholders. You must give day +-- values in order that they appear on the generated SQL. +-- +employee_4_3_2P :: Relation (Day,Day) Employee2 +employee_4_3_2P = relation' . placeholder $ \ph -> do + e <- query employee + let date = #startDate e + wheres $ date .>=. (! #fst) ph + wheres $ date .<=. (! #snd) ph + return $ Employee2 |$| #empId e + |*| #fname e + |*| #lname e + |*| date + +data Employee2 = Employee2 + { e2EmpId :: Int + , e2Fname :: String + , e2Lname :: String + , e2StartDate :: Day + } deriving (Show, Generic) + +$(makeRelationalRecord ''Employee2) + +-- | sql/4.3.3a +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT account_id, product_cd, cust_id, avail_balance +-- FROM LEARNINGSQL.account +-- WHERE product_cd IN ('CHK', 'SAV', 'CD', 'MM') +-- @ +-- +-- record version of 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')) +-- @ +-- +account_4_3_3a :: Relation () Account +account_4_3_3a = relation $ do + a <- query account + wheres $ #productCd a `in'` values ["CHK", "SAV", "CD", "MM"] + return a + +-- | +-- tuple version of 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')) +-- @ +-- +account_4_3_3aT :: Relation () (Int, String, Int, Maybe Double) +account_4_3_3aT = relation $ do + a <- query account + wheres $ #productCd a `in'` values ["CHK", "SAV", "CD", "MM"] + return $ (,,,) |$| #accountId a |*| #productCd a |*| #custId a |*| #availBalance a + +-- | +-- Adhoc defined record version of 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')) +-- @ +-- +-- Above sql is the same to the tuple version. +-- +account_4_3_3aR :: Relation () Account1 +account_4_3_3aR = relation $ do + a <- query account + wheres $ #productCd a `in'` values ["CHK", "SAV", "CD", "MM"] + return $ Account1 |$| #accountId a + |*| #productCd a + |*| #custId a + |*| #availBalance a + +data Account1 = Account1 + { a1AccountId :: Int + , a1ProductCd :: String + , a1CustId :: Int + , a1AvailBalance :: Maybe Double + } deriving (Show, Generic) + +$(makeRelationalRecord ''Account1) + +-- | +-- 9.1 What is a subquery? +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT account_id, product_cd, cust_id, avail_balance +-- FROM account +-- WHERE account_id = (SELECT MAX(account_id) +-- FROM account); +-- @ +-- +-- 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)) +-- @ +-- +account_9_1 :: Relation () Account1 +account_9_1 = relation $ do + a <- query account + ma <- queryScalar $ aggregatedUnique account #accountId max' + wheres $ just (#accountId a) .=. flattenMaybe ma + return $ Account1 |$| #accountId a + |*| #productCd a + |*| #custId a + |*| #availBalance a + +-- | sql/4.3.3b +-- +-- Handwritten 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') +-- @ +-- +-- Record version of 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 = ?))) +-- @ +-- +account_4_3_3b :: Relation String Account +account_4_3_3b = relation' $ do + a <- query account + (phProductCd,p) <- queryList' product_4_3_3b + wheres $ #productCd a `in'` p + return (phProductCd, a) + +-- | +-- Tuple version of 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 +-- (SELECT ALL T1.product_cd AS f0 FROM MAIN.product T1 WHERE +-- (T1.product_type_cd = ?))) +-- @ +-- +account_4_3_3bT :: Relation String (Int, String, Int, Maybe Double) +account_4_3_3bT = relation' $ do + a <- query account + (phProductCd,p) <- queryList' product_4_3_3b + wheres $ #productCd a `in'` p + let at = (,,,) |$| #accountId a |*| #productCd a |*| #custId a |*| #availBalance a + return (phProductCd, at) + +-- | +-- Adhoc record version of 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 +-- (SELECT ALL T1.product_cd AS f0 FROM MAIN.product T1 WHERE +-- (T1.product_type_cd = ?))) +-- @ +-- +account_4_3_3bR :: Relation String Account1 +account_4_3_3bR = relation' $ do + a <- query account + (phProductCd,p) <- queryList' product_4_3_3b + wheres $ #productCd a `in'` p + let ar = Account1 |$| #accountId a + |*| #productCd a + |*| #custId a + |*| #availBalance a + return (phProductCd, ar) + +product_4_3_3b :: Relation String String +product_4_3_3b = relation' . placeholder $ \ph -> do + p <- query product + wheres $ #productTypeCd p .=. ph + return $ #productCd p + +-- | sql/4.3.3c +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT account_id, product_cd, cust_id, avail_balance +-- FROM LEARNINGSQL.account +-- WHERE product_cd NOT IN ('CHK', 'SAV', 'CD', 'MM') +-- @ +-- +-- 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'))) +-- @ +-- +account_4_3_3c :: Relation () Account +account_4_3_3c = relation $ do + a <- query account + wheres $ not' (#productCd a `in'` values ["CHK", "SAV", "CD", "MM"]) + return a + +-- | sql/5.1.2a +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT e.fname, e.lname, d.name +-- FROM LEARNINGSQL.employee e INNER JOIN LEARNINGSQL.department d +-- USING (dept_id) +-- @ +-- +-- Record version of 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, +-- T1.dept_id AS f9, T1.name AS f10 FROM MAIN.employee T0 INNER JOIN +-- MAIN.department T1 ON (T0.dept_id = T1.dept_id) +-- @ +-- +join_5_1_2a :: Relation () (Employee, Department) +join_5_1_2a = relation $ do + e <- query employee + d <- query department + on $ #deptId e .=. just (#deptId d) + return $ e >< d + +-- | +-- Tuple version of 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) +-- @ +-- +join_5_1_2aT :: Relation () (String, String, String) +join_5_1_2aT = relation $ do + e <- query employee + d <- query department + on $ #deptId e .=. just (#deptId d) + return $ (,,) |$| #fname e |*| #lname e |*| #name d + +-- | +-- Left Outer Join +-- +-- Handwritten 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 +-- @ +-- +-- 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) +-- @ +-- +account_LeftOuterJoin :: Relation () Account4 +account_LeftOuterJoin = relation $ do + a <- query account + i <- queryMaybe individual + on $ just (#custId a) .=. (? #custId) i + return $ Account4 |$| #accountId a + |*| #custId a + |*| (? #fname) i + |*| (? #lname) i + +data Account4 = Account4 + { a4AccountId :: Int + , a4CustId :: Int + , a4Fname :: Maybe String + , a4Lname :: Maybe String + } deriving (Show, Generic) + +$(makeRelationalRecord ''Account4) + +-- | +-- Right Outer Join +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT c.cust_id, b.name +-- FROM customer c RIGHT OUTER JOIN business b +-- ON c.cust_id = b.cust_id +-- @ +-- +-- 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. +-- +business_RightOuterJoin :: Relation () (Maybe Int, String) +business_RightOuterJoin = relation $ do + c <- queryMaybe customer + b <- query business + on $ (? #custId) c .=. just (#custId b) + return ((? #custId) c >< #name b) + +-- | sql/5.1.3 +-- +-- Handwritten 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' +-- @ +-- +-- 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'))) +-- @ +-- +join_5_1_3 :: Relation () Account3 +join_5_1_3 = relation $ do + a <- query account + e <- query employee + on $ #openEmpId a .=. just (#empId e) + + b <- query branch + on $ #assignedBranchId e .=. just (#branchId b) + + wheres $ #startDate e .<=. unsafeSQLiteDayValue "2004-01-01" + wheres $ #title e .=. just (value "Teller") + `or'` #title e .=. just (value "Head Teller") + wheres $ #name b .=. value "Woburn Branch" + + return $ Account3 |$| #accountId a + |*| #custId a + |*| #openDate a + |*| #productCd a + +data Account3 = Account3 + { a3AccountId :: Int + , a3CustId :: Int + , a3OpenDate :: Day + , a3ProductCd :: String + } deriving (Show, Generic) + +$(makeRelationalRecord ''Account3) + +-- | sql/5.3a +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT e.fname, e.lname, e_mgr.fname mgr_fname, e_mgr.lname mgr_lname +-- FROM LEARNINGSQL.employee e INNER JOIN LEARNINGSQL.employee e_mgr +-- ON e.superior_emp_id = e_mgr.emp_id +-- @ +-- +-- Record version of 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, +-- T1.emp_id AS f9, T1.fname AS f10, T1.lname AS f11, T1.start_date AS +-- f12, T1.end_date AS f13, T1.superior_emp_id AS f14, T1.dept_id AS f15, +-- T1.title AS f16, T1.assigned_branch_id AS f17 FROM MAIN.employee T0 +-- INNER JOIN MAIN.employee T1 ON (T0.superior_emp_id = T1.emp_id) +-- @ +-- +selfJoin_5_3a :: Relation () (Employee, Employee) +selfJoin_5_3a = relation $ do + e <- query employee + m <- query employee + on $ #superiorEmpId e .=. just (#empId m) + return $ e >< m + +-- | +-- Tuple version of 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) +-- @ +-- +selfJoin_5_3aT :: Relation () ((String, String), (String, String)) +selfJoin_5_3aT = relation $ do + e <- query employee + m <- query employee + on $ #superiorEmpId e .=. just (#empId m) + let emp = #fname e >< #lname e + let mgr = #fname m >< #lname m + return $ emp >< mgr + +-- | sql/6.4.1a +-- +-- The standard SQL allows the syntax of UNION that has an order clause +-- at the last of query. Unfortunately, HRR dows not support. In addition, +-- HRR put a select statement having an order clause into parentheses. +-- If you want to sort whole row returned from UNION, place a order +-- clouse outside of the union relation. +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT emp_id, assigned_branch_id +-- FROM LEARNINGSQL.employee +-- WHERE title = 'Teller' +-- UNION +-- SELECT open_emp_id, open_branch_id +-- FROM LEARNINGSQL.account +-- WHERE product_cd = 'SAV' +-- ORDER BY open_emp_id +-- @ +-- +-- 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 +-- @ +-- +employee_6_4_1a :: Relation () (Maybe Int, Maybe Int) +employee_6_4_1a = relation $ do + e <- query employee + wheres $ #title e .=. just (value "Teller") + return $ just (#empId e) >< #assignedBranchId e + +account_6_4_1a :: Relation () (Maybe Int, Maybe Int) +account_6_4_1a = relation $ do + a <- query account + wheres $ #productCd a .=. value "SAV" + return $ #openEmpId a >< #openBranchId a + +union_6_4_1a_Nest :: Relation () (Maybe Int, Maybe Int) +union_6_4_1a_Nest = relation $ do + ea <- query $ employee_6_4_1a `union` account_6_4_1a + asc $ #fst ea + return ea + +-- | +-- Generated SQL has different meaning with the handwritten SQL +-- (order clause with UNION). +-- Such query cannot be expressed flatly with EDSL of HRR. +-- +-- 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') +-- @ +-- +union_6_4_1a_Flat :: Relation () (Maybe Int, Maybe Int) +union_6_4_1a_Flat = relation (do + e <- query employee + wheres $ #title e .=. just (value "Teller") + return $ just (#empId e) >< #assignedBranchId e + ) `union` relation (do + a <- query account + wheres $ #productCd a .=. value "SAV" + -- asc $ #openEmpId a + return $ #openEmpId a >< #openBranchId a + ) + +-- | sql/8.1a +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT open_emp_id, COUNT(*) how_many +-- FROM LEARNINGSQL.account +-- GROUP BY open_emp_id +-- ORDER BY open_emp_id +-- @ +-- +-- 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 +-- @ +-- +group_8_1a :: Relation () (Maybe Int, Int64) +group_8_1a = aggregateRelation $ do + a <- query account + g <- groupBy $ #openEmpId a + asc $ g + return $ g >< count (#accountId a) + +-- | +-- 9.4 Correlated Subqueries +-- +-- Handwritten 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); +-- @ +-- +-- 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)) +-- @ +-- +customer_9_4 :: Relation () Customer1 +customer_9_4 = relation $ do + c <- query customer + ca <- queryScalar $ aggregatedUnique (relation $ do + a <- query account + wheres $ #custId a .=. #custId c + return (#accountId a) + ) id' count + wheres $ just (value (2 :: Int64)) .=. ca + return (customer1 c) + +data Customer1 = Customer1 + { c1Custid :: Int + , c1CustTypeCd :: String + , c1City :: Maybe String + } deriving (Show, Generic) + +customer1 :: SqlContext c + => Record c Customer -> Record c Customer1 +customer1 c = Customer1 |$| #custId c + |*| #custTypeCd c + |*| #city c + +$(makeRelationalRecord ''Customer1) + +-- | +-- (from script) The insert statement +-- +-- Handwritten SQL: +-- +-- @ +-- INSERT INTO branch (branch_id, name, address, city, state, zip) +-- VALUES (null, 'Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451'); +-- @ +-- +-- Literal version of Generated SQL: +-- +-- @ +-- INSERT INTO MAIN.branch (name, address, city, state, zip) +-- VALUES ('Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451') +-- @ +-- +insertBranch_s1 :: Insert () +insertBranch_s1 = insertValueNoPH $ do + Branch.name' <-# value "Headquarters" + #address <-# value (Just "3882 Main St.") + #city <-# value (Just "Waltham") + #state <-# value (Just "MA") + #zip <-# value (Just "02451") + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- INSERT INTO MAIN.branch (name, address, city, state, zip) +-- VALUES (?, ?, ?, ?, ?) +-- @ +-- +insertBranch_s1P :: Insert Branch1 +insertBranch_s1P = insert piBranch1 + +piBranch1 :: Pi Branch Branch1 +piBranch1 = Branch1 |$| #name + |*| #address + |*| #city + |*| #state + |*| #zip + +data Branch1 = Branch1 + { b1Name :: String + , b1Address :: Maybe String + , b1City :: Maybe String + , b1State :: Maybe String + , b1Zip :: Maybe String + } deriving (Generic) + +$(makeRelationalRecord ''Branch1) + +branch1 :: Branch1 +branch1 = Branch1 + { b1Name = "Headquarters" + , b1Address = Just "3882 Main St." + , b1City = Just "Waltham" + , b1State = Just "MA" + , b1Zip = Just "02451" + } + +-- | +-- Literal version of Generated SQL: +-- +-- @ +-- 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 record value directly as SQL row value. +-- Above SQL is the same to the monadic building version. +-- +insertBranch_s1R :: Insert () +insertBranch_s1R = insertValueNoPH $ do + piBranch1 <-# value Branch1 + { b1Name = "Headquarters" + , b1Address = Just "3882 Main St." + , b1City = Just "Waltham" + , b1State = Just "MA" + , b1Zip = Just "02451" + } + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- INSERT INTO MAIN.branch (name, address, city, state, zip) +-- VALUES (?, ?, ?, ?, ?) +-- @ +-- +-- Thanks to generic-programing, it is possible to specify tuple type as Pi destination type. +-- Above SQL is the same to ad-hoc defined record version. +-- +insertBranch_s1PT :: Insert (String, Maybe String, Maybe String, Maybe String, Maybe String) +insertBranch_s1PT = insert piBranchTuple + +piBranchTuple :: Pi Branch (String, Maybe String, Maybe String, Maybe String, Maybe String) +piBranchTuple = (,,,,) + |$| #name + |*| #address + |*| #city + |*| #state + |*| #zip + +branchTuple :: (String, Maybe String, Maybe String, Maybe String, Maybe String) +branchTuple = ("Headquarters", + Just "3882 Main St.", + Just "Waltham", + Just "MA", + Just "02451") + + +-- | +-- (from script) The insert statement +-- +-- Handwritten 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')); +-- @ +-- +-- Literal version of 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')) +-- @ +-- +-- 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 = insertQuery piEmployee3 . relation $ do + d <- query department + b <- query branch + wheres $ #name d .=. value "Administration" + wheres $ #name b .=. value "Headquarters" + return $ Employee3 |$| value "Michael" + |*| value "Smith" + |*| unsafeSQLiteDayValue "2001-06-22" + |*| just (#deptId d) + |*| value (Just "President") + |*| just (#branchId b) + +-- this is equal to `defineDirectPi [1,2,3,6,7,8]' +piEmployee3 :: Pi Employee Employee3 +piEmployee3 = Employee3 |$| #fname + |*| #lname + |*| #startDate + |*| #deptId + |*| #title + |*| #assignedBranchId + +data Employee3 = Employee3 + { e3Fname :: String + , e3Lname :: String + , e3StartDate :: Day + , e3DeptId :: Maybe Int + , e3Title :: Maybe String + , e3AssignedBranchId :: Maybe Int + } deriving (Generic) + +$(makeRelationalRecord ''Employee3) + +-- | +-- 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. +-- +-- Unsafe version of 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 +-- @ +-- +insertEmployee_s2U :: InsertQuery () +insertEmployee_s2U = insertQuery piEmployee3 . relation $ do + d <- queryScalar . unsafeUnique . relation $ do + d' <- query department + wheres $ #name d' .=. value "Administration" + return $ #deptId d' + b <- queryScalar . unsafeUnique . relation $ do + b' <- query branch + wheres $ #name b' .=. value "Headquarters" + return $ #branchId b' + return $ Employee3 |$| value "Michael" + |*| value "Smith" + |*| unsafeSQLiteDayValue "2001-06-22" + |*| d + |*| value (Just "President") + |*| b + +-- 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 + } deriving (Generic) + +$(makeRelationalRecord ''Employee4) + +-- | +-- Placeholder version of 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')) +-- @ +-- +insertEmployee_s2P :: InsertQuery Employee4 +insertEmployee_s2P = insertQuery piEmployee3 . relation' $ do + d <- query department + b <- query branch + wheres $ #name d .=. value "Administration" + wheres $ #name b .=. value "Headquarters" + placeholder $ \ph -> + return $ Employee3 |$| (! #e4Fname) ph + |*| #e4Lname ph + |*| #e4StartDate ph + |*| just (#deptId d) + |*| #e4Title ph + |*| just (#branchId b) + +employee4 :: Employee4 +employee4 = Employee4 + { e4Fname = "Michael" + , e4Lname = "Smith" + , e4StartDate = read "2001-06-22" + , e4Title = Just "President" + } + +-- | +-- (original) Updating data +-- +-- Handwritten SQL: +-- +-- @ +-- UPDATE employee +-- SET lname = 'Bush', +-- dept_id = 3 +-- WHERE emp_id = 10; +-- @ +-- +-- Generated SQL: +-- +-- @ +-- UPDATE MAIN.employee SET lname = 'Bush', dept_id = 3 WHERE (emp_id +-- = 10) +-- @ +-- +updateEmployee_o3 :: Update () +updateEmployee_o3 = updateNoPH $ \proj -> do + #lname <-# value "Bush" + #deptId <-# just (value 3) + wheres $ #empId (proj :: Record Flat Employee) .=. value 10 + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- UPDATE MAIN.employee SET lname = ?, dept_id = ? WHERE (emp_id = ?) +-- @ +-- +-- Note: This function is equal to the following: +-- +-- @ +-- updateEmployee_o3P :: Update (String, Int, Int) +-- updateEmployee_o3P = derivedUpdate $ \proj -> do +-- (phLname,()) <- placeholder (\ph -> Employee.lname' <-# ph) +-- (phDeptId,()) <- placeholder (\ph -> Employee.deptId' <-# just ph) +-- (phEmpId,()) <- placeholder (\ph -> wheres $ proj ! Employee.empId' .=. ph) +-- return $ (,,) |$| phLname |*| phDeptId |*| phEmpId +-- @ +-- +updateEmployee_o3P :: Update (String, Int, Int) +updateEmployee_o3P = update $ \proj -> do + (phLname,()) <- placeholder (\ph -> #lname <-# ph) + (phDeptId,()) <- placeholder (\ph -> #deptId <-# just ph) + (phEmpId,()) <- placeholder (\ph -> wheres $ #empId (proj :: Record Flat Employee) .=. ph) + return $ (,,) |$| phLname |*| phDeptId |*| phEmpId + +-- | +-- 9.4.2 Data Manipulation Using Correlated Subqueries +-- +-- Handwritten 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); +-- @ +-- +-- 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))) +-- @ +-- +updateAccount_9_4_2 :: Update () +updateAccount_9_4_2 = updateNoPH $ \proj -> do + ts <- queryScalar $ aggregatedUnique (relation $ do + t <- query Transaction.transaction + wheres $ #accountId t .=. #accountId proj + return (#txnDate t) + ) id' max' + tl <- queryList $ relation $ do + t <- query Transaction.transaction + wheres $ #accountId t .=. #accountId proj + return (value (1 :: Int64)) + Account.lastActivityDate' <-# (toDay $ flattenMaybe ts) + wheres $ exists $ tl + +toDay :: SqlContext c => Record c (Maybe LocalTime) -> Record c (Maybe Day) +toDay dt = unsafeProjectSql $ "date(" ++ unsafeShowSql dt ++ ")" + +-- | +-- (original) Deleting data +-- +-- Handwritten SQL: +-- +-- @ +-- DELETE FROM account +-- WHERE account_id = 2; +-- @ +-- +-- Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.account WHERE (account_id = 2) +-- @ +-- +deleteAccount_o1 :: Delete () +deleteAccount_o1 = deleteNoPH $ \proj -> do + wheres $ proj ! Account.accountId' .=. value 2 + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.account WHERE (account_id = ?) +-- @ +-- +-- Note: This function is equal to the following: +-- +-- @ +-- deleteAccount_o1P :: Delete Int64 +-- deleteAccount_o1P = derivedDelete $ \proj -> do +-- fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) +-- @ +-- +deleteAccount_o1P :: Delete Int +deleteAccount_o1P = delete $ \proj -> do + fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) + +-- | +-- (original) Data modification using equality conditions +-- +-- Handwritten SQL: +-- +-- @ +-- DELETE FROM account +-- WHERE account_id >= 10 AND account_id <= 20; +-- @ +-- +-- Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.account WHERE ((account_id >= 10) AND (account_id <= +-- 20)) +-- @ +-- +deleteAccount_o2 :: Delete () +deleteAccount_o2 = deleteNoPH $ \proj' -> do + let proj = proj' :: Record Flat Account + wheres $ #accountId proj .>=. value 10 + wheres $ #accountId proj .<=. value 20 + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.account WHERE ((account_id >= ?) AND (account_id <= +-- ?)) +-- @ +-- +deleteAccount_o2P :: Delete (Int, Int) +deleteAccount_o2P = delete $ \proj' -> do + let proj = proj' :: Record Flat Account + (phMin,()) <- placeholder (\ph -> wheres $ #accountId proj .>=. ph) + (phMax,()) <- placeholder (\ph -> wheres $ #accountId proj .<=. ph) + return (phMin >< phMax) + +-- | +-- 9.4.2 Data manipulation using correlated subqueries +-- +-- Handwritten SQL: +-- +-- @ +-- DELETE FROM department d +-- WHERE NOT EXISTS (SELECT 1 +-- FROM employee e +-- WHERE e.dept_id = d.dept_id); +-- @ +-- +-- Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.department WHERE (NOT (EXISTS (SELECT ALL 1 AS f0 +-- FROM MAIN.employee T0 WHERE (T0.dept_id = dept_id)))) +-- @ +-- +deleteEmployee_9_4_2 :: Delete () +deleteEmployee_9_4_2 = deleteNoPH $ \proj -> do + el <- queryList $ relation $ do + e <- query employee + wheres $ #deptId e .=. just (#deptId (proj :: Record Flat Department)) + return (value (1 :: Int64)) + wheres $ not' . exists $ el + +-- +-- run and print sql +-- + +run :: (Show a, IConnection conn, FromSql SqlValue a, ToSql SqlValue p) + => conn -> p -> Relation p a -> IO () +run conn param rel = do + putStrLn $ "SQL: " ++ show rel + records <- runRelation conn rel param + mapM_ print records + putStrLn "" + +runI :: (IConnection conn, ToSql SqlValue p) + => conn -> p -> Insert p -> IO () +runI conn param ins = do + putStrLn $ "SQL: " ++ show ins + num <- runInsert conn ins param + print num + putStrLn "" + rollback conn + +runIQ :: (IConnection conn, ToSql SqlValue p) + => conn -> p -> InsertQuery p -> IO () +runIQ conn param ins = do + putStrLn $ "SQL: " ++ show ins + num <- runInsertQuery conn ins param + print num + putStrLn "" + rollback conn + +runU :: (IConnection conn, ToSql SqlValue p) + => conn -> p -> Update p -> IO () +runU conn param upd = do + putStrLn $ "SQL: " ++ show upd + num <- runUpdate conn upd param + print num + putStrLn "" + rollback conn + +runD :: (IConnection conn, ToSql SqlValue p) + => conn -> p -> Delete p -> IO () +runD conn param dlt = do + putStrLn $ "SQL: " ++ show dlt + num <- runDelete conn dlt param + print num + putStrLn "" + rollback conn + +main :: IO () +main = handleSqlError' $ withConnectionIO (connectSqlite3 "examples.db") $ \conn -> do + run conn () allAccount + run conn () account_3_7 + run conn () account_3_7_1 + run conn () employee_3_7_3 + run conn () employee_4_1_2 + run conn (read "2003-01-01") employee_4_1_2P + run conn () employee_4_3_2 + run conn (read "2001-01-01", read "2003-01-01") employee_4_3_2P + run conn () account_4_3_3a + run conn () account_4_3_3aT + run conn () account_4_3_3aR + run conn () account_9_1 + run conn "ACCOUNT" account_4_3_3b + run conn "ACCOUNT" account_4_3_3bT + run conn "ACCOUNT" account_4_3_3bR + run conn () account_4_3_3c + run conn () join_5_1_2a + run conn () join_5_1_2aT + run conn () account_LeftOuterJoin + putStrLn $ "SQL: " ++ show business_RightOuterJoin -- right join is not supported by SQLite3 + run conn () join_5_1_3 + run conn () selfJoin_5_3a + run conn () selfJoin_5_3aT + run conn () union_6_4_1a_Nest + run conn () union_6_4_1a_Flat + run conn () group_8_1a + run conn () customer_9_4 + runI conn () insertBranch_s1 + runI conn branch1 insertBranch_s1P + runI conn () insertBranch_s1R + runI conn branchTuple insertBranch_s1PT + runIQ conn () insertEmployee_s2 + runIQ conn () insertEmployee_s2U + runIQ conn employee4 insertEmployee_s2P + runU conn () updateEmployee_o3 + runU conn ("Bush", 3, 10) updateEmployee_o3P + runU conn () updateAccount_9_4_2 + runD conn () deleteAccount_o1 + runD conn 2 deleteAccount_o1P + runD conn () deleteAccount_o2 + runD conn (10,20) deleteAccount_o2P + runD conn () deleteEmployee_9_4_2 diff --git a/mains/specializedExamples.hs b/mains/specializedExamples.hs new file mode 100644 --- /dev/null +++ b/mains/specializedExamples.hs @@ -0,0 +1,1360 @@ +{-# OPTIONS_GHC -fno-warn-unused-binds #-} +{-# LANGUAGE MonadComprehensions #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-} + +import Database.Relational.CustomSQLite3 + +import GHC.Generics (Generic) +import Prelude hiding (product) +import Data.Int (Int64) +import Data.Time (Day, LocalTime) +import Data.Functor.ProductIsomorphic ((|$|), (|*|)) + +import qualified Account +import Account (Account, account) +import qualified Branch +import Branch (Branch, branch) +import qualified Business +import Business (business) +import qualified Customer +import Customer (Customer, customer) +import qualified Department +import Department (Department, department) +import qualified Individual +import Individual (individual) +--import qualified Officer +--import Officer (Officer, Officer) +import qualified Product +import Product (product) +--import qualified ProductType +--import ProductType (ProductType, productType) +import qualified Transaction +-- import Transaction (transaction) +import qualified Employee +import Employee (Employee, employee) + +allAccount :: Relation () Account +allAccount = relation $ query account + +-- | sql/3.7 +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT open_emp_id, product_cd +-- FROM account +-- ORDER BY open_emp_id, product_cd +-- @ +-- +-- 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 +-- @ +-- +account_3_7 :: Relation () (Maybe Int, String) +account_3_7 = relation $ do + a <- query account + let proj = (,) |$| a ! Account.openEmpId' + |*| a ! Account.productCd' + asc proj + return proj + +-- | sql/3.7.1 +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT account_id, product_cd, open_date, avail_balance +-- FROM account +-- ORDER BY avail_balance DESC +-- @ +-- +-- 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 +-- @ +-- +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) + +-- | sql/3.7.3 +-- +-- 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. +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT emp_id, title, start_date, fname, lname +-- FROM employee +-- ORDER BY 2,5 +-- @ +-- +-- 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 +-- @ +-- +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 :: Int + , e1Title :: Maybe String + , e1StartDate :: Day + , e1Fname :: String + , e1Lname' :: String + } deriving (Show, Generic) + +$(makeRelationalRecord ''Employee1) + +-- | sql/4.1.2 +-- +-- 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. +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT * +-- FROM employee +-- WHERE end_date IS NULL AND (title = 'Teller' OR start_date < '2003-01-01') +-- @ +-- +-- Literal version of 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'))) +-- @ +-- +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 :: SqlContext c => String -> Record c Day +unsafeSQLiteDayValue = unsafeProjectSqlTerms . showLiteral + +-- | +-- Another way, use a placeholder instead of a date literal. +-- There is no need to define a helper function. +-- +-- Placeholder version of 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 < ?))) +-- @ +-- +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 + +-- | sql/4.3.2 +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT emp_id, fname, lname, start_date FROM employee +-- WHERE start_date +-- BETWEEN date('2001-01-01') AND date('2002-12-31') +-- @ +-- +-- Literal version of 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')) +-- @ +-- +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' + +-- | +-- Placeholder version of Generated SQL: +-- +-- 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 <= ?)) +-- @ +-- +-- NOTE: Be careful on the order of the placeholders. You must give day +-- values in order that they appear on the generated SQL. +-- +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 + +data Employee2 = Employee2 + { e2EmpId :: Int + , e2Fname :: String + , e2Lname :: String + , e2StartDate :: Day + } deriving (Show, Generic) + +$(makeRelationalRecord ''Employee2) + +-- | sql/4.3.3a +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT account_id, product_cd, cust_id, avail_balance +-- FROM LEARNINGSQL.account +-- WHERE product_cd IN ('CHK', 'SAV', 'CD', 'MM') +-- @ +-- +-- record version of 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')) +-- @ +-- +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 + +-- | +-- tuple version of 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')) +-- @ +-- +account_4_3_3aT :: Relation () (Int, String, Int, Maybe Double) +account_4_3_3aT = relation $ do + a <- query account + wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"] + return $ (,,,) |$| a ! Account.accountId' |*| a ! Account.productCd' |*| a ! Account.custId' |*| a ! Account.availBalance' + +-- | +-- Adhoc defined record version of 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')) +-- @ +-- +-- Above sql is the same to the tuple version. +-- +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' + +data Account1 = Account1 + { a1AccountId :: Int + , a1ProductCd :: String + , a1CustId :: Int + , a1AvailBalance :: Maybe Double + } deriving (Show, Generic) + +$(makeRelationalRecord ''Account1) + +-- | +-- 9.1 What is a subquery? +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT account_id, product_cd, cust_id, avail_balance +-- FROM account +-- WHERE account_id = (SELECT MAX(account_id) +-- FROM account); +-- @ +-- +-- 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)) +-- @ +-- +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' + +-- | sql/4.3.3b +-- +-- Handwritten 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') +-- @ +-- +-- Record version of 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 = ?))) +-- @ +-- +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) + +-- | +-- Tuple version of 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 +-- (SELECT ALL T1.product_cd AS f0 FROM MAIN.product T1 WHERE +-- (T1.product_type_cd = ?))) +-- @ +-- +account_4_3_3bT :: Relation String (Int, String, Int, Maybe Double) +account_4_3_3bT = relation' $ do + a <- query account + (phProductCd,p) <- queryList' product_4_3_3b + wheres $ a ! Account.productCd' `in'` p + let at = (,,,) |$| a ! Account.accountId' |*| a ! Account.productCd' |*| a ! Account.custId' |*| a ! Account.availBalance' + return (phProductCd, at) + +-- | +-- Adhoc record version of 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 +-- (SELECT ALL T1.product_cd AS f0 FROM MAIN.product T1 WHERE +-- (T1.product_type_cd = ?))) +-- @ +-- +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) + +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' + +-- | sql/4.3.3c +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT account_id, product_cd, cust_id, avail_balance +-- FROM LEARNINGSQL.account +-- WHERE product_cd NOT IN ('CHK', 'SAV', 'CD', 'MM') +-- @ +-- +-- 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'))) +-- @ +-- +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 + +-- | sql/5.1.2a +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT e.fname, e.lname, d.name +-- FROM LEARNINGSQL.employee e INNER JOIN LEARNINGSQL.department d +-- USING (dept_id) +-- @ +-- +-- Record version of 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, +-- T1.dept_id AS f9, T1.name AS f10 FROM MAIN.employee T0 INNER JOIN +-- MAIN.department T1 ON (T0.dept_id = T1.dept_id) +-- @ +-- +join_5_1_2a :: Relation () (Employee, Department) +join_5_1_2a = relation $ do + e <- query employee + d <- query department + on $ e ! Employee.deptId' .=. just (d ! Department.deptId') + return $ e >< d + +-- | +-- Tuple version of 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) +-- @ +-- +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' + +-- | +-- Left Outer Join +-- +-- Handwritten 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 +-- @ +-- +-- 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) +-- @ +-- +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 :: Int + , a4CustId :: Int + , a4Fname :: Maybe String + , a4Lname :: Maybe String + } deriving (Show, Generic) + +$(makeRelationalRecord ''Account4) + +-- | +-- Right Outer Join +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT c.cust_id, b.name +-- FROM customer c RIGHT OUTER JOIN business b +-- ON c.cust_id = b.cust_id +-- @ +-- +-- 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. +-- +business_RightOuterJoin :: Relation () (Maybe Int, 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') + +-- | sql/5.1.3 +-- +-- Handwritten 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' +-- @ +-- +-- 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'))) +-- @ +-- +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 + { a3AccountId :: Int + , a3CustId :: Int + , a3OpenDate :: Day + , a3ProductCd :: String + } deriving (Show, Generic) + +$(makeRelationalRecord ''Account3) + +-- | sql/5.3a +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT e.fname, e.lname, e_mgr.fname mgr_fname, e_mgr.lname mgr_lname +-- FROM LEARNINGSQL.employee e INNER JOIN LEARNINGSQL.employee e_mgr +-- ON e.superior_emp_id = e_mgr.emp_id +-- @ +-- +-- Record version of 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, +-- T1.emp_id AS f9, T1.fname AS f10, T1.lname AS f11, T1.start_date AS +-- f12, T1.end_date AS f13, T1.superior_emp_id AS f14, T1.dept_id AS f15, +-- T1.title AS f16, T1.assigned_branch_id AS f17 FROM MAIN.employee T0 +-- INNER JOIN MAIN.employee T1 ON (T0.superior_emp_id = T1.emp_id) +-- @ +-- +selfJoin_5_3a :: Relation () (Employee, Employee) +selfJoin_5_3a = relation $ do + e <- query employee + m <- query employee + on $ e ! Employee.superiorEmpId' .=. just (m ! Employee.empId') + return $ e >< m + +-- | +-- Tuple version of 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) +-- @ +-- +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 + +-- | sql/6.4.1a +-- +-- The standard SQL allows the syntax of UNION that has an order clause +-- at the last of query. Unfortunately, HRR dows not support. In addition, +-- HRR put a select statement having an order clause into parentheses. +-- If you want to sort whole row returned from UNION, place a order +-- clouse outside of the union relation. +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT emp_id, assigned_branch_id +-- FROM LEARNINGSQL.employee +-- WHERE title = 'Teller' +-- UNION +-- SELECT open_emp_id, open_branch_id +-- FROM LEARNINGSQL.account +-- WHERE product_cd = 'SAV' +-- ORDER BY open_emp_id +-- @ +-- +-- 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 +-- @ +-- +employee_6_4_1a :: Relation () (Maybe Int, Maybe Int) +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 Int, Maybe Int) +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 Int, Maybe Int) +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 has different meaning with the handwritten SQL +-- (order clause with UNION). +-- Such query cannot be expressed flatly with EDSL of HRR. +-- +-- 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') +-- @ +-- +union_6_4_1a_Flat :: Relation () (Maybe Int, Maybe Int) +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" + -- asc $ a ! Account.openEmpId' + return $ a ! Account.openEmpId' >< a ! Account.openBranchId' + ) + +-- | sql/8.1a +-- +-- Handwritten SQL: +-- +-- @ +-- SELECT open_emp_id, COUNT(*) how_many +-- FROM LEARNINGSQL.account +-- GROUP BY open_emp_id +-- ORDER BY open_emp_id +-- @ +-- +-- 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 +-- @ +-- +group_8_1a :: Relation () (Maybe Int, Int64) +group_8_1a = aggregateRelation $ do + a <- query account + g <- groupBy $ a ! Account.openEmpId' + asc $ g ! id' + return $ g >< count (a ! Account.accountId') + +-- | +-- 9.4 Correlated Subqueries +-- +-- Handwritten 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); +-- @ +-- +-- 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)) +-- @ +-- +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 :: Int + , c1CustTypeCd :: String + , c1City :: Maybe String + } deriving (Show, Generic) + +customer1 :: SqlContext c + => Record c Customer -> Record c Customer1 +customer1 c = Customer1 |$| c ! Customer.custId' + |*| c ! Customer.custTypeCd' + |*| c ! Customer.city' + +$(makeRelationalRecord ''Customer1) + +-- | +-- (from script) The insert statement +-- +-- Handwritten SQL: +-- +-- @ +-- INSERT INTO branch (branch_id, name, address, city, state, zip) +-- VALUES (null, 'Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451'); +-- @ +-- +-- Literal version of Generated SQL: +-- +-- @ +-- INSERT INTO MAIN.branch (name, address, city, state, zip) +-- VALUES ('Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451') +-- @ +-- +insertBranch_s1 :: Insert () +insertBranch_s1 = insertValueNoPH $ 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") + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- INSERT INTO MAIN.branch (name, address, city, state, zip) +-- VALUES (?, ?, ?, ?, ?) +-- @ +-- +insertBranch_s1P :: Insert Branch1 +insertBranch_s1P = insert 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) + +branch1 :: Branch1 +branch1 = Branch1 + { b1Name = "Headquarters" + , b1Address = Just "3882 Main St." + , b1City = Just "Waltham" + , b1State = Just "MA" + , b1Zip = Just "02451" + } + +-- | +-- Literal version of Generated SQL: +-- +-- @ +-- 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 record value directly as SQL row value. +-- Above SQL is the same to the monadic building version. +-- +insertBranch_s1R :: Insert () +insertBranch_s1R = insertValueNoPH $ do + piBranch1 <-# value Branch1 + { b1Name = "Headquarters" + , b1Address = Just "3882 Main St." + , b1City = Just "Waltham" + , b1State = Just "MA" + , b1Zip = Just "02451" + } + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- INSERT INTO MAIN.branch (name, address, city, state, zip) +-- VALUES (?, ?, ?, ?, ?) +-- @ +-- +-- Thanks to generic-programing, it is possible to specify tuple type as Pi destination type. +-- Above SQL is the same to ad-hoc defined record version. +-- +insertBranch_s1PT :: Insert (String, Maybe String, Maybe String, Maybe String, Maybe String) +insertBranch_s1PT = insert piBranchTuple + +piBranchTuple :: Pi Branch (String, Maybe String, Maybe String, Maybe String, Maybe String) +piBranchTuple = (,,,,) + |$| Branch.name' + |*| Branch.address' + |*| Branch.city' + |*| Branch.state' + |*| Branch.zip' + +branchTuple :: (String, Maybe String, Maybe String, Maybe String, Maybe String) +branchTuple = ("Headquarters", + Just "3882 Main St.", + Just "Waltham", + Just "MA", + Just "02451") + + +-- | +-- (from script) The insert statement +-- +-- Handwritten 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')); +-- @ +-- +-- Literal version of 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')) +-- @ +-- +-- 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 = insertQuery 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 Int + , e3Title :: Maybe String + , e3AssignedBranchId :: Maybe Int + } deriving (Generic) + +$(makeRelationalRecord ''Employee3) + +-- | +-- 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. +-- +-- Unsafe version of 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 +-- @ +-- +insertEmployee_s2U :: InsertQuery () +insertEmployee_s2U = insertQuery 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 + +-- 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 + } deriving (Generic) + +$(makeRelationalRecord ''Employee4) + +-- | +-- Placeholder version of 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')) +-- @ +-- +insertEmployee_s2P :: InsertQuery Employee4 +insertEmployee_s2P = insertQuery 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" + } + +-- | +-- (original) Updating data +-- +-- Handwritten SQL: +-- +-- @ +-- UPDATE employee +-- SET lname = 'Bush', +-- dept_id = 3 +-- WHERE emp_id = 10; +-- @ +-- +-- Generated SQL: +-- +-- @ +-- UPDATE MAIN.employee SET lname = 'Bush', dept_id = 3 WHERE (emp_id +-- = 10) +-- @ +-- +updateEmployee_o3 :: Update () +updateEmployee_o3 = updateNoPH $ \proj -> do + Employee.lname' <-# value "Bush" + Employee.deptId' <-# just (value 3) + wheres $ proj ! Employee.empId' .=. value 10 + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- UPDATE MAIN.employee SET lname = ?, dept_id = ? WHERE (emp_id = ?) +-- @ +-- +-- Note: This function is equal to the following: +-- +-- @ +-- updateEmployee_o3P :: Update (String, Int, Int) +-- updateEmployee_o3P = derivedUpdate $ \proj -> do +-- (phLname,()) <- placeholder (\ph -> Employee.lname' <-# ph) +-- (phDeptId,()) <- placeholder (\ph -> Employee.deptId' <-# just ph) +-- (phEmpId,()) <- placeholder (\ph -> wheres $ proj ! Employee.empId' .=. ph) +-- return $ (,,) |$| phLname |*| phDeptId |*| phEmpId +-- @ +-- +updateEmployee_o3P :: Update (String, Int, Int) +updateEmployee_o3P = update $ \proj -> do + (phLname,()) <- placeholder (\ph -> Employee.lname' <-# ph) + (phDeptId,()) <- placeholder (\ph -> Employee.deptId' <-# just ph) + (phEmpId,()) <- placeholder (\ph -> wheres $ proj ! Employee.empId' .=. ph) + return $ (,,) |$| phLname |*| phDeptId |*| phEmpId + +-- | +-- 9.4.2 Data Manipulation Using Correlated Subqueries +-- +-- Handwritten 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); +-- @ +-- +-- 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))) +-- @ +-- +updateAccount_9_4_2 :: Update () +updateAccount_9_4_2 = updateNoPH $ \proj -> do + ts <- queryScalar $ aggregatedUnique (relation $ do + t <- query Transaction.transaction + wheres $ t ! Transaction.accountId' .=. proj ! Account.accountId' + return (t ! Transaction.txnDate') + ) id' max' + tl <- queryList $ relation $ do + t <- query Transaction.transaction + wheres $ t ! Transaction.accountId' .=. proj ! Account.accountId' + return (value (1 :: Int64)) + Account.lastActivityDate' <-# (toDay $ flattenMaybe ts) + wheres $ exists $ tl + +toDay :: SqlContext c => Record c (Maybe LocalTime) -> Record c (Maybe Day) +toDay dt = unsafeProjectSql $ "date(" ++ unsafeShowSql dt ++ ")" + +-- | +-- (original) Deleting data +-- +-- Handwritten SQL: +-- +-- @ +-- DELETE FROM account +-- WHERE account_id = 2; +-- @ +-- +-- Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.account WHERE (account_id = 2) +-- @ +-- +deleteAccount_o1 :: Delete () +deleteAccount_o1 = deleteNoPH $ \proj -> do + wheres $ proj ! Account.accountId' .=. value 2 + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.account WHERE (account_id = ?) +-- @ +-- +-- Note: This function is equal to the following: +-- +-- @ +-- deleteAccount_o1P :: Delete Int64 +-- deleteAccount_o1P = derivedDelete $ \proj -> do +-- fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) +-- @ +-- +deleteAccount_o1P :: Delete Int +deleteAccount_o1P = delete $ \proj -> do + fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) + +-- | +-- (original) Data modification using equality conditions +-- +-- Handwritten SQL: +-- +-- @ +-- DELETE FROM account +-- WHERE account_id >= 10 AND account_id <= 20; +-- @ +-- +-- Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.account WHERE ((account_id >= 10) AND (account_id <= +-- 20)) +-- @ +-- +deleteAccount_o2 :: Delete () +deleteAccount_o2 = deleteNoPH $ \proj -> do + wheres $ proj ! Account.accountId' .>=. value 10 + wheres $ proj ! Account.accountId' .<=. value 20 + +-- | +-- Placeholder version of Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.account WHERE ((account_id >= ?) AND (account_id <= +-- ?)) +-- @ +-- +deleteAccount_o2P :: Delete (Int, Int) +deleteAccount_o2P = delete $ \proj -> do + (phMin,()) <- placeholder (\ph -> wheres $ proj ! Account.accountId' .>=. ph) + (phMax,()) <- placeholder (\ph -> wheres $ proj ! Account.accountId' .<=. ph) + return (phMin >< phMax) + +-- | +-- 9.4.2 Data manipulation using correlated subqueries +-- +-- Handwritten SQL: +-- +-- @ +-- DELETE FROM department d +-- WHERE NOT EXISTS (SELECT 1 +-- FROM employee e +-- WHERE e.dept_id = d.dept_id); +-- @ +-- +-- Generated SQL: +-- +-- @ +-- DELETE FROM MAIN.department WHERE (NOT (EXISTS (SELECT ALL 1 AS f0 +-- FROM MAIN.employee T0 WHERE (T0.dept_id = dept_id)))) +-- @ +-- +deleteEmployee_9_4_2 :: Delete () +deleteEmployee_9_4_2 = deleteNoPH $ \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 + +-- +-- run and print sql +-- + +run :: (Show a, IConnection conn, FromSql SqlValue a, ToSql SqlValue p) + => conn -> p -> Relation p a -> IO () +run conn param rel = do + putStrLn $ "SQL: " ++ show rel + records <- runRelation conn rel param + mapM_ print records + putStrLn "" + +runI :: (IConnection conn, ToSql SqlValue p) + => conn -> p -> Insert p -> IO () +runI conn param ins = do + putStrLn $ "SQL: " ++ show ins + num <- runInsert conn ins param + print num + putStrLn "" + rollback conn + +runIQ :: (IConnection conn, ToSql SqlValue p) + => conn -> p -> InsertQuery p -> IO () +runIQ conn param ins = do + putStrLn $ "SQL: " ++ show ins + num <- runInsertQuery conn ins param + print num + putStrLn "" + rollback conn + +runU :: (IConnection conn, ToSql SqlValue p) + => conn -> p -> Update p -> IO () +runU conn param upd = do + putStrLn $ "SQL: " ++ show upd + num <- runUpdate conn upd param + print num + putStrLn "" + rollback conn + +runD :: (IConnection conn, ToSql SqlValue p) + => conn -> p -> Delete p -> IO () +runD conn param dlt = do + putStrLn $ "SQL: " ++ show dlt + num <- runDelete conn dlt param + print num + putStrLn "" + rollback conn + +main :: IO () +main = handleSqlError' $ withConnectionIO (connectSqlite3 "examples.db") $ \conn -> do + run conn () allAccount + run conn () account_3_7 + run conn () account_3_7_1 + run conn () employee_3_7_3 + run conn () employee_4_1_2 + run conn (read "2003-01-01") employee_4_1_2P + run conn () employee_4_3_2 + run conn (read "2001-01-01", read "2003-01-01") employee_4_3_2P + run conn () account_4_3_3a + run conn () account_4_3_3aT + run conn () account_4_3_3aR + run conn () account_9_1 + run conn "ACCOUNT" account_4_3_3b + run conn "ACCOUNT" account_4_3_3bT + run conn "ACCOUNT" account_4_3_3bR + run conn () account_4_3_3c + run conn () join_5_1_2a + run conn () join_5_1_2aT + run conn () account_LeftOuterJoin + putStrLn $ "SQL: " ++ show business_RightOuterJoin -- right join is not supported by SQLite3 + run conn () join_5_1_3 + run conn () selfJoin_5_3a + run conn () selfJoin_5_3aT + run conn () union_6_4_1a_Nest + run conn () union_6_4_1a_Flat + run conn () group_8_1a + run conn () customer_9_4 + runI conn () insertBranch_s1 + runI conn branch1 insertBranch_s1P + runI conn () insertBranch_s1R + runI conn branchTuple insertBranch_s1PT + runIQ conn () insertEmployee_s2 + runIQ conn () insertEmployee_s2U + runIQ conn employee4 insertEmployee_s2P + runU conn () updateEmployee_o3 + runU conn ("Bush", 3, 10) updateEmployee_o3P + runU conn () updateAccount_9_4_2 + runD conn () deleteAccount_o1 + runD conn 2 deleteAccount_o1P + runD conn () deleteAccount_o2 + runD conn (10,20) deleteAccount_o2P + runD conn () deleteEmployee_9_4_2 diff --git a/relational-record-examples.cabal b/relational-record-examples.cabal --- a/relational-record-examples.cabal +++ b/relational-record-examples.cabal @@ -1,5 +1,5 @@ name: relational-record-examples -version: 0.5.1.1 +version: 0.6.0.0 synopsis: Examples of Haskell Relationa Record description: Provides examples of Haskell Relational Record license: BSD3 @@ -30,13 +30,13 @@ flag binary description: building binary, too - default: False + default: True manual: True library hs-source-dirs: lib exposed-modules: - Database.Relational.Query.SQLite3 + Database.Relational.CustomSQLite3 Database.Record.TH.SQLite3 hs-source-dirs: entity @@ -61,49 +61,57 @@ , relational-query >= 0.11.2 , relational-query-HDBC >= 0.6.5 , template-haskell - -- not link directly but query type map - , relational-schemas >= 0.1.5 + , relational-schemas >= 0.1.7 if impl(ghc == 7.4.*) build-depends: ghc-prim == 0.2.* - default-language: Haskell2010 ghc-options: -Wall + if impl(ghc >= 8) + ghc-options: -Wcompat -Wnoncanonical-monadfail-instances + default-language: Haskell2010 + executable examples if impl(ghc >= 8.0) && flag(binary) buildable: True else buildable: False - hs-source-dirs: src + hs-source-dirs: mains main-is: examples.hs build-depends: base < 5 , product-isomorphic >= 0.0.3 - , relational-query >= 0.11 + , relational-query >= 0.12 , relational-record-examples , template-haskell , time if impl(ghc == 7.4.*) build-depends: ghc-prim == 0.2.* - default-language: Haskell2010 ghc-options: -Wall + if impl(ghc >= 8) + ghc-options: -Wcompat -Wnoncanonical-monadfail-instances + default-language: Haskell2010 + executable specialized-examples if flag(binary) buildable: True else buildable: False - hs-source-dirs: src + hs-source-dirs: mains main-is: specializedExamples.hs build-depends: base < 5 , product-isomorphic >= 0.0.3 - , relational-query >= 0.11 + , relational-query >= 0.12 , relational-record-examples , template-haskell , time if impl(ghc == 7.4.*) build-depends: ghc-prim == 0.2.* - default-language: Haskell2010 ghc-options: -Wall + if impl(ghc >= 8) + ghc-options: -Wcompat -Wnoncanonical-monadfail-instances + + default-language: Haskell2010 diff --git a/src/examples.hs b/src/examples.hs deleted file mode 100644 --- a/src/examples.hs +++ /dev/null @@ -1,1357 +0,0 @@ -{-# OPTIONS_GHC -Wno-unused-top-binds #-} -{-# LANGUAGE MonadComprehensions #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedLabels #-} - -import Database.Relational.Query.SQLite3 -import Database.Relational.OverloadedInstances () - -import GHC.Generics (Generic) -import Prelude hiding (product) -import Data.Int (Int64) -import Data.Time (Day, LocalTime) -import Data.Functor.ProductIsomorphic ((|$|), (|*|)) - -import qualified Account -import Account (Account, account) -import qualified Branch -import Branch (Branch, branch) -import Business (business) -import Customer (Customer, customer) -import Department (Department, department) -import Individual (individual) ---import qualified Officer ---import Officer (Officer, Officer) -import Product (product) ---import qualified ProductType ---import ProductType (ProductType, productType) -import qualified Transaction -import Employee (Employee, employee) - -allAccount :: Relation () Account -allAccount = relation $ query account - --- | sql/3.7 --- --- Handwritten SQL: --- --- @ --- SELECT open_emp_id, product_cd --- FROM account --- ORDER BY open_emp_id, product_cd --- @ --- --- 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 --- @ --- -account_3_7 :: Relation () (Maybe Int, String) -account_3_7 = relation $ do - a <- query account - let proj = (,) |$| #openEmpId a - |*| #productCd a - asc proj - return proj - --- | sql/3.7.1 --- --- Handwritten SQL: --- --- @ --- SELECT account_id, product_cd, open_date, avail_balance --- FROM account --- ORDER BY avail_balance DESC --- @ --- --- 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 --- @ --- -account_3_7_1 :: Relation () Account2 -account_3_7_1 = relation $ do - a <- query account - desc $ #availBalance a - return $ Account2 |$| #accountId a - |*| #productCd a - |*| #openDate a - |*| #availBalance a - -data Account2 = Account2 - { a2AccountId :: Int - , a2ProductCd :: String - , a2OpenDate :: Day - , a2AvailBalance :: Maybe Double - } deriving (Show, Generic) - -$(makeRelationalRecord ''Account2) - --- | sql/3.7.3 --- --- 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. --- --- Handwritten SQL: --- --- @ --- SELECT emp_id, title, start_date, fname, lname --- FROM employee --- ORDER BY 2,5 --- @ --- --- 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 --- @ --- -employee_3_7_3 :: Relation () Employee1 -employee_3_7_3 = relation $ do - e <- query employee - asc $ #title e - asc $ #lname e - return $ Employee1 |$| #empId e - |*| #title e - |*| #startDate e - |*| #fname e - |*| #lname e - -data Employee1 = Employee1 - { e1EmpId :: Int - , e1Title :: Maybe String - , e1StartDate :: Day - , e1Fname :: String - , e1Lname' :: String - } deriving (Show, Generic) - -$(makeRelationalRecord ''Employee1) - --- | sql/4.1.2 --- --- 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. --- --- Handwritten SQL: --- --- @ --- SELECT * --- FROM employee --- WHERE end_date IS NULL AND (title = 'Teller' OR start_date < '2003-01-01') --- @ --- --- Literal version of 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'))) --- @ --- -employee_4_1_2 :: Relation () Employee -employee_4_1_2 = relation $ do - e <- query employee - wheres $ isNothing (#endDate e) - wheres $ #title e .=. just (value "Teller") - `or'` #startDate e .<. unsafeSQLiteDayValue "2003-01-01" - return e - -unsafeSQLiteDayValue :: SqlContext c => String -> Record c Day -unsafeSQLiteDayValue = unsafeProjectSqlTerms . showConstantTermsSQL - --- | --- Another way, use a placeholder instead of a date literal. --- There is no need to define a helper function. --- --- Placeholder version of 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 < ?))) --- @ --- -employee_4_1_2P :: Relation Day Employee -employee_4_1_2P = relation' . placeholder $ \ph -> do - e <- query employee - wheres $ isNothing (#endDate e) - wheres $ #title e .=. just (value "Teller") - `or'` #startDate e .<. ph - return e - --- | sql/4.3.2 --- --- Handwritten SQL: --- --- @ --- SELECT emp_id, fname, lname, start_date FROM employee --- WHERE start_date --- BETWEEN date('2001-01-01') AND date('2002-12-31') --- @ --- --- Literal version of 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')) --- @ --- -employee_4_3_2 :: Relation () Employee2 -employee_4_3_2 = relation $ do - e <- query employee - wheres $ #startDate e .>=. unsafeSQLiteDayValue "2001-01-01" - wheres $ #startDate e .<=. unsafeSQLiteDayValue "2003-01-01" - return $ Employee2 |$| #empId e - |*| #fname e - |*| #lname e - |*| #startDate e - --- | --- Placeholder version of Generated SQL: --- --- 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 <= ?)) --- @ --- --- NOTE: Be careful on the order of the placeholders. You must give day --- values in order that they appear on the generated SQL. --- -employee_4_3_2P :: Relation (Day,Day) Employee2 -employee_4_3_2P = relation' . placeholder $ \ph -> do - e <- query employee - let date = #startDate e - wheres $ date .>=. (! #fst) ph - wheres $ date .<=. (! #snd) ph - return $ Employee2 |$| #empId e - |*| #fname e - |*| #lname e - |*| date - -data Employee2 = Employee2 - { e2EmpId :: Int - , e2Fname :: String - , e2Lname :: String - , e2StartDate :: Day - } deriving (Show, Generic) - -$(makeRelationalRecord ''Employee2) - --- | sql/4.3.3a.sh --- --- Handwritten SQL: --- --- @ --- SELECT account_id, product_cd, cust_id, avail_balance --- FROM LEARNINGSQL.account --- WHERE product_cd IN ('CHK', 'SAV', 'CD', 'MM') --- @ --- --- record version of 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')) --- @ --- -account_4_3_3a :: Relation () Account -account_4_3_3a = relation $ do - a <- query account - wheres $ #productCd a `in'` values ["CHK", "SAV", "CD", "MM"] - return a - --- | --- tuple version of 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')) --- @ --- -account_4_3_3aT :: Relation () (Int, String, Int, Maybe Double) -account_4_3_3aT = relation $ do - a <- query account - wheres $ #productCd a `in'` values ["CHK", "SAV", "CD", "MM"] - return $ (,,,) |$| #accountId a |*| #productCd a |*| #custId a |*| #availBalance a - --- | --- Adhoc defined record version of 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')) --- @ --- --- Above sql is the same to the tuple version. --- -account_4_3_3aR :: Relation () Account1 -account_4_3_3aR = relation $ do - a <- query account - wheres $ #productCd a `in'` values ["CHK", "SAV", "CD", "MM"] - return $ Account1 |$| #accountId a - |*| #productCd a - |*| #custId a - |*| #availBalance a - -data Account1 = Account1 - { a1AccountId :: Int - , a1ProductCd :: String - , a1CustId :: Int - , a1AvailBalance :: Maybe Double - } deriving (Show, Generic) - -$(makeRelationalRecord ''Account1) - --- | --- 9.1 What is a subquery? --- --- Handwritten SQL: --- --- @ --- SELECT account_id, product_cd, cust_id, avail_balance --- FROM account --- WHERE account_id = (SELECT MAX(account_id) --- FROM account); --- @ --- --- 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)) --- @ --- -account_9_1 :: Relation () Account1 -account_9_1 = relation $ do - a <- query account - ma <- queryScalar $ aggregatedUnique account #accountId max' - wheres $ just (#accountId a) .=. flattenMaybe ma - return $ Account1 |$| #accountId a - |*| #productCd a - |*| #custId a - |*| #availBalance a - --- | sql/4.3.3b.sh --- --- Handwritten 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') --- @ --- --- Record version of 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 = ?))) --- @ --- -account_4_3_3b :: Relation String Account -account_4_3_3b = relation' $ do - a <- query account - (phProductCd,p) <- queryList' product_4_3_3b - wheres $ #productCd a `in'` p - return (phProductCd, a) - --- | --- Tuple version of 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 --- (SELECT ALL T1.product_cd AS f0 FROM MAIN.product T1 WHERE --- (T1.product_type_cd = ?))) --- @ --- -account_4_3_3bT :: Relation String (Int, String, Int, Maybe Double) -account_4_3_3bT = relation' $ do - a <- query account - (phProductCd,p) <- queryList' product_4_3_3b - wheres $ #productCd a `in'` p - let at = (,,,) |$| #accountId a |*| #productCd a |*| #custId a |*| #availBalance a - return (phProductCd, at) - --- | --- Adhoc record version of 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 --- (SELECT ALL T1.product_cd AS f0 FROM MAIN.product T1 WHERE --- (T1.product_type_cd = ?))) --- @ --- -account_4_3_3bR :: Relation String Account1 -account_4_3_3bR = relation' $ do - a <- query account - (phProductCd,p) <- queryList' product_4_3_3b - wheres $ #productCd a `in'` p - let ar = Account1 |$| #accountId a - |*| #productCd a - |*| #custId a - |*| #availBalance a - return (phProductCd, ar) - -product_4_3_3b :: Relation String String -product_4_3_3b = relation' . placeholder $ \ph -> do - p <- query product - wheres $ #productTypeCd p .=. ph - return $ #productCd p - --- | sql/4.3.3c.sh --- --- Handwritten SQL: --- --- @ --- SELECT account_id, product_cd, cust_id, avail_balance --- FROM LEARNINGSQL.account --- WHERE product_cd NOT IN ('CHK', 'SAV', 'CD', 'MM') --- @ --- --- 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'))) --- @ --- -account_4_3_3c :: Relation () Account -account_4_3_3c = relation $ do - a <- query account - wheres $ not' (#productCd a `in'` values ["CHK", "SAV", "CD", "MM"]) - return a - --- | sql/5.1.2a.sh --- --- Handwritten SQL: --- --- @ --- SELECT e.fname, e.lname, d.name --- FROM LEARNINGSQL.employee e INNER JOIN LEARNINGSQL.department d --- USING (dept_id) --- @ --- --- Record version of 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, --- T1.dept_id AS f9, T1.name AS f10 FROM MAIN.employee T0 INNER JOIN --- MAIN.department T1 ON (T0.dept_id = T1.dept_id) --- @ --- -join_5_1_2a :: Relation () (Employee, Department) -join_5_1_2a = relation $ do - e <- query employee - d <- query department - on $ #deptId e .=. just (#deptId d) - return $ e >< d - --- | --- Tuple version of 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) --- @ --- -join_5_1_2aT :: Relation () (String, String, String) -join_5_1_2aT = relation $ do - e <- query employee - d <- query department - on $ #deptId e .=. just (#deptId d) - return $ (,,) |$| #fname e |*| #lname e |*| #name d - --- | --- Left Outer Join --- --- Handwritten 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 --- @ --- --- 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) --- @ --- -account_LeftOuterJoin :: Relation () Account4 -account_LeftOuterJoin = relation $ do - a <- query account - i <- queryMaybe individual - on $ just (#custId a) .=. (? #custId) i - return $ Account4 |$| #accountId a - |*| #custId a - |*| (? #fname) i - |*| (? #lname) i - -data Account4 = Account4 - { a4AccountId :: Int - , a4CustId :: Int - , a4Fname :: Maybe String - , a4Lname :: Maybe String - } deriving (Show, Generic) - -$(makeRelationalRecord ''Account4) - --- | --- Right Outer Join --- --- Handwritten SQL: --- --- @ --- SELECT c.cust_id, b.name --- FROM customer c RIGHT OUTER JOIN business b --- ON c.cust_id = b.cust_id --- @ --- --- 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. --- -business_RightOuterJoin :: Relation () (Maybe Int, String) -business_RightOuterJoin = relation $ do - c <- queryMaybe customer - b <- query business - on $ (? #custId) c .=. just (#custId b) - return ((? #custId) c >< #name b) - --- | sql/5.1.3.sh --- --- Handwritten 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' --- @ --- --- 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'))) --- @ --- -join_5_1_3 :: Relation () Account3 -join_5_1_3 = relation $ do - a <- query account - e <- query employee - on $ #openEmpId a .=. just (#empId e) - - b <- query branch - on $ #assignedBranchId e .=. just (#branchId b) - - wheres $ #startDate e .<=. unsafeSQLiteDayValue "2004-01-01" - wheres $ #title e .=. just (value "Teller") - `or'` #title e .=. just (value "Head Teller") - wheres $ #name b .=. value "Woburn Branch" - - return $ Account3 |$| #accountId a - |*| #custId a - |*| #openDate a - |*| #productCd a - -data Account3 = Account3 - { a3AccountId :: Int - , a3CustId :: Int - , a3OpenDate :: Day - , a3ProductCd :: String - } deriving (Show, Generic) - -$(makeRelationalRecord ''Account3) - --- | sql/5.3a.sh --- --- Handwritten SQL: --- --- @ --- SELECT e.fname, e.lname, e_mgr.fname mgr_fname, e_mgr.lname mgr_lname --- FROM LEARNINGSQL.employee e INNER JOIN LEARNINGSQL.employee e_mgr --- ON e.superior_emp_id = e_mgr.emp_id --- @ --- --- Record version of 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, --- T1.emp_id AS f9, T1.fname AS f10, T1.lname AS f11, T1.start_date AS --- f12, T1.end_date AS f13, T1.superior_emp_id AS f14, T1.dept_id AS f15, --- T1.title AS f16, T1.assigned_branch_id AS f17 FROM MAIN.employee T0 --- INNER JOIN MAIN.employee T1 ON (T0.superior_emp_id = T1.emp_id) --- @ --- -selfJoin_5_3a :: Relation () (Employee, Employee) -selfJoin_5_3a = relation $ do - e <- query employee - m <- query employee - on $ #superiorEmpId e .=. just (#empId m) - return $ e >< m - --- | --- Tuple version of 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) --- @ --- -selfJoin_5_3aT :: Relation () ((String, String), (String, String)) -selfJoin_5_3aT = relation $ do - e <- query employee - m <- query employee - on $ #superiorEmpId e .=. just (#empId m) - let emp = #fname e >< #lname e - let mgr = #fname m >< #lname m - return $ emp >< mgr - --- | sql/6.4.1a.sh --- --- The standard SQL allows the syntax of UNION that has an order clause --- at the last of query. Unfortunately, HRR dows not support. In addition, --- HRR put a select statement having an order clause into parentheses. --- If you want to sort whole row returned from UNION, place a order --- clouse outside of the union relation. --- --- Handwritten SQL: --- --- @ --- SELECT emp_id, assigned_branch_id --- FROM LEARNINGSQL.employee --- WHERE title = 'Teller' --- UNION --- SELECT open_emp_id, open_branch_id --- FROM LEARNINGSQL.account --- WHERE product_cd = 'SAV' --- ORDER BY open_emp_id --- @ --- --- 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 --- @ --- -employee_6_4_1a :: Relation () (Maybe Int, Maybe Int) -employee_6_4_1a = relation $ do - e <- query employee - wheres $ #title e .=. just (value "Teller") - return $ just (#empId e) >< #assignedBranchId e - -account_6_4_1a :: Relation () (Maybe Int, Maybe Int) -account_6_4_1a = relation $ do - a <- query account - wheres $ #productCd a .=. value "SAV" - return $ #openEmpId a >< #openBranchId a - -union_6_4_1a_Nest :: Relation () (Maybe Int, Maybe Int) -union_6_4_1a_Nest = relation $ do - ea <- query $ employee_6_4_1a `union` account_6_4_1a - asc $ #fst ea - return ea - --- | --- Generated SQL has different meaning with the handwritten SQL --- (order clause with UNION). --- Such query cannot be expressed flatly with EDSL of HRR. --- --- 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') --- @ --- -union_6_4_1a_Flat :: Relation () (Maybe Int, Maybe Int) -union_6_4_1a_Flat = relation (do - e <- query employee - wheres $ #title e .=. just (value "Teller") - return $ just (#empId e) >< #assignedBranchId e - ) `union` relation (do - a <- query account - wheres $ #productCd a .=. value "SAV" - -- asc $ #openEmpId a - return $ #openEmpId a >< #openBranchId a - ) - --- | sql/8.1a.sh --- --- Handwritten SQL: --- --- @ --- SELECT open_emp_id, COUNT(*) how_many --- FROM LEARNINGSQL.account --- GROUP BY open_emp_id --- ORDER BY open_emp_id --- @ --- --- 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 --- @ --- -group_8_1a :: Relation () (Maybe Int, Int64) -group_8_1a = aggregateRelation $ do - a <- query account - g <- groupBy $ #openEmpId a - asc $ g - return $ g >< count (#accountId a) - --- | --- 9.4 Correlated Subqueries --- --- Handwritten 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); --- @ --- --- 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)) --- @ --- -customer_9_4 :: Relation () Customer1 -customer_9_4 = relation $ do - c <- query customer - ca <- queryScalar $ aggregatedUnique (relation $ do - a <- query account - wheres $ #custId a .=. #custId c - return (#accountId a) - ) id' count - wheres $ just (value (2 :: Int64)) .=. ca - return (customer1 c) - -data Customer1 = Customer1 - { c1Custid :: Int - , c1CustTypeCd :: String - , c1City :: Maybe String - } deriving (Show, Generic) - -customer1 :: SqlContext c - => Record c Customer -> Record c Customer1 -customer1 c = Customer1 |$| #custId c - |*| #custTypeCd c - |*| #city c - -$(makeRelationalRecord ''Customer1) - --- | --- (from script) The insert statement --- --- Handwritten SQL: --- --- @ --- INSERT INTO branch (branch_id, name, address, city, state, zip) --- VALUES (null, 'Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451'); --- @ --- --- Literal version of Generated SQL: --- --- @ --- INSERT INTO MAIN.branch (name, address, city, state, zip) --- VALUES ('Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451') --- @ --- -insertBranch_s1 :: Insert () -insertBranch_s1 = insertValueNoPH $ do - Branch.name' <-# value "Headquarters" - #address <-# value (Just "3882 Main St.") - #city <-# value (Just "Waltham") - #state <-# value (Just "MA") - #zip <-# value (Just "02451") - --- | --- Placeholder version of Generated SQL: --- --- @ --- INSERT INTO MAIN.branch (name, address, city, state, zip) --- VALUES (?, ?, ?, ?, ?) --- @ --- -insertBranch_s1P :: Insert Branch1 -insertBranch_s1P = insert piBranch1 - -piBranch1 :: Pi Branch Branch1 -piBranch1 = Branch1 |$| #name - |*| #address - |*| #city - |*| #state - |*| #zip - -data Branch1 = Branch1 - { b1Name :: String - , b1Address :: Maybe String - , b1City :: Maybe String - , b1State :: Maybe String - , b1Zip :: Maybe String - } deriving (Generic) - -$(makeRelationalRecord ''Branch1) - -branch1 :: Branch1 -branch1 = Branch1 - { b1Name = "Headquarters" - , b1Address = Just "3882 Main St." - , b1City = Just "Waltham" - , b1State = Just "MA" - , b1Zip = Just "02451" - } - --- | --- Literal version of Generated SQL: --- --- @ --- 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 record value directly as SQL row value. --- Above SQL is the same to the monadic building version. --- -insertBranch_s1R :: Insert () -insertBranch_s1R = insertValueNoPH $ do - piBranch1 <-# value Branch1 - { b1Name = "Headquarters" - , b1Address = Just "3882 Main St." - , b1City = Just "Waltham" - , b1State = Just "MA" - , b1Zip = Just "02451" - } - --- | --- Placeholder version of Generated SQL: --- --- @ --- INSERT INTO MAIN.branch (name, address, city, state, zip) --- VALUES (?, ?, ?, ?, ?) --- @ --- --- Thanks to generic-programing, it is possible to specify tuple type as Pi destination type. --- Above SQL is the same to ad-hoc defined record version. --- -insertBranch_s1PT :: Insert (String, Maybe String, Maybe String, Maybe String, Maybe String) -insertBranch_s1PT = insert piBranchTuple - -piBranchTuple :: Pi Branch (String, Maybe String, Maybe String, Maybe String, Maybe String) -piBranchTuple = (,,,,) - |$| #name - |*| #address - |*| #city - |*| #state - |*| #zip - -branchTuple :: (String, Maybe String, Maybe String, Maybe String, Maybe String) -branchTuple = ("Headquarters", - Just "3882 Main St.", - Just "Waltham", - Just "MA", - Just "02451") - - --- | --- (from script) The insert statement --- --- Handwritten 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')); --- @ --- --- Literal version of 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')) --- @ --- --- 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 = insertQuery piEmployee3 . relation $ do - d <- query department - b <- query branch - wheres $ #name d .=. value "Administration" - wheres $ #name b .=. value "Headquarters" - return $ Employee3 |$| value "Michael" - |*| value "Smith" - |*| unsafeSQLiteDayValue "2001-06-22" - |*| just (#deptId d) - |*| value (Just "President") - |*| just (#branchId b) - --- this is equal to `defineDirectPi [1,2,3,6,7,8]' -piEmployee3 :: Pi Employee Employee3 -piEmployee3 = Employee3 |$| #fname - |*| #lname - |*| #startDate - |*| #deptId - |*| #title - |*| #assignedBranchId - -data Employee3 = Employee3 - { e3Fname :: String - , e3Lname :: String - , e3StartDate :: Day - , e3DeptId :: Maybe Int - , e3Title :: Maybe String - , e3AssignedBranchId :: Maybe Int - } deriving (Generic) - -$(makeRelationalRecord ''Employee3) - --- | --- 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. --- --- Unsafe version of 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 --- @ --- -insertEmployee_s2U :: InsertQuery () -insertEmployee_s2U = insertQuery piEmployee3 . relation $ do - d <- queryScalar . unsafeUnique . relation $ do - d' <- query department - wheres $ #name d' .=. value "Administration" - return $ #deptId d' - b <- queryScalar . unsafeUnique . relation $ do - b' <- query branch - wheres $ #name b' .=. value "Headquarters" - return $ #branchId b' - return $ Employee3 |$| value "Michael" - |*| value "Smith" - |*| unsafeSQLiteDayValue "2001-06-22" - |*| d - |*| value (Just "President") - |*| b - --- 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 - } deriving (Generic) - -$(makeRelationalRecord ''Employee4) - --- | --- Placeholder version of 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')) --- @ --- -insertEmployee_s2P :: InsertQuery Employee4 -insertEmployee_s2P = insertQuery piEmployee3 . relation' $ do - d <- query department - b <- query branch - wheres $ #name d .=. value "Administration" - wheres $ #name b .=. value "Headquarters" - placeholder $ \ph -> - return $ Employee3 |$| (! #e4Fname) ph - |*| #e4Lname ph - |*| #e4StartDate ph - |*| just (#deptId d) - |*| #e4Title ph - |*| just (#branchId b) - -employee4 :: Employee4 -employee4 = Employee4 - { e4Fname = "Michael" - , e4Lname = "Smith" - , e4StartDate = read "2001-06-22" - , e4Title = Just "President" - } - --- | --- (original) Updating data --- --- Handwritten SQL: --- --- @ --- UPDATE employee --- SET lname = 'Bush', --- dept_id = 3 --- WHERE emp_id = 10; --- @ --- --- Generated SQL: --- --- @ --- UPDATE MAIN.employee SET lname = 'Bush', dept_id = 3 WHERE (emp_id --- = 10) --- @ --- -updateEmployee_o3 :: Update () -updateEmployee_o3 = updateNoPH $ \proj -> do - #lname <-# value "Bush" - #deptId <-# just (value 3) - wheres $ #empId (proj :: Record Flat Employee) .=. value 10 - --- | --- Placeholder version of Generated SQL: --- --- @ --- UPDATE MAIN.employee SET lname = ?, dept_id = ? WHERE (emp_id = ?) --- @ --- --- Note: This function is equal to the following: --- --- @ --- updateEmployee_o3P :: Update (String, Int, Int) --- updateEmployee_o3P = derivedUpdate $ \proj -> do --- (phLname,()) <- placeholder (\ph -> Employee.lname' <-# ph) --- (phDeptId,()) <- placeholder (\ph -> Employee.deptId' <-# just ph) --- (phEmpId,()) <- placeholder (\ph -> wheres $ proj ! Employee.empId' .=. ph) --- return $ (,,) |$| phLname |*| phDeptId |*| phEmpId --- @ --- -updateEmployee_o3P :: Update (String, Int, Int) -updateEmployee_o3P = update $ \proj -> do - (phLname,()) <- placeholder (\ph -> #lname <-# ph) - (phDeptId,()) <- placeholder (\ph -> #deptId <-# just ph) - (phEmpId,()) <- placeholder (\ph -> wheres $ #empId (proj :: Record Flat Employee) .=. ph) - return $ (,,) |$| phLname |*| phDeptId |*| phEmpId - --- | --- 9.4.2 Data Manipulation Using Correlated Subqueries --- --- Handwritten 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); --- @ --- --- 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))) --- @ --- -updateAccount_9_4_2 :: Update () -updateAccount_9_4_2 = updateNoPH $ \proj -> do - ts <- queryScalar $ aggregatedUnique (relation $ do - t <- query Transaction.transaction - wheres $ #accountId t .=. #accountId proj - return (#txnDate t) - ) id' max' - tl <- queryList $ relation $ do - t <- query Transaction.transaction - wheres $ #accountId t .=. #accountId proj - return (value (1 :: Int64)) - Account.lastActivityDate' <-# (toDay $ flattenMaybe ts) - wheres $ exists $ tl - -toDay :: SqlContext c => Record c (Maybe LocalTime) -> Record c (Maybe Day) -toDay dt = unsafeProjectSql $ "date(" ++ unsafeShowSql dt ++ ")" - --- | --- (original) Deleting data --- --- Handwritten SQL: --- --- @ --- DELETE FROM account --- WHERE account_id = 2; --- @ --- --- Generated SQL: --- --- @ --- DELETE FROM MAIN.account WHERE (account_id = 2) --- @ --- -deleteAccount_o1 :: Delete () -deleteAccount_o1 = deleteNoPH $ \proj -> do - wheres $ proj ! Account.accountId' .=. value 2 - --- | --- Placeholder version of Generated SQL: --- --- @ --- DELETE FROM MAIN.account WHERE (account_id = ?) --- @ --- --- Note: This function is equal to the following: --- --- @ --- deleteAccount_o1P :: Delete Int64 --- deleteAccount_o1P = derivedDelete $ \proj -> do --- fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) --- @ --- -deleteAccount_o1P :: Delete Int -deleteAccount_o1P = delete $ \proj -> do - fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) - --- | --- (original) Data modification using equality conditions --- --- Handwritten SQL: --- --- @ --- DELETE FROM account --- WHERE account_id >= 10 AND account_id <= 20; --- @ --- --- Generated SQL: --- --- @ --- DELETE FROM MAIN.account WHERE ((account_id >= 10) AND (account_id <= --- 20)) --- @ --- -deleteAccount_o2 :: Delete () -deleteAccount_o2 = deleteNoPH $ \proj' -> do - let proj = proj' :: Record Flat Account - wheres $ #accountId proj .>=. value 10 - wheres $ #accountId proj .<=. value 20 - --- | --- Placeholder version of Generated SQL: --- --- @ --- DELETE FROM MAIN.account WHERE ((account_id >= ?) AND (account_id <= --- ?)) --- @ --- -deleteAccount_o2P :: Delete (Int, Int) -deleteAccount_o2P = delete $ \proj' -> do - let proj = proj' :: Record Flat Account - (phMin,()) <- placeholder (\ph -> wheres $ #accountId proj .>=. ph) - (phMax,()) <- placeholder (\ph -> wheres $ #accountId proj .<=. ph) - return (phMin >< phMax) - --- | --- 9.4.2 Data manipulation using correlated subqueries --- --- Handwritten SQL: --- --- @ --- DELETE FROM department d --- WHERE NOT EXISTS (SELECT 1 --- FROM employee e --- WHERE e.dept_id = d.dept_id); --- @ --- --- Generated SQL: --- --- @ --- DELETE FROM MAIN.department WHERE (NOT (EXISTS (SELECT ALL 1 AS f0 --- FROM MAIN.employee T0 WHERE (T0.dept_id = dept_id)))) --- @ --- -deleteEmployee_9_4_2 :: Delete () -deleteEmployee_9_4_2 = deleteNoPH $ \proj -> do - el <- queryList $ relation $ do - e <- query employee - wheres $ #deptId e .=. just (#deptId (proj :: Record Flat Department)) - return (value (1 :: Int64)) - wheres $ not' . exists $ el - --- --- run and print sql --- - -run :: (Show a, IConnection conn, FromSql SqlValue a, ToSql SqlValue p) - => conn -> p -> Relation p a -> IO () -run conn param rel = do - putStrLn $ "SQL: " ++ show rel - records <- runRelation conn rel param - mapM_ print records - putStrLn "" - -runI :: (IConnection conn, ToSql SqlValue p) - => conn -> p -> Insert p -> IO () -runI conn param ins = do - putStrLn $ "SQL: " ++ show ins - num <- runInsert conn ins param - print num - putStrLn "" - rollback conn - -runIQ :: (IConnection conn, ToSql SqlValue p) - => conn -> p -> InsertQuery p -> IO () -runIQ conn param ins = do - putStrLn $ "SQL: " ++ show ins - num <- runInsertQuery conn ins param - print num - putStrLn "" - rollback conn - -runU :: (IConnection conn, ToSql SqlValue p) - => conn -> p -> Update p -> IO () -runU conn param upd = do - putStrLn $ "SQL: " ++ show upd - num <- runUpdate conn upd param - print num - putStrLn "" - rollback conn - -runD :: (IConnection conn, ToSql SqlValue p) - => conn -> p -> Delete p -> IO () -runD conn param dlt = do - putStrLn $ "SQL: " ++ show dlt - num <- runDelete conn dlt param - print num - putStrLn "" - rollback conn - -main :: IO () -main = handleSqlError' $ withConnectionIO (connectSqlite3 "examples.db") $ \conn -> do - run conn () allAccount - run conn () account_3_7 - run conn () account_3_7_1 - run conn () employee_3_7_3 - run conn () employee_4_1_2 - run conn (read "2003-01-01") employee_4_1_2P - run conn () employee_4_3_2 - run conn (read "2001-01-01", read "2003-01-01") employee_4_3_2P - run conn () account_4_3_3a - run conn () account_4_3_3aT - run conn () account_4_3_3aR - run conn () account_9_1 - run conn "ACCOUNT" account_4_3_3b - run conn "ACCOUNT" account_4_3_3bT - run conn "ACCOUNT" account_4_3_3bR - run conn () account_4_3_3c - run conn () join_5_1_2a - run conn () join_5_1_2aT - run conn () account_LeftOuterJoin - putStrLn $ "SQL: " ++ show business_RightOuterJoin -- right join is not supported by SQLite3 - run conn () join_5_1_3 - run conn () selfJoin_5_3a - run conn () selfJoin_5_3aT - run conn () union_6_4_1a_Nest - run conn () union_6_4_1a_Flat - run conn () group_8_1a - run conn () customer_9_4 - runI conn () insertBranch_s1 - runI conn branch1 insertBranch_s1P - runI conn () insertBranch_s1R - runI conn branchTuple insertBranch_s1PT - runIQ conn () insertEmployee_s2 - runIQ conn () insertEmployee_s2U - runIQ conn employee4 insertEmployee_s2P - runU conn () updateEmployee_o3 - runU conn ("Bush", 3, 10) updateEmployee_o3P - runU conn () updateAccount_9_4_2 - runD conn () deleteAccount_o1 - runD conn 2 deleteAccount_o1P - runD conn () deleteAccount_o2 - runD conn (10,20) deleteAccount_o2P - runD conn () deleteEmployee_9_4_2 diff --git a/src/specializedExamples.hs b/src/specializedExamples.hs deleted file mode 100644 --- a/src/specializedExamples.hs +++ /dev/null @@ -1,1360 +0,0 @@ -{-# OPTIONS_GHC -Wno-unused-top-binds #-} -{-# LANGUAGE MonadComprehensions #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DataKinds #-} - -import Database.Relational.Query.SQLite3 - -import GHC.Generics (Generic) -import Prelude hiding (product) -import Data.Int (Int64) -import Data.Time (Day, LocalTime) -import Data.Functor.ProductIsomorphic ((|$|), (|*|)) - -import qualified Account -import Account (Account, account) -import qualified Branch -import Branch (Branch, branch) -import qualified Business -import Business (business) -import qualified Customer -import Customer (Customer, customer) -import qualified Department -import Department (Department, department) -import qualified Individual -import Individual (individual) ---import qualified Officer ---import Officer (Officer, Officer) -import qualified Product -import Product (product) ---import qualified ProductType ---import ProductType (ProductType, productType) -import qualified Transaction --- import Transaction (transaction) -import qualified Employee -import Employee (Employee, employee) - -allAccount :: Relation () Account -allAccount = relation $ query account - --- | sql/3.7 --- --- Handwritten SQL: --- --- @ --- SELECT open_emp_id, product_cd --- FROM account --- ORDER BY open_emp_id, product_cd --- @ --- --- 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 --- @ --- -account_3_7 :: Relation () (Maybe Int, String) -account_3_7 = relation $ do - a <- query account - let proj = (,) |$| a ! Account.openEmpId' - |*| a ! Account.productCd' - asc proj - return proj - --- | sql/3.7.1 --- --- Handwritten SQL: --- --- @ --- SELECT account_id, product_cd, open_date, avail_balance --- FROM account --- ORDER BY avail_balance DESC --- @ --- --- 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 --- @ --- -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) - --- | sql/3.7.3 --- --- 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. --- --- Handwritten SQL: --- --- @ --- SELECT emp_id, title, start_date, fname, lname --- FROM employee --- ORDER BY 2,5 --- @ --- --- 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 --- @ --- -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 :: Int - , e1Title :: Maybe String - , e1StartDate :: Day - , e1Fname :: String - , e1Lname' :: String - } deriving (Show, Generic) - -$(makeRelationalRecord ''Employee1) - --- | sql/4.1.2 --- --- 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. --- --- Handwritten SQL: --- --- @ --- SELECT * --- FROM employee --- WHERE end_date IS NULL AND (title = 'Teller' OR start_date < '2003-01-01') --- @ --- --- Literal version of 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'))) --- @ --- -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 :: SqlContext c => String -> Record c Day -unsafeSQLiteDayValue = unsafeProjectSqlTerms . showConstantTermsSQL - --- | --- Another way, use a placeholder instead of a date literal. --- There is no need to define a helper function. --- --- Placeholder version of 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 < ?))) --- @ --- -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 - --- | sql/4.3.2 --- --- Handwritten SQL: --- --- @ --- SELECT emp_id, fname, lname, start_date FROM employee --- WHERE start_date --- BETWEEN date('2001-01-01') AND date('2002-12-31') --- @ --- --- Literal version of 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')) --- @ --- -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' - --- | --- Placeholder version of Generated SQL: --- --- 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 <= ?)) --- @ --- --- NOTE: Be careful on the order of the placeholders. You must give day --- values in order that they appear on the generated SQL. --- -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 - -data Employee2 = Employee2 - { e2EmpId :: Int - , e2Fname :: String - , e2Lname :: String - , e2StartDate :: Day - } deriving (Show, Generic) - -$(makeRelationalRecord ''Employee2) - --- | sql/4.3.3a.sh --- --- Handwritten SQL: --- --- @ --- SELECT account_id, product_cd, cust_id, avail_balance --- FROM LEARNINGSQL.account --- WHERE product_cd IN ('CHK', 'SAV', 'CD', 'MM') --- @ --- --- record version of 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')) --- @ --- -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 - --- | --- tuple version of 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')) --- @ --- -account_4_3_3aT :: Relation () (Int, String, Int, Maybe Double) -account_4_3_3aT = relation $ do - a <- query account - wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"] - return $ (,,,) |$| a ! Account.accountId' |*| a ! Account.productCd' |*| a ! Account.custId' |*| a ! Account.availBalance' - --- | --- Adhoc defined record version of 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')) --- @ --- --- Above sql is the same to the tuple version. --- -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' - -data Account1 = Account1 - { a1AccountId :: Int - , a1ProductCd :: String - , a1CustId :: Int - , a1AvailBalance :: Maybe Double - } deriving (Show, Generic) - -$(makeRelationalRecord ''Account1) - --- | --- 9.1 What is a subquery? --- --- Handwritten SQL: --- --- @ --- SELECT account_id, product_cd, cust_id, avail_balance --- FROM account --- WHERE account_id = (SELECT MAX(account_id) --- FROM account); --- @ --- --- 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)) --- @ --- -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' - --- | sql/4.3.3b.sh --- --- Handwritten 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') --- @ --- --- Record version of 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 = ?))) --- @ --- -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) - --- | --- Tuple version of 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 --- (SELECT ALL T1.product_cd AS f0 FROM MAIN.product T1 WHERE --- (T1.product_type_cd = ?))) --- @ --- -account_4_3_3bT :: Relation String (Int, String, Int, Maybe Double) -account_4_3_3bT = relation' $ do - a <- query account - (phProductCd,p) <- queryList' product_4_3_3b - wheres $ a ! Account.productCd' `in'` p - let at = (,,,) |$| a ! Account.accountId' |*| a ! Account.productCd' |*| a ! Account.custId' |*| a ! Account.availBalance' - return (phProductCd, at) - --- | --- Adhoc record version of 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 --- (SELECT ALL T1.product_cd AS f0 FROM MAIN.product T1 WHERE --- (T1.product_type_cd = ?))) --- @ --- -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) - -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' - --- | sql/4.3.3c.sh --- --- Handwritten SQL: --- --- @ --- SELECT account_id, product_cd, cust_id, avail_balance --- FROM LEARNINGSQL.account --- WHERE product_cd NOT IN ('CHK', 'SAV', 'CD', 'MM') --- @ --- --- 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'))) --- @ --- -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 - --- | sql/5.1.2a.sh --- --- Handwritten SQL: --- --- @ --- SELECT e.fname, e.lname, d.name --- FROM LEARNINGSQL.employee e INNER JOIN LEARNINGSQL.department d --- USING (dept_id) --- @ --- --- Record version of 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, --- T1.dept_id AS f9, T1.name AS f10 FROM MAIN.employee T0 INNER JOIN --- MAIN.department T1 ON (T0.dept_id = T1.dept_id) --- @ --- -join_5_1_2a :: Relation () (Employee, Department) -join_5_1_2a = relation $ do - e <- query employee - d <- query department - on $ e ! Employee.deptId' .=. just (d ! Department.deptId') - return $ e >< d - --- | --- Tuple version of 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) --- @ --- -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' - --- | --- Left Outer Join --- --- Handwritten 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 --- @ --- --- 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) --- @ --- -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 :: Int - , a4CustId :: Int - , a4Fname :: Maybe String - , a4Lname :: Maybe String - } deriving (Show, Generic) - -$(makeRelationalRecord ''Account4) - --- | --- Right Outer Join --- --- Handwritten SQL: --- --- @ --- SELECT c.cust_id, b.name --- FROM customer c RIGHT OUTER JOIN business b --- ON c.cust_id = b.cust_id --- @ --- --- 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. --- -business_RightOuterJoin :: Relation () (Maybe Int, 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') - --- | sql/5.1.3.sh --- --- Handwritten 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' --- @ --- --- 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'))) --- @ --- -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 - { a3AccountId :: Int - , a3CustId :: Int - , a3OpenDate :: Day - , a3ProductCd :: String - } deriving (Show, Generic) - -$(makeRelationalRecord ''Account3) - --- | sql/5.3a.sh --- --- Handwritten SQL: --- --- @ --- SELECT e.fname, e.lname, e_mgr.fname mgr_fname, e_mgr.lname mgr_lname --- FROM LEARNINGSQL.employee e INNER JOIN LEARNINGSQL.employee e_mgr --- ON e.superior_emp_id = e_mgr.emp_id --- @ --- --- Record version of 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, --- T1.emp_id AS f9, T1.fname AS f10, T1.lname AS f11, T1.start_date AS --- f12, T1.end_date AS f13, T1.superior_emp_id AS f14, T1.dept_id AS f15, --- T1.title AS f16, T1.assigned_branch_id AS f17 FROM MAIN.employee T0 --- INNER JOIN MAIN.employee T1 ON (T0.superior_emp_id = T1.emp_id) --- @ --- -selfJoin_5_3a :: Relation () (Employee, Employee) -selfJoin_5_3a = relation $ do - e <- query employee - m <- query employee - on $ e ! Employee.superiorEmpId' .=. just (m ! Employee.empId') - return $ e >< m - --- | --- Tuple version of 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) --- @ --- -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 - --- | sql/6.4.1a.sh --- --- The standard SQL allows the syntax of UNION that has an order clause --- at the last of query. Unfortunately, HRR dows not support. In addition, --- HRR put a select statement having an order clause into parentheses. --- If you want to sort whole row returned from UNION, place a order --- clouse outside of the union relation. --- --- Handwritten SQL: --- --- @ --- SELECT emp_id, assigned_branch_id --- FROM LEARNINGSQL.employee --- WHERE title = 'Teller' --- UNION --- SELECT open_emp_id, open_branch_id --- FROM LEARNINGSQL.account --- WHERE product_cd = 'SAV' --- ORDER BY open_emp_id --- @ --- --- 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 --- @ --- -employee_6_4_1a :: Relation () (Maybe Int, Maybe Int) -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 Int, Maybe Int) -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 Int, Maybe Int) -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 has different meaning with the handwritten SQL --- (order clause with UNION). --- Such query cannot be expressed flatly with EDSL of HRR. --- --- 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') --- @ --- -union_6_4_1a_Flat :: Relation () (Maybe Int, Maybe Int) -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" - -- asc $ a ! Account.openEmpId' - return $ a ! Account.openEmpId' >< a ! Account.openBranchId' - ) - --- | sql/8.1a.sh --- --- Handwritten SQL: --- --- @ --- SELECT open_emp_id, COUNT(*) how_many --- FROM LEARNINGSQL.account --- GROUP BY open_emp_id --- ORDER BY open_emp_id --- @ --- --- 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 --- @ --- -group_8_1a :: Relation () (Maybe Int, Int64) -group_8_1a = aggregateRelation $ do - a <- query account - g <- groupBy $ a ! Account.openEmpId' - asc $ g ! id' - return $ g >< count (a ! Account.accountId') - --- | --- 9.4 Correlated Subqueries --- --- Handwritten 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); --- @ --- --- 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)) --- @ --- -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 :: Int - , c1CustTypeCd :: String - , c1City :: Maybe String - } deriving (Show, Generic) - -customer1 :: SqlContext c - => Record c Customer -> Record c Customer1 -customer1 c = Customer1 |$| c ! Customer.custId' - |*| c ! Customer.custTypeCd' - |*| c ! Customer.city' - -$(makeRelationalRecord ''Customer1) - --- | --- (from script) The insert statement --- --- Handwritten SQL: --- --- @ --- INSERT INTO branch (branch_id, name, address, city, state, zip) --- VALUES (null, 'Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451'); --- @ --- --- Literal version of Generated SQL: --- --- @ --- INSERT INTO MAIN.branch (name, address, city, state, zip) --- VALUES ('Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451') --- @ --- -insertBranch_s1 :: Insert () -insertBranch_s1 = insertValueNoPH $ 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") - --- | --- Placeholder version of Generated SQL: --- --- @ --- INSERT INTO MAIN.branch (name, address, city, state, zip) --- VALUES (?, ?, ?, ?, ?) --- @ --- -insertBranch_s1P :: Insert Branch1 -insertBranch_s1P = insert 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) - -branch1 :: Branch1 -branch1 = Branch1 - { b1Name = "Headquarters" - , b1Address = Just "3882 Main St." - , b1City = Just "Waltham" - , b1State = Just "MA" - , b1Zip = Just "02451" - } - --- | --- Literal version of Generated SQL: --- --- @ --- 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 record value directly as SQL row value. --- Above SQL is the same to the monadic building version. --- -insertBranch_s1R :: Insert () -insertBranch_s1R = insertValueNoPH $ do - piBranch1 <-# value Branch1 - { b1Name = "Headquarters" - , b1Address = Just "3882 Main St." - , b1City = Just "Waltham" - , b1State = Just "MA" - , b1Zip = Just "02451" - } - --- | --- Placeholder version of Generated SQL: --- --- @ --- INSERT INTO MAIN.branch (name, address, city, state, zip) --- VALUES (?, ?, ?, ?, ?) --- @ --- --- Thanks to generic-programing, it is possible to specify tuple type as Pi destination type. --- Above SQL is the same to ad-hoc defined record version. --- -insertBranch_s1PT :: Insert (String, Maybe String, Maybe String, Maybe String, Maybe String) -insertBranch_s1PT = insert piBranchTuple - -piBranchTuple :: Pi Branch (String, Maybe String, Maybe String, Maybe String, Maybe String) -piBranchTuple = (,,,,) - |$| Branch.name' - |*| Branch.address' - |*| Branch.city' - |*| Branch.state' - |*| Branch.zip' - -branchTuple :: (String, Maybe String, Maybe String, Maybe String, Maybe String) -branchTuple = ("Headquarters", - Just "3882 Main St.", - Just "Waltham", - Just "MA", - Just "02451") - - --- | --- (from script) The insert statement --- --- Handwritten 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')); --- @ --- --- Literal version of 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')) --- @ --- --- 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 = insertQuery 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 Int - , e3Title :: Maybe String - , e3AssignedBranchId :: Maybe Int - } deriving (Generic) - -$(makeRelationalRecord ''Employee3) - --- | --- 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. --- --- Unsafe version of 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 --- @ --- -insertEmployee_s2U :: InsertQuery () -insertEmployee_s2U = insertQuery 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 - --- 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 - } deriving (Generic) - -$(makeRelationalRecord ''Employee4) - --- | --- Placeholder version of 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')) --- @ --- -insertEmployee_s2P :: InsertQuery Employee4 -insertEmployee_s2P = insertQuery 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" - } - --- | --- (original) Updating data --- --- Handwritten SQL: --- --- @ --- UPDATE employee --- SET lname = 'Bush', --- dept_id = 3 --- WHERE emp_id = 10; --- @ --- --- Generated SQL: --- --- @ --- UPDATE MAIN.employee SET lname = 'Bush', dept_id = 3 WHERE (emp_id --- = 10) --- @ --- -updateEmployee_o3 :: Update () -updateEmployee_o3 = updateNoPH $ \proj -> do - Employee.lname' <-# value "Bush" - Employee.deptId' <-# just (value 3) - wheres $ proj ! Employee.empId' .=. value 10 - --- | --- Placeholder version of Generated SQL: --- --- @ --- UPDATE MAIN.employee SET lname = ?, dept_id = ? WHERE (emp_id = ?) --- @ --- --- Note: This function is equal to the following: --- --- @ --- updateEmployee_o3P :: Update (String, Int, Int) --- updateEmployee_o3P = derivedUpdate $ \proj -> do --- (phLname,()) <- placeholder (\ph -> Employee.lname' <-# ph) --- (phDeptId,()) <- placeholder (\ph -> Employee.deptId' <-# just ph) --- (phEmpId,()) <- placeholder (\ph -> wheres $ proj ! Employee.empId' .=. ph) --- return $ (,,) |$| phLname |*| phDeptId |*| phEmpId --- @ --- -updateEmployee_o3P :: Update (String, Int, Int) -updateEmployee_o3P = update $ \proj -> do - (phLname,()) <- placeholder (\ph -> Employee.lname' <-# ph) - (phDeptId,()) <- placeholder (\ph -> Employee.deptId' <-# just ph) - (phEmpId,()) <- placeholder (\ph -> wheres $ proj ! Employee.empId' .=. ph) - return $ (,,) |$| phLname |*| phDeptId |*| phEmpId - --- | --- 9.4.2 Data Manipulation Using Correlated Subqueries --- --- Handwritten 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); --- @ --- --- 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))) --- @ --- -updateAccount_9_4_2 :: Update () -updateAccount_9_4_2 = updateNoPH $ \proj -> do - ts <- queryScalar $ aggregatedUnique (relation $ do - t <- query Transaction.transaction - wheres $ t ! Transaction.accountId' .=. proj ! Account.accountId' - return (t ! Transaction.txnDate') - ) id' max' - tl <- queryList $ relation $ do - t <- query Transaction.transaction - wheres $ t ! Transaction.accountId' .=. proj ! Account.accountId' - return (value (1 :: Int64)) - Account.lastActivityDate' <-# (toDay $ flattenMaybe ts) - wheres $ exists $ tl - -toDay :: SqlContext c => Record c (Maybe LocalTime) -> Record c (Maybe Day) -toDay dt = unsafeProjectSql $ "date(" ++ unsafeShowSql dt ++ ")" - --- | --- (original) Deleting data --- --- Handwritten SQL: --- --- @ --- DELETE FROM account --- WHERE account_id = 2; --- @ --- --- Generated SQL: --- --- @ --- DELETE FROM MAIN.account WHERE (account_id = 2) --- @ --- -deleteAccount_o1 :: Delete () -deleteAccount_o1 = deleteNoPH $ \proj -> do - wheres $ proj ! Account.accountId' .=. value 2 - --- | --- Placeholder version of Generated SQL: --- --- @ --- DELETE FROM MAIN.account WHERE (account_id = ?) --- @ --- --- Note: This function is equal to the following: --- --- @ --- deleteAccount_o1P :: Delete Int64 --- deleteAccount_o1P = derivedDelete $ \proj -> do --- fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) --- @ --- -deleteAccount_o1P :: Delete Int -deleteAccount_o1P = delete $ \proj -> do - fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) - --- | --- (original) Data modification using equality conditions --- --- Handwritten SQL: --- --- @ --- DELETE FROM account --- WHERE account_id >= 10 AND account_id <= 20; --- @ --- --- Generated SQL: --- --- @ --- DELETE FROM MAIN.account WHERE ((account_id >= 10) AND (account_id <= --- 20)) --- @ --- -deleteAccount_o2 :: Delete () -deleteAccount_o2 = deleteNoPH $ \proj -> do - wheres $ proj ! Account.accountId' .>=. value 10 - wheres $ proj ! Account.accountId' .<=. value 20 - --- | --- Placeholder version of Generated SQL: --- --- @ --- DELETE FROM MAIN.account WHERE ((account_id >= ?) AND (account_id <= --- ?)) --- @ --- -deleteAccount_o2P :: Delete (Int, Int) -deleteAccount_o2P = delete $ \proj -> do - (phMin,()) <- placeholder (\ph -> wheres $ proj ! Account.accountId' .>=. ph) - (phMax,()) <- placeholder (\ph -> wheres $ proj ! Account.accountId' .<=. ph) - return (phMin >< phMax) - --- | --- 9.4.2 Data manipulation using correlated subqueries --- --- Handwritten SQL: --- --- @ --- DELETE FROM department d --- WHERE NOT EXISTS (SELECT 1 --- FROM employee e --- WHERE e.dept_id = d.dept_id); --- @ --- --- Generated SQL: --- --- @ --- DELETE FROM MAIN.department WHERE (NOT (EXISTS (SELECT ALL 1 AS f0 --- FROM MAIN.employee T0 WHERE (T0.dept_id = dept_id)))) --- @ --- -deleteEmployee_9_4_2 :: Delete () -deleteEmployee_9_4_2 = deleteNoPH $ \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 - --- --- run and print sql --- - -run :: (Show a, IConnection conn, FromSql SqlValue a, ToSql SqlValue p) - => conn -> p -> Relation p a -> IO () -run conn param rel = do - putStrLn $ "SQL: " ++ show rel - records <- runRelation conn rel param - mapM_ print records - putStrLn "" - -runI :: (IConnection conn, ToSql SqlValue p) - => conn -> p -> Insert p -> IO () -runI conn param ins = do - putStrLn $ "SQL: " ++ show ins - num <- runInsert conn ins param - print num - putStrLn "" - rollback conn - -runIQ :: (IConnection conn, ToSql SqlValue p) - => conn -> p -> InsertQuery p -> IO () -runIQ conn param ins = do - putStrLn $ "SQL: " ++ show ins - num <- runInsertQuery conn ins param - print num - putStrLn "" - rollback conn - -runU :: (IConnection conn, ToSql SqlValue p) - => conn -> p -> Update p -> IO () -runU conn param upd = do - putStrLn $ "SQL: " ++ show upd - num <- runUpdate conn upd param - print num - putStrLn "" - rollback conn - -runD :: (IConnection conn, ToSql SqlValue p) - => conn -> p -> Delete p -> IO () -runD conn param dlt = do - putStrLn $ "SQL: " ++ show dlt - num <- runDelete conn dlt param - print num - putStrLn "" - rollback conn - -main :: IO () -main = handleSqlError' $ withConnectionIO (connectSqlite3 "examples.db") $ \conn -> do - run conn () allAccount - run conn () account_3_7 - run conn () account_3_7_1 - run conn () employee_3_7_3 - run conn () employee_4_1_2 - run conn (read "2003-01-01") employee_4_1_2P - run conn () employee_4_3_2 - run conn (read "2001-01-01", read "2003-01-01") employee_4_3_2P - run conn () account_4_3_3a - run conn () account_4_3_3aT - run conn () account_4_3_3aR - run conn () account_9_1 - run conn "ACCOUNT" account_4_3_3b - run conn "ACCOUNT" account_4_3_3bT - run conn "ACCOUNT" account_4_3_3bR - run conn () account_4_3_3c - run conn () join_5_1_2a - run conn () join_5_1_2aT - run conn () account_LeftOuterJoin - putStrLn $ "SQL: " ++ show business_RightOuterJoin -- right join is not supported by SQLite3 - run conn () join_5_1_3 - run conn () selfJoin_5_3a - run conn () selfJoin_5_3aT - run conn () union_6_4_1a_Nest - run conn () union_6_4_1a_Flat - run conn () group_8_1a - run conn () customer_9_4 - runI conn () insertBranch_s1 - runI conn branch1 insertBranch_s1P - runI conn () insertBranch_s1R - runI conn branchTuple insertBranch_s1PT - runIQ conn () insertEmployee_s2 - runIQ conn () insertEmployee_s2U - runIQ conn employee4 insertEmployee_s2P - runU conn () updateEmployee_o3 - runU conn ("Bush", 3, 10) updateEmployee_o3P - runU conn () updateAccount_9_4_2 - runD conn () deleteAccount_o1 - runD conn 2 deleteAccount_o1P - runD conn () deleteAccount_o2 - runD conn (10,20) deleteAccount_o2P - runD conn () deleteEmployee_9_4_2