haskell - 我将如何使用每次传入都会重置的超时进行管道传输?
问题描述
如果没有收到任何内容,该withTimeout
函数假设每秒发送一次。相反,它无法在适当的时间发送事件。如果超过几秒而原始事件丢失,则一个事件将替换为其他事件。此外,它应该是对过去的每一秒计数的事件,而不是一个事件。错误在哪里,更正的地方是什么?谢谢!ConsoleEvent
CeTimeout
s :: Int
CeTimeout
CeTimeout
s
CeTimeout
n*s
CeTimeout
n
s
withTimeout :: (MonadIO t) => Int -> Pipe ConsoleEvent ConsoleEvent t ()
withTimeout ((* 1000000) -> s) = join . liftIO $ work
where
work :: (MonadIO t) => IO (Pipe ConsoleEvent ConsoleEvent t ())
work =
do
(oSent, iKept) <- spawn $ bounded 1
(oKept, iSent) <- spawn $ unbounded
(oTimeout, iTimeout) <- spawn $ bounded 1
tid <- launchTimeout oTimeout >>= newMVar
forkIO $ do
runEffect . forever $ fromInput iKept >-> factorTimeout tid oTimeout >-> toOutput oKept
forkIO $ do
runEffect . forever $ fromInput iTimeout >-> toOutput oKept
return $ do
await >>= (liftIO . guardedSend oSent)
(liftIO . guardedRecv $ iSent) >>= yield
guardedSend :: Output ConsoleEvent -> ConsoleEvent -> IO ()
guardedSend o ce =
(atomically $ send o ce) >>= \case
True -> return ()
otherwise -> die $ "withTimeout can not send"
guardedRecv :: Input ConsoleEvent -> IO ConsoleEvent
guardedRecv i =
(atomically $ recv i) >>= \case
Just a -> return a
otherwise -> die $ "withTimeout can not recv"
launchTimeout :: Output ConsoleEvent -> IO ThreadId
launchTimeout o =
forkIO . forever $ do
threadDelay $ s
(atomically $ send o CeTimeout) >>= \case
True -> return ()
otherwise -> die "withTimeout can not send timeout"
relaunchTimeout :: Output ConsoleEvent -> ThreadId -> IO ThreadId
relaunchTimeout o oldTid =
do
tid <- launchTimeout o
killThread oldTid
return tid
factorTimeout :: MVar ThreadId -> Output ConsoleEvent -> Pipe ConsoleEvent ConsoleEvent IO ()
factorTimeout v o =
do
ce <- await
liftIO . modifyMVar_ v $ relaunchTimeout o
yield ce
这是一个完全可执行的脚本。
解决方案
似乎 aPipe
只允许yield
每个await
. 这意味着CeTimeout
不能任意将 a 发送到管道中,因为没有任何东西进入管道引起流动。我将不得不通过消息来源确认这一点;同时,此函数已被重构为返回 aPipe
和 aProducer
而不仅仅是 a Pipe
。然后Producer
可以在调用函数中加入。最初的计划是只返回 a Pipe
,这样调用函数就不必做任何额外的工作来使超时起作用。那将是一个更加独立的解决方案。这个替代方案很好,因为它更明确。对于不熟悉管道的人来说,超时不会看起来像是凭空出现的。
withTimeout :: (MonadIO t) => Int -> IO (Pipe ConsoleEvent ConsoleEvent t (), Producer ConsoleEvent t ())
withTimeout ((* 1000000) -> s) =
do
(oTimeout, iTimeout) <- spawn $ bounded 1
vTid <- launchTimeout oTimeout >>= newMVar
return (factorTimeout vTid oTimeout, fromInput iTimeout)
where
launchTimeout :: Output ConsoleEvent -> IO ThreadId
launchTimeout o =
forkIO . forever $ do
threadDelay $ s
(atomically $ send o CeTimeout) >>= \case
True -> return ()
otherwise -> die "withTimeout can not send timeout"
relaunchTimeout :: Output ConsoleEvent -> ThreadId -> IO ThreadId
relaunchTimeout o oldTid =
do
tid <- launchTimeout o
killThread oldTid
return tid
factorTimeout :: (MonadIO t) => MVar ThreadId -> Output ConsoleEvent -> Pipe ConsoleEvent ConsoleEvent t ()
factorTimeout v o =
do
ce <- await
liftIO . modifyMVar_ v $ relaunchTimeout o
yield ce
main :: IO ()
main =
do
hSetBuffering stdin NoBuffering
hSetEcho stdin False
exitSemaphore <- newEmptyMVar
(o1, i1) <- spawn $ bounded 1
(o2, i2) <- spawn $ bounded 1
(timeoutTrap, timeoutRender) <- withTimeout 2
runEffect $ yield CeBegan >-> toOutput o1
forkIO $ do
runEffect . forever $ chars >-> toOutput o1
putMVar exitSemaphore ()
-- other inputs would be piped to o1 here
forkIO $ do
runEffect . forever $ fromInput i1 >-> timeoutTrap >-> toOutput o2
putMVar exitSemaphore ()
forkIO $ do
runEffect . forever $ timeoutRender >-> toOutput o2
putMVar exitSemaphore ()
forkIO $ do
-- logic would be done before dumpPipe
runEffect . forever $ fromInput i2 >-> dumpPipe >-> (await >> return ())
putMVar exitSemaphore ()
takeMVar exitSemaphore
这是一个完全可执行的脚本。
推荐阅读
- flutter - setState 不重建小部件
- javascript - 使用 vuejs 和 i18n 的数据库存储语言
- javascript - 我不断从 node js express post 请求正文中获取未定义
- apache-spark - Spark:如何在数据框中单独处理某些列内容?
- arrays - 在下面的 c 代码中,错误:'subscripted value is not an array, pointer or a vector' on line 19 for avg[i]=sum[i]/5
- java - Java for 循环返回“索引超出范围”错误
- azure - 如何从 Azure 中提取 AIP Scanner 的结果?
- excel - 如何使用 large 和 averageif
- c - C 标准是否定义了在 printf 中调用哪些函数?
- angular - 数据绑定到组件后如何触发函数或什么事件?