{-# LANGUAGE Rank2Types #-}

-- |
-- Module      : Database.HDBC.Session
-- Copyright   : 2013-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides a base bracketed function
-- to call close correctly against opend DB connection.
module Database.HDBC.Session (
  -- * Bracketed session
  -- $bracketedSession
  transaction,

  withConnectionIO, withConnectionIO_,

  bracketConnection,

  -- * Show errors
  -- $showErrors
  showSqlError, handleSqlError',

  -- * Deprecated
  withConnection,
  withConnectionIO',
  withConnectionCommit,
  ) where

import Database.HDBC (IConnection, handleSql,
                      SqlError(seState, seNativeError, seErrorMsg))
import qualified Database.HDBC as HDBC
import Control.Exception (bracket)


{- $bracketedSession
Bracket function implementation is provided by several packages,
so this package provides base implementation which requires
bracket function and corresponding lift function.
-}

{- $showErrors
Functions to show 'SqlError' type not to show 'String' fields.
-}

-- | show 'SqlError' not to show 'String' fields.
showSqlError :: SqlError -> String
showSqlError :: SqlError -> String
showSqlError SqlError
se = [String] -> String
unlines
  [String
"seState: '" forall a. [a] -> [a] -> [a]
++ SqlError -> String
seState SqlError
se forall a. [a] -> [a] -> [a]
++ String
"'",
   String
"seNativeError: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SqlError -> Int
seNativeError SqlError
se),
   String
"seErrorMsg: '" forall a. [a] -> [a] -> [a]
++ SqlError -> String
seErrorMsg SqlError
se forall a. [a] -> [a] -> [a]
++ String
"'"]

-- | Like 'handleSqlError', but not to show 'String' fields of SqlError.
handleSqlError' :: IO a -> IO a
handleSqlError' :: forall a. IO a -> IO a
handleSqlError' =  forall a. (SqlError -> IO a) -> IO a -> IO a
handleSql (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
reformat forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlError -> String
showSqlError)  where
  reformat :: String -> String
