relational-query-HDBC 0.6.4.6 → 0.6.5.0

raw patch · 14 files changed

+81/−197 lines, 14 filesdep +product-isomorphicdep −QuickCheckdep −quickcheck-simpledep −relational-query-HDBCdep ~HDBCdep ~persistable-recorddep ~relational-queryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: product-isomorphic

Dependencies removed: QuickCheck, quickcheck-simple, relational-query-HDBC

Dependency ranges changed: HDBC, persistable-record, relational-query

API changes (from Hackage documentation)

Files

• ChangeLog.md +2/−20
• relational-query-HDBC.cabal +4/−15
• src/Database/HDBC/Query/TH.hs +11/−15
• src/Database/HDBC/Record/Delete.hs +1/−1
• src/Database/HDBC/Record/Insert.hs +25/−36
• src/Database/HDBC/Record/InsertQuery.hs +1/−1
• src/Database/HDBC/Record/InternalTH.hs +1/−1
• src/Database/HDBC/Record/KeyUpdate.hs +6/−6
• src/Database/HDBC/Record/Query.hs +11/−13
• src/Database/HDBC/Record/Statement.hs +15/−20
• src/Database/HDBC/Record/Update.hs +1/−1
• src/Database/HDBC/Schema/Driver.hs +1/−1
• src/Database/HDBC/SqlValueExtra.hs +2/−3
• test/convertibleIso.hs +0/−64

@@ -1,26 +1,8 @@ <!-- -*- Markdown -*- --> -## 0.6.4.6--- fix. treat the error of compile-time macro as error.--## 0.6.4.5--- fix. do safe convert for integral conversion from SQL value.-- add test suite of conversion from and to SQL value.--## 0.6.4.4--- switch internal implementation of chunksInsert to lazy-IO.--## 0.6.4.3--- evaluate thunks in the result list of chunksInsert call.-- enable the is-disabled warning message of executeNoFetch.--## 0.6.4.2+## 0.6.5.0 -- add an upper bound of version constraint.+- apply relational-query-0.10.0  ## 0.6.4.1 

@@ -1,5 +1,5 @@ name:                relational-query-HDBC-version:             0.6.4.6+version:             0.6.5.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.@@ -55,10 +55,11 @@                        , template-haskell                        , dlist                        , th-data-compat+                       , product-isomorphic >= 0.0.3                         , names-th-                       , persistable-record >= 0.5-                       , relational-query >= 0.9.5 && < 0.10+                       , persistable-record >= 0.6+                       , relational-query >= 0.10                        , relational-schemas                        , HDBC >=2                        , HDBC-session@@ -68,18 +69,6 @@    default-language:    Haskell2010 -test-suite convertible-iso-  build-depends:         base <5-                       , QuickCheck-                       , quickcheck-simple-                       , convertible-                       , HDBC-                       , relational-query-HDBC-  type:                exitcode-stdio-1.0-  main-is:             convertibleIso.hs-  hs-source-dirs:      test-  ghc-options:         -Wall-  default-language:    Haskell2010  source-repository head   type:       git

