relational-query-HDBC 0.6.7.1 → 0.6.8.0

raw patch · 5 files changed

+50/−33 lines, 5 filesdep ~relational-queryPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: relational-query

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−1
• relational-query-HDBC.cabal +2/−2
• src/Database/HDBC/Query/TH.hs +13/−7
• src/Database/HDBC/Schema/Driver.hs +29/−21
• src/Database/HDBC/Schema/PostgreSQL.hs +1/−2

@@ -1,8 +1,12 @@ <!-- -*- Markdown -*- --> +## 0.6.8.0++- apply enableWarning flag in Config type.+ ## 0.6.7.1 -- fix do safe convert for integral conversion from SQL value.+- fix. do safe convert for integral conversion from SQL value. - add test suite of conversion from and to SQL value.  ## 0.6.7.0

@@ -1,5 +1,5 @@ name:                relational-query-HDBC-version:             0.6.7.1+version:             0.6.8.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.@@ -62,7 +62,7 @@                        , names-th                        , sql-words                        , persistable-record >= 0.6-                       , relational-query >= 0.11+                       , relational-query >= 0.11.2                        , relational-schemas                        , HDBC >=2                        , HDBC-session

@@ -27,7 +27,7 @@   inlineVerifiedQuery   ) where -import Control.Applicative ((<$>), (<*>))+import Control.Applicative ((<$>), pure, (<*>)) import Control.Monad (when, void) import Data.Maybe (listToMaybe, fromMaybe) import qualified Data.Map as Map@@ -42,15 +42,15 @@ import Database.Record (ToSql, FromSql) import Database.Record.TH (recordTemplate, defineSqlPersistableInstances) import Database.Relational-  (Config, nameConfig, recordConfig, verboseAsCompilerWarning, defaultConfig,-   Relation, relationalQuerySQL, QuerySuffix)+  (Config, nameConfig, recordConfig, enableWarning, verboseAsCompilerWarning,+   defaultConfig, Relation, relationalQuerySQL, QuerySuffix) import qualified Database.Relational.TH as Relational  import Database.HDBC.Session (withConnectionIO) import Database.HDBC.Record.Persistable ()  import Database.HDBC.Schema.Driver-  (runLog, newLogChan, takeLogs, Driver, driverConfig, getFields, getPrimaryKey)+  (foldLog, emptyLogChan, takeLogs, Driver, driverConfig, getFields, getPrimaryKey)   defineInstancesForSqlValue :: TypeQ   -- ^ Record type constructor.@@ -113,7 +113,7 @@                      -> Q [Dec]     -- ^ Result declaration tableAlongWithSchema connect config drv scm tbl derives = do   let getDBinfo = do-        logChan  <-  newLogChan $ verboseAsCompilerWarning config+        logChan  <-  emptyLogChan         infoP    <-  withConnectionIO connect                      (\conn ->                        (,)@@ -122,8 +122,14 @@         (,) infoP <$> takeLogs logChan    (((cols, notNullIdxs), primaryCols), logs) <- runIO getDBinfo-  mapM_ (runLog reportWarning reportError) logs-  when (null primaryCols) . reportWarning+  let reportWarning'+        | enableWarning config             =  reportWarning+        | otherwise                        =  const $ pure ()+      reportVerbose+        | verboseAsCompilerWarning config  =  reportWarning+        | otherwise                        =  const $ pure ()+  mapM_ (foldLog reportVerbose reportWarning' reportError) logs+  when (null primaryCols) . reportWarning'     $ "getPrimaryKey: Primary key not found for table: " ++ scm ++ "." ++ tbl    let colIxMap = Map.fromList $ zip [c | (c, _) <- cols] [(0 :: Int) .. ]

@@ -12,17 +12,20 @@ module Database.HDBC.Schema.Driver (   TypeMap, -  Log, runLog,-  LogChan, newLogChan, takeLogs, putWarning, putError, putVerbose,+  Log, foldLog,+  LogChan, emptyLogChan, takeLogs, putWarning, putError, putVerbose,   failWith, hoistMaybe, maybeIO,    Driver(Driver, typeMap, driverConfig, getFieldsWithMap, getPrimaryKey),   emptyDriver,-  getFields+  getFields,++  -- * Deprecated+  runLog, newLogChan,   ) where  import Language.Haskell.TH (TypeQ)-import Control.Applicative ((<$>), pure, (<*>))+import Control.Applicative ((<$>), pure) import Control.Monad (MonadPlus, mzero) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (..))@@ -40,26 +43,33 @@  -- | Log string type for compile time. data Log-  = Warning String+  = Verbose String+  | Warning String   | Error String  -- | Folding operation of 'Log' type.-runLog :: (String -> t) -> (String -> t) -> Log -> t-runLog wf ef = d  where+foldLog :: (String -> t) -> (String -> t) -> (String -> t) -> Log -> t+foldLog vf wf ef = d  where+  d (Verbose m) = vf m   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.-data LogChan =-  LogChan-  { chan :: IORef (DList Log)-  , verboseAsWarning :: Bool-  }+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 v =-  LogChan <$> newIORef mempty <*> pure v+newLogChan _ = emptyLogChan  -- | Take all logs list from channel. takeLogs :: LogChan -> IO [Log]@@ -77,8 +87,12 @@  -- | Push an error string into 'LogChan'. putError :: LogChan -> String -> IO ()-putError lchan = putLog lchan . Warning+putError lchan = putLog lchan . Error +-- | Put verbose compile-time message as warning when 'verboseAsWarning'.+putVerbose :: LogChan -> String -> IO ()+putVerbose lchan = putLog lchan . Verbose+ -- | Push an error string into 'LogChan' and return failed context. failWith :: LogChan -> String -> MaybeT IO a failWith lchan m = do@@ -98,12 +112,6 @@ -- | Run 'MaybeT' with default value. maybeIO :: b -> (a -> b) -> MaybeT IO a -> IO b maybeIO = maybeT---- | Put verbose compile-time message as warning when 'verboseAsWarning'.-putVerbose :: LogChan -> String -> IO ()-putVerbose lchan-  | verboseAsWarning lchan  =  putWarning lchan . ("info: " ++)-  | otherwise               =  const $ pure ()  -- | Interface type to load database system catalog via HDBC. data Driver conn =

@@ -72,8 +72,7 @@       tbl = map toLower tbl'   mayKeyLen <- runQuery' conn primaryKeyLengthQuerySQL (scm, tbl)   case mayKeyLen of-    []        -> do-      putLog lchan   "getPrimaryKey: Primary key not found."+    []        ->       return []     [keyLen]  -> do       primCols <- runQuery' conn (primaryKeyQuerySQL keyLen) (scm, tbl)