relational-record-examples 0.2.0.3 → 0.3.0.0
raw patch · 16 files changed
+140/−121 lines, 16 filesdep +relational-record-examplesdep −names-th
Dependencies added: relational-record-examples
Dependencies removed: names-th
Files
- Database/Record/TH/SQLite3.hs +20/−0
- Database/Relational/Query/SQLite3.hs +26/−0
- relational-record-examples.cabal +26/−9
- src/Account.hs +2/−2
- src/Branch.hs +2/−2
- src/Business.hs +2/−2
- src/Customer.hs +2/−2
- src/DataSource.hs +0/−33
- src/Department.hs +2/−2
- src/Employee.hs +2/−2
- src/Individual.hs +2/−2
- src/Officer.hs +2/−2
- src/Product.hs +2/−2
- src/ProductType.hs +2/−2
- src/Transaction.hs +2/−2
- src/examples.hs +46/−57
+ Database/Record/TH/SQLite3.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TemplateHaskell #-}++module Database.Record.TH.SQLite3 (+ defineTable+ ) where++import Database.HDBC.Query.TH (defineTableFromDB)+import Database.HDBC.Schema.Driver (typeMap)+import Database.HDBC.Schema.SQLite3 (driverSQLite3)+import Database.HDBC.Sqlite3 (connectSqlite3)+import Language.Haskell.TH (Q, Dec)++defineTable :: FilePath -> String -> Q [Dec]+defineTable fileName tableName =+ defineTableFromDB+ (connectSqlite3 fileName)+ (driverSQLite3 { typeMap = [("FLOAT", [t|Double|])] }) -- overwrite the default type map with yours+ "main" -- schema name, ignored by SQLite+ tableName+ [''Show]
+ Database/Relational/Query/SQLite3.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleContexts #-}++module Database.Relational.Query.SQLite3 (+ module Database.HDBC+ , module Database.HDBC.Query.TH+ , module Database.HDBC.Record+ , module Database.HDBC.Session+ , module Database.HDBC.Sqlite3+ , module Database.Record+ , module Database.Relational.Query+ , runRelation+ ) where++import Database.HDBC hiding (execute, finish, run)+import Database.HDBC.Query.TH+import Database.HDBC.Record hiding (execute, finish)+import Database.HDBC.Session+import Database.HDBC.Sqlite3+import Database.Record hiding (unique)+import Database.Relational.Query hiding (unique)++runRelation :: (ToSql SqlValue p,+ IConnection conn,+ FromSql SqlValue a) =>+ conn -> Relation p a -> p -> IO [a]+runRelation conn q p = runQuery conn (relationalQuery q) p
relational-record-examples.cabal view
@@ -1,5 +1,5 @@ name: relational-record-examples-version: 0.2.0.3+version: 0.3.0.0 synopsis: Examples of Haskell Relationa Record description: Provides examples of Haskell Relational Record license: BSD3@@ -28,14 +28,35 @@ sql/sql-memo examples.db +flag binary+ description: building binary, too+ default: False++library+ default-language: Haskell2010+ ghc-options: -Wall+ exposed-modules: Database.Relational.Query.SQLite3+ Database.Record.TH.SQLite3+ build-depends: base < 5+ , HDBC+ , HDBC-session+ , HDBC-sqlite3+ , persistable-record >= 0.2+ , relational-query >= 0.7+ , relational-query-HDBC >= 0.4+ , template-haskell+ executable examples+ if flag(binary)+ buildable: True+ else+ buildable: False hs-source-dirs: src main-is: examples.hs other-modules: Account Branch Business Customer- DataSource Department Employee Individual@@ -43,14 +64,10 @@ Product ProductType Transaction- build-depends: base <5- , HDBC- , HDBC-session- , HDBC-sqlite3- , names-th- , persistable-record >= 0.2+ build-depends: base < 5 , relational-query >= 0.7- , relational-query-HDBC >= 0.4+ , relational-record-examples , template-haskell , time default-language: Haskell2010+ ghc-options: -Wall
src/Account.hs view
@@ -2,6 +2,6 @@ module Account where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "account")+$(defineTable "examples.db" "account")
src/Branch.hs view
@@ -2,6 +2,6 @@ module Branch where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "branch")+$(defineTable "examples.db" "branch")
src/Business.hs view
@@ -2,6 +2,6 @@ module Business where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "business")+$(defineTable "examples.db" "business")
src/Customer.hs view
@@ -2,6 +2,6 @@ module Customer where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "customer")+$(defineTable "examples.db" "customer")
− src/DataSource.hs
@@ -1,33 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module DataSource (- connect, convTypes, defineTable- ) where--import Data.Time (Day, LocalTime)-import Database.HDBC.Query.TH (defineTableFromDB)-import Database.HDBC.Schema.Driver (typeMap)-import Database.HDBC.Schema.SQLite3 (driverSQLite3)-import Database.HDBC.Sqlite3 (Connection, connectSqlite3)-import Language.Haskell.TH (Q, Dec, TypeQ)--connect :: IO Connection-connect = connectSqlite3 "examples.db"--convTypes :: [(String, TypeQ)]-convTypes =- [ ("float", [t|Double|])- , ("date", [t|Day|])- , ("datetime", [t|LocalTime|])- , ("double", [t|Double|])- , ("varchar", [t|String|])- ]--defineTable :: String -> Q [Dec]-defineTable tableName =- defineTableFromDB- connect- (driverSQLite3 { typeMap = convTypes }) -- overwrite the default type map with yours- "main" -- schema name, ignored by SQLite- tableName- [''Show]
src/Department.hs view
@@ -2,6 +2,6 @@ module Department where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "department")+$(defineTable "examples.db" "department")
src/Employee.hs view
@@ -2,6 +2,6 @@ module Employee where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "employee")+$(defineTable "examples.db" "employee")
src/Individual.hs view
@@ -2,6 +2,6 @@ module Individual where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "individual")+$(defineTable "examples.db" "individual")
src/Officer.hs view
@@ -2,6 +2,6 @@ module Officer where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "officer")+$(defineTable "examples.db" "officer")
src/Product.hs view
@@ -2,8 +2,8 @@ module Product where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) import Prelude hiding (product) -$(defineTable "product")+$(defineTable "examples.db" "product")
src/ProductType.hs view
@@ -2,6 +2,6 @@ module ProductType where -import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "product_type")+$(defineTable "examples.db" "product_type")
src/Transaction.hs view
@@ -3,9 +3,9 @@ module Transaction where import Database.Relational.Query (Relation)-import DataSource (defineTable)+import Database.Record.TH.SQLite3 (defineTable) -$(defineTable "transaction0")+$(defineTable "examples.db" "transaction0") type Transaction = Transaction0
src/examples.hs view
@@ -4,16 +4,10 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} -import Database.Record--import Database.Relational.Query--import Database.HDBC (IConnection, SqlValue, rollback)-import Database.HDBC.Query.TH (makeRecordPersistableDefault)-import Database.HDBC.Record (runDelete, runInsert, runInsertQuery, runQuery, runUpdate)-import Database.HDBC.Session (withConnectionIO, handleSqlError')+import Database.Relational.Query.SQLite3 -import Data.Int (Int64)+import Prelude hiding (product)+import Data.Int (Int32, Int64) import Data.Time (Day, LocalTime) import qualified Account@@ -39,10 +33,6 @@ import qualified Employee import Employee (Employee, employee, tableOfEmployee) -import DataSource (connect)--import Prelude hiding (product)- allAccount :: Relation () Account allAccount = relation $ query account @@ -81,7 +71,7 @@ -- ('CHK', 'SAV', 'CD', 'MM')) -- @ ---account_4_3_3aT :: Relation () (((Int64, String), Int64), Maybe Double)+account_4_3_3aT :: Relation () (((Int32, String), Int32), Maybe Double) account_4_3_3aT = relation $ do a <- query account wheres $ a ! Account.productCd' `in'` values ["CHK", "SAV", "CD", "MM"]@@ -108,9 +98,9 @@ |*| a ! Account.availBalance' data Account1 = Account1- { a1AccountId :: Int64+ { a1AccountId :: Int32 , a1ProductCd :: String- , a1CustId :: Int64+ , a1CustId :: Int32 , a1AvailBalance :: Maybe Double } deriving (Show) @@ -236,7 +226,7 @@ -- WHERE (T1.product_cd = 'SAV') -- @ ---union_6_4_1a_Flat :: Relation () (Maybe Int64, Maybe Int64)+union_6_4_1a_Flat :: Relation () (Maybe Int32, Maybe Int32) union_6_4_1a_Flat = relation (do e <- query employee wheres $ e ! Employee.title' .=. just (value "Teller")@@ -262,19 +252,19 @@ -- T2.f0 ASC -- @ ---union_6_4_1a_Nest :: Relation () (Maybe Int64, Maybe Int64)+union_6_4_1a_Nest :: Relation () (Maybe Int32, Maybe Int32) union_6_4_1a_Nest = relation $ do ea <- query $ employee_6_4_1a `union` account_6_4_1a asc $ ea ! fst' return ea -employee_6_4_1a :: Relation () (Maybe Int64, Maybe Int64)+employee_6_4_1a :: Relation () (Maybe Int32, Maybe Int32) employee_6_4_1a = relation $ do e <- query employee wheres $ e ! Employee.title' .=. just (value "Teller") return $ just (e ! Employee.empId') >< e ! Employee.assignedBranchId' -account_6_4_1a :: Relation () (Maybe Int64, Maybe Int64)+account_6_4_1a :: Relation () (Maybe Int32, Maybe Int32) account_6_4_1a = relation $ do a <- query account wheres $ a ! Account.productCd' .=. value "SAV"@@ -298,7 +288,7 @@ -- MAIN.account T0 GROUP BY T0.open_emp_id ORDER BY T0.open_emp_id ASC -- @ ---group_8_1a :: Relation () (Maybe Int64, Int64)+group_8_1a :: Relation () (Maybe Int32, Int64) group_8_1a = aggregateRelation $ do a <- query account g <- groupBy $ a ! Account.openEmpId'@@ -344,7 +334,7 @@ -- (T1.product_type_cd = ?))) -- @ ---account_4_3_3bT :: Relation String (((Int64, String), Int64), Maybe Double)+account_4_3_3bT :: Relation String (((Int32, String), Int32), Maybe Double) account_4_3_3bT = relation' $ do a <- query account (phProductCd,p) <- queryList' product_4_3_3b@@ -422,7 +412,7 @@ -- T0 ORDER BY T0.open_emp_id ASC, T0.product_cd ASC -- @ ---account_3_7 :: Relation () (Maybe Int64, String)+account_3_7 :: Relation () (Maybe Int32, String) account_3_7 = relation $ do a <- query account let proj = (,) |$| a ! Account.openEmpId'@@ -458,7 +448,7 @@ |*| a ! Account.availBalance' data Account2 = Account2- { a2AccountId :: Int64+ { a2AccountId :: Int32 , a2ProductCd :: String , a2OpenDate :: Day , a2AvailBalance :: Maybe Double@@ -500,7 +490,7 @@ |*| e ! Employee.lname' data Employee1 = Employee1- { e1EmpId :: Int64+ { e1EmpId :: Int32 , e1Title :: Maybe String , e1StartDate :: Day , e1Fname :: String@@ -622,7 +612,7 @@ |*| date data Employee2 = Employee2- { e2EmpId :: Int64+ { e2EmpId :: Int32 , e2Fname :: String , e2Lname :: String , e2StartDate :: Day@@ -674,8 +664,8 @@ |*| a ! Account.productCd' data Account3 = Account3- { a3AccountId :: Int64- , a3CustId :: Int64+ { a3AccountId :: Int32+ , a3CustId :: Int32 , a3OpenDate :: Day , a3ProductCd :: String } deriving (Show)@@ -746,7 +736,7 @@ return (customer1 c) data Customer1 = Customer1- { c1Custid :: Int64+ { c1Custid :: Int32 , c1CustTypeCd :: String , c1City :: Maybe String } deriving (Show)@@ -761,7 +751,7 @@ -- | -- (original) Deleting data--- +-- -- Handwritten SQL: -- -- @@@ -794,7 +784,7 @@ -- fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) -- @ ---deleteAccount_o1P :: Delete Int64+deleteAccount_o1P :: Delete Int32 deleteAccount_o1P = derivedDelete $ \proj -> do fmap fst $ placeholder (\ph -> wheres $ proj ! Account.accountId' .=. ph) @@ -828,7 +818,7 @@ -- ?)) -- @ ---deleteAccount_o2P :: Delete (Int64,Int64)+deleteAccount_o2P :: Delete (Int32, Int32) deleteAccount_o2P = derivedDelete $ \proj -> do (phMin,()) <- placeholder (\ph -> wheres $ proj ! Account.accountId' .>=. ph) (phMax,()) <- placeholder (\ph -> wheres $ proj ! Account.accountId' .<=. ph)@@ -836,7 +826,7 @@ -- | -- 9.4.2 Data manipulation using correlated subqueries--- +-- -- Handwritten SQL: -- -- @@@ -845,7 +835,7 @@ -- FROM employee e -- WHERE e.dept_id = d.dept_id); -- @--- +-- -- Generated SQL: -- -- @@@ -904,7 +894,7 @@ -- return (phLname >< phDeptId >< phEmpId) -- @ ---updateEmployee_o3P :: Update ((String,Int64),Int64)+updateEmployee_o3P :: Update ((String,Int32),Int32) updateEmployee_o3P = derivedUpdate $ \proj -> do (phLname,()) <- placeholder (\ph -> Employee.lname' <-# ph) (phDeptId,()) <- placeholder (\ph -> Employee.deptId' <-# just ph)@@ -964,21 +954,21 @@ -- VALUES (null, 'Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451'); -- @ ----- Literal version of Generated SQL:+-- Generated SQL: -- -- @--- INSERT INTO MAIN.branch (name, address, city, state, zip) SELECT ALL--- 'Headquarters' AS f0, '3882 Main St.' AS f1, 'Waltham' AS f2, 'MA' AS--- f3, '02451' AS f4+-- INSERT INTO MAIN.branch (name, address, city, state, zip)+-- VALUES ('Headquarters', '3882 Main St.', 'Waltham', 'MA', '02451') -- @ ---insertBranch_s1 :: InsertQuery ()-insertBranch_s1 = derivedInsertQuery piBranch1 . relation $- return $ Branch1 |$| value "Headquarters"- |*| value (Just "3882 Main St.")- |*| value (Just "Waltham")- |*| value (Just "MA")- |*| value (Just "02451")+insertBranch_s1 :: Insert ()+insertBranch_s1 = derivedInsertValue $ do+ Branch.name' <-# value "Headquarters"+ Branch.address' <-# value (Just "3882 Main St.")+ Branch.city' <-# value (Just "Waltham")+ Branch.state' <-# value (Just "MA")+ Branch.zip' <-# value (Just "02451")+ return unitPlaceHolder -- this is equal to `definePi 1' piBranch1 :: Pi Branch Branch1@@ -1016,7 +1006,7 @@ -- @ -- insertBranch_s1P :: Insert Branch1-insertBranch_s1P = typedInsert tableOfBranch piBranch1+insertBranch_s1P = derivedInsert piBranch1 -- | -- (from script) The insert statement@@ -1072,9 +1062,9 @@ { e3Fname :: String , e3Lname :: String , e3StartDate :: Day- , e3DeptId :: Maybe Int64+ , e3DeptId :: Maybe Int32 , e3Title :: Maybe String- , e3AssignedBranchId :: Maybe Int64+ , e3AssignedBranchId :: Maybe Int32 } $(makeRecordPersistableDefault ''Employee3)@@ -1185,8 +1175,8 @@ |*| i ?! Individual.lname' data Account4 = Account4- { a4AccountId :: Int64- , a4CustId :: Int64+ { a4AccountId :: Int32+ , a4CustId :: Int32 , a4Fname :: Maybe String , a4Lname :: Maybe String } deriving (Show)@@ -1210,11 +1200,11 @@ -- SELECT ALL T0.cust_id AS f0, T1.name AS f1 FROM MAIN.customer T0 RIGHT -- JOIN MAIN.business T1 ON (T0.cust_id = T1.cust_id) -- @--- +-- -- Note: A function using right-out-join can be defined, but unfortunately -- SQLite3 does not support it. ---business_RightOuterJoin :: Relation () (Maybe Int64, String)+business_RightOuterJoin :: Relation () (Maybe Int32, String) business_RightOuterJoin = relation $ do c <- queryMaybe customer b <- query business@@ -1229,7 +1219,7 @@ => conn -> p -> Relation p a -> IO () run conn param rel = do putStrLn $ "SQL: " ++ show rel- records <- runQuery conn (relationalQuery rel) param+ records <- runRelation conn rel param mapM_ print records putStrLn "" rollback conn@@ -1271,7 +1261,7 @@ rollback conn main :: IO ()-main = handleSqlError' $ withConnectionIO connect $ \conn -> do+main = handleSqlError' $ withConnectionIO (connectSqlite3 "examples.db") $ \conn -> do run conn () allAccount run conn () account_4_3_3a run conn () account_4_3_3aT@@ -1304,11 +1294,10 @@ runU conn () updateEmployee_o3 runU conn (("Bush",3),10) updateEmployee_o3P runU conn () updateAccount_9_4_2- runIQ conn () insertBranch_s1+ runI conn () insertBranch_s1 runI conn branch1 insertBranch_s1P runIQ conn () insertEmployee_s2 runIQ conn () insertEmployee_s2U runIQ conn employee4 insertEmployee_s2P run conn () account_LeftOuterJoin putStrLn $ "SQL: " ++ show business_RightOuterJoin -- run conn () business_RightOuterJoin-