diff --git a/periodic-client/periodic-client.cabal b/periodic-client/periodic-client.cabal index d97aa67..2490563 100644 --- a/periodic-client/periodic-client.cabal +++ b/periodic-client/periodic-client.cabal @@ -16,6 +16,7 @@ cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: Periodic.Client + , Periodic.ClientPool , Periodic.Job , Periodic.Worker @@ -29,6 +30,8 @@ library , transformers , lifted-base , lifted-async + + , resource-pool default-language: Haskell2010 executable periodic diff --git a/periodic-client/src/Periodic/Client.hs b/periodic-client/src/Periodic/Client.hs index 53094b0..c0ae125 100644 --- a/periodic-client/src/Periodic/Client.hs +++ b/periodic-client/src/Periodic/Client.hs @@ -47,7 +47,7 @@ import Periodic.Utils (getEpochTime) import Periodic.Monad import System.Timeout.Lifted (timeout) -type ClientT m = PeriodicT m () +type ClientT m = PeriodicT m () data ClientEnv m = ClientEnv { periodicEnv :: Env m () diff --git a/periodic-client/src/Periodic/ClientPool.hs b/periodic-client/src/Periodic/ClientPool.hs new file mode 100644 index 0000000..9866990 --- /dev/null +++ b/periodic-client/src/Periodic/ClientPool.hs @@ -0,0 +1,23 @@ +module Periodic.ClientPool + ( + module Periodic.Client + , ClientEnv + , runClientT + , open + ) where + +import Data.Pool (Pool, createPool, withResource) +import Periodic.Client hiding (ClientEnv, close, open, runClientT) +import qualified Periodic.Client as Client (ClientEnv, close, open, + runClientT) +import Periodic.Transport (Transport) + +type ClientEnv = Pool (Client.ClientEnv IO) + +runClientT :: ClientEnv -> ClientT IO a -> IO a +runClientT pool m = withResource pool $ flip Client.runClientT m + +open + :: (Transport -> IO Transport) -> String -> Int -> IO ClientEnv +open f h = + createPool (Client.open f h) (`Client.runClientT` Client.close) 1 5000