relational-record-examples 0.3.1.4 → 0.3.1.5
raw patch · 17 files changed
+97/−136 lines, 17 filesdep −ghc-primdep ~persistable-recorddep ~relational-querydep ~relational-query-HDBC
Dependencies removed: ghc-prim
Dependency ranges changed: persistable-record, relational-query, relational-query-HDBC
Files
- Database/Record/TH/SQLite3.hs +20/−0
- Database/Relational/Query/SQLite3.hs +26/−0
- lib/Database/Record/TH/SQLite3.hs +0/−21
- lib/Database/Relational/Query/SQLite3.hs +0/−26
- relational-record-examples.cabal +6/−14
- src/Account.hs +1/−1
- src/Branch.hs +1/−1
- src/Business.hs +1/−1
- src/Customer.hs +1/−1
- src/Department.hs +1/−1
- src/Employee.hs +1/−1
- src/Individual.hs +1/−1
- src/Officer.hs +1/−1
- src/Product.hs +2/−1
- src/ProductType.hs +1/−1
- src/Transaction.hs +1/−1
- src/examples.hs +33/−64
+ 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|]), ("INTEGER", [t|Int|])] }) -- 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
− lib/Database/Record/TH/SQLite3.hs
@@ -1,21 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Database.Record.TH.SQLite3 (- defineTable- ) where--import GHC.Generics (Generic)-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|]), ("INTEGER", [t|Int|])] }) -- overwrite the default type map with yours- "main" -- schema name, ignored by SQLite- tableName- [''Show, ''Generic]
− lib/Database/Relational/Query/SQLite3.hs
@@ -1,26 +0,0 @@-{-# 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.3.1.4+version: 0.3.1.5 synopsis: Examples of Haskell Relationa Record description: Provides examples of Haskell Relational Record license: BSD3@@ -31,28 +31,23 @@ flag binary description: building binary, too default: False- manual: True library- hs-source-dirs: lib+ 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.5- , relational-query >= 0.9- , relational-query-HDBC >= 0.6.1+ , persistable-record >= 0.2+ , relational-query >= 0.7 && < 0.9+ , relational-query-HDBC >= 0.4 , template-haskell -- not link directly but query type map , relational-schemas >= 0.1.3- if impl(ghc == 7.4.*)- build-depends: ghc-prim == 0.2.* - default-language: Haskell2010- ghc-options: -Wall- executable examples if flag(binary) buildable: True@@ -76,8 +71,5 @@ , relational-record-examples , template-haskell , time- if impl(ghc == 7.4.*)- build-depends: ghc-prim == 0.2.*- default-language: Haskell2010 ghc-options: -Wall
src/Account.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Account where
src/Branch.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Branch where
src/Business.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Business where
src/Customer.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Customer where
src/Department.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Department where
src/Employee.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Employee where
src/Individual.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Individual where
src/Officer.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Officer where
src/Product.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Product where @@ -6,3 +6,4 @@ import Prelude hiding (product) $(defineTable "examples.db" "product")+
src/ProductType.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module ProductType where
src/Transaction.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Transaction where
src/examples.hs view
@@ -3,11 +3,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DeriveGeneric #-} import Database.Relational.Query.SQLite3 -import GHC.Generics (Generic) import Prelude hiding (product) import Data.Int (Int64) import Data.Time (Day, LocalTime)@@ -73,11 +71,11 @@ -- ('CHK', 'SAV', 'CD', 'MM')) -- @ ---account_4_3_3aT :: Relation () (Int, String, Int, Maybe Double)+account_4_3_3aT :: Relation () (((Int, String), Int), Maybe Double) account_4_3_3aT = 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'+ return $ a ! Account.accountId' >< a ! Account.productCd' >< a ! Account.custId' >< a ! Account.availBalance' -- | -- Adhoc defined record version of Generated SQL:@@ -104,9 +102,9 @@ , a1ProductCd :: String , a1CustId :: Int , a1AvailBalance :: Maybe Double- } deriving (Show, Generic)+ } deriving (Show) -$(makeRelationalRecord ''Account1)+$(makeRecordPersistableDefault ''Account1) -- | sql/5.1.2a.sh --@@ -144,12 +142,12 @@ -- = T1.dept_id) -- @ ---join_5_1_2aT :: Relation () (String, String, String)+join_5_1_2aT :: Relation () ((String, String), String) join_5_1_2aT = 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'+ return $ e ! Employee.fname' >< e ! Employee.lname' >< d ! Department.name' -- | sql/5.3a.sh --@@ -336,12 +334,12 @@ -- (T1.product_type_cd = ?))) -- @ ---account_4_3_3bT :: Relation String (Int, String, Int, Maybe Double)+account_4_3_3bT :: Relation String (((Int, String), Int), Maybe Double) account_4_3_3bT = relation' $ do a <- query account (phProductCd,p) <- queryList' product_4_3_3b wheres $ a ! Account.productCd' `in'` p- let at = (,,,) |$| a ! Account.accountId' |*| a ! Account.productCd' |*| a ! Account.custId' |*| a ! Account.availBalance'+ let at = a ! Account.accountId' >< a ! Account.productCd' >< a ! Account.custId' >< a ! Account.availBalance' return (phProductCd, at) -- |@@ -454,9 +452,9 @@ , a2ProductCd :: String , a2OpenDate :: Day , a2AvailBalance :: Maybe Double- } deriving (Show, Generic)+ } deriving (Show) -$(makeRelationalRecord ''Account2)+$(makeRecordPersistableDefault ''Account2) -- | sql/3.7.3 --@@ -497,9 +495,9 @@ , e1StartDate :: Day , e1Fname :: String , e1Lname' :: String- } deriving (Show, Generic)+ } deriving (Show) -$(makeRelationalRecord ''Employee1)+$(makeRecordPersistableDefault ''Employee1) -- | sql/4.1.2 --@@ -618,9 +616,9 @@ , e2Fname :: String , e2Lname :: String , e2StartDate :: Day- } deriving (Show, Generic)+ } deriving (Show) -$(makeRelationalRecord ''Employee2)+$(makeRecordPersistableDefault ''Employee2) -- | sql/5.1.3.sh --@@ -670,9 +668,9 @@ , a3CustId :: Int , a3OpenDate :: Day , a3ProductCd :: String- } deriving (Show, Generic)+ } deriving (Show) -$(makeRelationalRecord ''Account3)+$(makeRecordPersistableDefault ''Account3) -- | -- 9.1 What is a subquery?@@ -741,7 +739,7 @@ { c1Custid :: Int , c1CustTypeCd :: String , c1City :: Maybe String- } deriving (Show, Generic)+ } deriving (Show) customer1 :: (SqlProjectable (Projection c), ProjectableShowSql (Projection c)) => Projection c Customer -> Projection c Customer1@@ -749,7 +747,7 @@ |*| c ! Customer.custTypeCd' |*| c ! Customer.city' -$(makeRelationalRecord ''Customer1)+$(makeRecordPersistableDefault ''Customer1) -- | -- (original) Deleting data@@ -892,20 +890,20 @@ -- Note: This function is equal to the following: -- -- @--- updateEmployee_o3P :: Update (String, Int, Int)--- updateEmployee_o3P = derivedUpdate $ \proj -> do+-- updateEmployee_o3P :: Update ((String,Int64),Int64)+-- updateEmployee_o3P = typedUpdate tableOfEmployee . updateTarget' $ \proj -> do -- (phLname,()) <- placeholder (\ph -> Employee.lname' <-# ph) -- (phDeptId,()) <- placeholder (\ph -> Employee.deptId' <-# just ph) -- (phEmpId,()) <- placeholder (\ph -> wheres $ proj ! Employee.empId' .=. ph)--- return $ (,,) |$| phLname |*| phDeptId |*| phEmpId+-- return (phLname >< phDeptId >< phEmpId) -- @ ---updateEmployee_o3P :: Update (String, Int, Int)+updateEmployee_o3P :: Update ((String,Int),Int) updateEmployee_o3P = derivedUpdate $ \proj -> do (phLname,()) <- placeholder (\ph -> Employee.lname' <-# ph) (phDeptId,()) <- placeholder (\ph -> Employee.deptId' <-# just ph) (phEmpId,()) <- placeholder (\ph -> wheres $ proj ! Employee.empId' .=. ph)- return $ (,,) |$| phLname |*| phDeptId |*| phEmpId+ return (phLname >< phDeptId >< phEmpId) -- | -- 9.4.2 Data Manipulation Using Correlated Subqueries@@ -1000,50 +998,22 @@ , b1City :: Maybe String , b1State :: Maybe String , b1Zip :: Maybe String- } deriving (Generic)+ } -$(makeRelationalRecord ''Branch1)+$(makeRecordPersistableDefault ''Branch1) -- |--- Tuple placeholder version of Generated SQL:+-- Placeholder version of Generated SQL: -- -- @ -- INSERT INTO MAIN.branch (name, address, city, state, zip) VALUES (?, -- ?, ?, ?, ?) -- @ ----- Above sql is the same to adhoc defined record version.--- insertBranch_s1P :: Insert Branch1 insertBranch_s1P = derivedInsert piBranch1 -piBranchTuple :: Pi Branch (String, Maybe String, Maybe String, Maybe String, Maybe String)-piBranchTuple = (,,,,)- |$| Branch.name'- |*| Branch.address'- |*| Branch.city'- |*| Branch.state'- |*| Branch.zip'--branchTuple :: (String, Maybe String, Maybe String, Maybe String, Maybe String)-branchTuple = ("Headquarters",- Just "3882 Main St.",- Just "Waltham",- Just "MA",- Just "02451")- -- |--- Generated SQL is the same as not tuple version:------ @--- INSERT INTO MAIN.branch (name, address, city, state, zip) VALUES (?,--- ?, ?, ?, ?)--- @----insertBranch_s1PT :: Insert (String, Maybe String, Maybe String, Maybe String, Maybe String)-insertBranch_s1PT = derivedInsert piBranchTuple---- | -- (from script) The insert statement -- -- Handwritten SQL:@@ -1100,9 +1070,9 @@ , e3DeptId :: Maybe Int , e3Title :: Maybe String , e3AssignedBranchId :: Maybe Int- } deriving (Generic)+ } -$(makeRelationalRecord ''Employee3)+$(makeRecordPersistableDefault ''Employee3) -- | -- In the following code we simulate to use queryScalar with using@@ -1144,9 +1114,9 @@ , e4Lname :: String , e4StartDate :: Day , e4Title :: Maybe String- } deriving (Generic)+ } -$(makeRelationalRecord ''Employee4)+$(makeRecordPersistableDefault ''Employee4) -- | -- Placeholder version of Generated SQL:@@ -1214,9 +1184,9 @@ , a4CustId :: Int , a4Fname :: Maybe String , a4Lname :: Maybe String- } deriving (Show, Generic)+ } deriving (Show) -$(makeRelationalRecord ''Account4)+$(makeRecordPersistableDefault ''Account4) -- | -- Right Outer Join@@ -1326,11 +1296,10 @@ runD conn (10,20) deleteAccount_o2P runD conn () deleteEmployee_9_4_2 runU conn () updateEmployee_o3- runU conn ("Bush", 3, 10) updateEmployee_o3P+ runU conn (("Bush",3),10) updateEmployee_o3P runU conn () updateAccount_9_4_2 runI conn () insertBranch_s1 runI conn branch1 insertBranch_s1P- runI conn branchTuple insertBranch_s1PT runIQ conn () insertEmployee_s2 runIQ conn () insertEmployee_s2U runIQ conn employee4 insertEmployee_s2P