{-# 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.
    PreparedKeyUpdate p a -> Pi a p
updateKey         :: Pi a p
    -- | Untyped prepared statement before executed.
  , PreparedKeyUpdate p a -> Statement
preparedKeyUpdate :: Statement
  }

-- | Typed prepare key-update operation.
prepare :: IConnection conn
        => conn
        -> KeyUpdate p a
        -> IO (PreparedKeyUpdate p a)
prepare :: conn -> KeyUpdate p a -> IO (PreparedKeyUpdate p a)
prepare conn :: conn
conn ku :: KeyUpdate p a
ku = (Statement -> PreparedKeyUpdate p a)
-> IO Statement -> IO (PreparedKeyUpdate p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pi a p -> Statement -> PreparedKeyUpdate p a
forall p a. Pi a p -> Statement -> PreparedKeyUpdate p a
PreparedKeyUpdate Pi a p
key) (IO Statement -> IO (PreparedKeyUpdate p a))
-> (String -> IO Statement) -> String -> IO (PreparedKeyUpdate p a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. conn -> String -> IO Statement
forall conn. IConnection conn => conn -> String -> IO Statement
HDBC.prepare conn
conn (String -> IO (PreparedKeyUpdate p a))
-> String -> IO (PreparedKeyUpdate p a)
forall a b. (a -> b) -> a -> b
$ String
sql  where
  sql :: String
sql = KeyUpdate p a -> String
forall p a. KeyUpdate p a -> String
untypeKeyUpdate KeyUpdate p a
ku
  key :: Pi a p
key = KeyUpdate p a -> Pi a p
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 :: conn -> KeyUpdate p a -> IO (PreparedKeyUpdate p a)
prepareKeyUpdate =  conn -> KeyUpdate p a -> IO (PreparedKeyUpdate p a)
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 :: conn -> KeyUpdate p a -> (PreparedKeyUpdate p a -> IO b) -> IO b
withPrepareKeyUpdate conn :: conn
conn ku :: KeyUpdate p a
ku body :: PreparedKeyUpdate p a -> IO b
body =
    IO Statement -> (Statement -> IO ()) -> (Statement -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (conn -> String -> IO Statement
forall conn. IConnection conn => conn -> String -> IO Statement
HDBC.prepare conn
conn String
sql) Statement -> IO ()
HDBC.finish
    ((Statement -> IO b) -> IO b) -> (Statement -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ PreparedKeyUpdate p a -> IO b
body (PreparedKeyUpdate p a -> IO b)
-> (Statement -> PreparedKeyUpdate p a) -> Statement -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pi a p -> Statement -> PreparedKeyUpdate p a
forall p a. Pi a p -> Statement -> PreparedKeyUpdate p a
PreparedKeyUpdate Pi a p
key
  where
    sql :: String
sql = KeyUpdate p a -> String
forall p a. KeyUpdate p a -> String
untypeKeyUpdate KeyUpdate p a
ku
    key :: Pi a p
key = KeyUpdate p a -> Pi a p
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 :: PreparedKeyUpdate p a -> a -> BoundStatement ()
bindKeyUpdate pre :: PreparedKeyUpdate p a
pre a :: a
a =
  $WBoundStatement :: forall a. Statement -> [SqlValue] -> BoundStatement a
BoundStatement { bound :: Statement
bound = PreparedKeyUpdate p a -> Statement
forall p a. PreparedKeyUpdate p a -> Statement
preparedKeyUpdate PreparedKeyUpdate p a
pre, params :: [SqlValue]
params = Pi a p -> a -> [SqlValue]
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 = PreparedKeyUpdate p a -> Pi a p
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 :: PreparedKeyUpdate p a -> a -> IO Integer
runPreparedKeyUpdate pre :: PreparedKeyUpdate p a
pre = BoundStatement () -> IO Integer
executeBoundNoFetch (BoundStatement () -> IO Integer)
-> (a -> BoundStatement ()) -> a -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreparedKeyUpdate p a -> a -> BoundStatement ()
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 :: conn -> KeyUpdate p a -> a -> IO Integer
runKeyUpdate conn :: conn
conn q :: KeyUpdate p a
q a :: a
a = conn
-> KeyUpdate p a
-> (PreparedKeyUpdate p a -> IO Integer)
-> IO Integer
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 (PreparedKeyUpdate p a -> a -> IO Integer
forall a p.
ToSql SqlValue a =>
PreparedKeyUpdate p a -> a -> IO Integer
`runPreparedKeyUpdate` a
a)