reformat = (String
"SQL error: \n" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String
"  " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

-- | Generalized session with bracketed HDBC connection.
--   Run a transaction on a HDBC IConnection and close the connection.
bracketConnection :: (Monad m, IConnection conn)
                  => (forall c. m c -> (c -> m ()) -> (c -> m a) -> m a) -- ^ bracket
                  -> (forall b. IO b -> m b)                             -- ^ lift
                  -> IO conn                                             -- ^ Connect action
                  -> (conn -> m a)                                       -- ^ Transaction body
                  -> m a
bracketConnection :: forall (m :: * -> *) conn a.
(Monad m, IConnection conn) =>
(forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b) -> IO conn -> (conn -> m a) -> m a
bracketConnection forall c. m c -> (c -> m ()) -> (c -> m a) -> m a
bracket_ forall b. IO b -> m b
lift IO conn
connect conn -> m a
tbody =
    forall c. m c -> (c -> m ()) -> (c -> m a) -> m a
bracket_ (forall b. IO b -> m b
lift IO conn
open) (forall b. IO b -> m b
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall conn. IConnection conn => conn -> IO ()
close) conn -> m a
bodyWithRollback
  where
    open :: IO conn
open  = forall a. IO a -> IO a
handleSqlError' IO conn
connect
    close :: IConnection conn => conn -> IO ()
    close :: forall conn. IConnection conn => conn -> IO ()
close =  forall a. IO a -> IO a
handleSqlError' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall conn. IConnection conn => conn -> IO ()
HDBC.disconnect
    bodyWithRollback :: conn -> m a
bodyWithRollback conn
conn =
      forall c. m c -> (c -> m ()) -> (c -> m a) -> m a
bracket_
      (forall (m :: * -> *) a. Monad m => a -> m a
return ())
      -- Do rollback independent from driver default behavior when disconnect.
      (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. IO b -> m b
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO a
handleSqlError' forall a b. (a -> b) -> a -> b
$ forall conn. IConnection conn => conn -> IO ()
HDBC.rollback conn
conn)
      (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ conn -> m a
tbody conn
conn)

{-# DEPRECATED withConnection "use 'bracketConnection' instead of this." #-}
-- | Deprecated. use 'bracketConnection' instead of this.
withConnection :: (Monad m, IConnection conn)
               => (forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
               -> (forall b. IO b -> m b)
               -> IO conn
               -> (conn -> m a)
               -> m a
withConnection :: forall (m :: * -> *) conn a.
(Monad m, IConnection conn) =>
(forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b) -> IO conn -> (conn -> m a) -> m a
withConnection = forall (m :: * -> *) conn a.
(Monad m, IConnection conn) =>
(forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b) -> IO conn -> (conn -> m a) -> m a
bracketConnection

-- | Same as 'withConnectionIO' other than not wrapping transaction body in 'handleSqlError''.
withConnectionIO_ :: IConnection conn
                  => IO conn        -- ^ Connect action
                  -> (conn -> IO a) -- ^ Transaction body
                  -> IO a           -- ^ Result transaction action
withConnectionIO_ :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO_ = forall (m :: * -> *) conn a.
(Monad m, IConnection conn) =>
(forall c. m c -> (c -> m ()) -> (c -> m a) -> m a)
-> (forall b. IO b -> m b) -> IO conn -> (conn -> m a) -> m a
bracketConnection forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket forall a. a -> a
id

-- | Run a transaction on a HDBC 'IConnection' and close the connection.
--   Not issuing commit at last, so if you need, issue commit manually in transaction body.
withConnectionIO :: IConnection conn
                 => IO conn        -- ^ Connect action
                 -> (conn -> IO a) -- ^ Transaction body
                 -> IO a           -- ^ Result transaction action
withConnectionIO :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO IO conn
connect conn -> IO a
body = forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO_ IO conn
connect forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO a
handleSqlError' forall b c a. (b -> c) -> (a -> b) -> a -> c
. conn -> IO a
body

{-# DEPRECATED withConnectionIO' "use 'withConnectionIO' instead of this." #-}
-- | Deprecated. use 'withConnectionIO' instead of this.
withConnectionIO' :: IConnection conn
                  => IO conn        -- ^ Connect action
                  -> (conn -> IO a) -- ^ Transaction body
                  -> IO a           -- ^ Result transaction action
withConnectionIO' :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO' = forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO

-- | Run a transaction on a HDBC 'IConnection' and commit at last, and then close the connection.
--   In other words, the transaction with no exception is committed.
--   Handy definition for simple transactions.
transaction :: IConnection conn
            => IO conn        -- ^ Connect action
            -> (conn -> IO a) -- ^ Transaction body
            -> IO a           -- ^ Result transaction action
transaction :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
transaction IO conn
conn conn -> IO a
body =
  forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO IO conn
conn forall a b. (a -> b) -> a -> b
$ \conn
c -> do
    a
x <- conn -> IO a
body conn
c
    forall conn. IConnection conn => conn -> IO ()
HDBC.commit conn
c
    forall (m :: * -> *) a. Monad m => a -> m a
return a
x

{-# DEPRECATED withConnectionCommit "use 'transaction' instead of this." #-}
-- | Deprecated. use 'transaction' instead of this.
withConnectionCommit :: IConnection conn
                     => IO conn        -- ^ Connect action
                     -> (conn -> IO a) -- ^ Transaction body
                     -> IO a           -- ^ Result transaction action
withConnectionCommit :: forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionCommit IO conn
conn conn -> IO a
body =
  forall conn a.
IConnection conn =>
IO conn -> (conn -> IO a) -> IO a
withConnectionIO_ IO conn
conn forall a b. (a -> b) -> a -> b
$ \conn
c -> do
    a
x <- conn -> IO a
body conn
c
    forall conn. IConnection conn => conn -> IO ()
HDBC.commit conn
c
    forall (m :: * -> *) a. Monad m => a -> m a
return a
x