@@ -16,7 +16,6 @@ -- and HDBC instances correspond to RDB table schema. module Database.HDBC.Query.TH (   makeRelationalRecord,-  makeRecordPersistableDefault,    defineTableDefault',   defineTableDefault,@@ -27,10 +26,11 @@   inlineVerifiedQuery   ) where -import Data.Maybe (listToMaybe, fromMaybe)-import qualified Data.Map as Map import Control.Applicative ((<$>), (<*>)) import Control.Monad (when, void)+import Data.Maybe (listToMaybe, fromMaybe)+import qualified Data.Map as Map+import Data.Functor.ProductIsomorphic.TH (reifyRecordType)  import Database.HDBC (IConnection, SqlValue, prepare) @@ -39,11 +39,11 @@ import Language.Haskell.TH.Lib.Extra (reportWarning, reportError)  import Database.Record (ToSql, FromSql)-import Database.Record.TH (recordTemplate, reifyRecordType)-import Database.Relational.Query+import Database.Record.TH (recordTemplate, defineSqlPersistableInstances)+import Database.Relational   (Config, nameConfig, recordConfig, verboseAsCompilerWarning, defaultConfig,    Relation, relationalQuerySQL, QuerySuffix)-import qualified Database.Relational.Query.TH as Relational+import qualified Database.Relational.TH as Relational  import Database.HDBC.Session (withConnectionIO) import Database.HDBC.Record.Persistable ()@@ -64,16 +64,10 @@                      -> Q [Dec] -- ^ Result declaration makeRelationalRecord recTypeName = do   rr <- Relational.makeRelationalRecordDefault recTypeName-  ((typeCon, _), _) <- reifyRecordType recTypeName-  ps <- defineInstancesForSqlValue typeCon+  (((typeCon, avs), _), _) <- reifyRecordType recTypeName+  ps <- defineSqlPersistableInstances [t| SqlValue |] typeCon avs   return $ rr ++ ps -{-# 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@@ -83,7 +77,9 @@                     -> 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 <- defineSqlPersistableInstances [t| SqlValue |]+           (fst $ recordTemplate (recordConfig $ nameConfig config) schema table)+           []   return $ modelD ++ sqlvD  -- | Generate all HDBC templates about table.

@@ -19,7 +19,7 @@  import Database.HDBC (IConnection, SqlValue) -import Database.Relational.Query (Delete)+import Database.Relational (Delete) import Database.Record (ToSql)  import Database.HDBC.Record.Statement

@@ -2,7 +2,7 @@  -- | -- Module      : Database.HDBC.Record.Insert--- Copyright   : 2013-2018 Kei Hibino+-- Copyright   : 2013 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -19,16 +19,14 @@   chunksInsert,   ) where -import Control.Applicative ((<$>), (<*>))-import System.IO.Unsafe (unsafeInterleaveIO) import Database.HDBC (IConnection, SqlValue) -import Database.Relational.Query (Insert (..), untypeChunkInsert, chunkSizeOfInsert)+import Database.Relational (Insert (..), untypeChunkInsert, chunkSizeOfInsert) import Database.Record (ToSql, fromRecord)  import Database.HDBC.Record.Statement   (prepareNoFetch, withPrepareNoFetch, withUnsafePrepare, PreparedStatement, untypePrepared,-   BoundStatement (..), runPreparedNoFetch, runNoFetch, mapNoFetch, executeBoundNoFetch)+   BoundStatement (..), runPreparedNoFetch, runNoFetch, mapNoFetch, executeNoFetch)   -- | Typed prepared insert type.@@ -77,6 +75,15 @@ chunkBind :: ToSql SqlValue p => PreparedStatement [p] () -> [p] -> BoundStatement () chunkBind q ps = BoundStatement { bound = untypePrepared q, params =  ps >>= fromRecord } +chunks :: Int -> [a] -> [Either [a] [a]]+chunks n = rec'  where+  rec' xs+    | null tl    =  [ if length c == n+                      then Right c+                      else Left  c ]+    | otherwise  =  Right c : rec' tl  where+      (c, tl) = splitAt n xs+ withPrepareChunksInsert :: (IConnection conn, ToSql SqlValue a)                         => conn                         -> Insert a@@ -87,41 +94,23 @@   (\ins -> withUnsafePrepare conn (untypeChunkInsert i0)            (\iChunk -> body ins iChunk $ chunkSizeOfInsert i0)  ) -chunks :: Int -> [a] -> ([[a]], [a])-chunks n = rec'  where-  rec' xs-    | null tl    =  if length c == n-                    then ([c], [])-                    else ( [], c)-    | otherwise  =  (c : cs, ys)  where-      (c, tl) = splitAt n xs-      (cs, ys) = rec' tl--lazyMapIO :: (a -> IO b) -> [a] -> IO [b]-lazyMapIO _  []     =  return []-lazyMapIO f (x:xs)  =  unsafeInterleaveIO $ (:) <$> f x <*> lazyMapIO f xs--chunksLazyAction :: ToSql SqlValue a+-- Prepare and insert with chunk insert statement.+chunksInsertActions :: ToSql SqlValue a                  => [a]                  -> PreparedInsert a                  -> PreparedStatement [a] ()                  -> Int-                 -> IO ([Integer], [Integer])-chunksLazyAction rs ins iChunk size =-    (,)-    <$> lazyMapIO (executeBoundNoFetch . chunkBind iChunk) cs-    <*> (unsafeInterleaveIO $ mapM (runPreparedInsert ins) xs)+                 -> IO [[Integer]]+chunksInsertActions rs ins iChunk size =+    mapM insert $ chunks size rs   where-    (cs, xs) = chunks size rs+    insert (Right c) = do+      rv <- executeNoFetch $ chunkBind iChunk c+      return [rv]+    insert (Left  c) =+      mapM (runPreparedInsert ins) c  -- | Prepare and insert with chunk insert statement.-chunksInsert :: (IConnection conn, ToSql SqlValue a)-             => conn-             -> Insert a-             -> [a]-             -> IO [[Integer]]-chunksInsert conn ins rs = do-  (zs, os) <- withPrepareChunksInsert conn ins $ chunksLazyAction rs-  let zl = length zs-      ol = length os-  zl `seq` ol `seq` return (map (: []) zs ++ [os])+chunksInsert :: (IConnection conn, ToSql SqlValue a) => conn -> Insert a -> [a] -> IO [[Integer]]+chunksInsert conn ins rs =+  withPrepareChunksInsert conn ins $ chunksInsertActions rs

