relational-query-HDBC 0.6.6.1 → 0.6.7.0

raw patch · 6 files changed

+129/−48 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• relational-query-HDBC.cabal +4/−3
• src/Database/HDBC/Record/Insert.hs +83/−25
• src/Database/HDBC/Record/KeyUpdate.hs +2/−2
• src/Database/HDBC/Record/Query.hs +28/−12
• src/Database/HDBC/Record/Statement.hs +6/−6

@@ -1,5 +1,11 @@ <!-- -*- Markdown -*- --> +## 0.6.7.0++- add bulkInsert definitions, and deprecate chunksInsert.+- enable the mis-disabled warning message of executeNoFetch.+- make statement operations strict.+ ## 0.6.6.1  - update version constraint. ( along with re-versioned relational-query. )

@@ -1,5 +1,5 @@ name:                relational-query-HDBC-version:             0.6.6.1+version:             0.6.7.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.@@ -11,11 +11,12 @@ license-file:        LICENSE author:              Kei Hibino, Shohei Murayama, Shohei Yasutake, Sho KURODA maintainer:          ex8k.hibino@gmail.com, shohei.murayama@gmail.com, amutake.s@gmail.com, krdlab@gmail.com-copyright:           Copyright (c) 2013-2017 Kei Hibino, Shohei Murayama, Shohei Yasutake, Sho KURODA+copyright:           Copyright (c) 2013-2018 Kei Hibino, Shohei Murayama, Shohei Yasutake, Sho KURODA category:            Database build-type:          Simple cabal-version:       >=1.10-tested-with:           GHC == 8.2.1+tested-with:           GHC == 8.4.1, GHC == 8.4.2, GHC == 8.4.3+                     , GHC == 8.2.1, GHC == 8.2.2                      , GHC == 8.0.1, GHC == 8.0.2                      , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3                      , GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4

@@ -2,7 +2,7 @@  -- | -- Module      : Database.HDBC.Record.Insert--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2018 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -16,9 +16,16 @@    runPreparedInsert, runInsert, mapInsert, +  bulkInsert,+  bulkInsert',+  bulkInsertInterleave,+   chunksInsert,   ) where +import Control.Applicative ((<$>), (<*>))+import Control.Monad (unless)+import System.IO.Unsafe (unsafeInterleaveIO) import Database.HDBC (IConnection, SqlValue)  import Database.Relational (Insert (..), untypeChunkInsert, chunkSizeOfInsert)@@ -26,7 +33,7 @@  import Database.HDBC.Record.Statement   (prepareNoFetch, withPrepareNoFetch, withUnsafePrepare, PreparedStatement, untypePrepared,-   BoundStatement (..), runPreparedNoFetch, runNoFetch, mapNoFetch, executeNoFetch)+   BoundStatement (..), runPreparedNoFetch, runNoFetch, mapNoFetch, executeBoundNoFetch)   -- | Typed prepared insert type.@@ -75,15 +82,6 @@ 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@@ -94,23 +92,83 @@   (\ins -> withUnsafePrepare conn (untypeChunkInsert i0)            (\iChunk -> body ins iChunk $ chunkSizeOfInsert i0)  ) --- Prepare and insert with chunk insert statement.-chunksInsertActions :: ToSql SqlValue a+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                  => [a]                  -> PreparedInsert a                  -> PreparedStatement [a] ()                  -> Int-                 -> IO [[Integer]]-chunksInsertActions rs ins iChunk size =-    mapM insert $ chunks size rs+                 -> IO ([Integer], [Integer])+chunksLazyAction rs ins iChunk size =+    (,)+    <$> lazyMapIO (executeBoundNoFetch . chunkBind iChunk) cs+    <*> (unsafeInterleaveIO $ mapM (runPreparedInsert ins) xs)   where-    insert (Right c) = do-      rv <- executeNoFetch $ chunkBind iChunk c-      return [rv]-    insert (Left  c) =-      mapM (runPreparedInsert ins) c+    (cs, xs) = chunks size rs --- | Prepare and insert with chunk insert statement.-chunksInsert :: (IConnection conn, ToSql SqlValue a) => conn -> Insert a -> [a] -> IO [[Integer]]-chunksInsert conn ins rs =-  withPrepareChunksInsert conn ins $ chunksInsertActions rs+-- | Prepare and insert using chunk insert statement, with the Lazy-IO results of insert statements.+bulkInsertInterleave :: (IConnection conn, ToSql SqlValue a)+                     => conn+                     -> Insert a+                     -> [a]+                     -> IO ([Integer], [Integer])+bulkInsertInterleave conn ins =+  withPrepareChunksInsert conn ins . chunksLazyAction++chunksAction :: ToSql SqlValue a+             => [a]+             -> PreparedInsert a+             -> PreparedStatement [a] ()+             -> Int+             -> IO ()+chunksAction rs ins iChunk size = do+    (zs, os)  <-  chunksLazyAction rs ins iChunk size+    unless (all (== fromIntegral size) zs)+      $ fail "chunksAction: chunks: unexpected result size!"+    unless (all (== 1) os)+      $ fail "chunksAction: tails: unexpected result size!"++-- | Prepare and insert using chunk insert statement.+bulkInsert :: (IConnection conn, ToSql SqlValue a)+           => conn+           -> Insert a+           -> [a]+           -> IO ()+bulkInsert conn ins =+  withPrepareChunksInsert conn ins . chunksAction++-- | Prepare and insert using chunk insert statement, with the results of insert statements.+bulkInsert' :: (IConnection conn, ToSql SqlValue a)+             => conn+             -> Insert a+             -> [a]+             -> IO ([Integer], [Integer])+bulkInsert' conn ins rs = do+  p@(zs, os) <- withPrepareChunksInsert conn ins $ chunksLazyAction rs+  let zl = length zs+      ol = length os+  zl `seq` ol `seq` return p++{-# DEPRECATED chunksInsert "use bulkInsert' instead of this." #-}+-- | Deprecated. Use bulkInsert' instead of this. Prepare and insert using chunk insert statement.+chunksInsert :: (IConnection conn, ToSql SqlValue a)+             => conn+             -> Insert a+             -> [a]+             -> IO [[Integer]]+chunksInsert conn ins rs = do+  (zs, os) <- bulkInsert' conn ins rs+  return $ map (: []) zs ++ [os]

