adding examples.

doc/examples/Account.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module Account where
+
+import Prelude hiding (id)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "account" [derivingShow])

doc/examples/Branch.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module Branch where
+
+import Prelude hiding (id, zip)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "branch" [derivingShow])

doc/examples/Business.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module Business where
+
+import Prelude hiding (id)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "business" [derivingShow])

doc/examples/Customer.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module Customer where
+
+import Prelude hiding (id)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "customer" [derivingShow])

doc/examples/DataSource.hs

@@ -0,0 +1,20 @@
+module DataSource (
+    connect, 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 Database.HDBC.Query.TH (defineTableFromDB)
+
+connect :: IO Connection
+connect = connectPostgreSQL "dbname=testdb"
+
+defineTable :: [(String, TypeQ)] -> String -> String -> [ConName] -> Q [Dec]
+defineTable tmap scm tbl derives = do
+  defineTableFromDB
+    connect
+    (driverPostgreSQL { typeMap = tmap })
+    scm tbl derives

doc/examples/Department.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module Department where
+
+import Prelude hiding (id)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "department" [derivingShow])

doc/examples/Employee.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module Employee where
+
+import Prelude hiding (id)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "employee" [derivingShow])

doc/examples/Individual.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module Individual where
+
+import Prelude hiding (id)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "individual" [derivingShow])

doc/examples/Officer.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module Officer where
+
+import Prelude hiding (id)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "officer" [derivingShow])

doc/examples/Product.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
+module Product where
+
+import Prelude hiding (id, product)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "product" [derivingShow])

doc/examples/ProductType.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
+module ProductType where
+
+import Prelude hiding (id)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "product_type" [derivingShow])

doc/examples/Query.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+import Database.Record
+
+import Database.Relational.Query
+import Database.HDBC (IConnection, SqlValue)
+import Data.Int (Int32)
+
+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 Department
+import Department (Department, department)
+import qualified Product
+import Product (Product, product)
+import qualified Employee
+import Employee (Employee, employee)
+
+import DataSource (connect)
+import Database.HDBC.Record.Query
+  (ExecutedStatement,
+   runQuery, prepare, bindTo, execute, fetchUnique, fetchUnique')
+import Database.HDBC.Session (withConnectionIO, handleSqlError')
+
+allAccount :: Relation () (Account)
+allAccount =
+  relation $
+  [ a
+  | a  <- query account
+  ]
+
+join1 =
+  relation $
+  [ e >< d
+  | e <- query employee
+  , d <- query department
+  , () <- on $ e ! Employee.deptId' .=. d ! Department.deptId'
+  ]
+
+main :: IO ()
+main = do
+    print allAccount
+    handleSqlError' $ withConnectionIO connect $ \conn -> do
+        as <- runQuery conn () (fromRelation allAccount)
+        mapM_ print as

doc/examples/Transaction.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module Transaction where
+
+import Prelude hiding (id)
+import Database.Record.TH (derivingShow)
+
+import DataSource (defineTable)
+
+$(defineTable []
+  "LEARNINGSQL" "transaction" [derivingShow])

doc/examples/sql/add.sql

@@ -31,10 +31,10 @@ create table LEARNINGSQL.employee
   lname varchar(20) not null,
   start_date date not null,
   end_date date,
-  superior_emp_id smallint,
-  dept_id smallint,
+  superior_emp_id integer,
+  dept_id integer,
   title varchar(20),
-  assigned_branch_id smallint,
+  assigned_branch_id integer,
   constraint fk_e_emp_id 
     foreign key (superior_emp_id) references LEARNINGSQL.employee (emp_id),
   constraint fk_dept_id
@@ -117,8 +117,8 @@ create table LEARNINGSQL.account
   close_date date,
   last_activity_date date,
   status status_t,
-  open_branch_id smallint,
-  open_emp_id smallint,
+  open_branch_id integer,
+  open_emp_id integer,
   avail_balance float,
   pending_balance float,
   constraint fk_product_cd foreign key (product_cd)
@@ -140,8 +140,8 @@ create table LEARNINGSQL.transaction
   account_id integer not null,
   txn_type_cd txn_type_cd_t,
   amount float(53) not null,
-  teller_emp_id smallint,
-  execution_branch_id smallint,
+  teller_emp_id integer,
+  execution_branch_id integer,
   funds_avail_date date,
   constraint fk_t_account_id foreign key (account_id)
     references LEARNINGSQL.account (account_id),