···

       
68
       
68
       
 
       
  # Break out of "yaml >=0.10.4.0 && <0.11": https://github.com/commercialhaskell/stack/issues/4485

     

       
69
       
69
       
 
       
  stack = doJailbreak super.stack;

     

       
70
       
70
       
 
       


     

       
71
       
71
       
-
       
  # Fix build with ghc 8.6.x.

     

       
72
       
72
       
-
       
  git-annex = appendPatch super.git-annex ./patches/git-annex-fix-ghc-8.6.x-build.patch;

     

       
73
       
73
       
-
       


     

       
74
       
71
       
 
       
}

     

···

       
1
       
1
       
-
       
From 2e0e557e7512ddd0376f179e82c811d8b4cce401 Mon Sep 17 00:00:00 2001

     

       
2
       
2
       
-
       
From: Joey Hess <joeyh@joeyh.name>

     

       
3
       
3
       
-
       
Date: Sat, 5 Jan 2019 11:54:06 -0400

     

       
4
       
4
       
-
       
Subject: [PATCH] Support being built with ghc 8.0.1 (MonadFail)

     

       
5
       
5
       
-
       


     

       
6
       
6
       
-
       
Tested on an older ghc by enabling MonadFailDesugaring globally.

     

       
7
       
7
       
-
       


     

       
8
       
8
       
-
       
In TransferQueue, the lack of a MonadFail for STM exposed what would

     

       
9
       
9
       
-
       
normally be a bug in the pattern matching, although in this case an

     

       
10
       
10
       
-
       
earlier check that the queue was not empty avoided a pattern match

     

       
11
       
11
       
-
       
failure.

     

       
12
       
12
       
-
       
---

     

       
13
       
13
       
-
       
 Annex.hs                   |  2 ++

     

       
14
       
14
       
-
       
 Assistant/Monad.hs         |  2 ++

     

       
15
       
15
       
-
       
 Assistant/TransferQueue.hs | 21 +++++++++++----------

     

       
16
       
16
       
-
       
 CHANGELOG                  |  1 +

     

       
17
       
17
       
-
       
 4 files changed, 16 insertions(+), 10 deletions(-)

     

       
18
       
18
       
-
       


     

       
19
       
19
       
-
       
diff --git a/Annex.hs b/Annex.hs

     

       
20
       
20
       
-
       
index 0a0368d36..af0ede1f4 100644

     

       
21
       
21
       
-
       
--- a/Annex.hs

     

       
22
       
22
       
-
       
+++ b/Annex.hs

     

       
23
       
23
       
-
       
@@ -74,6 +74,7 @@ import "mtl" Control.Monad.Reader

     

       
24
       
24
       
-
       
 import Control.Concurrent

     

       
25
       
25
       
-
       
 import Control.Concurrent.Async

     

       
26
       
26
       
-
       
 import Control.Concurrent.STM

     

       
27
       
27
       
-
       
+import qualified Control.Monad.Fail as Fail

     

       
28
       
28
       
-
       
 import qualified Control.Concurrent.SSem as SSem

     

       
29
       
29
       
-
       
 import qualified Data.Map.Strict as M

     

       
30
       
30
       
-
       
 import qualified Data.Set as S

     

       
31
       
31
       
-
       
@@ -93,6 +94,7 @@ newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a }

     

       
32
       
32
       
-
       
 		MonadCatch,

     

       
33
       
33
       
-
       
 		MonadThrow,

     

       
34
       
34
       
-
       
 		MonadMask,

     

       
35
       
35
       
-
       
+		Fail.MonadFail,

     

       
36
       
36
       
-
       
 		Functor,

     

       
37
       
37
       
-
       
 		Applicative

     

       
38
       
38
       
-
       
 	)

     

       
39
       
39
       
-
       
diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs

     

       
40
       
40
       
-
       
index 403ee16a8..ef2ee6012 100644

     

       
41
       
41
       
-
       
--- a/Assistant/Monad.hs

     

       
42
       
42
       
-
       
+++ b/Assistant/Monad.hs

     

       
43
       
43
       
-
       
@@ -27,6 +27,7 @@ module Assistant.Monad (

     

       
44
       
44
       
-
       
 

     

       
45
       
45
       
-
       
 import "mtl" Control.Monad.Reader

     

       
46
       
46
       
-
       
 import System.Log.Logger

     

       
47
       
47
       
-
       
+import qualified Control.Monad.Fail as Fail

     

       
48
       
48
       
-
       
 

     

       
49
       
49
       
-
       
 import Annex.Common

     

       
50
       
50
       
-
       
 import Assistant.Types.ThreadedMonad

     

       
51
       
51
       
-
       
@@ -49,6 +50,7 @@ newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a }

     

       
52
       
52
       
-
       
 		Monad,

     

       
53
       
53
       
-
       
 		MonadIO,

     

       
54
       
54
       
-
       
 		MonadReader AssistantData,

     

       
55
       
55
       
-
       
+		Fail.MonadFail,

     

       
56
       
56
       
-
       
 		Functor,

     

       
57
       
57
       
-
       
 		Applicative

     

       
58
       
58
       
-
       
 	)

     

       
59
       
59
       
-
       
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs

     

       
60
       
60
       
-
       
index 6a4473262..7c0ab80d0 100644

     

       
61
       
61
       
-
       
--- a/Assistant/TransferQueue.hs

     

       
62
       
62
       
-
       
+++ b/Assistant/TransferQueue.hs

     

       
63
       
63
       
-
       
@@ -191,17 +191,18 @@ getNextTransfer acceptable = do

     

       
64
       
64
       
-
       
 		sz <- readTVar (queuesize q)

     

       
65
       
65
       
-
       
 		if sz < 1

     

       
66
       
66
       
-
       
 			then retry -- blocks until queuesize changes

     

       
67
       
67
       
-
       
-			else do

     

       
68
       
68
       
-
       
-				(r@(t,info):rest) <- readTList (queuelist q)

     

       
69
       
69
       
-
       
-				void $ modifyTVar' (queuesize q) pred

     

       
70
       
70
       
-
       
-				setTList (queuelist q) rest

     

       
71
       
71
       
-
       
-				if acceptable info

     

       
72
       
72
       
-
       
-					then do

     

       
73
       
73
       
-
       
-						adjustTransfersSTM dstatus $

     

       
74
       
74
       
-
       
-							M.insert t info

     

       
75
       
75
       
-
       
-						return $ Just r

     

       
76
       
76
       
-
       
-					else return Nothing

     

       
77
       
77
       
-
       
+			else readTList (queuelist q) >>= \case

     

       
78
       
78
       
-
       
+				[] -> retry -- blocks until something is queued

     

       
79
       
79
       
-
       
+				(r@(t,info):rest) -> do

     

       
80
       
80
       
-
       
+					void $ modifyTVar' (queuesize q) pred

     

       
81
       
81
       
-
       
+					setTList (queuelist q) rest

     

       
82
       
82
       
-
       
+					if acceptable info

     

       
83
       
83
       
-
       
+						then do

     

       
84
       
84
       
-
       
+							adjustTransfersSTM dstatus $

     

       
85
       
85
       
-
       
+								M.insert t info

     

       
86
       
86
       
-
       
+							return $ Just r

     

       
87
       
87
       
-
       
+						else return Nothing

     

       
88
       
88
       
-
       
 

     

       
89
       
89
       
-
       
 {- Moves transfers matching a condition from the queue, to the

     

       
90
       
90
       
-
       
  - currentTransfers map. -}

     

       
91
       
91
       
-