@@ -31,7 +31,7 @@ import Database.Record (ToSql)  import Database.HDBC.Record.Statement-  (BoundStatement (BoundStatement, bound, params), executeNoFetch)+  (BoundStatement (BoundStatement, bound, params), executeBoundNoFetch)   -- | Typed prepared key-update type.@@ -87,7 +87,7 @@                      => PreparedKeyUpdate p a                      -> a                      -> IO Integer-runPreparedKeyUpdate pre = executeNoFetch . bindKeyUpdate pre+runPreparedKeyUpdate pre = executeBoundNoFetch . bindKeyUpdate pre  -- | Prepare insert statement, bind parameters, --   execute statement and get execution result.

@@ -12,14 +12,23 @@ -- This module provides typed 'Query' running sequence -- which intermediate structures are typed. module Database.HDBC.Record.Query (+  -- * Prepare   PreparedQuery, prepare, prepareQuery, withPrepareQuery, -  fetch, fetchAll, fetchAll',+  -- * Fetch strictly+  fetch, fetchAll',   listToUnique, fetchUnique, fetchUnique', -  runStatement, runStatement',-  runPreparedQuery, runPreparedQuery',-  runQuery, runQuery'+  runStatement',+  runPreparedQuery',+  runQuery',++  -- * Fetch with Lazy-IO+  -- $fetchWithLazyIO+  fetchAll,+  runStatement,+  runPreparedQuery,+  runQuery,   ) where  import Data.Maybe (listToMaybe)@@ -69,15 +78,22 @@   rows <- fetchs (executed es)   return $ fmap toRecord rows +{- $fetchWithLazyIO+__CAUTION!!__++/Lazy-IO/ APIs may be harmful in complex transaction with RDBMs interfaces+which require sequential ordered calls of low-level APIs.+ -}+ -- | Fetch a record. fetch :: FromSql SqlValue a => ExecutedStatement a -> IO (Maybe a) fetch =  fetchRecords HDBC.fetchRow --- | Lazily Fetch all records.+-- | /Lazy-IO/ version of 'fetchAll''. fetchAll :: FromSql SqlValue a => ExecutedStatement a -> IO [a] fetchAll =  fetchRecords HDBC.fetchAllRows --- | Strict version of 'fetchAll'.+-- | Strictly fetch all records. fetchAll' :: FromSql SqlValue a => ExecutedStatement a -> IO [a] fetchAll' =  fetchRecords HDBC.fetchAllRows' @@ -108,29 +124,29 @@   HDBC.finish $ executed es   return z --- | Execute statement and lazily fetch all records.+-- | /Lazy-IO/ version of 'runStatement''. runStatement :: FromSql SqlValue a => BoundStatement a -> IO [a] runStatement =  (>>= fetchAll) . executeBound --- | Strict version of 'runStatement'.+-- | Execute a parameter-bounded statement and strictly fetch all records. runStatement' :: FromSql SqlValue a => BoundStatement a -> IO [a] runStatement' =  (>>= fetchAll') . executeBound --- | Bind parameters, execute statement and lazily fetch all records.+-- | /Lazy-IO/ version of 'runPreparedQuery''. runPreparedQuery :: (ToSql SqlValue p, FromSql SqlValue a)                  => PreparedQuery p a -- ^ Statement to bind to                  -> p                 -- ^ Parameter type                  -> IO [a]            -- ^ Action to get records runPreparedQuery ps = runStatement . bind ps --- | Strict version of 'runPreparedQuery'.+-- | Bind parameters, execute statement and strictly fetch all records. runPreparedQuery' :: (ToSql SqlValue p, FromSql SqlValue a)                   => PreparedQuery p a -- ^ Statement to bind to                   -> p                 -- ^ Parameter type                   -> IO [a]            -- ^ Action to get records runPreparedQuery' ps = runStatement' . bind ps --- | Prepare SQL, bind parameters, execute statement and lazily fetch all records.+-- | /Lazy-IO/ version of 'runQuery''. runQuery :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a)          => conn      -- ^ Database connection          -> Query p a -- ^ Query to get record type 'a' requires parameter 'p'@@ -138,7 +154,7 @@          -> IO [a]    -- ^ Action to get records runQuery conn q p = prepare conn q >>= (`runPreparedQuery` p) --- | Strict version of 'runQuery'.+-- | Prepare SQL, bind parameters, execute statement and strictly fetch all records. runQuery' :: (IConnection conn, ToSql SqlValue p, FromSql SqlValue a)           => conn      -- ^ Database connection           -> Query p a -- ^ Query to get record type 'a' requires parameter 'p'

@@ -2,7 +2,7 @@  -- | -- Module      : Database.HDBC.Record.Statement--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2018 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -46,7 +46,7 @@   BoundStatement   {     -- | Untyped prepared statement before executed.-    bound  :: Statement+    bound  :: !Statement     -- | Bound parameters.   , params :: [SqlValue]   }@@ -55,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.@@ -118,7 +118,7 @@ executeBound bs = do   let stmt = bound bs   n <- HDBC.execute stmt (params bs)-  return $ ExecutedStatement stmt n+  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.@@ -134,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