{-# LANGUAGE FlexibleContexts #-}
module Database.HDBC.Record.Insert (
PreparedInsert, prepare, prepareInsert,
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)
import Database.Record (ToSql, fromRecord)
import Database.HDBC.Record.Statement
(prepareNoFetch, withPrepareNoFetch, withUnsafePrepare, PreparedStatement, untypePrepared,
BoundStatement (..), executeNoFetch, runNoFetch, mapNoFetch, executeBoundNoFetch)
type PreparedInsert a = PreparedStatement a ()
prepare :: IConnection conn
=> conn
-> Insert a
-> IO (PreparedInsert a)
prepare :: conn -> Insert a -> IO (PreparedInsert a)
prepare = conn -> Insert a -> IO (PreparedInsert a)
forall (s :: * -> *) conn p.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> IO (PreparedStatement p ())
prepareNoFetch
prepareInsert :: IConnection conn
=> conn
-> Insert a
-> IO (PreparedInsert a)
prepareInsert :: conn -> Insert a -> IO (PreparedInsert a)
prepareInsert = conn -> Insert a -> IO (PreparedInsert a)
forall conn a.
IConnection conn =>
conn -> Insert a -> IO (PreparedInsert a)
prepare
runPreparedInsert :: ToSql SqlValue a
=> PreparedInsert a
-> a
-> IO Integer
runPreparedInsert :: PreparedInsert a -> a -> IO Integer
runPreparedInsert = PreparedInsert a -> a -> IO Integer
forall a.
ToSql SqlValue a =>
PreparedStatement a () -> a -> IO Integer
executeNoFetch
runInsert :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> a
-> IO Integer
runInsert :: conn -> Insert a -> a -> IO Integer
runInsert = conn -> Insert a -> a -> IO Integer
forall (s :: * -> *) conn a.
(UntypeableNoFetch s, IConnection conn, ToSql SqlValue a) =>
conn -> s a -> a -> IO Integer
runNoFetch
mapInsert :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> [a]
-> IO [Integer]
mapInsert :: conn -> Insert a -> [a] -> IO [Integer]
mapInsert = conn -> Insert a -> [a] -> IO [Integer]
forall (s :: * -> *) conn a.
(UntypeableNoFetch s, IConnection conn, ToSql SqlValue a) =>
conn -> s a -> [a] -> IO [Integer]
mapNoFetch
chunkBind :: ToSql SqlValue p => PreparedStatement [p] () -> [p] -> BoundStatement ()
chunkBind :: PreparedStatement [p] () -> [p] -> BoundStatement ()
chunkBind q :: PreparedStatement [p] ()
q ps :: [p]
ps = $WBoundStatement :: forall a. Statement -> [SqlValue] -> BoundStatement a
BoundStatement { bound :: Statement
bound = PreparedStatement [p] () -> Statement
forall p a. PreparedStatement p a -> Statement
untypePrepared PreparedStatement [p] ()
q, params :: [SqlValue]
params = [p]
ps [p] -> (p -> [SqlValue]) -> [SqlValue]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= p -> [SqlValue]
forall q a. ToSql q a => a -> [q]
fromRecord }
withPrepareChunksInsert :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> (PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b)
-> IO b
withPrepareChunksInsert :: conn
-> Insert a
-> (PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b)
-> IO b
withPrepareChunksInsert conn :: conn
conn i0 :: Insert a
i0 body :: PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b
body =
conn -> Insert a -> (PreparedInsert a -> IO b) -> IO b
forall (s :: * -> *) conn p a.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> (PreparedStatement p () -> IO a) -> IO a
withPrepareNoFetch conn
conn Insert a
i0
(\ins :: PreparedInsert a
ins -> conn -> String -> (PreparedStatement [p] () -> IO b) -> IO b
forall conn p a b.
IConnection conn =>
conn -> String -> (PreparedStatement p a -> IO b) -> IO b
withUnsafePrepare conn
conn (Insert a -> String
forall a. Insert a -> String
untypeChunkInsert Insert a
i0)
(\iChunk :: PreparedStatement [p] ()
iChunk -> PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b
body PreparedInsert a
ins PreparedStatement [p] ()
iChunk (Int -> IO b) -> Int -> IO b
forall a b. (a -> b) -> a -> b
$ Insert a -> Int
forall a. Insert a -> Int
chunkSizeOfInsert Insert a
i0) )
chunks :: Int -> [a] -> ([[a]], [a])
chunks :: Int -> [a] -> ([[a]], [a])
chunks n :: Int
n = [a] -> ([[a]], [a])
forall a. [a] -> ([[a]], [a])
rec' where
rec' :: [a] -> ([[a]], [a])
rec' xs :: [a]
xs
| [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
tl = if [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
then ([[a]
c], [])
else ( [], [a]
c)
| Bool
otherwise = ([a]
c [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
cs, [a]
ys) where
(c :: [a]
c, tl :: [a]
tl) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs
(cs :: [[a]]
cs, ys :: [a]
ys) = [a] -> ([[a]], [a])
rec' [a]
tl
lazyMapIO :: (a -> IO b) -> [a] -> IO [b]
lazyMapIO :: (a -> IO b) -> [a] -> IO [b]
lazyMapIO _ [] = [b] -> IO [b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
lazyMapIO f :: a -> IO b
f (x :: a
x:xs :: [a]
xs) = IO [b] -> IO [b]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [b] -> IO [b]) -> IO [b] -> IO [b]
forall a b. (a -> b) -> a -> b
$ (:) (b -> [b] -> [b]) -> IO b -> IO ([b] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> IO b
f a
x IO ([b] -> [b]) -> IO [b] -> IO [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> IO b) -> [a] -> IO [b]
forall a b. (a -> IO b) -> [a] -> IO [b]
lazyMapIO a -> IO b
f [a]
xs
chunksLazyAction :: ToSql SqlValue a
=> [a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer])
chunksLazyAction :: [a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer])
chunksLazyAction rs :: [a]
rs ins :: PreparedInsert a
ins iChunk :: PreparedStatement [a] ()
iChunk size :: Int
size =
(,)
([Integer] -> [Integer] -> ([Integer], [Integer]))
-> IO [Integer] -> IO ([Integer] -> ([Integer], [Integer]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> IO Integer) -> [[a]] -> IO [Integer]
forall a b. (a -> IO b) -> [a] -> IO [b]
lazyMapIO (BoundStatement () -> IO Integer
executeBoundNoFetch (BoundStatement () -> IO Integer)
-> ([a] -> BoundStatement ()) -> [a] -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreparedStatement [a] () -> [a] -> BoundStatement ()
forall p.
ToSql SqlValue p =>
PreparedStatement [p] () -> [p] -> BoundStatement ()
chunkBind PreparedStatement [a] ()
iChunk) [[a]]
cs
IO ([Integer] -> ([Integer], [Integer]))
-> IO [Integer] -> IO ([Integer], [Integer])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO [Integer] -> IO [Integer]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [Integer] -> IO [Integer]) -> IO [Integer] -> IO [Integer]
forall a b. (a -> b) -> a -> b
$ (a -> IO Integer) -> [a] -> IO [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PreparedInsert a -> a -> IO Integer
forall a.
ToSql SqlValue a =>
PreparedStatement a () -> a -> IO Integer
runPreparedInsert PreparedInsert a
ins) [a]
xs)
where
(cs :: [[a]]
cs, xs :: [a]
xs) = Int -> [a] -> ([[a]], [a])
forall a. Int -> [a] -> ([[a]], [a])
chunks Int
size [a]
rs
bulkInsertInterleave :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> [a]
-> IO ([Integer], [Integer])
bulkInsertInterleave :: conn -> Insert a -> [a] -> IO ([Integer], [Integer])
bulkInsertInterleave conn :: conn
conn ins :: Insert a
ins =
conn
-> Insert a
-> (PreparedInsert a
-> PreparedStatement [a] () -> Int -> IO ([Integer], [Integer]))
-> IO ([Integer], [Integer])
forall conn a p b.
(IConnection conn, ToSql SqlValue a) =>
conn
-> Insert a
-> (PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b)
-> IO b
withPrepareChunksInsert conn
conn Insert a
ins ((PreparedInsert a
-> PreparedStatement [a] () -> Int -> IO ([Integer], [Integer]))
-> IO ([Integer], [Integer]))
-> ([a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer]))
-> [a]
-> IO ([Integer], [Integer])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer])
forall a.
ToSql SqlValue a =>
[a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer])
chunksLazyAction
chunksAction :: ToSql SqlValue a
=> [a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ()
chunksAction :: [a] -> PreparedInsert a -> PreparedStatement [a] () -> Int -> IO ()
chunksAction rs :: [a]
rs ins :: PreparedInsert a
ins iChunk :: PreparedStatement [a] ()
iChunk size :: Int
size = do
(zs :: [Integer]
zs, os :: [Integer]
os) <- [a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer])
forall a.
ToSql SqlValue a =>
[a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer])
chunksLazyAction [a]
rs PreparedInsert a
ins PreparedStatement [a] ()
iChunk Int
size
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) [Integer]
zs)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "chunksAction: chunks: unexpected result size!"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Integer -> Bool) -> [Integer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1) [Integer]
os)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "chunksAction: tails: unexpected result size!"
bulkInsert :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> [a]
-> IO ()
bulkInsert :: conn -> Insert a -> [a] -> IO ()
bulkInsert conn :: conn
conn ins :: Insert a
ins =
conn
-> Insert a
-> (PreparedInsert a -> PreparedStatement [a] () -> Int -> IO ())
-> IO ()
forall conn a p b.
(IConnection conn, ToSql SqlValue a) =>
conn
-> Insert a
-> (PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b)
-> IO b
withPrepareChunksInsert conn
conn Insert a
ins ((PreparedInsert a -> PreparedStatement [a] () -> Int -> IO ())
-> IO ())
-> ([a]
-> PreparedInsert a -> PreparedStatement [a] () -> Int -> IO ())
-> [a]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> PreparedInsert a -> PreparedStatement [a] () -> Int -> IO ()
forall a.
ToSql SqlValue a =>
[a] -> PreparedInsert a -> PreparedStatement [a] () -> Int -> IO ()
chunksAction
bulkInsert' :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> [a]
-> IO ([Integer], [Integer])
bulkInsert' :: conn -> Insert a -> [a] -> IO ([Integer], [Integer])
bulkInsert' conn :: conn
conn ins :: Insert a
ins rs :: [a]
rs = do
p :: ([Integer], [Integer])
p@(zs :: [Integer]
zs, os :: [Integer]
os) <- conn
-> Insert a
-> (PreparedInsert a
-> PreparedStatement [a] () -> Int -> IO ([Integer], [Integer]))
-> IO ([Integer], [Integer])
forall conn a p b.
(IConnection conn, ToSql SqlValue a) =>
conn
-> Insert a
-> (PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b)
-> IO b
withPrepareChunksInsert conn
conn Insert a
ins ((PreparedInsert a
-> PreparedStatement [a] () -> Int -> IO ([Integer], [Integer]))
-> IO ([Integer], [Integer]))
-> (PreparedInsert a
-> PreparedStatement [a] () -> Int -> IO ([Integer], [Integer]))
-> IO ([Integer], [Integer])
forall a b. (a -> b) -> a -> b
$ [a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer])
forall a.
ToSql SqlValue a =>
[a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer])
chunksLazyAction [a]
rs
let zl :: Int
zl = [Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
zs
ol :: Int
ol = [Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
os
Int
zl Int -> IO ([Integer], [Integer]) -> IO ([Integer], [Integer])
forall a b. a -> b -> b
`seq` Int
ol Int -> IO ([Integer], [Integer]) -> IO ([Integer], [Integer])
forall a b. a -> b -> b
`seq` ([Integer], [Integer]) -> IO ([Integer], [Integer])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Integer], [Integer])
p
{-# DEPRECATED chunksInsert "use bulkInsert' instead of this." #-}
chunksInsert :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> [a]
-> IO [[Integer]]
chunksInsert :: conn -> Insert a -> [a] -> IO [[Integer]]
chunksInsert conn :: conn
conn ins :: Insert a
ins rs :: [a]
rs = do
(zs :: [Integer]
zs, os :: [Integer]
os) <- conn -> Insert a -> [a] -> IO ([Integer], [Integer])
forall conn a.
(IConnection conn, ToSql SqlValue a) =>
conn -> Insert a -> [a] -> IO ([Integer], [Integer])
bulkInsert' conn
conn Insert a
ins [a]
rs
[[Integer]] -> IO [[Integer]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Integer]] -> IO [[Integer]]) -> [[Integer]] -> IO [[Integer]]
forall a b. (a -> b) -> a -> b
$ (Integer -> [Integer]) -> [Integer] -> [[Integer]]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: []) [Integer]
zs [[Integer]] -> [[Integer]] -> [[Integer]]
forall a. [a] -> [a] -> [a]
++ [[Integer]
os]