module Database.GP.Conn
  ( Conn (..),
    connect,
    Database (..),
    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
  { -- | The database type
    Conn -> Database
db             :: Database,
    -- | If True, the GenericPersistence functions will commit the transaction after each operation.
    Conn -> Bool
implicitCommit :: Bool,
    -- | The wrapped connection
    ()
connection     :: conn
  }

-- | An enumeration of the supported database types.
data Database = Postgres | MySQL | SQLite | Oracle | MSSQL
  deriving (Int -> Database -> ShowS
[Database] -> ShowS
Database -> String
(Int -> Database -> ShowS)
-> (Database -> String) -> ([Database] -> ShowS) -> Show Database
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Database -> ShowS
showsPrec :: Int -> Database -> ShowS
$cshow :: Database -> String
show :: Database -> String
$cshowList :: [Database] -> ShowS
showList :: [Database] -> ShowS
Show, Database -> Database -> Bool
(Database -> Database -> Bool)
-> (Database -> Database -> Bool) -> Eq Database
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Database -> Database -> Bool
== :: Database -> Database -> Bool
$c/= :: Database -> Database -> Bool
/= :: Database -> Database -> Bool
Eq, Int -> Database
Database -> Int
Database -> [Database]
Database -> Database
Database -> Database -> [Database]
Database -> Database -> Database -> [Database]
(Database -> Database)
-> (Database -> Database)
-> (Int -> Database)
-> (Database -> Int)
-> (Database -> [Database])
-> (Database -> Database -> [Database])
-> (Database -> Database -> [Database])
-> (Database -> Database -> Database -> [Database])
-> Enum Database
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Database -> Database
succ :: Database -> Database
$cpred :: Database -> Database
pred :: Database -> Database
$ctoEnum :: Int -> Database
toEnum :: Int -> Database
$cfromEnum :: Database -> Int
fromEnum :: Database -> Int
$cenumFrom :: Database -> [Database]
enumFrom :: Database -> [Database]
$cenumFromThen :: Database -> Database -> [Database]
enumFromThen :: Database -> Database -> [Database]
$cenumFromTo :: Database -> Database -> [Database]
enumFromTo :: Database -> Database -> [Database]
$cenumFromThenTo :: Database -> Database -> Database -> [Database]
enumFromThenTo :: Database -> Database -> Database -> [Database]
Enum)

-- | a smart constructor for the Conn type.
connect :: forall conn. IConnection conn => Database -> conn -> Conn
connect :: forall conn. IConnection conn => Database -> conn -> Conn
connect Database
db = Database -> Bool -> conn -> Conn
forall conn. IConnection conn => Database -> Bool -> conn -> Conn
Conn Database
db Bool
True

-- | 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 Database
_db 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 Database
db 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
. Database -> Bool -> conn -> Conn
forall conn. IConnection conn => Database -> Bool -> conn -> Conn
Conn Database
db 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 database type e.g. Postgres, MySQL, SQLite
  Database ->
  -- | 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 =>
Database
-> String
-> (String -> IO conn)
-> Double
-> Int
-> IO ConnectionPool
createConnPool Database
db 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 = Database -> conn -> Conn
forall conn. IConnection conn => Database -> conn -> Conn
connect Database
db (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