@@ -277,60 +277,56 @@ mkEsScribe
277277 -> PermitFunc
278278 -> Verbosity
279279 -> IO Scribe
280−mkEsScribe cfg@EsScribeCfg {..} env permit verb = error "fuck"
281− -- q <- newTBMQueueIO $ unEsQueueSize essQueueSize
282− -- endSig <- newEmptyMVar
283−
284− -- runBH prx env $ do
285− -- if shardingEnabled
286− -- then do
287− -- -- create or update
288− -- res <- putTemplate prx tpl tplName
289− -- unless (statusIsSuccessful (responseStatus res)) $
290− -- liftIO $ EX.throwIO (CouldNotPutTemplate res)
291− -- else do
292− -- ixExists <- indexExists prx ix
293− -- if ixExists
294− -- then do
295− -- res <- updateIndexSettings prx (toUpdatabaleIndexSettings prx essIndexSettings) ix
296− -- unless (statusIsSuccessful (responseStatus res)) $
297− -- liftIO $ EX.throwIO (CouldNotUpdateIndexSettings res)
298− -- else do
299− -- r1 <- createIndex prx essIndexSettings ix
300− -- unless (statusIsSuccessful (responseStatus r1)) $
301− -- liftIO $ EX.throwIO (CouldNotCreateIndex r1)
302− -- r2 <- putMapping prx ix mapping mappingValue
303− -- unless (statusIsSuccessful (responseStatus r2)) $
304− -- liftIO $ EX.throwIO (CouldNotCreateMapping r2)
305−
306− -- workers <- replicateM (unEsPoolSize essPoolSize) $ async $
307− -- startWorker cfg env mapping q
308−
309− -- _ <- async $ do
310− -- takeMVar endSig
311− -- atomically $ closeTBMQueue q
312− -- mapM_ waitCatch workers
313− -- putMVar endSig ()
314−
315− -- let finalizer = putMVar endSig () >> takeMVar endSig
316− -- return (Scribe (logger q) finalizer permit)
317− -- where
318− -- logger :: forall a. LogItem a => TBMQueue (IndexName v, Value) -> Item a -> IO ()
319− -- logger q i =
320− -- void $ atomically $ tryWriteTBMQueue q (chooseIxn prx ix essIndexSharding i, itemJson' i)
321− -- prx :: Typeable.Proxy v
322− -- prx = Typeable.Proxy
323− -- tplName = toTemplateName prx ixn
324− -- shardingEnabled = case essIndexSharding of
325− -- NoIndexSharding -> False
326− -- _ -> True
327− -- tpl = toIndexTemplate prx (toTemplatePattern prx (ixn <> "-*")) (Just essIndexSettings) [mappingValue]
328− -- ixn = fromIndexName prx ix
329− -- itemJson' :: LogItem a => Item a -> Value
330− -- itemJson' i
331− -- | essAnnotateTypes = itemJson verb (TypeAnnotated <$> i)
332− -- | otherwise = itemJson verb i
333−
280+mkEsScribe cfg@EsScribeCfg {..} env permit verb = do
281+ q <- newTBMQueueIO $ unEsQueueSize essQueueSize
282+ endSig <- newEmptyMVar
283+
284+ runBH prx env $ do
285+ if shardingEnabled
286+ then do
287+ -- create or update
288+ res <- putTemplate prx tpl tplName
289+ unless (statusIsSuccessful (responseStatus res)) $
290+ liftIO $ EX.throwIO (CouldNotPutTemplate res)
291+ else do
292+ ixExists <- indexExists prx essIndexName
293+ if ixExists
294+ then do
295+ res <- updateIndexSettings prx (toUpdatabaleIndexSettings prx essIndexSettings) essIndexName
296+ unless (statusIsSuccessful (responseStatus res)) $
297+ liftIO $ EX.throwIO (CouldNotUpdateIndexSettings res)
298+ else do
299+ r1 <- createIndex prx essIndexSettings essIndexName
300+ unless (statusIsSuccessful (responseStatus r1)) $
301+ liftIO $ EX.throwIO (CouldNotCreateIndex r1)
302+ r2 <- putMapping prx essIndexName essIndexMapping essIndexMappingValue
303+ unless (statusIsSuccessful (responseStatus r2)) $
304+ liftIO $ EX.throwIO (CouldNotCreateMapping r2)
305+
306+ workers <- replicateM (unEsPoolSize essPoolSize) $ async $
307+ startWorker cfg env essIndexMapping q
308+
309+ _ <- async $ do
310+ takeMVar endSig
311+ atomically $ closeTBMQueue q
312+ mapM_ waitCatch workers
313+ putMVar endSig ()
314+
315+ let finalizer = putMVar endSig () >> takeMVar endSig
316+ return (Scribe (logger q) finalizer permit)
317+ where
318+ logger :: forall a. LogItem a => TBMQueue (IndexName v, Value) -> Item a -> IO ()
319+ logger q i =
320+ void $ atomically $ tryWriteTBMQueue q
321+ (chooseIxn prx essIndexName essIndexSharding i, applyItemFunc (essItemFormatter verb) i)
322+ prx :: Typeable.Proxy v
323+ prx = Typeable.Proxy
324+ tplName = toTemplateName prx ixn
325+ shardingEnabled = case essIndexSharding of
326+ NoIndexSharding -> False
327+ _ -> True
328+ tpl = toIndexTemplate prx (toTemplatePattern prx (ixn <> "-*")) (Just essIndexSettings) [essIndexMappingValue]
329+ ixn = fromIndexName prx essIndexName
334330
335331-------------------------------------------------------------------------------
336332baseMapping :: ESVersion v => proxy v -> MappingName v -> Value