module Periodic.Trans.ClientPool
  ( module Periodic.Trans.Client
  , ClientPoolEnv
  , runClientPoolT
  , openPool
  ) where

import           Data.Pool             (Pool, createPool, withResource)
import           Metro.Class           (Transport, TransportConfig)
import           Periodic.Trans.Client hiding (close)
import qualified Periodic.Trans.Client as C (close)

type ClientPoolEnv tp = Pool (ClientEnv tp)

runClientPoolT :: ClientPoolEnv tp -> ClientT tp IO a -> IO a
runClientPoolT :: ClientPoolEnv tp -> ClientT tp IO a -> IO a
runClientPoolT pool :: ClientPoolEnv tp
pool m :: ClientT tp IO a
m = ClientPoolEnv tp -> (ClientEnv tp -> IO a) -> IO a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource ClientPoolEnv tp
pool ((ClientEnv tp -> IO a) -> IO a) -> (ClientEnv tp -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ (ClientEnv tp -> ClientT tp IO a -> IO a)
-> ClientT tp IO a -> ClientEnv tp -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ClientEnv tp -> ClientT tp IO a -> IO a
forall (m :: * -> *) tp a.
Monad m =>
ClientEnv tp -> ClientT tp m a -> m a
runClientT ClientT tp IO a
m

openPool :: Transport tp => TransportConfig tp -> Int -> IO (ClientPoolEnv tp)
openPool :: TransportConfig tp -> Int -> IO (ClientPoolEnv tp)
openPool config :: TransportConfig tp
config = IO (ClientEnv tp)
-> (ClientEnv tp -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (ClientPoolEnv tp)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
createPool (TransportConfig tp -> IO (ClientEnv tp)
forall (m :: * -> *) tp.
(MonadUnliftIO m, Transport tp) =>
TransportConfig tp -> m (ClientEnv tp)
open TransportConfig tp
config) (ClientEnv tp -> ClientT tp IO () -> IO ()
forall (m :: * -> *) tp a.
Monad m =>
ClientEnv tp -> ClientT tp m a -> m a
`runClientT` ClientT tp IO ()
forall (m :: * -> *) tp u.
(MonadUnliftIO m, Transport tp) =>
BaseClientT u tp m ()
C.close) 1 5000