update examples to use sqlite3

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "account" [derivingShow])
+  "main" "account" [derivingShow])

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "branch" [derivingShow])
+  "main" "branch" [derivingShow])

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "business" [derivingShow])
+  "main" "business" [derivingShow])

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "customer" [derivingShow])
+  "main" "customer" [derivingShow])

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 Data.Int (Int32)
-import Database.HDBC.PostgreSQL (connectPostgreSQL, Connection)
+import Data.Time (Day, LocalTime)
-import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL)
-import Database.HDBC.Schema.Driver (typeMap)
-import Language.Haskell.TH.Name.CamelCase (ConName)
 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 })

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "department" [derivingShow])
+  "main" "department" [derivingShow])

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "employee" [derivingShow])
+  "main" "employee" [derivingShow])

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "individual" [derivingShow])
+  "main" "individual" [derivingShow])

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "officer" [derivingShow])
+  "main" "officer" [derivingShow])

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "product" [derivingShow])
+  "main" "product" [derivingShow])

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "product_type" [derivingShow])
+  "main" "product_type" [derivingShow])

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 qualified Customer
-import Customer (Customer, customer)
+--import Customer (Customer, customer)
-import qualified Individual
+--import qualified Individual
-import Individual (Individual, individual)
+--import Individual (Individual, individual)
-import qualified ProductType
+--import qualified ProductType
-import ProductType (ProductType, productType)
+--import ProductType (ProductType, productType)
-import qualified Branch
+--import qualified Branch
-import Branch (Branch, Branch)
+--import Branch (Branch, Branch)
-import qualified Officer
+--import qualified Officer
-import Officer (Officer, Officer)
+--import Officer (Officer, Officer)
-import qualified Transaction
+--import qualified Transaction
-import Transaction (Transaction, transaction)
+--import Transaction (Transaction, transaction)
-import qualified Business
+--import qualified Business
-import Business (Business, business)
+--import Business (Business, business)
 import qualified Department
 import Department (Department, department)
-import qualified Product
+--import qualified Product
-import Product (Product, 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 =
+allAccount = relation $ query account
-  relation
-  [ a
-  | a  <- query account
-  ]
 
 -- sql/4.3.3a.sh
 --
@@ -50,20 +46,16 @@ allAccount =
 -- @
 --
 account1 :: Relation () Account
-account1 =
+account1 = relation $ do
-  relation
+  a  <- query account
-  [ a
+  wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"]
-  | a  <- query account
+  return a
-  , () <- wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"]
-  ]
 
-account1' :: Relation () (((Int32, String), Int32), Maybe Double)
+account1' :: Relation () (((Int64, String), Int64), Maybe Double)
-account1' =
+account1' = relation $ do
-  relation
+  a  <- query account
-  [ a ! Account.accountId' >< a ! Account.productCd' >< a ! Account.custId' >< a ! Account.availBalance'
+  wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"]
-  | a  <- query account
+  return $ a ! Account.accountId' >< a ! Account.productCd' >< a ! Account.custId' >< a ! Account.availBalance'
-  , () <- wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"]
-  ]
 
 -- | sql/5.1.2a.sh
 --
@@ -74,22 +66,18 @@ account1' =
 -- @
 --
 join1 :: Relation () (Employee, Department)
-join1 =
+join1 = relation $ do
-  relation
+  e  <- query employee
-  [ e >< d
+  d  <- query department
-  | e  <- query employee
+  on $ e ! Employee.deptId' .=. just (d ! Department.deptId')
-  , d  <- query department
+  return $ e >< d
-  , () <- on $ e ! Employee.deptId' .=. just (d ! Department.deptId')
-  ]
 
 join1' :: Relation () ((String, String), String)
-join1' =
+join1' = relation $ do
-  relation
+  e  <- query employee
-  [ e ! Employee.fname' >< e ! Employee.lname' >< d ! Department.name'
+  d  <- query department
-  | e  <- query employee
+  on $ e ! Employee.deptId' .=. just (d ! Department.deptId')
-  , d  <- query department
+  return $ e ! Employee.fname' >< e ! Employee.lname' >< d ! Department.name'
-  , () <- on $ e ! Employee.deptId' .=. just (d ! Department.deptId')
-  ]
 
 -- | sql/5.3a.sh
 --
@@ -100,24 +88,20 @@ join1' =
 -- @
 --
 selfJoin1 :: Relation () (Employee, Employee)
-selfJoin1 =
+selfJoin1 = relation $ do
-  relation
+  e  <- query employee
-  [ e >< m
+  m  <- query employee
-  | e  <- query employee
+  on $ e ! Employee.superiorEmpId' .=. just (m ! Employee.empId')
-  , m  <- query employee
+  return $ e >< m
-  , () <- on $ e ! Employee.superiorEmpId' .=. just (m ! Employee.empId')
-  ]
 
 selfJoin1' :: Relation () ((String, String), (String, String))
