fix build failure by avoiding refutable pattern match

This commit is contained in:
Joey Hess 2020-12-09 12:43:38 -04:00
parent 4bce767ca6
commit a8cdcf528e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 23 additions and 6 deletions

View file

@ -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.

View file

@ -27,3 +27,5 @@ index 973f75629..0de145461 100644
[[!meta author=jwodder]]
[[!tag projects/datalad]]
> [[fixed|done]] --[[Joey]]

View file

@ -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.
"""]]