如何解决为什么在添加`bracketOnError`时此代码内存泄漏?
首先,我对没有一个最小的示例表示歉意(我可以尝试构造一个示例,但现在我有一个“之前和之后”的示例):
首先出现内存泄漏的“之后”:
protoReceiver :: RIO FdsEnv ()
protoReceiver = do
logItS Info ["Entering FarmPCMessage protoReceiver"]
tMap <- liftIO $ newThreadMap
fdsEnv <- ask
let lgr = fdsLogger fdsEnv
loopBody <- pure $ bracketOnError
(runResourceT $ protoServe fdsEnv tMap readFarmPCMessage)
(\(_,w) -> do
logLogItS Debug lgr ["Entering cleanup for protoReceiver"]
)
(\(server,_) -> do
logLogItS Debug lgr ["Entering FarmPCMessage protoReceiver bracket"]
server
.| mapMC (liftIO . traverse_ (persistFarmEntry fdsEnv))
.| mapMC ((logLogIt Info lgr) . pure)
.| sinkUnits & runConduitRes
)
liftIO loopBody
这是“ before”代码,它不会导致内存泄漏:
protoReceiver :: RIO FdsEnv ()
protoReceiver = do
logItS Info ["Entering FarmPCMessage protoReceiver"]
tMap <- liftIO $ newThreadMap
fdsEnv <- ask
let lgr = fdsLogger fdsEnv
(dmgrProtoServe,tcpWorker) <- liftIO $ runResourceT
$ protoServe fdsEnv tMap readFarmPCMessage
liftIO $ runResourceT $ dmgrProtoServe
.| mapMC (liftIO . traverse_ (persistFarmEntry fdsEnv))
.| mapMC ((logLogIt Info lgr) . pure)
.| sinkUnits & runConduit
我对泄漏进行了概要分析,尽管不确定是否特别有用(赞赏有关更好的概要图表的任何建议):
解决方法
问题是经典泄漏方案的变体,其中在消耗时我们保留对惰性列表的开头的引用:
import Data.Foldable (traverse_)
main :: IO ()
main = do
let xs = [1..]
traverse_ print xs
traverse_ print xs -- commenting this statement solves the leak
在这里,管道Source
充当着各种“惰性列表”。即使在使用原始源值(server
时,也需要保留对其的引用,因为在发生错误的情况下必须将其传递给异常处理程序。但是异常处理程序似乎并没有利用它。
解决方案是在我们传递给bracketOnError
的主要计算获得该值后立即削减该引用。为此,我们可以使用MVar
。不是因为它具有同步功能,而是因为它是一个可变的引用,可以“留空”。
分配操作可以返回一个(Source m r,a)
值,而不是返回一个(MVar (Source m r),a)
值。然后,主要计算将来自takeMVar
,以掌握管道源。一旦我们开始使用源代码,原始值将被垃圾回收,因为将不再有对其的引用。
以下是遵循这些建议后OP使用的工作代码:
protoReceiver :: RIO FdsEnv ()
protoReceiver = retryForever $ do
logItS Info ["Entering FarmPCMessage protoReceiver"]
tMap <- liftIO $ newThreadMap
fdsEnv <- ask
let lgr = fdsLogger fdsEnv
loopBody <- pure $ bracket
(runResourceT $ do
swTup <- protoServe fdsEnv tMap readFarmPCMessage
serverMVar <- newMVar $ fst swTup
pure (serverMVar,snd $! swTup)
)
(\(_,worker) -> do
logLogItS Debug lgr ["Entering cleanup for protoReceiver"]
killChildThreads tMap
cancel worker
)
(\(serverMVar,_) -> do
logLogItS Debug lgr ["Entering FarmPCMessage protoReceiver bracket"]
server <- takeMVar serverMVar
logLogItS Debug lgr ["FarmPCMessage protoReceiver bracket: got server"]
server
.| mapMC (liftIO . traverse_ (persistFarmEntry fdsEnv))
.| mapMC ((logLogIt Info lgr) . pure)
.| sinkUnits & runConduitRes
)
liftIO $ retryForever $ loopBody
where
killChildThreads = liftIO . killThreadHierarchy
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。