    {-# 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: '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SqlError -> String
    seState SqlError
    se String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'",
       String
    "seNativeError: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (SqlError -> Int
    seNativeError SqlError
    se),
       String
    "seErrorMsg: '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SqlError -> String
    seErrorMsg SqlError
    se String -> String -> String
    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' =  (SqlError -> IO a) -> IO a -> IO a
    forall a. (SqlError -> IO a) -> IO a -> IO a
    handleSql (String -> IO a
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> IO a) -> (SqlError -> String) -> SqlError -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    reformat (String -> String) -> (SqlError -> String) -> SqlError -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SqlError -> String
    showSqlError)  where
      reformat :: String -> String
    reformat = (String
    "SQL error: \n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    unlines ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    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 =
        m conn -> (conn -> m ()) -> (conn -> m a) -> m a
    forall c. m c -> (c -> m ()) -> (c -> m a) -> m a
    bracket_ (IO conn -> m conn
    forall b. IO b -> m b
    lift IO conn
    open) (IO () -> m ()
    forall b. IO b -> m b
    lift (IO () -> m ()) -> (conn -> IO ()) -> conn -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . conn -> IO ()
    forall conn. IConnection conn => conn -> IO ()
    close) conn -> m a
    bodyWithRollback
      where
        open :: IO conn
    open  = IO conn -> IO conn
    forall a. IO a -> IO a
    handleSqlError' IO conn
    connect
        close :: IConnection conn => conn -> IO ()
        close :: forall conn. IConnection conn => conn -> IO ()
    close =  IO () -> IO ()
    forall a. IO a -> IO a
    handleSqlError' (IO () -> IO ()) -> (conn -> IO ()) -> conn -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . conn -> IO ()
    forall conn. IConnection conn => conn -> IO ()
    HDBC.disconnect
        bodyWithRollback :: conn -> m a
    bodyWithRollback conn
    conn =
          m () -> (() -> m ()) -> (() -> m a) -> m a
    forall c. m c -> (c -> m ()) -> (c -> m a) -> m a
    bracket_
          (() -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
          -- Do rollback independent from driver default behavior when disconnect.
          (m () -> () -> m ()
    forall a b. a -> b -> a
    const (m () -> () -> m ()) -> (IO () -> m ()) -> IO () -> () -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> m ()
    forall b. IO b -> m b
    lift (IO () -> m ()) -> (IO () -> IO ()) -> IO () -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> IO ()
    forall a. IO a -> IO a
    handleSqlError' (IO () -> () -> m ()) -> IO () -> () -> m ()
    forall a b. (a -> b) -> a -> b
    $ conn -> IO ()
    forall conn. IConnection conn => conn -> IO ()
    HDBC.rollback conn
    conn)
          (m a -> () -> m a
    forall a b. a -> b -> a
    const (m a -> () -> m a) -> m a -> () -> m a
    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 c. m c -> (c -> m ()) -> (c -> m a) -> m a)
    -> (forall b. IO b -> m b) -> IO conn -> (conn -> m a) -> m a
    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 c. IO c -> (c -> IO ()) -> (c -> IO a) -> IO a)
    -> (forall a. IO a -> IO a) -> IO conn -> (conn -> IO a) -> IO a
    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 IO c -> (c -> IO ()) -> (c -> IO a) -> IO a
    forall c. IO c -> (c -> IO ()) -> (c -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket IO b -> IO b
    forall a. a -> a
    forall a. IO a -> IO 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 = IO conn -> (conn -> IO a) -> IO a
    forall conn a.
    IConnection conn =>
    IO conn -> (conn -> IO a) -> IO a
    withConnectionIO_ IO conn
    connect ((conn -> IO a) -> IO a) -> (conn -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ IO a -> IO a
    forall a. IO a -> IO a
    handleSqlError' (IO a -> IO a) -> (conn -> IO a) -> conn -> IO a
    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' = IO conn -> (conn -> IO a) -> IO a
    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 =
      IO conn -> (conn -> IO a) -> IO a
    forall conn a.
    IConnection conn =>
    IO conn -> (conn -> IO a) -> IO a
    withConnectionIO IO conn
    conn ((conn -> IO a) -> IO a) -> (conn -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \conn
    c -> do
        x <- conn -> IO a
    body conn
    c
        HDBC.commit c
        return 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 =
      IO conn -> (conn -> IO a) -> IO a
    forall conn a.
    IConnection conn =>
    IO conn -> (conn -> IO a) -> IO a
    withConnectionIO_ IO conn
    conn ((conn -> IO a) -> IO a) -> (conn -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \conn
    c -> do
        x <- conn -> IO a
    body conn
    c
        HDBC.commit c
        return x