relational-query-HDBC 0.6.4.3 → 0.6.4.4

raw patch · 3 files changed

+38/−23 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• relational-query-HDBC.cabal +1/−1
• src/Database/HDBC/Record/Insert.hs +33/−22

@@ -1,5 +1,9 @@ <!-- -*- Markdown -*- --> +## 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.

@@ -1,5 +1,5 @@ name:                relational-query-HDBC-version:             0.6.4.3+version:             0.6.4.4 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.

@@ -19,6 +19,8 @@   chunksInsert,   ) where +import Control.Applicative ((<$>), (<*>))+import System.IO.Unsafe (unsafeInterleaveIO) import Database.HDBC (IConnection, SqlValue)  import Database.Relational.Query (Insert (..), untypeChunkInsert, chunkSizeOfInsert)@@ -75,15 +77,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 +87,41 @@   (\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 <- executeBoundNoFetch $ chunkBind iChunk c-      rv `seq` 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+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])