{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Database.HDBC.Record.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.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)


-- | Typed prepared insert type.
type PreparedInsert a = PreparedStatement a ()

-- | Typed prepare insert operation.
prepare :: IConnection conn
        => conn
        -> Insert a
        -> IO (PreparedInsert a)
prepare :: forall conn a.
IConnection conn =>
conn -> Insert a -> IO (PreparedInsert a)
prepare =  forall (s :: * -> *) conn p.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> IO (PreparedStatement p ())
prepareNoFetch

-- | Same as 'prepare'.
prepareInsert :: IConnection conn
              => conn
              -> Insert a
              -> IO (PreparedInsert a)
prepareInsert :: forall conn a.
IConnection conn =>
conn -> Insert a -> IO (PreparedInsert a)
prepareInsert = forall conn a.
IConnection conn =>
conn -> Insert a -> IO (PreparedInsert a)
prepare

-- | Bind parameters, execute statement and get execution result.
runPreparedInsert :: ToSql SqlValue a
                  => PreparedInsert a
                  -> a
                  -> IO Integer
runPreparedInsert :: forall a. ToSql SqlValue a => PreparedInsert a -> a -> IO Integer
runPreparedInsert =  forall a. ToSql SqlValue a => PreparedInsert a -> a -> IO Integer
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 :: forall conn a.
(IConnection conn, ToSql SqlValue a) =>
conn -> Insert a -> a -> IO Integer
runInsert =  forall (s :: * -> *) conn a.
(UntypeableNoFetch s, IConnection conn, ToSql SqlValue a) =>
conn -> s a -> a -> IO Integer
runNoFetch

-- | Prepare and insert each record.
mapInsert :: (IConnection conn, ToSql SqlValue a)
          => conn
          -> Insert a
          -> [a]
          -> IO [Integer]
mapInsert :: forall conn a.
(IConnection conn, ToSql SqlValue a) =>
conn -> Insert a -> [a] -> IO [Integer]
mapInsert = forall (s :: * -> *) conn a.
(UntypeableNoFetch s, IConnection conn, ToSql SqlValue a) =>
conn -> s a -> [a] -> IO [Integer]
mapNoFetch


-- | Unsafely bind chunk of records.
chunkBind :: ToSql SqlValue p => PreparedStatement [p] () -> [p] -> BoundStatement ()
chunkBind :: forall p.
ToSql SqlValue p =>
PreparedStatement [p] () -> [p] -> BoundStatement ()
chunkBind PreparedStatement [p] ()
q [p]
ps = BoundStatement { bound :: Statement
bound = forall p a. PreparedStatement p a -> Statement
untypePrepared PreparedStatement [p] ()
q, params :: [SqlValue]
params =  [p]
ps forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 :: 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
i0 PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b
body =
  forall (s :: * -> *) conn p a.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> (PreparedStatement p () -> IO a) -> IO a
withPrepareNoFetch conn
conn Insert a
i0
  (\PreparedInsert a
ins -> forall conn p a b.
IConnection conn =>
conn -> String -> (PreparedStatement p a -> IO b) -> IO b
withUnsafePrepare conn
conn (forall a. Insert a -> String
untypeChunkInsert Insert a
i0)
           (\PreparedStatement [p] ()
iChunk -> PreparedInsert a -> PreparedStatement [p] () -> Int -> IO b
body PreparedInsert a
ins PreparedStatement [p] ()
iChunk forall a b. (a -> b) -> a -> b
$ forall a. Insert a -> Int
chunkSizeOfInsert Insert a
i0)  )

chunks :: Int -> [a] -> ([[a]], [a])
chunks :: forall a. Int -> [a] -> ([[a]], [a])
chunks Int
n = forall {a}. [a] -> ([[a]], [a])
rec'  where
  rec' :: [a] -> ([[a]], [a])
rec' [a]
xs
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
tl    =  if forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
c forall a. Eq a => a -> a -> Bool
== Int
n
                    then ([[a]
c], [])
                    else ( [], [a]
c)
    | Bool
otherwise  =  ([a]
c forall a. a -> [a] -> [a]
: [[a]]
cs, [a]
ys)  where
      ([a]
c, [a]
tl) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs
      ([[a]]
cs, [a]
ys) = [a] -> ([[a]], [a])
rec' [a]
tl

lazyMapIO :: (a -> IO b) -> [a] -> IO [b]
lazyMapIO :: forall a b. (a -> IO b) -> [a] -> IO [b]
lazyMapIO a -> IO b
_  []     =  forall (m :: * -> *) a. Monad m => a -> m a
return []
lazyMapIO a -> IO b
f (a
x:[a]
xs)  =  forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> IO b
f a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 :: 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 =
    (,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> IO b) -> [a] -> IO [b]
lazyMapIO (BoundStatement () -> IO Integer
executeBoundNoFetch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p.
ToSql SqlValue p =>
PreparedStatement [p] () -> [p] -> BoundStatement ()
chunkBind PreparedStatement [a] ()
iChunk) [[a]]
cs
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. ToSql SqlValue a => PreparedInsert a -> a -> IO Integer
runPreparedInsert PreparedInsert a
ins) [a]
xs)
  where
    ([[a]]
cs, [a]
xs) = forall a. Int -> [a] -> ([[a]], [a])
chunks Int
size [a]
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 :: forall conn a.
(IConnection conn, ToSql SqlValue a) =>
conn -> Insert a -> [a] -> IO ([Integer], [Integer])
bulkInsertInterleave conn
conn Insert a
ins =
  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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a.
