summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKeiHibino <>2017-07-17 11:38:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-07-17 11:38:00 (GMT)
commit6738861f765404852bf3a7a49f8f172d2dc13230 (patch)
tree479816241d3c3625348e92642d327840ed192cb2
parent710a0a8df94ba7af6d46c041d79f70f1d18a75ac (diff)
version 0.6.2.10.6.2.1
-rw-r--r--ChangeLog.md41
-rw-r--r--relational-query-HDBC.cabal7
-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, 104 insertions, 45 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..562e288
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,41 @@
+<!-- -*- Markdown -*- -->
+
+## 0.6.2.1
+
+- add tested-with 8.2.1.
+
+## 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 0aab1d6..acae171 100644
--- a/relational-query-HDBC.cabal
+++ b/relational-query-HDBC.cabal
@@ -1,5 +1,5 @@
name: relational-query-HDBC
-version: 0.6.1.2
+version: 0.6.2.1
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.
@@ -21,6 +21,7 @@ tested-with: GHC == 8.2.1
, 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 +57,8 @@ library
, th-data-compat
, names-th
- , persistable-record >= 0.4 && < 0.5
- , relational-query >= 0.8
+ , persistable-record >= 0.5
+ , relational-query >= 0.9
, relational-schemas
, HDBC >=2
, HDBC-session
diff --git a/src/Database/HDBC/Query/TH.hs b/src/Database/HDBC/Query/TH.hs
index 008517c..a12bfc6 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 Kei Hibino
+-- Copyright : 2013-2017 Kei Hibino
-- License : BSD3
--
-- Maintainer : ex8k.hibino@gmail.com
@@ -15,6 +15,7 @@
-- 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',
@@ -37,9 +38,11 @@ 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.TH (makeRecordPersistableWithSqlTypeDefault)
-import qualified Database.Record.TH as Record
-import Database.Relational.Query (Relation, Config, verboseAsCompilerWarning, defaultConfig, relationalQuerySQL)
+import Database.Record (ToSql, FromSql)
+import Database.Record.TH (recordTemplate, reifyRecordType)
+import Database.Relational.Query
+ (Config, nameConfig, recordConfig, verboseAsCompilerWarning, defaultConfig,
+ Relation, relationalQuerySQL)
import Database.Relational.Query.SQL (QuerySuffix)
import qualified Database.Relational.Query.TH as Relational
@@ -50,18 +53,29 @@ 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.
-makeRecordPersistableDefault :: Name -- ^ Type constructor name
- -> Q [Dec] -- ^ Result declaration
-makeRecordPersistableDefault recTypeName = do
+makeRelationalRecord :: Name -- ^ Type constructor name
+ -> Q [Dec] -- ^ Result declaration
+makeRelationalRecord 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
+ ((typeCon, _), _) <- reifyRecordType recTypeName
+ ps <- defineInstancesForSqlValue typeCon
return $ rr ++ ps
--- | Generate all HDBC templates about table except for constraint keys using default naming rule.
+{-# DEPRECATED makeRecordPersistableDefault "Use makeRelationalRecord instead of this." #-}
+-- | Deprecated. use 'makeRelationalRecord'.
+makeRecordPersistableDefault :: Name -- ^ Type constructor name
+ -> Q [Dec] -- ^ Result declaration
+makeRecordPersistableDefault = makeRelationalRecord
+
+-- | Generate all HDBC templates about table except for constraint keys.
defineTableDefault' :: Config -- ^ Configuration to generate query with
-> String -- ^ Schema name
-> String -- ^ Table name
@@ -70,10 +84,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 <- makeRecordPersistableWithSqlTypeDefault [t| SqlValue |] schema table $ length columns
+ sqlvD <- defineInstancesForSqlValue . fst $ recordTemplate (recordConfig $ nameConfig config) schema table
return $ modelD ++ sqlvD
--- | Generate all HDBC templates about table using default naming rule.
+-- | Generate all HDBC templates about table.
defineTableDefault :: Config -- ^ Configuration to generate query with
-> String -- ^ Schema name
-> String -- ^ Table name
@@ -84,7 +98,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 <- makeRecordPersistableWithSqlTypeDefault [t| SqlValue |] schema table $ length columns
+ sqlvD <- defineInstancesForSqlValue . fst $ recordTemplate (recordConfig $ nameConfig config) schema table
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 2faa518..6a75518 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.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
+import Database.Record (FromSql, ToSql)
import Database.Relational.Schema.IBMDB2
(normalizeColumn, notNull, getType, columnsQuerySQL, primaryKeyQuerySQL)
@@ -46,9 +46,8 @@ import Database.HDBC.Schema.Driver
Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
--- Specify type constructor and data constructor from same table name.
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined
- [t| SqlValue |] ''Columns)
+instance FromSql SqlValue Columns
+instance ToSql SqlValue Columns
logPrefix :: String -> String
logPrefix = ("IBMDB2: " ++)
diff --git a/src/Database/HDBC/Schema/MySQL.hs b/src/Database/HDBC/Schema/MySQL.hs
index dac2719..fbe48e8 100644
--- a/src/Database/HDBC/Schema/MySQL.hs
+++ b/src/Database/HDBC/Schema/MySQL.hs
@@ -26,6 +26,7 @@ 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
@@ -39,7 +40,6 @@ import Database.HDBC.Schema.Driver ( TypeMap
, getPrimaryKey
, emptyDriver
)
-import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
import Database.Relational.Schema.MySQL ( normalizeColumn
, notNull
, getType
@@ -50,7 +50,9 @@ import Database.Relational.Schema.MySQL ( normalizeColumn
import Database.Relational.Schema.MySQLInfo.Columns (Columns)
import qualified Database.Relational.Schema.MySQLInfo.Columns as Columns
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined [t| SqlValue |] ''Columns)
+
+instance FromSql SqlValue Columns
+instance ToSql SqlValue Columns
logPrefix :: String -> String
logPrefix = ("MySQL: " ++)
diff --git a/src/Database/HDBC/Schema/Oracle.hs b/src/Database/HDBC/Schema/Oracle.hs
index 800e5f7..145d019 100644
--- a/src/Database/HDBC/Schema/Oracle.hs
+++ b/src/Database/HDBC/Schema/Oracle.hs
@@ -23,9 +23,10 @@ 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
@@ -38,9 +39,9 @@ import Database.Relational.Schema.Oracle
import Database.Relational.Schema.OracleDataDictionary.TabColumns (DbaTabColumns)
import qualified Database.Relational.Schema.OracleDataDictionary.TabColumns as Cols
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined
- [t|SqlValue|]
- ''DbaTabColumns)
+
+instance FromSql SqlValue DbaTabColumns
+instance ToSql SqlValue DbaTabColumns
logPrefix :: String -> String
logPrefix = ("Oracle: " ++)
diff --git a/src/Database/HDBC/Schema/PostgreSQL.hs b/src/Database/HDBC/Schema/PostgreSQL.hs
index c8480ae..266b9e9 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.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
+import Database.Record (FromSql, ToSql)
import Database.Relational.Schema.PostgreSQL
(normalizeColumn, notNull, getType, columnQuerySQL,
@@ -45,11 +45,11 @@ import Database.HDBC.Schema.Driver
Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined
- [t| SqlValue |] ''PgAttribute)
+instance FromSql SqlValue PgAttribute
+instance ToSql SqlValue PgAttribute
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined
- [t| SqlValue |] ''PgType)
+instance FromSql SqlValue PgType
+instance ToSql SqlValue PgType
logPrefix :: String -> String
logPrefix = ("PostgreSQL: " ++)
diff --git a/src/Database/HDBC/Schema/SQLServer.hs b/src/Database/HDBC/Schema/SQLServer.hs
index 2d778d2..a4c3398 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.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
+import Database.Record (FromSql, ToSql)
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)
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined
- [t| SqlValue |] ''Columns)
+instance FromSql SqlValue Columns
+instance ToSql SqlValue Columns
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined
- [t| SqlValue |] ''Types)
+instance FromSql SqlValue Types
+instance ToSql SqlValue Types
logPrefix :: String -> String
logPrefix = ("SQLServer: " ++)
diff --git a/src/Database/HDBC/Schema/SQLite3.hs b/src/Database/HDBC/Schema/SQLite3.hs
index 855b5ad..eff3f2c 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.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
+import Database.Record (FromSql, ToSql)
import Database.Relational.Schema.SQLite3 (getType, indexInfoQuerySQL, indexListQuerySQL, normalizeColumn,
normalizeType, notNull, tableInfoQuerySQL)
import Database.Relational.Schema.SQLite3Syscat.IndexInfo (IndexInfo)
@@ -38,14 +38,15 @@ import Database.Relational.Schema.SQLite3Syscat.IndexList (IndexList)
import Database.Relational.Schema.SQLite3Syscat.TableInfo (TableInfo)
import Language.Haskell.TH (TypeQ)
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined
- [t| SqlValue |] ''TableInfo)
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined
- [t| SqlValue |] ''IndexList)
+instance FromSql SqlValue TableInfo
+instance ToSql SqlValue TableInfo
-$(makeRecordPersistableWithSqlTypeDefaultFromDefined
- [t| SqlValue |] ''IndexInfo)
+instance FromSql SqlValue IndexList
+instance ToSql SqlValue IndexList
+
+instance FromSql SqlValue IndexInfo
+instance ToSql SqlValue IndexInfo
logPrefix :: String -> String
logPrefix = ("SQLite3: " ++)