Exception 捕获管道中的异常而不终止它
这感觉像是一个长期的尝试,但我编写了一个管道来连接数据库,获取服务器上的数据库列表,连接到每个数据库,然后对每个数据库执行一个查询一个用户计数,然后打印这些计数。不幸的是,这是我可以从我的真实例子中简化的。我正在使用pipes-4.1.0、pipes-safe-2.0.2和mysql-simple-0.2.2.4。代码如下:Exception 捕获管道中的异常而不终止它,exception,haskell,haskell-pipes,Exception,Haskell,Haskell Pipes,这感觉像是一个长期的尝试,但我编写了一个管道来连接数据库,获取服务器上的数据库列表,连接到每个数据库,然后对每个数据库执行一个查询一个用户计数,然后打印这些计数。不幸的是,这是我可以从我的真实例子中简化的。我正在使用pipes-4.1.0、pipes-safe-2.0.2和mysql-simple-0.2.2.4。代码如下: {-# LANGUAGE RankNTypes, OverloadedStrings #-} import Pipes import qualified Pipes.Sa
{-# LANGUAGE RankNTypes, OverloadedStrings #-}
import Pipes
import qualified Pipes.Safe as PS
import qualified Pipes.Prelude as P
import Database.MySQL.Simple
import qualified Data.Text as T
import Control.Monad.Catch as MC
import Control.Monad (forever)
import Database.MySQL.Simple.QueryParams
import Database.MySQL.Simple.QueryResults
data DBName = DBName T.Text deriving Show
-- connect to a database and use a table.
mydb :: T.Text -> ConnectInfo
mydb = undefined
-- Quirk of (mysql|postgresql)-simple libraries
unOnly (Only a) = a
queryProducer :: (MonadIO m, QueryParams params, QueryResults r) => Connection -> Query -> params -> Pipes.Producer' r m ()
queryProducer = undefined
myDBNames :: (PS.MonadSafe m, MonadIO m) => Producer DBName m ()
myDBNames = PS.bracket (liftIO $ connect $ mydb "sometable") (liftIO . close) $ \db ->
queryProducer db "show databases" () >-> P.map (DBName . unOnly)
-- I realize this is inefficient, one step at a time.
connectToDB :: (PS.MonadSafe m, MonadIO m) => Pipe DBName Connection m ()
connectToDB = forever $ do
(DBName dbname) <- await
PS.bracket
(liftIO . connect . mydb $ dbname)
(liftIO . close)
yield
userCount :: (PS.MonadCatch m, MonadIO m) => Pipe Connection Int m ()
userCount = forever $ do
db <- await
queryProducer db "select count(*) from user" () >-> P.map unOnly
main :: IO ()
main = PS.runSafeT $ runEffect $ myDBNames >-> P.tee P.print >-> connectToDB >-> userCount >-> P.print
这不管用。有时它会打印失败并生成0,但在出现异常时立即终止。我想可能是因为我在例外情况下脱离了queryProducer,我应该再次调用它,所以我尝试了这个递归版本:
thequery db >-> P.map unOnly
where
thequery db = queryProducer db "select count(*) from user" () `PS.catchAll` (\e -> (liftIO $ putStrLn "failure") >> yield (Only 0) >> thequery db)
但这也失败了。然而,有时它实际上会执行一些查询,打印出几次失败,并在再次以异常终止之前产生几次0。我真的不明白为什么会这样
根据async库,异常应该发送到管道运行的线程中,因此看起来不可能是线程问题
如果我的queryProducer的实现很重要,那么它是按照pipes postgresql查询函数建模的,被推广到Producer,这样我就可以将它嵌入到其他组合器中。在mysql simple下面,在mysql库中有一个throw,如果您的sql没有意义,它会抛出一个ConnectionError,它会通过这个函数一路渗透
{-# LANGUAGE RankNTypes #-}
import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.STM as STM
import qualified Database.MySQL.Simple as My
import Database.MySQL.Simple.QueryParams
import Database.MySQL.Simple.QueryResults
import qualified Pipes
import qualified Pipes.Concurrent as Pipes
--------------------------------------------------------------------------------
-- | Convert a query to a 'Producer' of rows.
--
-- For example,
--
-- > pg <- connectToMysql
-- > query pg "SELECT * FROM widgets WHERE ID = ?" (Only widgetId) >-> print
--
-- Will select all widgets for a given @widgetId@, and then print each row to
-- standard output.
queryProducer
:: (MonadIO m, QueryResults r, QueryParams params)
=> My.Connection -> My.Query -> params -> Pipes.Producer' r m ()
queryProducer c q p = do
(o, i, seal) <- liftIO (Pipes.spawn' Pipes.Single)
worker <- liftIO $ Async.async $ do
My.fold c q p () (const $ void . STM.atomically . Pipes.send o)
STM.atomically seal
liftIO $ Async.link worker
Pipes.fromInput i
我还尝试使用EitherT来尝试捕获异常,因为过去在管道中似乎就是这样做的。但是pipes教程中的文档在3到4之间消失了,这让我怀疑这种技术是否仍然被推荐。不幸的是,我无法让它工作,因为我使用queryProducer而不是单一的wait/yields,我不知道如何构造它。根据Gabe的评论,我修复了queryProducer函数,确保在启动链接函数之前查询不会发生
query :: (MonadIO m, QueryResults r, QueryParams params) => My.Connection -> My.Query -> params -> Pipes.Producer' r m ()
query c q p = do
(o, i, seal) <- liftIO (Pipes.spawn' Pipes.Single)
mvar <- liftIO $ newEmptyMVar
worker <- liftIO $ Async.async $ do
takeMVar mvar
My.fold c q p () (const $ void . STM.atomically . Pipes.send o)
STM.atomically seal
liftIO $ Async.link worker
liftIO $ putMVar mvar ()
Pipes.fromInput i
我已经对此进行了测试,它似乎起到了作用。如果在queryProducer中删除行liftIO$Async.link worker并将最后一行更改为类似于Pipes的内容,会发生什么情况。从输入I中,这仍然受支持,您可以在Pipes.Lift中找到相关文档。现在使用Pipes.Lift.catchError,我今天晚些时候会写一个答案。所以我不确定这是否相关,但a中存在已知的竞争条件。您也可以在Github上的Pipes安全问题跟踪器上为此打开一个问题吗?我想这将需要一段时间来解决,我想跟踪堆栈外溢出的情况。正如您所说,这肯定是异步库中的竞争条件。当我把一个小线程延迟之前,折叠的问题消失了。
query :: (MonadIO m, QueryResults r, QueryParams params) => My.Connection -> My.Query -> params -> Pipes.Producer' r m ()
query c q p = do
(o, i, seal) <- liftIO (Pipes.spawn' Pipes.Single)
mvar <- liftIO $ newEmptyMVar
worker <- liftIO $ Async.async $ do
takeMVar mvar
My.fold c q p () (const $ void . STM.atomically . Pipes.send o)
STM.atomically seal
liftIO $ Async.link worker
liftIO $ putMVar mvar ()
Pipes.fromInput i