relational-record-examples 0.3.1.5 → 0.3.2.0
raw patch · 17 files changed
+136/−97 lines, 17 filesdep +ghc-primdep ~persistable-recorddep ~relational-querydep ~relational-query-HDBCPVP ok
version bump matches the API change (PVP)
Dependencies added: ghc-prim
Dependency ranges changed: persistable-record, relational-query, relational-query-HDBC
API changes (from Hackage documentation)
Files
- Database/Record/TH/SQLite3.hs +0/−20
- Database/Relational/Query/SQLite3.hs +0/−26
- lib/Database/Record/TH/SQLite3.hs +21/−0
- lib/Database/Relational/Query/SQLite3.hs +26/−0
- relational-record-examples.cabal +14/−6
- 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 +1/−2
- src/ProductType.hs +1/−1
- src/Transaction.hs +1/−1
- src/examples.hs +64/−33
− Database/Record/TH/SQLite3.hs
@@ -1,20 +0,0 @@-{-# 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
@@ -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
+ lib/Database/Record/TH/SQLite3.hs view
@@ -0,0 +1,21 @@+{-# 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 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.3.1.5+version: 0.3.2.0 synopsis: Examples of Haskell Relationa Record description: Provides examples of Haskell Relational Record license: BSD3@@ -31,23 +31,28 @@ flag binary description: building binary, too default: False+ manual: True library- default-language: Haskell2010- ghc-options: -Wall+ hs-source-dirs: lib 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 && < 0.9- , relational-query-HDBC >= 0.4+ , persistable-record >= 0.5+ , relational-query >= 0.9+ , relational-query-HDBC >= 0.6.1 , 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@@ -71,5 +76,8 @@ , 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 #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Account where
src/Branch.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Branch where
src/Business.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Business where
src/Customer.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Customer where
src/Department.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Department where
src/Employee.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Employee where
src/Individual.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Individual where
src/Officer.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Officer where
src/Product.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Product where @@ -6,4 +6,3 @@ import Prelude hiding (product) $(defineTable "examples.db" "product")-
src/ProductType.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module ProductType where
src/Transaction.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} module Transaction where
src/examples.hs view
@@ -3,9 +3,11 @@ {-# 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)@@ -71,11 +73,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:@@ -102,9 +104,9 @@ , a1ProductCd :: String , a1CustId :: Int , a1AvailBalance :: Maybe Double- } deriving (Show)+ } deriving (Show, Generic) -$(makeRecordPersistableDefault ''Account1)+$(makeRelationalRecord ''Account1) -- | sql/5.1.2a.sh --@@ -142,12 +144,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 --@@ -334,12 +336,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) -- |@@ -452,9 +454,9 @@ , a2ProductCd :: String , a2OpenDate :: Day , a2AvailBalance :: Maybe Double- } deriving (Show)+ } deriving (Show, Generic) -$(makeRecordPersistableDefault ''Account2)+$(makeRelationalRecord ''Account2) -- | sql/3.7.3 --@@ -495,9 +497,9 @@ , e1StartDate :: Day , e1Fname :: String , e1Lname' :: String- } deriving (Show)+ } deriving (Show, Generic) -$(makeRecordPersistableDefault ''Employee1)+$(makeRelationalRecord ''Employee1) -- | sql/4.1.2 --@@ -616,9 +618,9 @@ , e2Fname :: String , e2Lname :: String , e2StartDate :: Day- } deriving (Show)+ } deriving (Show, Generic) -$(makeRecordPersistableDefault ''Employee2)+$(makeRelationalRecord ''Employee2) -- | sql/5.1.3.sh --@@ -668,9 +670,9 @@ , a3CustId :: Int , a3OpenDate :: Day , a3ProductCd :: String- } deriving (Show)+ } deriving (Show, Generic) -$(makeRecordPersistableDefault ''Account3)+$(makeRelationalRecord ''Account3) -- | -- 9.1 What is a subquery?@@ -739,7 +741,7 @@ { c1Custid :: Int , c1CustTypeCd :: String , c1City :: Maybe String- } deriving (Show)+ } deriving (Show, Generic) customer1 :: (SqlProjectable (Projection c), ProjectableShowSql (Projection c)) => Projection c Customer -> Projection c Customer1@@ -747,7 +749,7 @@ |*| c ! Customer.custTypeCd' |*| c ! Customer.city' -$(makeRecordPersistableDefault ''Customer1)+$(makeRelationalRecord ''Customer1) -- | -- (original) Deleting data@@ -890,20 +892,20 @@ -- Note: This function is equal to the following: -- -- @--- updateEmployee_o3P :: Update ((String,Int64),Int64)--- updateEmployee_o3P = typedUpdate tableOfEmployee . updateTarget' $ \proj -> do+-- 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 -- @ ---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@@ -998,22 +1000,50 @@ , b1City :: Maybe String , b1State :: Maybe String , b1Zip :: Maybe String- }+ } deriving (Generic) -$(makeRecordPersistableDefault ''Branch1)+$(makeRelationalRecord ''Branch1) -- |--- Placeholder version of Generated SQL:+-- Tuple 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:@@ -1070,9 +1100,9 @@ , e3DeptId :: Maybe Int , e3Title :: Maybe String , e3AssignedBranchId :: Maybe Int- }+ } deriving (Generic) -$(makeRecordPersistableDefault ''Employee3)+$(makeRelationalRecord ''Employee3) -- | -- In the following code we simulate to use queryScalar with using@@ -1114,9 +1144,9 @@ , e4Lname :: String , e4StartDate :: Day , e4Title :: Maybe String- }+ } deriving (Generic) -$(makeRecordPersistableDefault ''Employee4)+$(makeRelationalRecord ''Employee4) -- | -- Placeholder version of Generated SQL:@@ -1184,9 +1214,9 @@ , a4CustId :: Int , a4Fname :: Maybe String , a4Lname :: Maybe String- } deriving (Show)+ } deriving (Show, Generic) -$(makeRecordPersistableDefault ''Account4)+$(makeRelationalRecord ''Account4) -- | -- Right Outer Join@@ -1296,10 +1326,11 @@ 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