mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-10-26 10:18:01 +03:00
relational-record-examples: call macros first to fit TH restrictions
This commit is contained in:
parent
ba0a125b5f
commit
0f0a1a2198
@ -61,6 +61,17 @@ account_3_7 = relation $ do
|
||||
asc proj
|
||||
return proj
|
||||
|
||||
-----
|
||||
|
||||
data Account2 = Account2
|
||||
{ a2AccountId :: Int
|
||||
, a2ProductCd :: String
|
||||
, a2OpenDate :: Day
|
||||
, a2AvailBalance :: Maybe Double
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Account2)
|
||||
|
||||
-- | sql/3.7.1
|
||||
--
|
||||
-- Handwritten SQL:
|
||||
@ -88,14 +99,17 @@ account_3_7_1 = relation $ do
|
||||
|*| #openDate a
|
||||
|*| #availBalance a
|
||||
|
||||
data Account2 = Account2
|
||||
{ a2AccountId :: Int
|
||||
, a2ProductCd :: String
|
||||
, a2OpenDate :: Day
|
||||
, a2AvailBalance :: Maybe Double
|
||||
-----
|
||||
|
||||
data Employee1 = Employee1
|
||||
{ e1EmpId :: Int
|
||||
, e1Title :: Maybe String
|
||||
, e1StartDate :: Day
|
||||
, e1Fname :: String
|
||||
, e1Lname' :: String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Account2)
|
||||
$(makeRelationalRecord ''Employee1)
|
||||
|
||||
-- | sql/3.7.3
|
||||
--
|
||||
@ -130,16 +144,6 @@ employee_3_7_3 = relation $ do
|
||||
|*| #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'.
|
||||
@ -199,6 +203,17 @@ employee_4_1_2P = relation' . placeholder $ \ph -> do
|
||||
`or'` #startDate e .<. ph
|
||||
return e
|
||||
|
||||
-----
|
||||
|
||||
data Employee2 = Employee2
|
||||
{ e2EmpId :: Int
|
||||
, e2Fname :: String
|
||||
, e2Lname :: String
|
||||
, e2StartDate :: Day
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Employee2)
|
||||
|
||||
-- | sql/4.3.2
|
||||
--
|
||||
-- Handwritten SQL:
|
||||
@ -252,15 +267,6 @@ employee_4_3_2P = relation' . placeholder $ \ph -> do
|
||||
|*| #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:
|
||||
@ -302,6 +308,17 @@ account_4_3_3aT = relation $ do
|
||||
wheres $ #productCd a `in'` values ["CHK", "SAV", "CD", "MM"]
|
||||
return $ (,,,) |$| #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)
|
||||
|
||||
-- |
|
||||
-- Adhoc defined record version of Generated SQL:
|
||||
--
|
||||
@ -322,15 +339,6 @@ account_4_3_3aR = relation $ do
|
||||
|*| #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?
|
||||
--
|
||||
@ -504,6 +512,17 @@ join_5_1_2aT = relation $ do
|
||||
on $ #deptId e .=. just (#deptId d)
|
||||
return $ (,,) |$| #fname e |*| #lname e |*| #name d
|
||||
|
||||
-----
|
||||
|
||||
data Account4 = Account4
|
||||
{ a4AccountId :: Int
|
||||
, a4CustId :: Int
|
||||
, a4Fname :: Maybe String
|
||||
, a4Lname :: Maybe String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Account4)
|
||||
|
||||
-- |
|
||||
-- Left Outer Join
|
||||
--
|
||||
@ -532,15 +551,6 @@ account_LeftOuterJoin = relation $ do
|
||||
|*| (? #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
|
||||
--
|
||||
@ -569,6 +579,17 @@ business_RightOuterJoin = relation $ do
|
||||
on $ (? #custId) c .=. just (#custId b)
|
||||
return ((? #custId) c >< #name b)
|
||||
|
||||
-----
|
||||
|
||||
data Account3 = Account3
|
||||
{ a3AccountId :: Int
|
||||
, a3CustId :: Int
|
||||
, a3OpenDate :: Day
|
||||
, a3ProductCd :: String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Account3)
|
||||
|
||||
-- | sql/5.1.3
|
||||
--
|
||||
-- Handwritten SQL:
|
||||
@ -612,15 +633,6 @@ join_5_1_3 = relation $ do
|
||||
|*| #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:
|
||||
@ -768,6 +780,16 @@ group_8_1a = aggregateRelation $ do
|
||||
asc $ g
|
||||
return $ g >< count (#accountId a)
|
||||
|
||||
-----
|
||||
|
||||
data Customer1 = Customer1
|
||||
{ c1Custid :: Int
|
||||
, c1CustTypeCd :: String
|
||||
, c1City :: Maybe String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Customer1)
|
||||
|
||||
-- |
|
||||
-- 9.4 Correlated Subqueries
|
||||
--
|
||||
@ -801,20 +823,12 @@ customer_9_4 = relation $ do
|
||||
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
|
||||
--
|
||||
@ -840,6 +854,18 @@ insertBranch_s1 = insertValueNoPH $ do
|
||||
#state <-# value (Just "MA")
|
||||
#zip <-# value (Just "02451")
|
||||
|
||||
-----
|
||||
|
||||
data Branch1 = Branch1
|
||||
{ b1Name :: String
|
||||
, b1Address :: Maybe String
|
||||
, b1City :: Maybe String
|
||||
, b1State :: Maybe String
|
||||
, b1Zip :: Maybe String
|
||||
} deriving (Generic)
|
||||
|
||||
$(makeRelationalRecord ''Branch1)
|
||||
|
||||
-- |
|
||||
-- Placeholder version of Generated SQL:
|
||||
--
|
||||
@ -858,16 +884,6 @@ piBranch1 = Branch1 |$| #name
|
||||
|*| #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"
|
||||
@ -927,6 +943,18 @@ branchTuple = ("Headquarters",
|
||||
Just "MA",
|
||||
Just "02451")
|
||||
|
||||
-----
|
||||
|
||||
data Employee3 = Employee3
|
||||
{ e3Fname :: String
|
||||
, e3Lname :: String
|
||||
, e3StartDate :: Day
|
||||
, e3DeptId :: Maybe Int
|
||||
, e3Title :: Maybe String
|
||||
, e3AssignedBranchId :: Maybe Int
|
||||
} deriving (Generic)
|
||||
|
||||
$(makeRelationalRecord ''Employee3)
|
||||
|
||||
-- |
|
||||
-- (from script) The insert statement
|
||||
@ -978,17 +1006,6 @@ piEmployee3 = Employee3 |$| #fname
|
||||
|*| #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
|
||||
@ -1022,6 +1039,8 @@ insertEmployee_s2U = insertQuery piEmployee3 . relation $ do
|
||||
|*| 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
|
||||
|
@ -66,6 +66,17 @@ account_3_7 = relation $ do
|
||||
asc proj
|
||||
return proj
|
||||
|
||||
-----
|
||||
|
||||
data Account2 = Account2
|
||||
{ a2AccountId :: Int
|
||||
, a2ProductCd :: String
|
||||
, a2OpenDate :: Day
|
||||
, a2AvailBalance :: Maybe Double
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Account2)
|
||||
|
||||
-- | sql/3.7.1
|
||||
--
|
||||
-- Handwritten SQL:
|
||||
@ -93,14 +104,17 @@ account_3_7_1 = relation $ do
|
||||
|*| a ! Account.openDate'
|
||||
|*| a ! Account.availBalance'
|
||||
|
||||
data Account2 = Account2
|
||||
{ a2AccountId :: Int
|
||||
, a2ProductCd :: String
|
||||
, a2OpenDate :: Day
|
||||
, a2AvailBalance :: Maybe Double
|
||||
-----
|
||||
|
||||
data Employee1 = Employee1
|
||||
{ e1EmpId :: Int
|
||||
, e1Title :: Maybe String
|
||||
, e1StartDate :: Day
|
||||
, e1Fname :: String
|
||||
, e1Lname' :: String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Account2)
|
||||
$(makeRelationalRecord ''Employee1)
|
||||
|
||||
-- | sql/3.7.3
|
||||
--
|
||||
@ -135,16 +149,6 @@ employee_3_7_3 = relation $ do
|
||||
|*| 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'.
|
||||
@ -204,6 +208,17 @@ employee_4_1_2P = relation' . placeholder $ \ph -> do
|
||||
`or'` e ! Employee.startDate' .<. ph
|
||||
return e
|
||||
|
||||
-----
|
||||
|
||||
data Employee2 = Employee2
|
||||
{ e2EmpId :: Int
|
||||
, e2Fname :: String
|
||||
, e2Lname :: String
|
||||
, e2StartDate :: Day
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Employee2)
|
||||
|
||||
-- | sql/4.3.2
|
||||
--
|
||||
-- Handwritten SQL:
|
||||
@ -257,15 +272,6 @@ employee_4_3_2P = relation' . placeholder $ \ph -> do
|
||||
|*| 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:
|
||||
@ -307,6 +313,17 @@ account_4_3_3aT = relation $ do
|
||||
wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"]
|
||||
return $ (,,,) |$| 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)
|
||||
|
||||
-- |
|
||||
-- Adhoc defined record version of Generated SQL:
|
||||
--
|
||||
@ -327,15 +344,6 @@ account_4_3_3aR = relation $ do
|
||||
|*| 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?
|
||||
--
|
||||
@ -509,6 +517,17 @@ join_5_1_2aT = relation $ do
|
||||
on $ e ! Employee.deptId' .=. just (d ! Department.deptId')
|
||||
return $ (,,) |$| e ! Employee.fname' |*| e ! Employee.lname' |*| d ! Department.name'
|
||||
|
||||
-----
|
||||
|
||||
data Account4 = Account4
|
||||
{ a4AccountId :: Int
|
||||
, a4CustId :: Int
|
||||
, a4Fname :: Maybe String
|
||||
, a4Lname :: Maybe String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Account4)
|
||||
|
||||
-- |
|
||||
-- Left Outer Join
|
||||
--
|
||||
@ -537,15 +556,6 @@ account_LeftOuterJoin = relation $ do
|
||||
|*| 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
|
||||
--
|
||||
@ -574,6 +584,17 @@ business_RightOuterJoin = relation $ do
|
||||
on $ c ?! Customer.custId' .=. just (b ! Business.custId')
|
||||
return (c ?! Customer.custId' >< b ! Business.name')
|
||||
|
||||
-----
|
||||
|
||||
data Account3 = Account3
|
||||
{ a3AccountId :: Int
|
||||
, a3CustId :: Int
|
||||
, a3OpenDate :: Day
|
||||
, a3ProductCd :: String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Account3)
|
||||
|
||||
-- | sql/5.1.3
|
||||
--
|
||||
-- Handwritten SQL:
|
||||
@ -617,15 +638,6 @@ join_5_1_3 = relation $ do
|
||||
|*| 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:
|
||||
@ -773,6 +785,16 @@ group_8_1a = aggregateRelation $ do
|
||||
asc $ g ! id'
|
||||
return $ g >< count (a ! Account.accountId')
|
||||
|
||||
-----
|
||||
|
||||
data Customer1 = Customer1
|
||||
{ c1Custid :: Int
|
||||
, c1CustTypeCd :: String
|
||||
, c1City :: Maybe String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
$(makeRelationalRecord ''Customer1)
|
||||
|
||||
-- |
|
||||
-- 9.4 Correlated Subqueries
|
||||
--
|
||||
@ -806,20 +828,12 @@ customer_9_4 = relation $ do
|
||||
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
|
||||
--
|
||||
@ -845,6 +859,18 @@ insertBranch_s1 = insertValueNoPH $ do
|
||||
Branch.state' <-# value (Just "MA")
|
||||
Branch.zip' <-# value (Just "02451")
|
||||
|
||||
-----
|
||||
|
||||
data Branch1 = Branch1
|
||||
{ b1Name :: String
|
||||
, b1Address :: Maybe String
|
||||
, b1City :: Maybe String
|
||||
, b1State :: Maybe String
|
||||
, b1Zip :: Maybe String
|
||||
} deriving (Generic)
|
||||
|
||||
$(makeRelationalRecord ''Branch1)
|
||||
|
||||
-- |
|
||||
-- Placeholder version of Generated SQL:
|
||||
--
|
||||
@ -863,16 +889,6 @@ piBranch1 = Branch1 |$| Branch.name'
|
||||
|*| 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"
|
||||
@ -932,6 +948,18 @@ branchTuple = ("Headquarters",
|
||||
Just "MA",
|
||||
Just "02451")
|
||||
|
||||
-----
|
||||
|
||||
data Employee3 = Employee3
|
||||
{ e3Fname :: String
|
||||
, e3Lname :: String
|
||||
, e3StartDate :: Day
|
||||
, e3DeptId :: Maybe Int
|
||||
, e3Title :: Maybe String
|
||||
, e3AssignedBranchId :: Maybe Int
|
||||
} deriving (Generic)
|
||||
|
||||
$(makeRelationalRecord ''Employee3)
|
||||
|
||||
-- |
|
||||
-- (from script) The insert statement
|
||||
@ -983,17 +1011,6 @@ piEmployee3 = Employee3 |$| Employee.fname'
|
||||
|*| 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
|
||||
@ -1027,6 +1044,8 @@ insertEmployee_s2U = insertQuery piEmployee3 . relation $ do
|
||||
|*| 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
|
||||
|
Loading…
Reference in New Issue
Block a user