module Hasql.Pool
(
  Pool,
  Settings(..),
  acquire,
  release,
  UsageError(..),
  use,
)
where

import Hasql.Pool.Prelude
import qualified Hasql.Connection
import qualified Hasql.Session
import qualified Data.Pool as ResourcePool
import qualified Hasql.Pool.ResourcePool as ResourcePool


-- |
-- A pool of connections to DB.
newtype Pool =
  Pool (ResourcePool.Pool (Either Hasql.Connection.ConnectionError Hasql.Connection.Connection))
  deriving (Int -> Pool -> ShowS
[Pool] -> ShowS
Pool -> String
(Int -> Pool -> ShowS)
-> (Pool -> String) -> ([Pool] -> ShowS) -> Show Pool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pool] -> ShowS
$cshowList :: [Pool] -> ShowS
show :: Pool -> String
$cshow :: Pool -> String
showsPrec :: Int -> Pool -> ShowS
$cshowsPrec :: Int -> Pool -> ShowS
Show)

-- |
-- Settings of the connection pool. Consist of:
-- 
-- * Pool-size.
-- 
-- * Timeout.   
-- An amount of time for which an unused resource is kept open.
-- The smallest acceptable value is 0.5 seconds.
-- 
-- * Connection settings.
-- 
type Settings =
  (Int, NominalDiffTime, Hasql.Connection.Settings)

-- |
-- Given the pool-size, timeout and connection settings
-- create a connection-pool.
acquire :: Settings -> IO Pool
acquire :: Settings -> IO Pool
acquire (Int
size, NominalDiffTime
timeout, Settings
connectionSettings) =
  (Pool (Either ConnectionError Connection) -> Pool)
-> IO (Pool (Either ConnectionError Connection)) -> IO Pool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pool (Either ConnectionError Connection) -> Pool
Pool (IO (Pool (Either ConnectionError Connection)) -> IO Pool)
-> IO (Pool (Either ConnectionError Connection)) -> IO Pool
forall a b. (a -> b) -> a -> b
$
  IO (Either ConnectionError Connection)
-> (Either ConnectionError Connection -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (Pool (Either ConnectionError Connection))
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
ResourcePool.createPool IO (Either ConnectionError Connection)
acquire Either ConnectionError Connection -> IO ()
forall b. Either b Connection -> IO ()
release Int
forall p. Num p => p
stripes NominalDiffTime
timeout Int
size
  where
    acquire :: IO (Either ConnectionError Connection)
acquire =
      Settings -> IO (Either ConnectionError Connection)
Hasql.Connection.acquire Settings
connectionSettings
    release :: Either b Connection -> IO ()
release =
      (b -> IO ())
-> (Connection -> IO ()) -> Either b Connection -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO () -> b -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())) Connection -> IO ()
Hasql.Connection.release
    stripes :: p
stripes =
      p
1

-- |
-- Release the connection-pool.
release :: Pool -> IO ()
release :: Pool -> IO ()
release (Pool Pool (Either ConnectionError Connection)
pool) =
  Pool (Either ConnectionError Connection) -> IO ()
forall a. Pool a -> IO ()
ResourcePool.destroyAllResources Pool (Either ConnectionError Connection)
pool

-- |
-- A union over the connection establishment error and the session error.
data UsageError =
  ConnectionError Hasql.Connection.ConnectionError |
  SessionError Hasql.Session.QueryError
  deriving (Int -> UsageError -> ShowS
[UsageError] -> ShowS
UsageError -> String
(Int -> UsageError -> ShowS)
-> (UsageError -> String)
-> ([UsageError] -> ShowS)
-> Show UsageError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UsageError] -> ShowS
$cshowList :: [UsageError] -> ShowS
show :: UsageError -> String
$cshow :: UsageError -> String
showsPrec :: Int -> UsageError -> ShowS
$cshowsPrec :: Int -> UsageError -> ShowS
Show, UsageError -> UsageError -> Bool
(UsageError -> UsageError -> Bool)
-> (UsageError -> UsageError -> Bool) -> Eq UsageError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsageError -> UsageError -> Bool
$c/= :: UsageError -> UsageError -> Bool
== :: UsageError -> UsageError -> Bool
$c== :: UsageError -> UsageError -> Bool
Eq)

-- |
-- Use a connection from the pool to run a session and
-- return the connection to the pool, when finished.
use :: Pool -> Hasql.Session.Session a -> IO (Either UsageError a)
use :: Pool -> Session a -> IO (Either UsageError a)
use (Pool Pool (Either ConnectionError Connection)
pool) Session a
session =
  (Either ConnectionError (Either QueryError a)
 -> Either UsageError a)
-> IO (Either ConnectionError (Either QueryError a))
-> IO (Either UsageError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ConnectionError -> Either UsageError a)
-> (Either QueryError a -> Either UsageError a)
-> Either ConnectionError (Either QueryError a)
-> Either UsageError a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (UsageError -> Either UsageError a
forall a b. a -> Either a b
Left (UsageError -> Either UsageError a)
-> (ConnectionError -> UsageError)
-> ConnectionError
-> Either UsageError a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConnectionError -> UsageError
ConnectionError) ((QueryError -> Either UsageError a)
-> (a -> Either UsageError a)
-> Either QueryError a
-> Either UsageError a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (UsageError -> Either UsageError a
forall a b. a -> Either a b
Left (UsageError -> Either UsageError a)
-> (QueryError -> UsageError) -> QueryError -> Either UsageError a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QueryError -> UsageError
SessionError) a -> Either UsageError a
forall a b. b -> Either a b
Right)) (IO (Either ConnectionError (Either QueryError a))
 -> IO (Either UsageError a))
-> IO (Either ConnectionError (Either QueryError a))
-> IO (Either UsageError a)
forall a b. (a -> b) -> a -> b
$
  Pool (Either ConnectionError Connection)
-> (Either ConnectionError Connection
    -> IO (Either ConnectionError (Either QueryError a)))
-> IO (Either ConnectionError (Either QueryError a))
forall resource failure success.
Pool resource
-> (resource -> IO (Either failure success))
-> IO (Either failure success)
ResourcePool.withResourceOnEither Pool (Either ConnectionError Connection)
pool ((Either ConnectionError Connection
  -> IO (Either ConnectionError (Either QueryError a)))
 -> IO (Either ConnectionError (Either QueryError a)))
-> (Either ConnectionError Connection
    -> IO (Either ConnectionError (Either QueryError a)))
-> IO (Either ConnectionError (Either QueryError a))
forall a b. (a -> b) -> a -> b
$
  (Connection -> IO (Either QueryError a))
-> Either ConnectionError Connection
-> IO (Either ConnectionError (Either QueryError a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Connection -> IO (Either QueryError a))
 -> Either ConnectionError Connection
 -> IO (Either ConnectionError (Either QueryError a)))
-> (Connection -> IO (Either QueryError a))
-> Either ConnectionError Connection
-> IO (Either ConnectionError (Either QueryError a))
forall a b. (a -> b) -> a -> b
$
  Session a -> Connection -> IO (Either QueryError a)
forall a. Session a -> Connection -> IO (Either QueryError a)
Hasql.Session.run Session a
session