{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Database.HDBC.Record.KeyUpdate
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides typed 'KeyUpdate' running sequence
-- which intermediate structures are typed.
module Database.HDBC.Record.KeyUpdate (
  PreparedKeyUpdate,

  prepare, prepareKeyUpdate, withPrepareKeyUpdate,

  bindKeyUpdate,

  runPreparedKeyUpdate, runKeyUpdate
  ) where

import Control.Exception (bracket)
import Database.HDBC (IConnection, SqlValue, Statement)
import qualified Database.HDBC as HDBC

import Database.Relational
  (KeyUpdate, untypeKeyUpdate, updateValuesWithKey, Pi)
import qualified Database.Relational as DSL
import Database.Record (ToSql)

import Database.HDBC.Record.Statement
  (BoundStatement (BoundStatement, bound, params), executeBoundNoFetch)


-- | Typed prepared key-update type.
data PreparedKeyUpdate p a =
  PreparedKeyUpdate
  {
    -- | Key to specify update target records.
    forall p a. PreparedKeyUpdate p a -> Pi a p
updateKey         :: Pi a p
    -- | Untyped prepared statement before executed.
  , forall p a. PreparedKeyUpdate p a -> Statement
preparedKeyUpdate :: Statement
  }

-- | Typed prepare key-update operation.
prepare :: IConnection conn
        => conn
        -> KeyUpdate p a
        -> IO (PreparedKeyUpdate p a)
prepare :: forall conn p a.
IConnection conn =>
conn -> KeyUpdate p a -> IO (PreparedKeyUpdate p a)
prepare conn
conn KeyUpdate p a
ku = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall p a. Pi a p -> Statement -> PreparedKeyUpdate p a
PreparedKeyUpdate Pi a p
key) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall conn. IConnection conn => conn -> String -> IO Statement
HDBC.prepare conn
conn forall a b. (a -> b) -> a -> b
$ String
sql  where
  sql :: String
sql = forall p a. KeyUpdate p a -> String
untypeKeyUpdate KeyUpdate p a
ku
  key :: Pi a p
key = forall p a. KeyUpdate p a -> Pi a p
DSL.updateKey KeyUpdate p a
ku

-- | Same as 'prepare'.
prepareKeyUpdate :: IConnection conn
                 => conn
                 -> KeyUpdate p a
                 -> IO (PreparedKeyUpdate p a)
prepareKeyUpdate :: forall conn p a.
IConnection conn =>
conn -> KeyUpdate p a -> IO (PreparedKeyUpdate p a)
prepareKeyUpdate =  forall conn p a.
IConnection conn =>
conn -> KeyUpdate p a -> IO (PreparedKeyUpdate p a)
prepare

-- | Bracketed prepare operation.
withPrepareKeyUpdate :: IConnection conn
                     => conn
                     -> KeyUpdate p a
                     -> (PreparedKeyUpdate p a -> IO b)
                     -> IO b
withPrepareKeyUpdate :: forall conn p a b.
IConnection conn =>
conn -> KeyUpdate p a -> (PreparedKeyUpdate p a -> IO b) -> IO b
withPrepareKeyUpdate conn
conn KeyUpdate p a
ku PreparedKeyUpdate p a -> IO b
body =
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall conn. IConnection conn => conn -> String -> IO Statement
HDBC.prepare conn
conn String
sql) Statement -> IO ()
HDBC.finish
    forall a b. (a -> b) -> a -> b
$ PreparedKeyUpdate p a -> IO b
body forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. Pi a p -> Statement -> PreparedKeyUpdate p a
PreparedKeyUpdate Pi a p
key
  where
    sql :: String
sql = forall p a. KeyUpdate p a -> String
untypeKeyUpdate KeyUpdate p a
ku
    key :: Pi a p
key = forall p a. KeyUpdate p a -> Pi a p
DSL.updateKey KeyUpdate p a
ku

-- | Typed operation to bind parameters for 'PreparedKeyUpdate' type.
bindKeyUpdate :: ToSql SqlValue a
              => PreparedKeyUpdate p a
              -> a
              -> BoundStatement ()
bindKeyUpdate :: forall a p.
ToSql SqlValue a =>
PreparedKeyUpdate p a -> a -> BoundStatement ()
bindKeyUpdate PreparedKeyUpdate p a
pre a
a =
  BoundStatement { bound :: Statement
bound = forall p a. PreparedKeyUpdate p a -> Statement
preparedKeyUpdate PreparedKeyUpdate p a
pre, params :: [SqlValue]
params = forall q r p. ToSql q r => Pi r p -> r -> [q]
updateValuesWithKey Pi a p
key a
a }
  where key :: Pi a p
key = forall p a. PreparedKeyUpdate p a -> Pi a p
updateKey PreparedKeyUpdate p a
pre

-- | Bind parameters, execute statement and get execution result.
runPreparedKeyUpdate :: ToSql SqlValue a
                     => PreparedKeyUpdate p a
                     -> a
                     -> IO Integer
runPreparedKeyUpdate :: forall a p.
ToSql SqlValue a =>
PreparedKeyUpdate p a -> a -> IO Integer
runPreparedKeyUpdate PreparedKeyUpdate p a
pre = BoundStatement () -> IO Integer
executeBoundNoFetch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a p.
ToSql SqlValue a =>
PreparedKeyUpdate p a -> a -> BoundStatement ()
bindKeyUpdate PreparedKeyUpdate p a
pre

-- | Prepare insert statement, bind parameters,
--   execute statement and get execution result.
runKeyUpdate :: (IConnection conn, ToSql SqlValue a)
             => conn
             -> KeyUpdate p a
             -> a
             -> IO Integer
runKeyUpdate :: forall conn a p.
(IConnection conn, ToSql SqlValue a) =>
conn -> KeyUpdate p a -> a -> IO Integer
runKeyUpdate conn
conn KeyUpdate p a
q a
a = forall conn p a b.
IConnection conn =>
conn -> KeyUpdate p a -> (PreparedKeyUpdate p a -> IO b) -> IO b
withPrepareKeyUpdate conn
conn KeyUpdate p a
q (forall a p.
ToSql SqlValue a =>
PreparedKeyUpdate p a -> a -> IO Integer
`runPreparedKeyUpdate` a
a)