diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ +## 0.7.0.0 + +- support overwriting of type-map along with column-name. +- replace `execute` and `executeNoFetch`. + ## 0.6.8.1 - apply renamed LiteralSQL class. 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.8.1 +version: 0.7.0.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. 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-2017 Kei Hibino +-- Copyright : 2013-2018 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com @@ -35,7 +35,7 @@ import Database.HDBC (IConnection, SqlValue, prepare) -import Language.Haskell.TH (Q, runIO, Name, TypeQ, Dec) +import Language.Haskell.TH (Q, runIO, Name, TypeQ, Type (AppT, ConT), Dec) import Language.Haskell.TH.Name.CamelCase (varCamelcaseName) import Language.Haskell.TH.Lib.Extra (reportWarning, reportError) @@ -104,15 +104,16 @@ return $ modelD ++ sqlvD tableAlongWithSchema :: IConnection conn - => IO conn -- ^ Connect action to system catalog database - -> Config -- ^ Configuration to generate query with - -> Driver conn -- ^ Driver definition - -> String -- ^ Schema name - -> String -- ^ Table name - -> [Name] -- ^ Derivings - -> Q [Dec] -- ^ Result declaration -tableAlongWithSchema connect config drv scm tbl derives = do - let getDBinfo = do + => IO conn -- ^ Connect action to system catalog database + -> Driver conn -- ^ Driver definition + -> String -- ^ Schema name + -> String -- ^ Table name + -> [(String, TypeQ)] -- ^ Additional column-name and column-type mapping to overwrite default + -> [Name] -- ^ Derivings + -> Q [Dec] -- ^ Result declaration +tableAlongWithSchema connect drv scm tbl cmap derives = do + let config = driverConfig drv + getDBinfo = do logChan <- emptyLogChan infoP <- withConnectionIO connect (\conn -> @@ -140,18 +141,23 @@ primaryIxs = fromMaybe [] . sequence $ map snd ixLookups mapM_ (uncurry warnLk) ixLookups - defineTableDefault config scm tbl cols derives primaryIxs (listToMaybe notNullIdxs) + let liftMaybe tyQ sty = do + ty <- tyQ + case ty of + (AppT (ConT n) _) | n == ''Maybe -> [t| Maybe $(sty) |] + _ -> sty + cols1 = [ (,) cn . maybe ty (liftMaybe ty) . Map.lookup cn $ Map.fromList cmap | (cn, ty) <- cols ] + defineTableDefault config scm tbl cols1 derives primaryIxs (listToMaybe notNullIdxs) -{-# DEPRECATED defineTableFromDB' "Use defineTableFromDB with updated driverConfig field of Driver argument." #-} -- | Generate all HDBC templates using system catalog informations with specified config. defineTableFromDB' :: IConnection conn - => IO conn -- ^ Connect action to system catalog database - -> Config -- ^ Configuration to generate query with - -> Driver conn -- ^ Driver definition - -> String -- ^ Schema name - -> String -- ^ Table name - -> [Name] -- ^ Derivings - -> Q [Dec] -- ^ Result declaration + => IO conn -- ^ Connect action to system catalog database + -> Driver conn -- ^ Driver definition + -> String -- ^ Schema name + -> String -- ^ Table name + -> [(String, TypeQ)] -- ^ Additional column-name and column-type mapping to overwrite default + -> [Name] -- ^ Derivings + -> Q [Dec] -- ^ Result declaration defineTableFromDB' = tableAlongWithSchema -- | Generate all HDBC templates using system catalog informations. @@ -162,7 +168,7 @@ -> String -- ^ Table name -> [Name] -- ^ Derivings -> Q [Dec] -- ^ Result declaration -defineTableFromDB connect driver = tableAlongWithSchema connect (driverConfig driver) driver +defineTableFromDB connect driver tbl scm = tableAlongWithSchema connect driver tbl scm [] -- | Verify composed 'Query' and inline it in compile type. inlineVerifiedQuery :: IConnection conn diff --git a/src/Database/HDBC/Record/Delete.hs b/src/Database/HDBC/Record/Delete.hs --- a/src/Database/HDBC/Record/Delete.hs +++ b/src/Database/HDBC/Record/Delete.hs @@ -23,7 +23,7 @@ import Database.Record (ToSql) import Database.HDBC.Record.Statement - (prepareNoFetch, withPrepareNoFetch, PreparedStatement, runPreparedNoFetch, runNoFetch) + (prepareNoFetch, withPrepareNoFetch, PreparedStatement, executeNoFetch, runNoFetch) -- | Typed prepared delete type. @@ -56,7 +56,7 @@ => PreparedDelete p -> p -> IO Integer -runPreparedDelete = runPreparedNoFetch +runPreparedDelete = executeNoFetch -- | Prepare delete statement, bind parameters, -- execute statement and get execution result. diff --git a/src/Database/HDBC/Record/Insert.hs b/src/Database/HDBC/Record/Insert.hs --- a/src/Database/HDBC/Record/Insert.hs +++ b/src/Database/HDBC/Record/Insert.hs @@ -33,7 +33,7 @@ import Database.HDBC.Record.Statement (prepareNoFetch, withPrepareNoFetch, withUnsafePrepare, PreparedStatement, untypePrepared, - BoundStatement (..), runPreparedNoFetch, runNoFetch, mapNoFetch, executeBoundNoFetch) + BoundStatement (..), executeNoFetch, runNoFetch, mapNoFetch, executeBoundNoFetch) -- | Typed prepared insert type. @@ -58,7 +58,7 @@ => PreparedInsert a -> a -> IO Integer -runPreparedInsert = runPreparedNoFetch +runPreparedInsert = executeNoFetch -- | Prepare insert statement, bind parameters, -- execute statement and get execution result. diff --git a/src/Database/HDBC/Record/InsertQuery.hs b/src/Database/HDBC/Record/InsertQuery.hs --- a/src/Database/HDBC/Record/InsertQuery.hs +++ b/src/Database/HDBC/Record/InsertQuery.hs @@ -23,7 +23,7 @@ import Database.Record (ToSql) import Database.HDBC.Record.Statement - (prepareNoFetch, withPrepareNoFetch, PreparedStatement, runPreparedNoFetch, runNoFetch) + (prepareNoFetch, withPrepareNoFetch, PreparedStatement, executeNoFetch, runNoFetch) -- | Typed prepared insert query type. type PreparedInsertQuery p = PreparedStatement p () @@ -55,7 +55,7 @@ => PreparedInsertQuery p -> p -> IO Integer -runPreparedInsertQuery = runPreparedNoFetch +runPreparedInsertQuery = executeNoFetch -- | Prepare insert statement, bind parameters, -- execute statement and get execution result. diff --git a/src/Database/HDBC/Record/Statement.hs b/src/Database/HDBC/Record/Statement.hs --- a/src/Database/HDBC/Record/Statement.hs +++ b/src/Database/HDBC/Record/Statement.hs @@ -20,11 +20,14 @@ ExecutedStatement, executed, result, - executeBound, execute, executePrepared, + executeBound, execute, prepareNoFetch, - executeBoundNoFetch, executeNoFetch, runPreparedNoFetch, + executeBoundNoFetch, executeNoFetch, runNoFetch, mapNoFetch, + + -- * Deprecated. + executePrepared, runPreparedNoFetch, ) where import Control.Exception (bracket) @@ -120,32 +123,34 @@ n <- HDBC.execute stmt (params bs) n `seq` return (ExecutedStatement stmt n) -{-# WARNING execute "Use 'executeBound' instead of this. This name will be used for executePrepared function in future release." #-} --- | Use 'executeBound' instead of this. --- WARNING! This name will be used for executePrepared function in future release. -execute :: BoundStatement a -> IO (ExecutedStatement a) -execute = executeBound - -- | Bind parameters, execute prepared statement and get executed statement. +execute :: ToSql SqlValue p => PreparedStatement p a -> p -> IO (ExecutedStatement a) +execute st = executeBound . bind st + +{-# DEPRECATED executePrepared "use `execute` instead of this." #-} +-- | Deprecated. executePrepared :: ToSql SqlValue p => PreparedStatement p a -> p -> IO (ExecutedStatement a) -executePrepared st = executeBound . bind st +executePrepared = execute -- | Typed execute operation. Only get result. executeBoundNoFetch :: BoundStatement () -> IO Integer executeBoundNoFetch = fmap result . executeBound -{-# WARNING executeNoFetch "Use 'executeBoundNoFetch' instead of this. This name will be used for runPreparedNoFetch function in future release." #-} --- | Use 'executeBoundNoFetch' instead of this. --- WARNING! This name will be used for runPreparedNoFetch function in future release. -executeNoFetch :: BoundStatement () -> IO Integer -executeNoFetch = executeBoundNoFetch - -- | Bind parameters, execute prepared statement and get execution result. +executeNoFetch :: ToSql SqlValue a + => PreparedStatement a () + -> a + -> IO Integer +executeNoFetch p = executeBoundNoFetch . (p `bind`) + + +{-# DEPRECATED runPreparedNoFetch "use `executeNoFetch` instead of this." #-} +-- | Deprecated. runPreparedNoFetch :: ToSql SqlValue a => PreparedStatement a () -> a -> IO Integer -runPreparedNoFetch p = executeBoundNoFetch . (p `bind`) +runPreparedNoFetch = executeNoFetch -- | Prepare and run sequence for polymorphic no-fetch statement. runNoFetch :: (UntypeableNoFetch s, IConnection conn, ToSql SqlValue a) diff --git a/src/Database/HDBC/Record/Update.hs b/src/Database/HDBC/Record/Update.hs --- a/src/Database/HDBC/Record/Update.hs +++ b/src/Database/HDBC/Record/Update.hs @@ -23,7 +23,7 @@ import Database.Record (ToSql) import Database.HDBC.Record.Statement - (prepareNoFetch, withPrepareNoFetch, PreparedStatement, runPreparedNoFetch, runNoFetch, mapNoFetch) + (prepareNoFetch, withPrepareNoFetch, PreparedStatement, executeNoFetch, runNoFetch, mapNoFetch) -- | Typed prepared update type. @@ -56,7 +56,7 @@ => PreparedUpdate p -> p -> IO Integer -runPreparedUpdate = runPreparedNoFetch +runPreparedUpdate = executeNoFetch -- | Prepare update statement, bind parameters, -- execute statement and get execution result. diff --git a/src/Database/HDBC/Schema/Driver.hs b/src/Database/HDBC/Schema/Driver.hs --- a/src/Database/HDBC/Schema/Driver.hs +++ b/src/Database/HDBC/Schema/Driver.hs @@ -19,9 +19,6 @@ Driver(Driver, typeMap, driverConfig, getFieldsWithMap, getPrimaryKey), emptyDriver, getFields, - - -- * Deprecated - runLog, newLogChan, ) where import Language.Haskell.TH (TypeQ) @@ -54,22 +51,12 @@ d (Warning m) = wf m d (Error m) = ef m -{-# DEPRECATED runLog "use foldLog instead of this." #-} --- | Deprecated. -runLog :: (String -> t) -> (String -> t) -> Log -> t -runLog wf = foldLog wf wf - -- | Channel to store compile-time warning messages. newtype LogChan = LogChan { chan :: IORef (DList Log) } -- | Build and return a new instance of 'LogChan'. emptyLogChan :: IO LogChan emptyLogChan = LogChan <$> newIORef mempty - -{-# DEPRECATED newLogChan "use emptyLogChan instead of this." #-} --- | Deprecated. -newLogChan :: Bool -> IO LogChan -newLogChan _ = emptyLogChan -- | Take all logs list from channel. takeLogs :: LogChan -> IO [Log]