Support being built with ghc 8.0.1 (MonadFail)

Tested on an older ghc by enabling MonadFailDesugaring globally.

In TransferQueue, the lack of a MonadFail for STM exposed what would
normally be a bug in the pattern matching, although in this case an
earlier check that the queue was not empty avoided a pattern match
failure.
This commit is contained in:
Joey Hess 2019-01-05 11:54:06 -04:00
parent 6ec993252e
commit 2e0e557e75
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 16 additions and 10 deletions

View file

@ -74,6 +74,7 @@ import "mtl" Control.Monad.Reader
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import qualified Control.Monad.Fail as Fail
import qualified Control.Concurrent.SSem as SSem
import qualified Data.Map.Strict as M
import qualified Data.Set as S
@ -93,6 +94,7 @@ newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a }
MonadCatch,
MonadThrow,
MonadMask,
Fail.MonadFail,
Functor,
Applicative
)

View file

@ -27,6 +27,7 @@ module Assistant.Monad (
import "mtl" Control.Monad.Reader
import System.Log.Logger
import qualified Control.Monad.Fail as Fail
import Annex.Common
import Assistant.Types.ThreadedMonad
@ -49,6 +50,7 @@ newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a }
Monad,
MonadIO,
MonadReader AssistantData,
Fail.MonadFail,
Functor,
Applicative
)

View file

@ -191,16 +191,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
[] -> retry -- blocks until something is queued
(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
{- Moves transfers matching a condition from the queue, to the
- currentTransfers map. -}

View file

@ -16,6 +16,7 @@ git-annex (7.20181212) UNRELEASED; urgency=medium
and improved parsing and serialization of git-annex branch data.
* The benchmark command, which only had some old benchmarking of the sqlite
databases before, now allows benchmarking any other git-annex commands.
* Support being built with ghc 8.0.1 (MonadFail).
-- Joey Hess <id@joeyh.name> Tue, 18 Dec 2018 12:24:52 -0400