fix build failure by avoiding refutable pattern match
This commit is contained in:
parent
4bce767ca6
commit
a8cdcf528e
3 changed files with 23 additions and 6 deletions
|
@ -53,7 +53,7 @@ withTransferrer a = do
|
|||
withTransferrer' False nocheck program nonBatchCommandMaker pool a
|
||||
|
||||
withTransferrer'
|
||||
:: (MonadIO m, MonadFail m, MonadMask m)
|
||||
:: (MonadIO m, MonadMask m)
|
||||
=> Bool
|
||||
-- ^ When minimizeprocesses is True, only one Transferrer is left
|
||||
-- running in the pool at a time. So if this needed to start a
|
||||
|
@ -67,8 +67,11 @@ withTransferrer'
|
|||
-> m a
|
||||
withTransferrer' minimizeprocesses mkcheck program batchmaker pool a = do
|
||||
(mi, leftinpool) <- liftIO $ atomically (popTransferrerPool pool)
|
||||
i@(TransferrerPoolItem (Just t) check) <- liftIO $ case mi of
|
||||
Nothing -> mkTransferrerPoolItem mkcheck =<< mkTransferrer program batchmaker
|
||||
(i@(TransferrerPoolItem _ check), t) <- liftIO $ case mi of
|
||||
Nothing -> do
|
||||
t <- mkTransferrer program batchmaker
|
||||
i <- mkTransferrerPoolItem mkcheck t
|
||||
return (i, t)
|
||||
Just i -> checkTransferrerPoolItem program batchmaker i
|
||||
a t `finally` returntopool leftinpool check t i
|
||||
where
|
||||
|
@ -85,10 +88,10 @@ withTransferrer' minimizeprocesses mkcheck program batchmaker pool a = do
|
|||
|
||||
{- Check if a Transferrer from the pool is still ok to be used.
|
||||
- If not, stop it and start a new one. -}
|
||||
checkTransferrerPoolItem :: FilePath -> BatchCommandMaker -> TransferrerPoolItem -> IO TransferrerPoolItem
|
||||
checkTransferrerPoolItem :: FilePath -> BatchCommandMaker -> TransferrerPoolItem -> IO (TransferrerPoolItem, Transferrer)
|
||||
checkTransferrerPoolItem program batchmaker i = case i of
|
||||
TransferrerPoolItem (Just t) check -> ifM check
|
||||
( return i
|
||||
( return (i, t)
|
||||
, do
|
||||
shutdownTransferrer t
|
||||
new check
|
||||
|
@ -97,7 +100,7 @@ checkTransferrerPoolItem program batchmaker i = case i of
|
|||
where
|
||||
new check = do
|
||||
t <- mkTransferrer program batchmaker
|
||||
return $ TransferrerPoolItem (Just t) check
|
||||
return (TransferrerPoolItem (Just t) check, t)
|
||||
|
||||
{- Requests that a Transferrer perform a Transfer, and waits for it to
|
||||
- finish.
|
||||
|
|
|
@ -27,3 +27,5 @@ index 973f75629..0de145461 100644
|
|||
|
||||
[[!meta author=jwodder]]
|
||||
[[!tag projects/datalad]]
|
||||
|
||||
> [[fixed|done]] --[[Joey]]
|
||||
|
|
|
@ -0,0 +1,12 @@
|
|||
[[!comment format=mdwn
|
||||
username="joey"
|
||||
subject="""comment 1"""
|
||||
date="2020-12-09T16:40:24Z"
|
||||
content="""
|
||||
Indeed, and thank you for the patch.
|
||||
|
||||
However, MonadFail often suggests a code smell, here it's the `Just ... <-`
|
||||
pattern match which could potentially fail. In fact, it's not possible for
|
||||
it to, so I have instead made that clear in a way that the type checker
|
||||
can understand.
|
||||
"""]]
|
Loading…
Reference in a new issue