diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Monad.hs | 2 | ||||
| -rw-r--r-- | Assistant/TransferQueue.hs | 21 |
2 files changed, 13 insertions, 10 deletions
diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs index 403ee16a8..f1b2dc78c 100644 --- a/Assistant/Monad.hs +++ b/Assistant/Monad.hs @@ -1,6 +1,7 @@ {- git-annex assistant monad - - Copyright 2012 Joey Hess <id@joeyh.name> + - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com> - - Licensed under the GNU GPL version 3 or higher. -} @@ -49,6 +50,7 @@ newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a } Monad, MonadIO, MonadReader AssistantData, + MonadFail, Functor, Applicative ) diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index fbc589673..1679e0daf 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -192,16 +192,17 @@ getNextTransfer acceptable = do sz <- readTVar (queuesize q) if sz < 1 then retry -- blocks until queuesize changes - else do - (r@(t,info):rest) <- readTList (queuelist q) - void $ modifyTVar' (queuesize q) pred - setTList (queuelist q) rest - if acceptable info - then do - adjustTransfersSTM dstatus $ - M.insert t info - return $ Just r - else return Nothing + else readTList (queuelist q) >>= \case + (r@(t,info):rest) -> do + void $ modifyTVar' (queuesize q) pred + setTList (queuelist q) rest + if acceptable info + then do + adjustTransfersSTM dstatus $ + M.insert t info + return $ Just r + else return Nothing + _ -> error "empty queue claims to be nonempty" {- Moves transfers matching a condition from the queue, to the - currentTransfers map. -} |