module Database.GP.Conn
  ( Conn (..),
    connect,
    TxHandling (..),
    ConnectionPool,
    createConnPool,
    withResource,
  )
where

import           Control.Monad ((>=>))
import           Data.Pool     (Pool, PoolConfig, defaultPoolConfig, newPool,
                                withResource)
import           Database.HDBC (IConnection (..))

-- |
--  This module defines a wrapper around an HDBC IConnection.
--  Using this wrapper `Conn` simplifies the signature of the functions in the `Database.GP` module.
--  It allows to use any HDBC connection without having to define a new function for each connection type.
--  It also provides additional attributes to the connection, like the database type and the implicit commit flag.
--  These attributes can be used to implement database specific functionality, modify transaction behaviour, etc.
--
--  This code has been inspired by the HDBC ConnectionWrapper and some parts have been copied verbatim
--  from the HDBC Database.HDBC.Types module.
--
--  This module also defines a ConnectionPool type, which provides basic connection pooling functionality.

-- | A wrapper around an HDBC IConnection.
data Conn = forall conn. IConnection conn => 
  Conn 
    Bool -- | If True, the GenericPersistence functions will commit the transaction after each operation.
    conn -- | The wrapped HDBC IConnection

data TxHandling = AutoCommit | ExplicitCommit

-- | a smart constructor for the Conn type.
connect :: forall conn. IConnection conn => TxHandling -> conn -> Conn
connect :: forall conn. IConnection conn => TxHandling -> conn -> Conn
connect = \case
  TxHandling
AutoCommit     -> Bool -> conn -> Conn
forall conn. IConnection conn => Bool -> conn -> Conn
Conn Bool
True
  TxHandling
ExplicitCommit -> Bool -> conn -> Conn
forall conn. IConnection conn => Bool -> conn -> Conn
Conn Bool
False

-- | allows to execute a function that requires an `IConnection` argument on a `Conn`.
withWConn :: forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn :: forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn (Conn Bool
_ic conn
conn) forall conn. IConnection conn => conn -> b
f = conn -> b
forall conn. IConnection conn => conn -> b
f conn
conn

-- | manually implement the IConnection type class for the Conn type.
instance IConnection Conn where
  disconnect :: Conn -> IO ()
disconnect Conn
w = Conn -> (forall conn. IConnection conn => conn -> IO ()) -> IO ()
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> IO ()
forall conn. IConnection conn => conn -> IO ()
disconnect
  commit :: Conn -> IO ()
commit Conn
w = Conn -> (forall conn. IConnection conn => conn -> IO ()) -> IO ()
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> IO ()
forall conn. IConnection conn => conn -> IO ()
commit
  rollback :: Conn -> IO ()
rollback Conn
w = Conn -> (forall conn. IConnection conn => conn -> IO ()) -> IO ()
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> IO ()
forall conn. IConnection conn => conn -> IO ()
rollback
  runRaw :: Conn -> String -> IO ()
runRaw Conn
w = Conn
-> (forall conn. IConnection conn => conn -> String -> IO ())
-> String
-> IO ()
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> String -> IO ()
forall conn. IConnection conn => conn -> String -> IO ()
runRaw
  run :: Conn -> String -> [SqlValue] -> IO Integer
run Conn
w = Conn
-> (forall conn.
    IConnection conn =>
    conn -> String -> [SqlValue] -> IO Integer)
-> String
-> [SqlValue]
-> IO Integer
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> String -> [SqlValue] -> IO Integer
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO Integer
run
  prepare :: Conn -> String -> IO Statement
prepare Conn
w = Conn
-> (forall conn.
    IConnection conn =>
    conn -> String -> IO Statement)
-> String
-> IO Statement
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> String -> IO Statement
forall conn. IConnection conn => conn -> String -> IO Statement
prepare
  clone :: Conn -> IO Conn