ToSql SqlValue a =>
[a] -> PreparedInsert a -> PreparedStatement [a] () -> Int -> IO ()
chunksAction [a]
rs PreparedInsert a
ins PreparedStatement [a] ()
iChunk Int
size = do
    ([Integer]
zs, [Integer]
os)  <-  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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) [Integer]
zs)
      forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"chunksAction: chunks: unexpected result size!"
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Integer
1) [Integer]
os)
      forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"chunksAction: tails: unexpected result size!"

-- | Prepare and insert using chunk insert statement.
bulkInsert :: (IConnection conn, ToSql SqlValue a)
           => conn
           -> Insert a
           -> [a]
           -> IO ()
bulkInsert :: forall conn a.
(IConnection conn, ToSql SqlValue a) =>
conn -> Insert a -> [a] -> IO ()
bulkInsert conn
conn Insert a
ins =
  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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ToSql SqlValue a =>
[a] -> PreparedInsert a -> PreparedStatement [a] () -> Int -> IO ()
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' :: forall conn a.
(IConnection conn, ToSql SqlValue a) =>
conn -> Insert a -> [a] -> IO ([Integer], [Integer])
bulkInsert' conn
conn Insert a
ins [a]
rs = do
  p :: ([Integer], [Integer])
p@([Integer]
zs, [Integer]
os) <- 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 forall a b. (a -> b) -> a -> b
$ forall a.
ToSql SqlValue a =>
[a]
-> PreparedInsert a
-> PreparedStatement [a] ()
-> Int
-> IO ([Integer], [Integer])
chunksLazyAction [a]
rs
  let zl :: Int
zl = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
zs
      ol :: Int
ol = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
os
  Int
zl seq :: forall a b. a -> b -> b
`seq` Int
ol seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return ([Integer], [Integer])
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 :: forall conn a.
(IConnection conn, ToSql SqlValue a) =>
conn -> Insert a -> [a] -> IO [[Integer]]
chunksInsert conn
conn Insert a
ins [a]
rs = do
  ([Integer]
zs, [Integer]
os) <- forall conn a.
(IConnection conn, ToSql SqlValue a) =>
conn -> Insert a -> [a] -> IO ([Integer], [Integer])
bulkInsert' conn
conn Insert a
ins [a]
rs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
: []) [Integer]
zs forall a. [a] -> [a] -> [a]
++ [[Integer]
os]