@@ -19,7 +19,7 @@  import Database.HDBC (IConnection, SqlValue) -import Database.Relational.Query (InsertQuery)+import Database.Relational (InsertQuery) import Database.Record (ToSql)  import Database.HDBC.Record.Statement

@@ -30,7 +30,7 @@ import Database.Record (PersistableWidth) import Database.Record.TH (deriveNotNullType) import Database.Record.Instances ()-import Database.Relational.Query.TH (defineScalarDegree)+import Database.Relational.TH (defineScalarDegree)  import Database.HDBC.Record.TH (derivePersistableInstanceFromConvertible) 

@@ -25,13 +25,13 @@ import Database.HDBC (IConnection, SqlValue, Statement) import qualified Database.HDBC as HDBC -import Database.Relational.Query+import Database.Relational   (KeyUpdate, untypeKeyUpdate, updateValuesWithKey, Pi)-import qualified Database.Relational.Query as Query+import qualified Database.Relational as DSL import Database.Record (ToSql)  import Database.HDBC.Record.Statement-  (BoundStatement (BoundStatement, bound, params), executeBoundNoFetch)+  (BoundStatement (BoundStatement, bound, params), executeNoFetch)   -- | Typed prepared key-update type.@@ -51,7 +51,7 @@         -> IO (PreparedKeyUpdate p a) prepare conn ku = fmap (PreparedKeyUpdate key) . HDBC.prepare conn $ sql  where   sql = untypeKeyUpdate ku-  key = Query.updateKey ku+  key = DSL.updateKey ku  -- | Same as 'prepare'. prepareKeyUpdate :: IConnection conn@@ -71,7 +71,7 @@     $ body . PreparedKeyUpdate key   where     sql = untypeKeyUpdate ku-    key = Query.updateKey ku+    key = DSL.updateKey ku  -- | Typed operation to bind parameters for 'PreparedKeyUpdate' type. bindKeyUpdate :: ToSql SqlValue a@@ -87,7 +87,7 @@                      => PreparedKeyUpdate p a                      -> a                      -> IO Integer-runPreparedKeyUpdate pre = executeBoundNoFetch . bindKeyUpdate pre+runPreparedKeyUpdate pre = executeNoFetch . bindKeyUpdate pre  -- | Prepare insert statement, bind parameters, --   execute statement and get execution result.

