module Database.HDBC.Record.Insert (
PreparedInsert, prepare, prepareInsert,
runPreparedInsert, runInsert, mapInsert,
chunksInsertActions, chunksInsert,
) where
import Database.HDBC (IConnection, SqlValue)
import Database.Relational.Query (Insert (..))
import Database.Record (ToSql, fromRecord)
import Database.HDBC.Record.Statement
(prepareNoFetch, unsafePrepare, PreparedStatement, untypePrepared, BoundStatement (..),
runPreparedNoFetch, runNoFetch, mapNoFetch, executeNoFetch)
type PreparedInsert a = PreparedStatement a ()
prepare :: IConnection conn
=> conn
-> Insert a
-> IO (PreparedInsert a)
prepare = prepareNoFetch
prepareInsert :: IConnection conn
=> conn
-> Insert a
-> IO (PreparedInsert a)
prepareInsert = prepare
runPreparedInsert :: ToSql SqlValue a
=> PreparedInsert a
-> a
-> IO Integer
runPreparedInsert = runPreparedNoFetch
runInsert :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> a
-> IO Integer
runInsert = runNoFetch
mapInsert :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> [a]
-> IO [Integer]
mapInsert = mapNoFetch
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
chunksInsertActions :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> [a]
-> IO [ IO [Integer] ]
chunksInsertActions conn i0 rs = do
ins <- unsafePrepare conn $ untypeInsert i0
iChunk <- unsafePrepare conn $ untypeChunkInsert i0
let insert (Right c) = do
rv <- executeNoFetch $ chunkBind iChunk c
return [rv]
insert (Left c) =
mapM (runPreparedInsert ins) c
return . map insert $ chunks (chunkSizeOfInsert i0) rs
chunksInsert :: (IConnection conn, ToSql SqlValue a) => conn -> Insert a -> [a] -> IO [[Integer]]
chunksInsert conn ins rs = do
as <- chunksInsertActions conn ins rs
sequence as