{-# 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.
    forall p a. PreparedStatement p a -> Statement
prepared :: Statement
    }

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

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

-- | Unsafely untype prepared statement.
untypePrepared :: PreparedStatement p a -> Statement
untypePrepared :: forall p a. PreparedStatement p a -> Statement
untypePrepared =  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 :: forall conn p a.
IConnection conn =>
conn -> String -> IO (PreparedStatement p a)
unsafePrepare conn
conn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall p a. Statement -> PreparedStatement p a
PreparedStatement forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (s :: * -> *) conn p.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> IO (PreparedStatement p ())
prepareNoFetch conn
conn = forall conn p a.
IConnection conn =>
conn -> String -> IO (PreparedStatement p a)
unsafePrepare conn
conn forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall p a. PreparedStatement p a -> IO ()
finish = Statement -> IO ()
HDBC.finish forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall conn p a b.
IConnection conn =>
conn -> String -> (PreparedStatement p a -> IO b) -> IO b
withUnsafePrepare conn
conn String
qs =
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall conn p a.
IConnection conn =>
conn -> String -> IO (PreparedStatement p a)
unsafePrepare conn
conn String
qs) 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 :: forall (s :: * -> *) conn p a.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> (PreparedStatement p () -> IO a) -> IO a
withPrepareNoFetch conn
conn s p
s =
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall (s :: * -> *) conn p.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> IO (PreparedStatement p ())
prepareNoFetch conn
conn s p
s) 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 :: forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> BoundStatement a
bind PreparedStatement p a
q p
p = BoundStatement { bound :: Statement
bound = forall p a. PreparedStatement p a -> Statement
prepared PreparedStatement p a
q, params :: [SqlValue]
params = 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 :: forall p a.
ToSql SqlValue p =>
p -> PreparedStatement p a -> BoundStatement a
bindTo =  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> BoundStatement a
bind

-- | Typed execute operation.
executeBound :: BoundStatement a -> IO (ExecutedStatement a)
executeBound :: forall a. BoundStatement a -> IO (ExecutedStatement a)
executeBound BoundStatement a
bs = do
  let stmt :: Statement
stmt = forall a. BoundStatement a -> Statement
bound BoundStatement a
bs
  Integer
n <- Statement -> [SqlValue] -> IO Integer
HDBC.execute Statement
stmt (forall a. BoundStatement a -> [SqlValue]
params BoundStatement a
bs)
  Integer
n seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> IO (ExecutedStatement a)
execute PreparedStatement p a
st = forall a. BoundStatement a -> IO (ExecutedStatement a)
executeBound forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall p a.
ToSql SqlValue p =>
PreparedStatement p a -> p -> IO (ExecutedStatement a)
executePrepared = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ExecutedStatement a -> Integer
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a.
ToSql SqlValue a =>
PreparedStatement a () -> a -> IO Integer
executeNoFetch PreparedStatement a ()
p = BoundStatement () -> IO Integer
executeBoundNoFetch forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PreparedStatement a ()
p 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 :: forall a.
ToSql SqlValue a =>
PreparedStatement a () -> a -> IO Integer
runPreparedNoFetch = 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 :: forall (s :: * -> *) conn a.
(UntypeableNoFetch s, IConnection conn, ToSql SqlValue a) =>
conn -> s a -> a -> IO Integer
runNoFetch conn
conn s a
s a
p = forall (s :: * -> *) conn p a.
(UntypeableNoFetch s, IConnection conn) =>
conn -> s p -> (PreparedStatement p () -> IO a) -> IO a
withPrepareNoFetch conn
conn s a
s (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 :: forall (s :: * -> *) conn a.
(UntypeableNoFetch s, IConnection conn, ToSql SqlValue a) =>
conn -> s a -> [a] -> IO [Integer]
mapNoFetch conn
conn s a
s [a]
rs =
  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 ()
ps -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
ToSql SqlValue a =>
PreparedStatement a () -> a -> IO Integer
runPreparedNoFetch PreparedStatement a ()
ps) [a]
rs)