@@ -26,9 +26,8 @@ import Database.HDBC (IConnection, Statement, SqlValue) import qualified Database.HDBC as HDBC -import Database.Relational.Query (Query, untypeQuery)-import Database.Record-  (ToSql, RecordFromSql, FromSql(recordFromSql), runToRecord)+import Database.Relational (Query, untypeQuery)+import Database.Record (ToSql, FromSql, toRecord)  import Database.HDBC.Record.Statement   (unsafePrepare, withUnsafePrepare, PreparedStatement,@@ -62,26 +61,25 @@ withPrepareQuery conn = withUnsafePrepare conn . untypeQuery  -- | Polymorphic fetch operation.-fetchRecordsExplicit :: Functor f-                     => (Statement -> IO (f [SqlValue]) )-                     -> RecordFromSql SqlValue a-                     -> ExecutedStatement a-                     -> IO (f a)-fetchRecordsExplicit fetchs fromSql es = do+fetchRecords :: (Functor f, FromSql SqlValue a)+             => (Statement -> IO (f [SqlValue]) )+             -> ExecutedStatement a+             -> IO (f a)+fetchRecords fetchs es = do   rows <- fetchs (executed es)-  return $ fmap (runToRecord fromSql) rows+  return $ fmap toRecord rows  -- | Fetch a record. fetch :: FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a)-fetch =  fetchRecordsExplicit HDBC.fetchRow recordFromSql+fetch =  fetchRecords HDBC.fetchRow  -- | Lazily Fetch all records. fetchAll :: FromSql SqlValue a => ExecutedStatement a -> IO [a]-fetchAll =  fetchRecordsExplicit HDBC.fetchAllRows recordFromSql+fetchAll =  fetchRecords HDBC.fetchAllRows  -- | Strict version of 'fetchAll'. fetchAll' :: FromSql SqlValue a => ExecutedStatement a -> IO [a]-fetchAll' =  fetchRecordsExplicit HDBC.fetchAllRows' recordFromSql+fetchAll' =  fetchRecords HDBC.fetchAllRows'  -- | Fetch all records but get only first record. --   Expecting result records is unique.

@@ -2,7 +2,7 @@  -- | -- Module      : Database.HDBC.Record.Statement--- Copyright   : 2013-2018 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -16,7 +16,7 @@    withUnsafePrepare, withPrepareNoFetch, -  BoundStatement (..), bind', bind, bindTo,+  BoundStatement (..), bind, bindTo,    ExecutedStatement, executed, result, @@ -28,12 +28,11 @@   ) where  import Control.Exception (bracket)-import Database.Relational.Query (UntypeableNoFetch (untypeNoFetch))+import Database.Relational (UntypeableNoFetch (untypeNoFetch)) import Database.HDBC (IConnection, Statement, SqlValue) import qualified Database.HDBC as HDBC -import Database.Record-  (RecordToSql, ToSql(recordToSql), runFromRecord)+import Database.Record (ToSql, fromRecord)  -- | Typed prepared statement type. newtype PreparedStatement p a =@@ -47,7 +46,7 @@   BoundStatement   {     -- | Untyped prepared statement before executed.-    bound  :: !Statement+    bound  :: Statement     -- | Bound parameters.   , params :: [SqlValue]   }@@ -56,9 +55,9 @@ data ExecutedStatement a =   ExecutedStatement   { -- | Untyped executed statement.-    executed :: !Statement+    executed :: Statement     -- | Result of HDBC execute.-  , result   :: !Integer+  , result   :: Integer   }  -- | Unsafely untype prepared statement.@@ -103,16 +102,12 @@ withPrepareNoFetch conn s =   bracket (prepareNoFetch conn s) finish --- | Typed operation to bind parameters.-bind' :: RecordToSql SqlValue p -- ^ Proof object to convert from parameter type 'p' into 'SqlValue' list.-      -> PreparedStatement p a  -- ^ Prepared query to bind to-      -> p                      -- ^ Parameter to bind-      -> BoundStatement a       -- ^ Result parameter bound statement-bind' toSql q p = BoundStatement { bound = prepared q, params = runFromRecord toSql p }---- | Typed operation to bind parameters. Inferred 'RecordToSql' is used.-bind :: ToSql SqlValue p => PreparedStatement p a -> p -> BoundStatement a-bind =  bind' recordToSql+-- | Typed operation to bind parameters. Inferred 'ToSql' is used.+bind :: ToSql SqlValue p+     => PreparedStatement p a -- ^ Prepared query to bind to+     -> p                     -- ^ Parameter to bind+     -> BoundStatement a      -- ^ Result parameter bound statement+bind q p = BoundStatement { bound = prepared q, params = fromRecord p }  -- | Same as 'bind' except for argument is flipped. bindTo :: ToSql SqlValue p => p -> PreparedStatement p a -> BoundStatement a@@ -123,7 +118,7 @@ executeBound bs = do   let stmt = bound bs   n <- HDBC.execute stmt (params bs)-  n `seq` return (ExecutedStatement stmt n)+  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.@@ -139,7 +134,7 @@ 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." #-}+{- 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

