Deal with the MonadFail proposal

base-4.9 split MonadFail from Monad. Strengthen some type signatures to
require MonadFail instead of just Monad, derive MonadFail in relevant
places, and change a partial pattern match inside STM to one that
explicitly calls error. (STM is not a MonadFail; the user must
explicitly specify the desired semantics if a pattern match doesn’t work
out. In this case, the failing branch of the pattern should never be
reached, so crashing is fine.)

9 files changed, 42 insertions, 16 deletions

diff --git a/Annex.hs b/Annex.hs
index 54f71aee9..281531610 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -92,6 +92,7 @@ newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a }
 		MonadCatch,
 		MonadThrow,
 		MonadMask,
+		MonadFail,
 		Functor,
 		Applicative
 	)
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. -}
diff --git a/COPYRIGHT b/COPYRIGHT
index d3007b4ec..1c9f7ebce 100644
--- a/COPYRIGHT
+++ b/COPYRIGHT
@@ -11,6 +11,24 @@ Copyright: © 2011 Joey Hess <id@joeyh.name>
            © 2014 Robie Basak <robie@justgohome.co.uk>
 License: GPL-3+
 
+Files: Utility/HumanTime.hs
+Copyright: 2012-2013 Joey Hess <id@joeyh.name>
+           2022 Benjamin Barenblat <bbarenblat@gmail.com>
+License: Apache-2.0
+ Licensed under the Apache License, Version 2.0 (the "License"); you may not use
+ this file except in compliance with the License. You may obtain a copy of the
+ License at
+ .
+     https://www.apache.org/licenses/LICENSE-2.0
+ .
+ Unless required by applicable law or agreed to in writing, software distributed
+ under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR
+ CONDITIONS OF ANY KIND, either express or implied. See the License for the
+ specific language governing permissions and limitations under the License.
+ .
+ On Debian systems, the complete text of the Apache License, Version 2.0, can be
+ found in "/usr/share/common-licenses/Apache-2.0".
+
 Files: Utility/ThreadScheduler.hs
 Copyright: 2011 Bas van Dijk & Roel van Dijk
            2012, 2013 Joey Hess <id@joeyh.name>
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 143bb6498..2a6dc0ef9 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -1,6 +1,7 @@
 {- git-annex command-line option parsing
  -
  - Copyright 2010-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -182,7 +183,7 @@ parseAllOption = flag' WantAllKeys
 	<> help "operate on all versions of all files"
 	)
 
-parseKey :: Monad m => String -> m Key
+parseKey :: MonadFail m => String -> m Key
 parseKey = maybe (fail "invalid key") return . file2key
 
 -- Options to match properties of annexed files.
diff --git a/Command/Expire.hs b/Command/Expire.hs
index 28f90dfb5..bb65d5cfe 100644
--- a/Command/Expire.hs
+++ b/Command/Expire.hs
@@ -1,6 +1,7 @@
 {- git-annex command
  -
  - Copyright 2015 Joey Hess <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -108,7 +109,7 @@ parseExpire ps = do
 		Nothing -> giveup $ "bad expire time: " ++ s
 		Just d -> Just (now - durationToPOSIXTime d)
 
-parseActivity :: Monad m => String -> m Activity
+parseActivity :: MonadFail m => String -> m Activity
 parseActivity s = case readish s of
 	Nothing -> fail $ "Unknown activity. Choose from: " ++ 
 		unwords (map show [minBound..maxBound :: Activity])
diff --git a/Command/Init.hs b/Command/Init.hs
index 8ce82a75e..e12c6700c 100644
--- a/Command/Init.hs
+++ b/Command/Init.hs
@@ -1,6 +1,7 @@
 {- git-annex command
  -
  - Copyright 2010 Joey Hess <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -30,7 +31,7 @@ optParser desc = InitOptions
 		<> help "Override default annex.version"
 		))
 
-parseVersion :: Monad m => String -> m Version
+parseVersion :: MonadFail m => String -> m Version
 parseVersion v
 	| v `elem` supportedVersions = return v
 	| otherwise = fail $ v ++ " is not a currently supported repository version"
diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs
index fe7cf22a9..77d846d97 100644
--- a/Utility/HumanTime.hs
+++ b/Utility/HumanTime.hs
@@ -1,8 +1,9 @@
 {- Time for humans.
  -
  - Copyright 2012-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
  -
- - License: BSD-2-clause
+ - License: Apache-2.0
  -}
 
 module Utility.HumanTime (
@@ -44,7 +45,7 @@ daysToDuration :: Integer -> Duration
 daysToDuration i = Duration $ i * dsecs
 
 {- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -}
-parseDuration :: Monad m => String -> m Duration
+parseDuration :: MonadFail m => String -> m Duration
 parseDuration = maybe parsefail (return . Duration) . go 0
   where
 	go n [] = return n
diff --git a/git-annex.cabal b/git-annex.cabal
index d94b1469f..403fb65c2 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -202,7 +202,7 @@ custom-setup
 Executable git-annex
   Main-Is: git-annex.hs
   Build-Depends:
-   base (>= 4.6 && < 5.0),
+   base (>= 4.9 && < 5.0),
    optparse-applicative (>= 0.11.0), 
    containers (>= 0.5.0.0),
    exceptions (>= 0.6),