{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Database.HDBC.Record.Statement
-- Copyright   : 2013-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides typed statement running sequence
-- which intermediate structures are typed.
module Database.HDBC.Record.Statement (
  PreparedStatement, untypePrepared, unsafePrepare, finish,

  withUnsafePrepare, withPrepareNoFetch,

  BoundStatement (..), bind, bindTo,

  ExecutedStatement, executed, result,

  executeBound, execute,

  prepareNoFetch,
  executeBoundNoFetch, executeNoFetch,
  runNoFetch, mapNoFetch,

  -- * Deprecated.
  executePrepared, runPreparedNoFetch,
  ) where

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

import Database.Record (ToSql, fromRecord)

-- | Typed prepared statement type.
newtype PreparedStatement p a =
  PreparedStatement {
    -- | Untyped prepared statement before executed.
    PreparedStatement p a -> Statement
prepared :: Statement
    }

-- | Typed prepared statement which has bound placeholder parameters.
data BoundStatement a =
  BoundStatement
  {
    -- | Untyped prepared statement before executed.
    BoundStatement a -> Statement
bound  :: !Statement
    -- | Bound parameters.
  , BoundStatement a -> [SqlValue]
params :: [SqlValue]
  }

-- | Typed executed statement.
data ExecutedStatement a =
  ExecutedStatement
  { -- | Untyped executed statement.
    ExecutedStatement a -> Statement
executed :: !Statement
    -- | Result of HDBC execute.
  , ExecutedStatement a -> Integer
result   :: !Integer
  }

-- | Unsafely untype prepared statement.
untypePrepared :: PreparedStatement p a -> Statement
untypePrepared :: PreparedStatement p a -> Statement
untypePrepared =  PreparedStatement p a -> Statement
forall p a. PreparedStatement p a -> Statement
prepared

-- | Run prepare and unsafely make Typed prepared statement.
unsafePrepare :: IConnection conn
              => conn                       -- ^ Database connection
              -> String                     -- ^ Raw SQL String
              -> IO (PreparedStatement p a) -- ^ Result typed prepared query with parameter type 'p' and result type 'a'
unsafePrepare :: conn -> String -> IO (PreparedStatement p a)
unsafePrepare conn :: conn
conn = (Statement -> PreparedStatement p a)
-> IO Statement -> IO (PreparedStatement p a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Statement -> PreparedStatement p a
forall p a. Statement -> PreparedStatement p a
PreparedStatement (IO Statement -> IO (PreparedStatement p a))
-> (String -> IO Statement) -> String -> IO (PreparedStatement 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

-- | Generalized prepare inferred from 'UntypeableNoFetch' instance.
prepareNoFetch :: (UntypeableNoFetch s, IConnection conn)
               => conn
               -> s p
               -> IO (PreparedStatement p ())
prepareNoFetch :: conn -> s p -> IO (PreparedStatement p ())
prepareNoFetch conn :: conn
conn = conn -> String -> IO (PreparedStatement p ())
forall conn p a.
IConnection conn =>
conn -> String -> IO (PreparedStatement p a)
unsafePrepare conn
conn (String -> IO (PreparedStatement p ()))
-> (s p -> String) -> s p -> IO (PreparedStatement p ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s p -> String
forall (s :: * -> *) p. UntypeableNoFetch s => s p -> String
untypeNoFetch

-- | Close PreparedStatement. Useful for connection pooling cases.
--   PreparedStatement is released on closing connection,
--   so connection pooling cases often cause resource leaks.
finish :: PreparedStatement p a -> IO ()
finish :: PreparedStatement p a -> IO ()
finish = Statement -> IO ()
HDBC.finish (Statement -> IO ())
-> (PreparedStatement p a -> Statement)
-> PreparedStatement p a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreparedStatement p a -> Statement
forall p a. PreparedStatement p a -> Statement
prepared

-- | Bracketed prepare operation.
--   Unsafely make Typed prepared statement.
--   PreparedStatement is released on closing connection,
--   so connection pooling cases often cause resource leaks.
withUnsafePrepare :: IConnection conn
                  => conn   -- ^ Database connection
                  -> String -- ^ Raw SQL String
                  -> (PreparedStatement p a -> IO b)
                  -> IO b
withUnsafePrepare :: conn -> String -> (PreparedStatement p a -> IO b) -> IO b
withUnsafePrepare conn :: conn
conn qs :: String
qs =
  IO (PreparedStatement p a)
-> (PreparedStatement p a -> IO ())
-> (PreparedStatement p a -> IO b)
-> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (conn -> String -> IO (PreparedStatement p a)
forall conn p a.
IConnection conn =>
conn -> String -> IO (PreparedStatement p a)
unsafePrepare conn
conn String
qs) PreparedStatement p a -> IO ()
forall p a. PreparedStatement p a -> IO ()
finish

-- | Bracketed prepare operation.
--   Generalized prepare inferred from 'UntypeableNoFetch' instance.
withPrepareNoFetch :: (UntypeableNoFetch s, IConnection conn)
                   => conn
                   -> s p
                   -> (PreparedStatement p () -> IO a)
                   -> IO a
withPrepareNoFetch :: conn -> s p -> (PreparedStatement p () -> IO a) -> IO a
withPrepareNoFetch conn :: conn
conn s :: s p
s =
  IO (PreparedStatement p ())
-> (PreparedStatement p () -> IO ())
-> (PreparedStatement p () -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (conn -> s p -> IO (PreparedStatement p ())
forall (s :: * -> *) conn p.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> IO (PreparedStatement p ())
prepareNoFetch conn
conn s p
s) PreparedStatement p () -> IO ()
forall p a. PreparedStatement p a -> IO ()
finish

-- | Typed operation to bind parameters. Inferred 'ToSql' is used.
bind :: ToSql SqlValue p
     => PreparedStatement p a -- ^ Prepared query to bind to
     -> p                     -- ^ Parameter to bind
     -> BoundStatement a      -- ^ Result parameter bound statement
bind :: PreparedStatement p a -> p -> BoundStatement a
bind q :: PreparedStatement p a
q p :: p
p = $WBoundStatement :: forall a. Statement -> [SqlValue] -> BoundStatement a
BoundStatement { bound :: Statement
bound = PreparedStatement p a -> Statement
forall p a. PreparedStatement p a -> Statement
prepared PreparedStatement p a
q, params :: [SqlValue]
params = p -> [SqlValue]
forall q a. ToSql q a => a -> [q]
fromRecord p
p }

-- | Same as 'bind' except for argument is flipped.
bindTo :: ToSql SqlValue p => p -> PreparedStatement p a -> BoundStatement a
bindTo :: p -> PreparedStatement p a -> BoundStatement a
bindTo =  (PreparedStatement p a -> p -> BoundStatement a)
-> p -> PreparedStatement p a -> BoundStatement a
forall a b c. (a -> b -> c) -> b -> a -> c
flip PreparedStatement p a -> p -> BoundStatement a
forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> BoundStatement a
bind

-- | Typed execute operation.
executeBound :: BoundStatement a -> IO (ExecutedStatement a)
executeBound :: BoundStatement a -> IO (ExecutedStatement a)
executeBound bs :: BoundStatement a
bs = do
  let stmt :: Statement
stmt = BoundStatement a -> Statement
forall a. BoundStatement a -> Statement
bound BoundStatement a
bs
  Integer
n <- Statement -> [SqlValue] -> IO Integer
HDBC.execute Statement
stmt (BoundStatement a -> [SqlValue]
forall a. BoundStatement a -> [SqlValue]
params BoundStatement a
bs)
  Integer
n Integer -> IO (ExecutedStatement a) -> IO (ExecutedStatement a)
forall a b. a -> b -> b
`seq` ExecutedStatement a -> IO (ExecutedStatement a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement -> Integer -> ExecutedStatement a
forall a. Statement -> Integer -> ExecutedStatement a
ExecutedStatement Statement
stmt Integer
n)

-- | Bind parameters, execute prepared statement and get executed statement.
execute ::  ToSql SqlValue p => PreparedStatement p a -> p -> IO (ExecutedStatement a)
execute :: PreparedStatement p a -> p -> IO (ExecutedStatement a)
execute st :: PreparedStatement p a
st = BoundStatement a -> IO (ExecutedStatement a)
forall a. BoundStatement a -> IO (ExecutedStatement a)
executeBound (BoundStatement a -> IO (ExecutedStatement a))
-> (p -> BoundStatement a) -> p -> IO (ExecutedStatement a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreparedStatement p a -> p -> BoundStatement a
forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> BoundStatement a
bind PreparedStatement p a
st

{-# DEPRECATED executePrepared "use `execute` instead of this." #-}
-- | Deprecated.
executePrepared ::  ToSql SqlValue p => PreparedStatement p a -> p -> IO (ExecutedStatement a)
executePrepared :: PreparedStatement p a -> p -> IO (ExecutedStatement a)
executePrepared = PreparedStatement p a -> p -> IO (ExecutedStatement a)
forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> IO (ExecutedStatement a)
execute

-- | Typed execute operation. Only get result.
executeBoundNoFetch :: BoundStatement () -> IO Integer
executeBoundNoFetch :: BoundStatement () -> IO Integer
executeBoundNoFetch = (ExecutedStatement () -> Integer)
-> IO (ExecutedStatement ()) -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExecutedStatement () -> Integer
forall a. ExecutedStatement a -> Integer
result (IO (ExecutedStatement ()) -> IO Integer)
-> (BoundStatement () -> IO (ExecutedStatement ()))
-> BoundStatement ()
-> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundStatement () -> IO (ExecutedStatement ())
forall a. BoundStatement a -> IO (ExecutedStatement a)
executeBound

-- | Bind parameters, execute prepared statement and get execution result.
executeNoFetch :: ToSql SqlValue a
               => PreparedStatement a ()
               -> a
               -> IO Integer
executeNoFetch :: PreparedStatement a () -> a -> IO Integer
executeNoFetch p :: PreparedStatement a ()
p = BoundStatement () -> IO Integer
executeBoundNoFetch (BoundStatement () -> IO Integer)
-> (a -> BoundStatement ()) -> a -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PreparedStatement a ()
p PreparedStatement a () -> a -> BoundStatement ()
forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> BoundStatement a
`bind`)


{-# DEPRECATED runPreparedNoFetch "use `executeNoFetch` instead of this." #-}
-- | Deprecated.
runPreparedNoFetch :: ToSql SqlValue a
                   => PreparedStatement a ()
                   -> a
                   -> IO Integer
runPreparedNoFetch :: PreparedStatement a () -> a -> IO Integer
runPreparedNoFetch = PreparedStatement a () -> a -> IO Integer
forall a.
ToSql SqlValue a =>
PreparedStatement a () -> a -> IO Integer
executeNoFetch

-- | Prepare and run sequence for polymorphic no-fetch statement.
runNoFetch :: (UntypeableNoFetch s, IConnection conn, ToSql SqlValue a)
           => conn
           -> s a
           -> a
           -> IO Integer
runNoFetch :: conn -> s a -> a -> IO Integer
runNoFetch conn :: conn
conn s :: s a
s p :: a
p = conn -> s a -> (PreparedStatement a () -> IO Integer) -> IO Integer
forall (s :: * -> *) conn p a.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> (PreparedStatement p () -> IO a) -> IO a
withPrepareNoFetch conn
conn s a
s (PreparedStatement a () -> a -> IO Integer
forall a.
ToSql SqlValue a =>
PreparedStatement a () -> a -> IO Integer
`runPreparedNoFetch` a
p)

-- | Prepare and run it against each parameter list.
mapNoFetch :: (UntypeableNoFetch s, IConnection conn, ToSql SqlValue a)
           => conn
           -> s a
           -> [a]
           -> IO [Integer]
mapNoFetch :: conn -> s a -> [a] -> IO [Integer]
mapNoFetch conn :: conn
conn s :: s a
s rs :: [a]
rs =
  conn
-> s a -> (PreparedStatement a () -> IO [Integer]) -> IO [Integer]
forall (s :: * -> *) conn p a.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> (PreparedStatement p () -> IO a) -> IO a
withPrepareNoFetch conn
conn s a
s (\ps :: PreparedStatement a ()
ps -> (a -> IO Integer) -> [a] -> IO [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PreparedStatement a () -> a -> IO Integer
forall a.
ToSql SqlValue a =>
PreparedStatement a () -> a -> IO Integer
runPreparedNoFetch PreparedStatement a ()
ps) [a]
rs)