diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,45 @@ + + +## 0.6.4.0 + +- add new function name definitions to execute bounded statement. + +## 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 --- a/relational-query-HDBC.cabal +++ b/relational-query-HDBC.cabal @@ -1,5 +1,5 @@ name: relational-query-HDBC -version: 0.6.3.1 +version: 0.6.4.0 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 @@ , 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 @@ , th-data-compat , names-th - , persistable-record >= 0.4 && < 0.5 - , relational-query >= 0.8.8 && < 0.9 + , 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 --- 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,11 +38,12 @@ 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.Record (ToSql, FromSql) +import Database.Record.TH (recordTemplate, reifyRecordType) import Database.Relational.Query - (Relation, Config, verboseAsCompilerWarning, defaultConfig, - relationalQuerySQL, QuerySuffix) + (Config, nameConfig, recordConfig, verboseAsCompilerWarning, defaultConfig, + Relation, relationalQuerySQL) +import Database.Relational.Query.SQL (QuerySuffix) import qualified Database.Relational.Query.TH as Relational import Database.HDBC.Session (withConnectionIO) @@ -51,18 +53,29 @@ (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 @@ -71,10 +84,10 @@ -> 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 @@ -85,7 +98,7 @@ -> 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 --- a/src/Database/HDBC/Schema/IBMDB2.hs +++ b/src/Database/HDBC/Schema/IBMDB2.hs @@ -34,7 +34,7 @@ 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 @@ 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 --- a/src/Database/HDBC/Schema/MySQL.hs +++ b/src/Database/HDBC/Schema/MySQL.hs @@ -26,6 +26,7 @@ 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 @@ , getPrimaryKey , emptyDriver ) -import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined) import Database.Relational.Schema.MySQL ( normalizeColumn , notNull , getType @@ -50,7 +50,9 @@ 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 --- a/src/Database/HDBC/Schema/Oracle.hs +++ b/src/Database/HDBC/Schema/Oracle.hs @@ -23,9 +23,10 @@ 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.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 --- a/src/Database/HDBC/Schema/PostgreSQL.hs +++ b/src/Database/HDBC/Schema/PostgreSQL.hs @@ -31,7 +31,7 @@ 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 @@ 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 --- a/src/Database/HDBC/Schema/SQLServer.hs +++ b/src/Database/HDBC/Schema/SQLServer.hs @@ -29,7 +29,7 @@ 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 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 --- a/src/Database/HDBC/Schema/SQLite3.hs +++ b/src/Database/HDBC/Schema/SQLite3.hs @@ -30,7 +30,7 @@ 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.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: " ++)