summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKeiHibino <>2017-07-17 11:32:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-07-17 11:32:00 (GMT)
commit710a0a8df94ba7af6d46c041d79f70f1d18a75ac (patch)
tree5c54ce0699fa1cc87712689b2340dddbb14e6d36
parentbf620b92d3fe41a59cd0fb5260fd9c284141ee22 (diff)
version 0.6.1.20.6.1.2
-rw-r--r--ChangeLog.md37
-rw-r--r--relational-query-HDBC.cabal10
-rw-r--r--src/Database/HDBC/Query/TH.hs44
-rw-r--r--src/Database/HDBC/Schema/IBMDB2.hs7
-rw-r--r--src/Database/HDBC/Schema/MySQL.hs6
-rw-r--r--src/Database/HDBC/Schema/Oracle.hs9
-rw-r--r--src/Database/HDBC/Schema/PostgreSQL.hs10
-rw-r--r--src/Database/HDBC/Schema/SQLServer.hs10
-rw-r--r--src/Database/HDBC/Schema/SQLite3.hs15
9 files changed, 47 insertions, 101 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
deleted file mode 100644
index a846c80..0000000
--- a/ChangeLog.md
+++ /dev/null
@@ -1,37 +0,0 @@
-<!-- -*- Markdown -*- -->
-
-## 0.6.2.0
-
-- Apply generic instances.
-
-## 0.6.0.2
-
-- Add tested-with.
-
-## 0.6.0.1
-
-- Update compatibility for GHC 8.
-- Drop old tests of Oracle.
-
-## 0.6.0.0
-
-- Use updated template of persistable-record.
-- Drop persistableSqlValue.
-
-## 0.5.0.0
-
-- Use updated template of relational-query.
-- Drop old examples of Oracle.
-
-## 0.4.0.0
-
-- TH quotation of derive class names.
-
-## 0.3.0.0
-
-- Hide chunksInsertActions.
-- Add withPrepareDelete.
-
-## 0.2.0.0
-
-- Add logging interface for schema driver.
diff --git a/relational-query-HDBC.cabal b/relational-query-HDBC.cabal
index 7b54160..0aab1d6 100644
--- a/relational-query-HDBC.cabal
+++ b/relational-query-HDBC.cabal
@@ -1,5 +1,5 @@
name: relational-query-HDBC
-version: 0.6.2.0
+version: 0.6.1.2
synopsis: HDBC instance of relational-query and typed query interface for HDBC
description: This package contains the HDBC instance of relational-query and
the typed query interface for HDBC.
@@ -15,12 +15,12 @@ copyright: Copyright (c) 2013-2017 Kei Hibino, Shohei Murayama, Shohei
category: Database
build-type: Simple
cabal-version: >=1.10
-tested-with: GHC == 8.0.1, GHC == 8.0.2
+tested-with: GHC == 8.2.1
+ , GHC == 8.0.1, GHC == 8.0.2
, GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3
, GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4
, GHC == 7.6.1, GHC == 7.6.2, GHC == 7.6.3
, GHC == 7.4.1, GHC == 7.4.2
-extra-source-files: ChangeLog.md
library
exposed-modules:
@@ -56,8 +56,8 @@ library
, th-data-compat
, names-th
- , persistable-record >= 0.5
- , relational-query >= 0.9
+ , persistable-record >= 0.4 && < 0.5
+ , relational-query >= 0.8
, relational-schemas
, HDBC >=2
, HDBC-session
diff --git a/src/Database/HDBC/Query/TH.hs b/src/Database/HDBC/Query/TH.hs
index a12bfc6..008517c 100644
--- a/src/Database/HDBC/Query/TH.hs
+++ b/src/Database/HDBC/Query/TH.hs
@@ -5,7 +5,7 @@
-- |
-- Module : Database.HDBC.Query.TH
--- Copyright : 2013-2017 Kei Hibino
+-- Copyright : 2013 Kei Hibino
-- License : BSD3
--
-- Maintainer : ex8k.hibino@gmail.com
@@ -15,7 +15,6 @@
-- This module contains templates to generate Haskell record types
-- and HDBC instances correspond to RDB table schema.
module Database.HDBC.Query.TH (
- makeRelationalRecord,
makeRecordPersistableDefault,
defineTableDefault',
@@ -38,11 +37,9 @@ import Language.Haskell.TH (Q, runIO, Name, TypeQ, Dec)
import Language.Haskell.TH.Name.CamelCase (varCamelcaseName)
import Language.Haskell.TH.Lib.Extra (reportWarning, reportError)
-import Database.Record (ToSql, FromSql)
-import Database.Record.TH (recordTemplate, reifyRecordType)
-import Database.Relational.Query
- (Config, nameConfig, recordConfig, verboseAsCompilerWarning, defaultConfig,
- Relation, relationalQuerySQL)
+import Database.Record.TH (makeRecordPersistableWithSqlTypeDefault)
+import qualified Database.Record.TH as Record
+import Database.Relational.Query (Relation, Config, verboseAsCompilerWarning, defaultConfig, relationalQuerySQL)
import Database.Relational.Query.SQL (QuerySuffix)
import qualified Database.Relational.Query.TH as Relational
@@ -53,29 +50,18 @@ import Database.HDBC.Schema.Driver
(runLog, newLogChan, takeLogs, Driver, getFields, getPrimaryKey)
-defineInstancesForSqlValue :: TypeQ -- ^ Record type constructor.
- -> Q [Dec] -- ^ Instance declarations.
-defineInstancesForSqlValue typeCon = do
- [d| instance FromSql SqlValue $typeCon
- instance ToSql SqlValue $typeCon
- |]
-
-- | Generate all persistable templates against defined record like type constructor.
-makeRelationalRecord :: Name -- ^ Type constructor name
- -> Q [Dec] -- ^ Result declaration
-makeRelationalRecord recTypeName = do
- rr <- Relational.makeRelationalRecordDefault recTypeName
- ((typeCon, _), _) <- reifyRecordType recTypeName
- ps <- defineInstancesForSqlValue typeCon
- return $ rr ++ ps
-
-{-# DEPRECATED makeRecordPersistableDefault "Use makeRelationalRecord instead of this." #-}
--- | Deprecated. use 'makeRelationalRecord'.
makeRecordPersistableDefault :: Name -- ^ Type constructor name
-> Q [Dec] -- ^ Result declaration
-makeRecordPersistableDefault = makeRelationalRecord
+makeRecordPersistableDefault recTypeName = do
+ rr <- Relational.makeRelationalRecordDefault recTypeName
+ (pair, (_mayNs, cts)) <- Record.reifyRecordType recTypeName
+ let width = length cts
+ ps <- Record.makeRecordPersistableWithSqlType [t| SqlValue |]
+ (Record.persistableFunctionNamesDefault recTypeName) pair width
+ return $ rr ++ ps
--- | Generate all HDBC templates about table except for constraint keys.
+-- | Generate all HDBC templates about table except for constraint keys using default naming rule.
defineTableDefault' :: Config -- ^ Configuration to generate query with
-> String -- ^ Schema name
-> String -- ^ Table name
@@ -84,10 +70,10 @@ defineTableDefault' :: Config -- ^ Configuration to generate query wi
-> Q [Dec] -- ^ Result declaration
defineTableDefault' config schema table columns derives = do
modelD <- Relational.defineTableTypesAndRecord config schema table columns derives
- sqlvD <- defineInstancesForSqlValue . fst $ recordTemplate (recordConfig $ nameConfig config) schema table
+ sqlvD <- makeRecordPersistableWithSqlTypeDefault [t| SqlValue |] schema table $ length columns
return $ modelD ++ sqlvD
--- | Generate all HDBC templates about table.
+-- | Generate all HDBC templates about table using default naming rule.
defineTableDefault :: Config -- ^ Configuration to generate query with
-> String -- ^ Schema name
-> String -- ^ Table name
@@ -98,7 +84,7 @@ defineTableDefault :: Config -- ^ Configuration to generate query wit
-> Q [Dec] -- ^ Result declaration
defineTableDefault config schema table columns derives primary notNull = do
modelD <- Relational.defineTable config schema table columns derives primary notNull
- sqlvD <- defineInstancesForSqlValue . fst $ recordTemplate (recordConfig $ nameConfig config) schema table
+ sqlvD <- makeRecordPersistableWithSqlTypeDefault [t| SqlValue |] schema table $ length columns
return $ modelD ++ sqlvD
-- | Generate all HDBC templates using system catalog informations with specified config.
diff --git a/src/Database/HDBC/Schema/IBMDB2.hs b/src/Database/HDBC/Schema/IBMDB2.hs
index 6a75518..2faa518 100644
--- a/src/Database/HDBC/Schema/IBMDB2.hs
+++ b/src/Database/HDBC/Schema/IBMDB2.hs
@@ -34,7 +34,7 @@ import Database.HDBC (IConnection, SqlValue)
import Database.HDBC.Record.Query (runQuery')
import Database.HDBC.Record.Persistable ()
-import Database.Record (FromSql, ToSql)
+import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
import Database.Relational.Schema.IBMDB2
(normalizeColumn, notNull, getType, columnsQuerySQL, primaryKeyQuerySQL)
@@ -46,8 +46,9 @@ import Database.HDBC.Schema.Driver
Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
-instance FromSql SqlValue Columns
-instance ToSql SqlValue Columns
+-- Specify type constructor and data constructor from same table name.
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined
+ [t| SqlValue |] ''Columns)
logPrefix :: String -> String
logPrefix = ("IBMDB2: " ++)
diff --git a/src/Database/HDBC/Schema/MySQL.hs b/src/Database/HDBC/Schema/MySQL.hs
index fbe48e8..dac2719 100644
--- a/src/Database/HDBC/Schema/MySQL.hs
+++ b/src/Database/HDBC/Schema/MySQL.hs
@@ -26,7 +26,6 @@ import qualified Data.List as List
import Data.Map (fromList)
import Database.HDBC (IConnection, SqlValue)
-import Database.Record (FromSql, ToSql)
import Database.HDBC.Record.Query (runQuery')
import Database.HDBC.Record.Persistable ()
import Database.HDBC.Schema.Driver ( TypeMap
@@ -40,6 +39,7 @@ import Database.HDBC.Schema.Driver ( TypeMap
, getPrimaryKey
, emptyDriver
)
+import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
import Database.Relational.Schema.MySQL ( normalizeColumn
, notNull
, getType
@@ -50,9 +50,7 @@ import Database.Relational.Schema.MySQL ( normalizeColumn
import Database.Relational.Schema.MySQLInfo.Columns (Columns)
import qualified Database.Relational.Schema.MySQLInfo.Columns as Columns
-
-instance FromSql SqlValue Columns
-instance ToSql SqlValue Columns
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined [t| SqlValue |] ''Columns)
logPrefix :: String -> String
logPrefix = ("MySQL: " ++)
diff --git a/src/Database/HDBC/Schema/Oracle.hs b/src/Database/HDBC/Schema/Oracle.hs
index 145d019..800e5f7 100644
--- a/src/Database/HDBC/Schema/Oracle.hs
+++ b/src/Database/HDBC/Schema/Oracle.hs
@@ -23,10 +23,9 @@ import Data.Maybe (catMaybes)
import Language.Haskell.TH (TypeQ)
import Database.HDBC (IConnection, SqlValue)
-import Database.Record (FromSql, ToSql)
-
import Database.HDBC.Record.Query (runQuery')
import Database.HDBC.Record.Persistable ()
+import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
import Database.HDBC.Schema.Driver
( TypeMap, LogChan, putVerbose, failWith, maybeIO, hoistMaybe,
Driver, getFieldsWithMap, getPrimaryKey, emptyDriver
@@ -39,9 +38,9 @@ import Database.Relational.Schema.Oracle
import Database.Relational.Schema.OracleDataDictionary.TabColumns (DbaTabColumns)
import qualified Database.Relational.Schema.OracleDataDictionary.TabColumns as Cols
-
-instance FromSql SqlValue DbaTabColumns
-instance ToSql SqlValue DbaTabColumns
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined
+ [t|SqlValue|]
+ ''DbaTabColumns)
logPrefix :: String -> String
logPrefix = ("Oracle: " ++)
diff --git a/src/Database/HDBC/Schema/PostgreSQL.hs b/src/Database/HDBC/Schema/PostgreSQL.hs
index 266b9e9..c8480ae 100644
--- a/src/Database/HDBC/Schema/PostgreSQL.hs
+++ b/src/Database/HDBC/Schema/PostgreSQL.hs
@@ -31,7 +31,7 @@ import Database.HDBC (IConnection, SqlValue)
import Database.HDBC.Record.Query (runQuery')
import Database.HDBC.Record.Persistable ()
-import Database.Record (FromSql, ToSql)
+import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
import Database.Relational.Schema.PostgreSQL
(normalizeColumn, notNull, getType, columnQuerySQL,
@@ -45,11 +45,11 @@ import Database.HDBC.Schema.Driver
Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
-instance FromSql SqlValue PgAttribute
-instance ToSql SqlValue PgAttribute
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined
+ [t| SqlValue |] ''PgAttribute)
-instance FromSql SqlValue PgType
-instance ToSql SqlValue PgType
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined
+ [t| SqlValue |] ''PgType)
logPrefix :: String -> String
logPrefix = ("PostgreSQL: " ++)
diff --git a/src/Database/HDBC/Schema/SQLServer.hs b/src/Database/HDBC/Schema/SQLServer.hs
index a4c3398..2d778d2 100644
--- a/src/Database/HDBC/Schema/SQLServer.hs
+++ b/src/Database/HDBC/Schema/SQLServer.hs
@@ -29,7 +29,7 @@ import Database.HDBC.Record.Persistable ()
import Database.HDBC.Schema.Driver
(TypeMap, LogChan, putVerbose, failWith, maybeIO,
Driver, hoistMaybe, getFieldsWithMap, getPrimaryKey, emptyDriver)
-import Database.Record (FromSql, ToSql)
+import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
import Database.Relational.Schema.SQLServer (columnTypeQuerySQL, getType, normalizeColumn,
notNull, primaryKeyQuerySQL)
import Database.Relational.Schema.SQLServerSyscat.Columns (Columns)
@@ -37,11 +37,11 @@ import Database.Relational.Schema.SQLServerSyscat.Types (Types)
import Language.Haskell.TH (TypeQ)
-instance FromSql SqlValue Columns
-instance ToSql SqlValue Columns
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined
+ [t| SqlValue |] ''Columns)
-instance FromSql SqlValue Types
-instance ToSql SqlValue Types
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined
+ [t| SqlValue |] ''Types)
logPrefix :: String -> String
logPrefix = ("SQLServer: " ++)
diff --git a/src/Database/HDBC/Schema/SQLite3.hs b/src/Database/HDBC/Schema/SQLite3.hs
index eff3f2c..855b5ad 100644
--- a/src/Database/HDBC/Schema/SQLite3.hs
+++ b/src/Database/HDBC/Schema/SQLite3.hs
@@ -30,7 +30,7 @@ import Database.HDBC.Record.Persistable ()
import Database.HDBC.Schema.Driver
(TypeMap, LogChan, putVerbose, failWith, maybeIO,
Driver, hoistMaybe, getFieldsWithMap, getPrimaryKey, emptyDriver)
-import Database.Record (FromSql, ToSql)
+import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
import Database.Relational.Schema.SQLite3 (getType, indexInfoQuerySQL, indexListQuerySQL, normalizeColumn,
normalizeType, notNull, tableInfoQuerySQL)
import Database.Relational.Schema.SQLite3Syscat.IndexInfo (IndexInfo)
@@ -38,15 +38,14 @@ import Database.Relational.Schema.SQLite3Syscat.IndexList (IndexList)
import Database.Relational.Schema.SQLite3Syscat.TableInfo (TableInfo)
import Language.Haskell.TH (TypeQ)
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined
+ [t| SqlValue |] ''TableInfo)
-instance FromSql SqlValue TableInfo
-instance ToSql SqlValue TableInfo
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined
+ [t| SqlValue |] ''IndexList)
-instance FromSql SqlValue IndexList
-instance ToSql SqlValue IndexList
-
-instance FromSql SqlValue IndexInfo
-instance ToSql SqlValue IndexInfo
+$(makeRecordPersistableWithSqlTypeDefaultFromDefined
+ [t| SqlValue |] ''IndexInfo)
logPrefix :: String -> String
logPrefix = ("SQLite3: " ++)