clone w :: Conn
w@(Conn Bool
ic conn
_) = Conn
-> (forall conn. IConnection conn => conn -> IO Conn) -> IO Conn
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w (conn -> IO conn
forall conn. IConnection conn => conn -> IO conn
clone (conn -> IO conn) -> (conn -> IO Conn) -> conn -> IO Conn
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Conn -> IO Conn
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Conn -> IO Conn) -> (conn -> Conn) -> conn -> IO Conn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> conn -> Conn
forall conn. IConnection conn => Bool -> conn -> Conn
Conn Bool
ic)
  hdbcDriverName :: Conn -> String
hdbcDriverName Conn
w = Conn -> (forall conn. IConnection conn => conn -> String) -> String
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> String
forall conn. IConnection conn => conn -> String
hdbcDriverName
  hdbcClientVer :: Conn -> String
hdbcClientVer Conn
w = Conn -> (forall conn. IConnection conn => conn -> String) -> String
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> String
forall conn. IConnection conn => conn -> String
hdbcClientVer
  proxiedClientName :: Conn -> String
proxiedClientName Conn
w = Conn -> (forall conn. IConnection conn => conn -> String) -> String
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> String
forall conn. IConnection conn => conn -> String
proxiedClientName
  proxiedClientVer :: Conn -> String
proxiedClientVer Conn
w = Conn -> (forall conn. IConnection conn => conn -> String) -> String
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> String
forall conn. IConnection conn => conn -> String
proxiedClientVer
  dbServerVer :: Conn -> String
dbServerVer Conn
w = Conn -> (forall conn. IConnection conn => conn -> String) -> String
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> String
forall conn. IConnection conn => conn -> String
dbServerVer
  dbTransactionSupport :: Conn -> Bool
dbTransactionSupport Conn
w = Conn -> (forall conn. IConnection conn => conn -> Bool) -> Bool
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> Bool
forall conn. IConnection conn => conn -> Bool
dbTransactionSupport
  getTables :: Conn -> IO [String]
getTables Conn
w = Conn
-> (forall conn. IConnection conn => conn -> IO [String])
-> IO [String]
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> IO [String]
forall conn. IConnection conn => conn -> IO [String]
getTables
  describeTable :: Conn -> String -> IO [(String, SqlColDesc)]
describeTable Conn
w = Conn
-> (forall conn.
    IConnection conn =>
    conn -> String -> IO [(String, SqlColDesc)])
-> String
-> IO [(String, SqlColDesc)]
forall b. Conn -> (forall conn. IConnection conn => conn -> b) -> b
withWConn Conn
w conn -> String -> IO [(String, SqlColDesc)]
forall conn.
IConnection conn =>
conn -> String -> IO [(String, SqlColDesc)]
describeTable

-- | A pool of connections.
type ConnectionPool = Pool Conn

-- | Creates a connection pool.
createConnPool ::
  IConnection conn =>
  -- | the transaction mode
  TxHandling ->
  -- | the connection string
  String ->
  -- | a function that takes a connection string and returns an IConnection
  (String -> IO conn) ->
  -- | the time (in seconds) to keep idle connections open
  Double ->
  -- | the maximum number of connections to keep open
  Int ->
  -- | the resulting connection pool
  IO ConnectionPool
createConnPool :: forall conn.
IConnection conn =>
TxHandling
-> String
-> (String -> IO conn)
-> Double
-> Int
-> IO ConnectionPool
createConnPool TxHandling
txHandling String
connectString String -> IO conn
connectFun Double
idle Int
numConns = PoolConfig Conn -> IO ConnectionPool
forall a. PoolConfig a -> IO (Pool a)
newPool PoolConfig Conn
poolConfig
  where
    freshConnection :: IO Conn
    freshConnection :: IO Conn
freshConnection = TxHandling -> conn -> Conn
forall conn. IConnection conn => TxHandling -> conn -> Conn
connect TxHandling
txHandling (conn -> Conn) -> IO conn -> IO Conn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO conn
connectFun String
connectString
    poolConfig :: PoolConfig Conn
    poolConfig :: PoolConfig Conn
poolConfig = IO Conn -> (Conn -> IO ()) -> Double -> Int -> PoolConfig Conn
forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
defaultPoolConfig IO Conn
freshConnection Conn -> IO ()
forall conn. IConnection conn => conn -> IO ()
disconnect Double
idle Int
numConns