on master help sign in
Don't use block form of withManager

Control gets returned from this function immediately, so the behavior of the manager was questionable. Instead, we manually allocate a reference and deallocate it after all the workers are done.

commitd80deeee71cac1f84bbe71cdb35ac00691dc9210 authorMichael Xavier <michael@michaelxavier.net> dateMon 18 May 2015, 09:39 (11 years ago) parent2c7a57e
1 file changed+21−21
katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+21−21
katip-elasticsearch/src/Katip/Scribes/ElasticSearch.hs+21−21
@@ -32,7 +32,6 @@ import Control.Monad.Catch
3232import Control.Monad.STM
3333import Control.Retry
3434import Data.Aeson
35−import Data.Monoid
3635import qualified Data.Text.Encoding as T
3736import Data.Typeable
3837import Data.UUID
@@ -86,26 +85,27 @@ mkEsScribe
8685 -- ^ Returns a finalizer that will gracefully flush all remaining logs before shutting down workers
8786mkEsScribe cfg@EsScribeCfg {..} server ix mapping sev verb = do
8887 q <- newTBMQueueIO $ unEsQueueSize essQueueSize
89− withManager essManagerSettings $ \mgr -> do
90− let env = BHEnv { bhServer = server
91− , bhManager = mgr
92− }
93− endSig <- newEmptyMVar
94−
95− workers <- replicateM (unEsPoolSize essPoolSize) $ async $
96− startWorker cfg env ix mapping q
97−
98− _ <- async $ do
99− takeMVar endSig
100− atomically $ closeTBMQueue q
101− mapM_ wait workers
102− putMVar endSig ()
103−
104− let scribe = Scribe $ \ i ->
105− when (_itemSeverity i >= sev) $
106− void $ atomically $ tryWriteTBMQueue q (itemJson verb i)
107− let finalizer = putMVar endSig () >> takeMVar endSig
108− return (scribe, finalizer)
88+ mgr <- newManager essManagerSettings
89+ let env = BHEnv { bhServer = server
90+ , bhManager = mgr
91+ }
92+ endSig <- newEmptyMVar
93+
94+ workers <- replicateM (unEsPoolSize essPoolSize) $ async $
95+ startWorker cfg env ix mapping q
96+
97+ _ <- async $ do
98+ takeMVar endSig
99+ atomically $ closeTBMQueue q
100+ mapM_ wait workers
101+ closeManager mgr
102+ putMVar endSig ()
103+
104+ let scribe = Scribe $ \ i ->
105+ when (_itemSeverity i >= sev) $
106+ void $ atomically $ tryWriteTBMQueue q (itemJson verb i)
107+ let finalizer = putMVar endSig () >> takeMVar endSig
108+ return (scribe, finalizer)
109109
110110
111111-------------------------------------------------------------------------------