module Database.HDBC.Record.Insert (
PreparedInsert, prepare, prepareInsert,
runPreparedInsert, runInsert, mapInsert,
chunksInsert,
) where
import Database.HDBC (IConnection, SqlValue)
import Database.Relational.Query (Insert (..), untypeChunkInsert, chunkSizeOfInsert)
import Database.Record (ToSql, fromRecord)
import Database.HDBC.Record.Statement
(prepareNoFetch, withPrepareNoFetch, withUnsafePrepare, 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
withPrepareChunksInsert :: (IConnection conn, ToSql SqlValue a)
=> conn
-> Insert a
-> (PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b)
-> IO b
withPrepareChunksInsert conn i0 body =
withPrepareNoFetch conn i0
(\ins -> withUnsafePrepare conn (untypeChunkInsert i0)
(\iChunk -> body ins iChunk $ chunkSizeOfInsert i0) )
chunksInsertActions :: ToSql SqlValue a
=> [a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO [[Integer]]
chunksInsertActions rs ins iChunk size =
mapM insert $ chunks size rs
where
insert (Right c) = do
rv <- executeNoFetch $ chunkBind iChunk c
return [rv]
insert (Left c) =
mapM (runPreparedInsert ins) c
chunksInsert :: (IConnection conn, ToSql SqlValue a) => conn -> Insert a -> [a] -> IO [[Integer]]
chunksInsert conn ins rs =
withPrepareChunksInsert conn ins $ chunksInsertActions rs