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' False nocheck program nonBatchCommandMaker pool a
withTransferrer' withTransferrer'
:: (MonadIO m, MonadFail m, MonadMask m) :: (MonadIO m, MonadMask m)
=> Bool => Bool
-- ^ When minimizeprocesses is True, only one Transferrer is left -- ^ When minimizeprocesses is True, only one Transferrer is left
-- running in the pool at a time. So if this needed to start a -- running in the pool at a time. So if this needed to start a
@ -67,8 +67,11 @@ withTransferrer'
-> m a -> m a
withTransferrer' minimizeprocesses mkcheck program batchmaker pool a = do withTransferrer' minimizeprocesses mkcheck program batchmaker pool a = do
(mi, leftinpool) <- liftIO $ atomically (popTransferrerPool pool) (mi, leftinpool) <- liftIO $ atomically (popTransferrerPool pool)
i@(TransferrerPoolItem (Just t) check) <- liftIO $ case mi of (i@(TransferrerPoolItem _ check), t) <- liftIO $ case mi of
Nothing -> mkTransferrerPoolItem mkcheck =<< mkTransferrer program batchmaker Nothing -> do
t <- mkTransferrer program batchmaker
i <- mkTransferrerPoolItem mkcheck t
return (i, t)
Just i -> checkTransferrerPoolItem program batchmaker i Just i -> checkTransferrerPoolItem program batchmaker i
a t `finally` returntopool leftinpool check t i a t `finally` returntopool leftinpool check t i
where 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. {- Check if a Transferrer from the pool is still ok to be used.
- If not, stop it and start a new one. -} - 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 checkTransferrerPoolItem program batchmaker i = case i of
TransferrerPoolItem (Just t) check -> ifM check TransferrerPoolItem (Just t) check -> ifM check
( return i ( return (i, t)
, do , do
shutdownTransferrer t shutdownTransferrer t
new check new check
@ -97,7 +100,7 @@ checkTransferrerPoolItem program batchmaker i = case i of
where where
new check = do new check = do
t <- mkTransferrer program batchmaker 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 {- Requests that a Transferrer perform a Transfer, and waits for it to
- finish. - finish.

View file

@ -27,3 +27,5 @@ index 973f75629..0de145461 100644
[[!meta author=jwodder]] [[!meta author=jwodder]]
[[!tag projects/datalad]] [[!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.
"""]]