relational-record-examples 0.6.0.0 → 0.6.0.1
raw patch · 4 files changed
+219/−179 lines, 4 files
Files
- mains/examples.hs +106/−87
- mains/specializedExamples.hs +106/−87
- relational-record-examples.cabal +6/−4
- sql/5.3a.sh +1/−1
mains/examples.hs view
@@ -61,6 +61,17 @@ 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 @@ |*| #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 @@ |*| #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 @@ `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:@@ -213,15 +228,15 @@ -- -- @ -- 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'))+-- T0.start_date AS f3 FROM MAIN.employee T0 WHERE+-- ((T0.start_date >= '2001-01-01') AND (T0.start_date <= '2002-12-31')) -- @ -- 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"+ wheres $ #startDate e .<=. unsafeSQLiteDayValue "2002-12-31" return $ Employee2 |$| #empId e |*| #fname e |*| #lname e@@ -234,8 +249,8 @@ -- -- @ -- 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 <= ?))+-- 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@@ -252,15 +267,6 @@ |*| #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 @@ 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 @@ |*| #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 @@ 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 @@ |*| (? #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 @@ 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 @@ |*| #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:@@ -671,7 +683,7 @@ -- | 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,+-- at the last of query. Unfortunately, HRR does 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.@@ -768,6 +780,16 @@ 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 @@ 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 @@ #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 @@ |*| #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,7 +943,19 @@ 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 @@ |*| #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@@ -1021,6 +1038,8 @@ |*| d |*| value (Just "President") |*| b++----- -- place the definition of Employee4 that contains template-haskell, before -- insertEmployee_s2P uses the function to be generated.
mains/specializedExamples.hs view
@@ -66,6 +66,17 @@ 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 @@ |*| 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 @@ |*| 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 @@ `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:@@ -218,15 +233,15 @@ -- -- @ -- 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'))+-- T0.start_date AS f3 FROM MAIN.employee T0 WHERE+-- ((T0.start_date >= '2001-01-01') AND (T0.start_date <= '2002-12-31')) -- @ -- 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"+ wheres $ e ! Employee.startDate' .<=. unsafeSQLiteDayValue "2002-12-31" return $ Employee2 |$| e ! Employee.empId' |*| e ! Employee.fname' |*| e ! Employee.lname'@@ -239,8 +254,8 @@ -- -- @ -- 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 <= ?))+-- 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@@ -257,15 +272,6 @@ |*| 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 @@ 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 @@ |*| 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 @@ 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 @@ |*| 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 @@ 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 @@ |*| 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:@@ -676,7 +688,7 @@ -- | 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,+-- at the last of query. Unfortunately, HRR does 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.@@ -773,6 +785,16 @@ 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 @@ 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 @@ 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 @@ |*| 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,7 +948,19 @@ 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 @@ |*| 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@@ -1026,6 +1043,8 @@ |*| d |*| value (Just "President") |*| b++----- -- place the definition of Employee4 that contains template-haskell, before -- insertEmployee_s2P uses the function to be generated.
relational-record-examples.cabal view
@@ -1,5 +1,5 @@ name: relational-record-examples-version: 0.6.0.0+version: 0.6.0.1 synopsis: Examples of Haskell Relationa Record description: Provides examples of Haskell Relational Record license: BSD3@@ -68,7 +68,9 @@ ghc-options: -Wall if impl(ghc >= 8)- ghc-options: -Wcompat -Wnoncanonical-monadfail-instances+ ghc-options: -Wcompat+ if impl(ghc >= 8) && impl(ghc < 8.8)+ ghc-options: -Wnoncanonical-monadfail-instances default-language: Haskell2010 @@ -90,7 +92,7 @@ ghc-options: -Wall if impl(ghc >= 8)- ghc-options: -Wcompat -Wnoncanonical-monadfail-instances+ ghc-options: -Wcompat default-language: Haskell2010 @@ -112,6 +114,6 @@ ghc-options: -Wall if impl(ghc >= 8)- ghc-options: -Wcompat -Wnoncanonical-monadfail-instances+ ghc-options: -Wcompat default-language: Haskell2010
sql/5.3a.sh view
@@ -2,7 +2,7 @@ # Self-join -sqlite3 exmaples.db "+sqlite3 examples.db " SELECT e.fname, e.lname, e_mgr.fname mgr_fname, e_mgr.lname mgr_lname FROM employee e INNER JOIN employee e_mgr ON e.superior_emp_id = e_mgr.emp_id