{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- |
-- Module:       $HEADER$
-- Description:  ConnectionPool data type which is a specialized Pool wrapper.
-- Copyright:    (c) 2014 Peter Trsko
-- License:      BSD3
--
-- Maintainer:   peter.trsko@gmail.com
-- Stability:    unstable (internal module)
-- Portability:  non-portable (DeriveDataTypeable, FlexibleContexts,
--               NoImplicitPrelude)
--
-- Internal packages are here to provide access to internal definitions for
-- library writers, but they should not be used in application code.
--
-- Preferably use qualified import, e.g.:
--
-- > import qualified Data.ConnectionPool.Internal.ConnectionPool as Internal
--
-- This module doesn't depend on
-- <http://hackage.haskell.org/package/streaming-commons streaming-commons>
-- and other non-HaskellPlatform packages with notable exception of
-- <http://hackage.haskell.org/package/resource-pool resource-pool>. Another
-- notable thing is that this package is not OS specific. Please, bear this in
-- mind when doing modifications.
module Data.ConnectionPool.Internal.ConnectionPool
    ( ConnectionPool(ConnectionPool)
    , createConnectionPool
    , withConnection
    )
  where

import Control.Applicative ((<$>))
import Data.Function ((.))
import Data.Tuple (fst, uncurry)
import Data.Typeable (Typeable)
import System.IO (IO)

import Control.Monad.Trans.Control (MonadBaseControl)
import Network.Socket (Socket)

import Data.Pool (Pool)
import Data.Pool as Pool (createPool, withResource)

import Data.ConnectionPool.Internal.ResourcePoolParams (ResourcePoolParams)
import qualified Data.ConnectionPool.Internal.ResourcePoolParams
  as ResourcePoolParams (ResourcePoolParams(..))


-- | Simple specialized wrapper for 'Pool'.
newtype ConnectionPool a = ConnectionPool (Pool (Socket, a))
  deriving (Typeable)

-- | Specialized wrapper for 'Pool.createPool', see its documentation for
-- details.
createConnectionPool
    :: IO (Socket, a)
    -- ^ Acquire a connection which is prepresented by a 'Socket'. There might
    -- be additional information associated with specific connection that we
    -- represent here as a sencond type in a tuple. Such information are
    -- considered read only and aren't passed to release function (see next
    -- argument).
    -> (Socket -> IO ())
    -- ^ Release a connection which is prepresented by a 'Socket'.
    -> ResourcePoolParams
    -- ^ Data type representing all 'Pool.createPool' parameters that describe
    -- internal 'Pool' parameters.
    -> IO (ConnectionPool a)
    -- ^ Created connection pool that is parametrised by additional connection
    -- details.
createConnectionPool acquire release params =
    ConnectionPool <$> Pool.createPool
        acquire
        (release . fst)
        (ResourcePoolParams._numberOfStripes params)
        (ResourcePoolParams._resourceIdleTimeout params)
        (ResourcePoolParams._numberOfResourcesPerStripe params)

-- | Specialized wrapper for 'Pool.withConnection'.
withConnection
    :: MonadBaseControl IO m
    => ConnectionPool a
    -> (Socket -> a -> m r)
    -> m r
withConnection (ConnectionPool pool) f =
    Pool.withResource pool (uncurry f)