content: {-# LANGUAGE FlexibleContexts #-}
  
  -- |
  -- Module      : Database.Relational.HDBC.Insert
  -- Copyright   : 2013-2018 Kei Hibino
  -- License     : BSD3
  --
  -- Maintainer  : ex8k.hibino@gmail.com
  -- Stability   : experimental
  -- Portability : unknown
  --
  -- This module provides typed 'Insert' running sequence
  -- which intermediate structures are typed.
  module Database.Relational.HDBC.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.Relational.HDBC.Statement
    (prepareNoFetch, withPrepareNoFetch, withUnsafePrepare, PreparedStatement, untypePrepared,
     BoundStatement (..), executeNoFetch, runNoFetch, mapNoFetch, executeBoundNoFetch)
  
  
  -- | Typed prepared insert type.
  type PreparedInsert a = PreparedStatement a ()
  
  -- | Typed prepare insert operation.
  prepare :: IConnection conn
          => conn
          -> Insert a
          -> IO (PreparedInsert a)
  prepare =  prepareNoFetch
  
  -- | Same as 'prepare'.
  prepareInsert :: IConnection conn
                => conn
                -> Insert a
                -> IO (PreparedInsert a)
  prepareInsert = prepare
  
  -- | Bind parameters, execute statement and get execution result.
  runPreparedInsert :: ToSql SqlValue a
                    => PreparedInsert a
                    -> a
                    -> IO Integer
  runPreparedInsert =  executeNoFetch
  
  -- | Prepare insert statement, bind parameters,
  --   execute statement and get execution result.
  runInsert :: (IConnection conn, ToSql SqlValue a)
            => conn
            -> Insert a
            -> a
            -> IO Integer
  runInsert =  runNoFetch
  
  -- | Prepare and insert each record.
  mapInsert :: (IConnection conn, ToSql SqlValue a)
            => conn
            -> Insert a
            -> [a]
            -> IO [Integer]
  mapInsert = mapNoFetch
  
  
  -- | Unsafely bind chunk of records.
  chunkBind :: ToSql SqlValue p => PreparedStatement [p] () -> [p] -> BoundStatement ()
  chunkBind q ps = BoundStatement { bound = untypePrepared q, params =  ps >>= fromRecord }
  
  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)  )
  
  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], [Integer])
  chunksLazyAction rs ins iChunk size =
      (,)
      <$> lazyMapIO (executeBoundNoFetch . chunkBind iChunk) cs
      <*> (unsafeInterleaveIO $ mapM (runPreparedInsert ins) xs)
    where
      (cs, xs) = chunks size 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]
  