{-# 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 :: 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

-- | Same as 'prepare'.
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

-- | Bind parameters, execute statement and get execution result.
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

-- | Prepare insert statement, bind parameters,
--   execute statement and get execution result.
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

-- | Prepare and insert each record.
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


-- | Unsafely bind chunk of records.
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

-- | 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 -> 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!"

-- | Prepare and insert using chunk insert statement.
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

-- | 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 -> 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." #-}
-- | 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 -> 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]