@@ -19,7 +19,7 @@  import Database.HDBC (IConnection, SqlValue) -import Database.Relational.Query (Update)+import Database.Relational (Update) import Database.Record (ToSql)  import Database.HDBC.Record.Statement

@@ -75,7 +75,7 @@  -- | Push an error string into 'LogChan'. putError :: LogChan -> String -> IO ()-putError lchan = putLog lchan . Error+putError lchan = putLog lchan . Warning  -- | Push an error string into 'LogChan' and return failed context. failWith :: LogChan -> String -> MaybeT IO a

@@ -1,5 +1,4 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS -fno-warn-orphans #-}  -- |@@ -21,9 +20,9 @@ safeConvertFromIntegral32 i =   safeConvert (fromIntegral i :: Int32) -safeConvertToIntegral32 :: Convertible Int32 a => SqlValue -> ConvertResult a+safeConvertToIntegral32 :: Integral a => SqlValue -> ConvertResult a safeConvertToIntegral32 v =-  safeConvert =<< (safeConvert v :: ConvertResult Int32)+  fmap fromIntegral (safeConvert v :: ConvertResult Int32)  instance Convertible Int8 SqlValue where   safeConvert = safeConvertFromIntegral32

@@ -1,64 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}--import Control.Applicative ((<$>))-import Data.Int (Int8, Int16)-import Data.Convertible (Convertible, safeConvert, ConvertResult)-import Database.HDBC (SqlValue (SqlInteger))--import Test.QuickCheck (Arbitrary (..), resize)-import Test.QuickCheck.Simple (qcTest, defaultMain)--import Database.HDBC.Record.Persistable ()----prop_toFromQvInt8 :: Int8 -> Bool-prop_toFromQvInt8 i8 = Right i8 == (safeConvert =<< sv)-  where-    sv :: ConvertResult SqlValue-    sv = safeConvert i8--prop_toFromQvInt16 :: Int16 -> Bool-prop_toFromQvInt16 i16 = Right i16 == (safeConvert =<< sv)-  where-    sv :: ConvertResult SqlValue-    sv = safeConvert i16---newtype IntegerR i =-  IntegerR Integer-  deriving (Eq, Show)--instance Arbitrary (IntegerR Int8) where-  arbitrary = IntegerR <$> resize 1000 arbitrary--instance Arbitrary (IntegerR Int16) where-  arbitrary = IntegerR <$> resize 100000 arbitrary---prop_fromToQvBounded :: (Integral a, Convertible SqlValue a, Convertible a SqlValue)-                     => a -> a -> IntegerR a -> Bool-prop_fromToQvBounded mn' mx' (IntegerR i)-  | i < mn || mx < i  =  True-  | otherwise         =  Right sv == (safeConvert =<< ix)-  where-    sv = SqlInteger i-    ix = safeConvert sv `asTypeOf` Right mn'-    mn = fromIntegral mn'-    mx = fromIntegral mx'--prop_fromToQvInt8 :: IntegerR Int8 -> Bool-prop_fromToQvInt8 = prop_fromToQvBounded minBound maxBound--prop_fromToQvInt16 :: IntegerR Int16 -> Bool-prop_fromToQvInt16 = prop_fromToQvBounded minBound maxBound--main :: IO ()-main =-  defaultMain-  [ qcTest "int8  - to SqlV from SqlV" prop_toFromQvInt8-  , qcTest "int16 - to SqlV from SqlV" prop_toFromQvInt16-  , qcTest "int8  - from SqlV to SqlV" prop_fromToQvInt8-  , qcTest "int16 - from SqlV to SqlV" prop_fromToQvInt16-  ]