khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-11-29 14:45:51 +03:00
Code Issues Projects Releases Wiki Activity

exporting two modules from examples.

Browse Source
This commit is contained in:
Kazu Yamamoto 2016-05-19 16:12:52 +09:00
parent db534d6d1a
commit a440651b26
15 changed files with 75 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
relational-record-examples/src/DataSource.hs → relational-record-examples/Database/Record/TH/SQLite3.hs
View File

@ -1,22 +1,19 @@
{-# LANGUAGE TemplateHaskell #-}
module DataSource (
connect, defineTable
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 (Connection, connectSqlite3)
import Language.Haskell.TH (Q, Dec, TypeQ)
import Database.HDBC.Sqlite3 (connectSqlite3)
import Language.Haskell.TH (Q, Dec)
connect :: IO Connection
connect = connectSqlite3 "examples.db"
defineTable :: String -> Q [Dec]
defineTable tableName =
defineTable :: FilePath -> String -> Q [Dec]
defineTable fileName tableName =
defineTableFromDB
connect
(connectSqlite3 fileName)
(driverSQLite3 { typeMap = [("FLOAT", [t|Double|])] }) -- overwrite the default type map with yours
"main" -- schema name, ignored by SQLite
tableName

26
relational-record-examples/Database/Relational/Query/SQLite3.hs Normal file
View File

@ -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

24
relational-record-examples/relational-record-examples.cabal
View File

@ -32,6 +32,20 @@ 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
@ -43,7 +57,6 @@ executable examples
Branch
Business
Customer
DataSource
Department
Employee
Individual
@ -51,14 +64,9 @@ executable examples
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

4
relational-record-examples/src/Account.hs
View File

@ -2,6 +2,6 @@
module Account where
import DataSource (defineTable)
import Database.Record.TH.SQLite3 (defineTable)
$(defineTable "account")
$(defineTable "examples.db" "account")

4
relational-record-examples/src/Branch.hs
View File

@ -2,6 +2,6 @@
module Branch where
import DataSource (defineTable)
import Database.Record.TH.SQLite3 (defineTable)
$(defineTable "branch")
$(defineTable "examples.db" "branch")

4
relational-record-examples/src/Business.hs
View File

@ -2,6 +2,6 @@
module Business where
import DataSource (defineTable)
import Database.Record.TH.SQLite3 (defineTable)
$(defineTable "business")
$(defineTable "examples.db" "business")

4
relational-record-examples/src/Customer.hs
View File

@ -2,6 +2,6 @@
module Customer where
import DataSource (defineTable)
import Database.Record.TH.SQLite3 (defineTable)
$(defineTable "customer")
$(defineTable "examples.db" "customer")

4
relational-record-examples/src/Department.hs
View File

@ -2,6 +2,6 @@
module Department where
import DataSource (defineTable)
import Database.Record.TH.SQLite3 (defineTable)
$(defineTable "department")
$(defineTable "examples.db" "department")

4
relational-record-examples/src/Employee.hs
View File

@ -2,6 +2,6 @@
module Employee where
import DataSource (defineTable)
import Database.Record.TH.SQLite3 (defineTable)
$(defineTable "employee")
$(defineTable "examples.db" "employee")

4
relational-record-examples/src/Individual.hs
View File

@ -2,6 +2,6 @@
module Individual where
import DataSource (defineTable)
import Database.Record.TH.SQLite3 (defineTable)
$(defineTable "individual")
$(defineTable "examples.db" "individual")

4
relational-record-examples/src/Officer.hs
View File

@ -2,6 +2,6 @@
module Officer where
import DataSource (defineTable)
import Database.Record.TH.SQLite3 (defineTable)
$(defineTable "officer")
$(defineTable "examples.db" "officer")

4
relational-record-examples/src/Product.hs
View File

@ -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")

4
relational-record-examples/src/ProductType.hs
View File

@ -2,6 +2,6 @@
module ProductType where
import DataSource (defineTable)
import Database.Record.TH.SQLite3 (defineTable)
$(defineTable "product_type")
$(defineTable "examples.db" "product_type")

4
relational-record-examples/src/Transaction.hs
View File

@ -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

18
relational-record-examples/src/examples.hs
View File

@ -4,15 +4,9 @@
{-# 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 Prelude hiding (product)
import Data.Int (Int32, Int64)
import Data.Time (Day, LocalTime)
@ -39,10 +33,6 @@ import Transaction (transaction)
import qualified Employee
import Employee (Employee, employee, tableOfEmployee)
import DataSource (connect)
import Prelude hiding (product)
allAccount :: Relation () Account
allAccount = relation $ query account
@ -1229,7 +1219,7 @@ run :: (Show a, IConnection conn, FromSql SqlValue a, ToSql SqlValue p)
=> 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 @@ runD conn param dlt = do
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