From 8f33fa72ad1cbabb6d4416d6a2731f8f8e8479d8 Mon Sep 17 00:00:00 2001 From: Shohei Murayama Date: Thu, 11 Dec 2014 17:35:33 +0900 Subject: [PATCH] update examples to use sqlite3 --- doc/examples/Account.hs | 6 +- doc/examples/Branch.hs | 6 +- doc/examples/Business.hs | 6 +- doc/examples/Customer.hs | 6 +- doc/examples/DataSource.hs | 29 ++++-- doc/examples/Department.hs | 6 +- doc/examples/Employee.hs | 6 +- doc/examples/Individual.hs | 6 +- doc/examples/Officer.hs | 6 +- doc/examples/Product.hs | 6 +- doc/examples/ProductType.hs | 6 +- doc/examples/Query.hs | 199 ++++++++++++++++-------------------- doc/examples/Transaction.hs | 10 +- doc/examples/sql/add.sql | 22 ++-- 14 files changed, 156 insertions(+), 164 deletions(-) diff --git a/doc/examples/Account.hs b/doc/examples/Account.hs index b9c2a0d8..ba369be5 100644 --- a/doc/examples/Account.hs +++ b/doc/examples/Account.hs @@ -5,7 +5,7 @@ module Account where import Prelude hiding (id) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "account" [derivingShow]) +$(defineTable convTypes + "main" "account" [derivingShow]) diff --git a/doc/examples/Branch.hs b/doc/examples/Branch.hs index 40fab493..3af58542 100644 --- a/doc/examples/Branch.hs +++ b/doc/examples/Branch.hs @@ -5,7 +5,7 @@ module Branch where import Prelude hiding (id, zip) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "branch" [derivingShow]) +$(defineTable convTypes + "main" "branch" [derivingShow]) diff --git a/doc/examples/Business.hs b/doc/examples/Business.hs index 4c96036c..fc1f73d7 100644 --- a/doc/examples/Business.hs +++ b/doc/examples/Business.hs @@ -5,7 +5,7 @@ module Business where import Prelude hiding (id) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "business" [derivingShow]) +$(defineTable convTypes + "main" "business" [derivingShow]) diff --git a/doc/examples/Customer.hs b/doc/examples/Customer.hs index 4ce21dcb..0a807e01 100644 --- a/doc/examples/Customer.hs +++ b/doc/examples/Customer.hs @@ -5,7 +5,7 @@ module Customer where import Prelude hiding (id) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "customer" [derivingShow]) +$(defineTable convTypes + "main" "customer" [derivingShow]) diff --git a/doc/examples/DataSource.hs b/doc/examples/DataSource.hs index 5ceb263d..1881ce1b 100644 --- a/doc/examples/DataSource.hs +++ b/doc/examples/DataSource.hs @@ -1,19 +1,32 @@ +{-# LANGUAGE TemplateHaskell #-} + module DataSource ( - connect, defineTable + connect, convTypes, defineTable ) where -import Language.Haskell.TH (Q, Dec, TypeQ) -import Database.HDBC.PostgreSQL (connectPostgreSQL, Connection) -import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL) -import Database.HDBC.Schema.Driver (typeMap) -import Language.Haskell.TH.Name.CamelCase (ConName) +import Data.Int (Int32) +import Data.Time (Day, LocalTime) import Database.HDBC.Query.TH (defineTableFromDB) +import Database.HDBC.Schema.SQLite3 (driverSQLite3) +import Database.HDBC.Schema.Driver (typeMap) +import Database.HDBC.Sqlite3 (Connection, connectSqlite3) +import Language.Haskell.TH (Q, Dec, TypeQ) +import Language.Haskell.TH.Name.CamelCase (ConName) connect :: IO Connection -connect = connectPostgreSQL "dbname=testdb" +connect = connectSqlite3 "test.db" + +convTypes :: [(String, TypeQ)] +convTypes = + [ ("float", [t|Double|]) + , ("date", [t|Day|]) + , ("datetime", [t|LocalTime|]) + , ("double", [t|Double|]) + , ("varchar", [t|String|]) + ] defineTable :: [(String, TypeQ)] -> String -> String -> [ConName] -> Q [Dec] defineTable tmap = defineTableFromDB connect - (driverPostgreSQL { typeMap = tmap }) + (driverSQLite3 { typeMap = tmap }) diff --git a/doc/examples/Department.hs b/doc/examples/Department.hs index 09960425..ecf19d61 100644 --- a/doc/examples/Department.hs +++ b/doc/examples/Department.hs @@ -5,7 +5,7 @@ module Department where import Prelude hiding (id) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "department" [derivingShow]) +$(defineTable convTypes + "main" "department" [derivingShow]) diff --git a/doc/examples/Employee.hs b/doc/examples/Employee.hs index 3a67abc1..0c929bb7 100644 --- a/doc/examples/Employee.hs +++ b/doc/examples/Employee.hs @@ -5,7 +5,7 @@ module Employee where import Prelude hiding (id) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "employee" [derivingShow]) +$(defineTable convTypes + "main" "employee" [derivingShow]) diff --git a/doc/examples/Individual.hs b/doc/examples/Individual.hs index 55360e75..fc6a8516 100644 --- a/doc/examples/Individual.hs +++ b/doc/examples/Individual.hs @@ -5,7 +5,7 @@ module Individual where import Prelude hiding (id) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "individual" [derivingShow]) +$(defineTable convTypes + "main" "individual" [derivingShow]) diff --git a/doc/examples/Officer.hs b/doc/examples/Officer.hs index 9bab5105..336b29b4 100644 --- a/doc/examples/Officer.hs +++ b/doc/examples/Officer.hs @@ -5,7 +5,7 @@ module Officer where import Prelude hiding (id) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "officer" [derivingShow]) +$(defineTable convTypes + "main" "officer" [derivingShow]) diff --git a/doc/examples/Product.hs b/doc/examples/Product.hs index 29545e60..b493fc81 100644 --- a/doc/examples/Product.hs +++ b/doc/examples/Product.hs @@ -6,7 +6,7 @@ module Product where import Prelude hiding (id, product) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "product" [derivingShow]) +$(defineTable convTypes + "main" "product" [derivingShow]) diff --git a/doc/examples/ProductType.hs b/doc/examples/ProductType.hs index fa3b0f44..a22b6d61 100644 --- a/doc/examples/ProductType.hs +++ b/doc/examples/ProductType.hs @@ -6,7 +6,7 @@ module ProductType where import Prelude hiding (id) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "product_type" [derivingShow]) +$(defineTable convTypes + "main" "product_type" [derivingShow]) diff --git a/doc/examples/Query.hs b/doc/examples/Query.hs index 2757296e..40474fd9 100644 --- a/doc/examples/Query.hs +++ b/doc/examples/Query.hs @@ -5,28 +5,28 @@ import Database.Record import Database.Relational.Query import Database.HDBC (IConnection, SqlValue) -import Data.Int (Int32, Int64) +import Data.Int (Int64) import qualified Account import Account (Account(..), account) -import qualified Customer -import Customer (Customer, customer) -import qualified Individual -import Individual (Individual, individual) -import qualified ProductType -import ProductType (ProductType, productType) -import qualified Branch -import Branch (Branch, Branch) -import qualified Officer -import Officer (Officer, Officer) -import qualified Transaction -import Transaction (Transaction, transaction) -import qualified Business -import Business (Business, business) +--import qualified Customer +--import Customer (Customer, customer) +--import qualified Individual +--import Individual (Individual, individual) +--import qualified ProductType +--import ProductType (ProductType, productType) +--import qualified Branch +--import Branch (Branch, Branch) +--import qualified Officer +--import Officer (Officer, Officer) +--import qualified Transaction +--import Transaction (Transaction, transaction) +--import qualified Business +--import Business (Business, business) import qualified Department import Department (Department, department) -import qualified Product -import Product (Product, product) +--import qualified Product +--import Product (Product, product) import qualified Employee import Employee (Employee, employee) @@ -35,11 +35,7 @@ import Database.HDBC.Record.Query (runQuery) import Database.HDBC.Session (withConnectionIO, handleSqlError') allAccount :: Relation () Account -allAccount = - relation - [ a - | a <- query account - ] +allAccount = relation $ query account -- sql/4.3.3a.sh -- @@ -50,20 +46,16 @@ allAccount = -- @ -- account1 :: Relation () Account -account1 = - relation - [ a - | a <- query account - , () <- wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"] - ] +account1 = relation $ do + a <- query account + wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"] + return a -account1' :: Relation () (((Int32, String), Int32), Maybe Double) -account1' = - relation - [ a ! Account.accountId' >< a ! Account.productCd' >< a ! Account.custId' >< a ! Account.availBalance' - | a <- query account - , () <- wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"] - ] +account1' :: Relation () (((Int64, String), Int64), Maybe Double) +account1' = 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' -- | sql/5.1.2a.sh -- @@ -74,22 +66,18 @@ account1' = -- @ -- join1 :: Relation () (Employee, Department) -join1 = - relation - [ e >< d - | e <- query employee - , d <- query department - , () <- on $ e ! Employee.deptId' .=. just (d ! Department.deptId') - ] +join1 = relation $ do + e <- query employee + d <- query department + on $ e ! Employee.deptId' .=. just (d ! Department.deptId') + return $ e >< d join1' :: Relation () ((String, String), String) -join1' = - relation - [ e ! Employee.fname' >< e ! Employee.lname' >< d ! Department.name' - | e <- query employee - , d <- query department - , () <- on $ e ! Employee.deptId' .=. just (d ! Department.deptId') - ] +join1' = 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' -- | sql/5.3a.sh -- @@ -100,24 +88,20 @@ join1' = -- @ -- selfJoin1 :: Relation () (Employee, Employee) -selfJoin1 = - relation - [ e >< m - | e <- query employee - , m <- query employee - , () <- on $ e ! Employee.superiorEmpId' .=. just (m ! Employee.empId') - ] +selfJoin1 = relation $ do + e <- query employee + m <- query employee + on $ e ! Employee.superiorEmpId' .=. just (m ! Employee.empId') + return $ e >< m selfJoin1' :: Relation () ((String, String), (String, String)) -selfJoin1' = - relation - [ emp >< mgr - | 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' - ] +selfJoin1' = 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 -- @@ -132,46 +116,34 @@ selfJoin1' = -- ORDER BY open_emp_id -- @ -- -employee1 :: Relation () (Maybe Int32, Maybe Int32) -employee1 = - relation - [ just (e ! Employee.empId') >< e ! Employee.assignedBranchId' - | e <- query employee - , () <- wheres $ e ! Employee.title' .=. just (value "Teller") - ] +employee1 :: Relation () (Maybe Int64, Maybe Int64) +employee1 = relation $ do + e <- query employee + wheres $ e ! Employee.title' .=. just (value "Teller") + return $ just (e ! Employee.empId') >< e ! Employee.assignedBranchId' -account2 :: Relation () (Maybe Int32, Maybe Int32) -account2 = - relation - [ a ! Account.openEmpId' >< a ! Account.openBranchId' - | a <- query account - , () <- wheres $ a ! Account.productCd' .=. value "SAV" - ] +account2 :: Relation () (Maybe Int64, Maybe Int64) +account2 = relation $ do + a <- query account + wheres $ a ! Account.productCd' .=. value "SAV" + return $ a ! Account.openEmpId' >< a ! Account.openBranchId' -union1 :: Relation () (Maybe Int32, Maybe Int32) -union1 = - relation - [ ea - | ea <- query $ employee1 `union` account2 - , () <- asc $ ea ! fst' - ] +union1 :: Relation () (Maybe Int64, Maybe Int64) +union1 = relation $ do + ea <- query $ employee1 `union` account2 + asc $ ea ! fst' + return ea -union1' :: Relation () (Maybe Int32, Maybe Int32) -union1' = - relation - [ ea - | ea <- query $ relation - [ just (e ! Employee.empId') >< e ! Employee.assignedBranchId' - | e <- query employee - , () <- wheres $ e ! Employee.title' .=. just (value "Teller") - ] - `union` relation - [ a ! Account.openEmpId' >< a ! Account.openBranchId' - | a <- query account - , () <- wheres $ a ! Account.productCd' .=. value "SAV" - ] - , () <- asc $ ea ! fst' - ] +union1' :: Relation () (Maybe Int64, Maybe Int64) +union1' = relation (do + e <- query employee + wheres $ e ! Employee.title' .=. just (value "Teller") + return $ just (e ! Employee.empId') >< e ! Employee.assignedBranchId' + ) `union` relation (do + a <- query account + wheres $ a ! Account.productCd' .=. value "SAV" + return $ a ! Account.openEmpId' >< a ! Account.openBranchId' + ) -- | sql/8.1a.sh -- @@ -182,14 +154,16 @@ union1' = -- ORDER BY open_emp_id -- @ -- -group1 :: Relation () (Maybe Int32, Int64) -group1 = - aggregateRelation - [ g >< count a - | a <- query account - , g <- groupBy $ a ! Account.openEmpId' - , () <- asc $ g ! id' - ] +group1 :: Relation () (Maybe Int64, Int64) +group1 = aggregateRelation $ do + a <- query account + g <- groupBy $ a ! Account.openEmpId' + asc $ g ! id' + return $ g >< count (a ! Account.accountId') + +-- +-- run and print sql +-- runAndPrint :: (Show a, IConnection conn, FromSql SqlValue a, ToSql SqlValue p) => conn -> Relation p a -> p -> IO () @@ -210,6 +184,7 @@ main = handleSqlError' $ withConnectionIO connect $ \conn -> do run join1' () run selfJoin1 () run selfJoin1' () - run union1 () - run union1' () + --run union1 () + --run union1' () run group1 () + diff --git a/doc/examples/Transaction.hs b/doc/examples/Transaction.hs index 89c3be43..2750bd98 100644 --- a/doc/examples/Transaction.hs +++ b/doc/examples/Transaction.hs @@ -5,7 +5,11 @@ module Transaction where import Prelude hiding (id) import Database.Record.TH (derivingShow) -import DataSource (defineTable) +import DataSource (convTypes, defineTable) -$(defineTable [] - "LEARNINGSQL" "transaction" [derivingShow]) +$(defineTable convTypes + "main" "transaction0" [derivingShow]) + +type Transaction = Transaction0 + +transaction = transaction0 diff --git a/doc/examples/sql/add.sql b/doc/examples/sql/add.sql index 73e3cc67..0d2681ad 100644 --- a/doc/examples/sql/add.sql +++ b/doc/examples/sql/add.sql @@ -27,10 +27,10 @@ create table employee lname varchar(20) not null, start_date date not null, end_date date, - superior_emp_id smallint unsigned, - dept_id smallint unsigned, + superior_emp_id integer, + dept_id integer, title varchar(20), - assigned_branch_id smallint unsigned, + assigned_branch_id integer, constraint fk_e_emp_id foreign key (superior_emp_id) references employee (emp_id), constraint fk_dept_id @@ -87,7 +87,7 @@ create table business create table officer (officer_id integer primary key autoincrement not null, - cust_id integer unsigned not null, + cust_id integer not null, fname varchar(30) not null, lname varchar(30) not null, title varchar(20), @@ -100,13 +100,13 @@ create table officer create table account (account_id integer primary key autoincrement not null, product_cd varchar(10) not null, - cust_id integer unsigned not null, + cust_id integer not null, open_date date not null, close_date date, last_activity_date date, - status integer not null, - open_branch_id smallint unsigned, - open_emp_id smallint unsigned, + status text not null, + open_branch_id integer, + open_emp_id integer, avail_balance float(10,2), pending_balance float(10,2), check(status = 'ACTIVE' or status = 'CLOSED' or status = 'FROZEN') @@ -123,11 +123,11 @@ create table account create table transaction0 (txn_id integer primary key autoincrement not null, txn_date datetime not null, - account_id integer unsigned not null, + account_id integer not null, txn_type_cd text not null, amount double(10,2) not null, - teller_emp_id smallint unsigned, - execution_branch_id smallint unsigned, + teller_emp_id integer, + execution_branch_id integer, funds_avail_date datetime, check (txn_type_cd = 'DBT' or txn_type_cd = 'CDT'), constraint fk_t_account_id foreign key (account_id)