fix build failure by avoiding refutable pattern match

diff --git a/Annex/TransferrerPool.hs b/Annex/TransferrerPool.hs
index f44d46db908c9ac155a032280872955761f2baf6..f2c885f815b22cf8ada6b115ecb31e3bd586fe1d 100644 (file)
--- a/Annex/TransferrerPool.hs
+++ b/Annex/TransferrerPool.hs
@@ -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.

diff --git a/doc/bugs/Build_failing_because_MonadFail_is_not_in_scope.mdwn b/doc/bugs/Build_failing_because_MonadFail_is_not_in_scope.mdwn
index f3c6ce140a84ca4195245fc4719aff8ce0ff032a..e6a2d9809e75156e26c08c9297b0269d1705e26e 100644 (file)
--- a/doc/bugs/Build_failing_because_MonadFail_is_not_in_scope.mdwn
+++ b/doc/bugs/Build_failing_because_MonadFail_is_not_in_scope.mdwn
@@ -27,3 +27,5 @@ index 973f75629..0de145461 100644
 
 [[!meta author=jwodder]]
 [[!tag projects/datalad]]
+
+> [[fixed|done]] --[[Joey]]

diff --git a/doc/bugs/Build_failing_because_MonadFail_is_not_in_scope/comment_1_3ebe2e53fd8e8ce673267ac2715d964c._comment b/doc/bugs/Build_failing_because_MonadFail_is_not_in_scope/comment_1_3ebe2e53fd8e8ce673267ac2715d964c._comment
new file mode 100644 (file)
index 0000000..39aaf12
--- /dev/null
+++ b/doc/bugs/Build_failing_because_MonadFail_is_not_in_scope/comment_1_3ebe2e53fd8e8ce673267ac2715d964c._comment
@@ -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.
+"""]]