-selfJoin1' =
+selfJoin1' = relation $ do
-  relation
+  e  <- query employee
-  [ emp >< mgr
+  m  <- query employee
-  | e  <- query employee
+  on $ e ! Employee.superiorEmpId' .=. just (m ! Employee.empId')
-  , m  <- query employee
+  let emp = e ! Employee.fname' >< e ! Employee.lname'
-  , () <- on $ e ! Employee.superiorEmpId' .=. just (m ! Employee.empId')
+  let mgr = m ! Employee.fname' >< m ! Employee.lname'
-  , let emp = e ! Employee.fname' >< e ! Employee.lname'
+  return $ emp >< mgr
-  , let mgr = m ! Employee.fname' >< m ! Employee.lname'
-  ]
 
 -- | sql/6.4.1a.sh
 --
@@ -132,46 +116,34 @@ selfJoin1' =
 --   ORDER BY open_emp_id
 -- @
 --
-employee1 :: Relation () (Maybe Int32, Maybe Int32)
+employee1 :: Relation () (Maybe Int64, Maybe Int64)
-employee1 =
+employee1 = relation $ do
-  relation
+  e  <- query employee
-  [ just (e ! Employee.empId') >< e ! Employee.assignedBranchId'
+  wheres $ e ! Employee.title' .=. just (value "Teller")
-  | e  <- query employee
+  return $ just (e ! Employee.empId') >< e ! Employee.assignedBranchId'
-  , () <- wheres $ e ! Employee.title' .=. just (value "Teller")
-  ]
 
-account2 :: Relation () (Maybe Int32, Maybe Int32)
+account2 :: Relation () (Maybe Int64, Maybe Int64)
-account2 =
+account2 = relation $ do
-  relation
+  a  <- query account
-  [ a ! Account.openEmpId' >< a ! Account.openBranchId'
+  wheres $ a ! Account.productCd' .=. value "SAV"
-  | a  <- query account
+  return $ a ! Account.openEmpId' >< a ! Account.openBranchId'
-  , () <- wheres $ a ! Account.productCd' .=. value "SAV"
-  ]
 
-union1 :: Relation () (Maybe Int32, Maybe Int32)
+union1 :: Relation () (Maybe Int64, Maybe Int64)
-union1 =
+union1 = relation $ do
-  relation
+  ea <- query $ employee1 `union` account2
-  [ ea
+  asc $ ea ! fst'
-  | ea <- query $ employee1 `union` account2
+  return ea
-  , () <- asc $ ea ! fst'
-  ]
 
-union1' :: Relation () (Maybe Int32, Maybe Int32)
+union1' :: Relation () (Maybe Int64, Maybe Int64)
-union1' =
+union1' = relation (do
-  relation
+    e  <- query employee
-  [ ea
+    wheres $ e ! Employee.title' .=. just (value "Teller")
-  | ea <- query $ relation
+    return $ just (e ! Employee.empId') >< e ! Employee.assignedBranchId'
-          [ just (e ! Employee.empId') >< e ! Employee.assignedBranchId'
+  ) `union` relation (do
-          | e  <- query employee
+    a  <- query account
-          , () <- wheres $ e ! Employee.title' .=. just (value "Teller")
+    wheres $ a ! Account.productCd' .=. value "SAV"
-          ]
+    return $ a ! Account.openEmpId' >< a ! Account.openBranchId'
-          `union` relation
+  )
-          [ a ! Account.openEmpId' >< a ! Account.openBranchId'
-          | a  <- query account
-          , () <- wheres $ a ! Account.productCd' .=. value "SAV"
-          ]
-  , () <- asc $ ea ! fst'
-  ]
 
 -- | sql/8.1a.sh
 --
@@ -182,14 +154,16 @@ union1' =
 --   ORDER BY open_emp_id
 -- @
 --
-group1 :: Relation () (Maybe Int32, Int64)
+group1 :: Relation () (Maybe Int64, Int64)
-group1 =
+group1 = aggregateRelation $ do
-  aggregateRelation
+  a  <- query account
-  [ g >< count a
+  g  <- groupBy $ a ! Account.openEmpId'
-  | a  <- query account
+  asc $ g ! id'
-  , g  <- groupBy $ a ! Account.openEmpId'
+  return $ g >< count (a ! Account.accountId')
-  , () <- asc $ g ! id'
+
-  ]
+--
+-- 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 ()
+

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 []
+$(defineTable convTypes
-  "LEARNINGSQL" "transaction" [derivingShow])
+  "main" "transaction0" [derivingShow])
+
+type Transaction = Transaction0
+
+transaction = transaction0

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,
+  superior_emp_id integer,
-  dept_id smallint unsigned,
+  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,
+  status text not null,
-  open_branch_id smallint unsigned,
+  open_branch_id integer,
-  open_emp_id smallint unsigned,
+  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,
+  teller_emp_id integer,
-  execution_branch_id smallint unsigned,
+  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)