From ee8649ef51c94d09e417c8f01a1a60d1e1613fe1 Mon Sep 17 00:00:00 2001
From: Lupino <lmjubuntu@gmail.com>
Date: Mon, 12 Mar 2018 15:05:06 +0800
Subject: [PATCH] add simple client pool

---
 periodic-client/periodic-client.cabal      |  3 +++
 periodic-client/src/Periodic/Client.hs     |  2 +-
 periodic-client/src/Periodic/ClientPool.hs | 23 ++++++++++++++++++++++
 3 files changed, 27 insertions(+), 1 deletion(-)
 create mode 100644 periodic-client/src/Periodic/ClientPool.hs

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