Deal with the Semigroup/Monoid proposal

base-4.11 made Semigroup a superclass of Monoid. Provide Semigroup
implementations for Monoids.

5 files changed, 29 insertions, 17 deletions

diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index a716b56e3..a1b42a953 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -1,6 +1,7 @@
 {- git fsck interface
  -
  - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -44,15 +45,17 @@ type MissingObjects = S.Set Sha
 
 type Truncated = Bool
 
+instance Semigroup FsckOutput where
+	FsckOutput s1 t1 <> FsckOutput s2 t2 = FsckOutput (S.union s1 s2) (t1 || t2)
+	FsckOutput s t <> _ = FsckOutput s t
+	_ <> FsckOutput s t = FsckOutput s t
+	NoFsckOutput <> NoFsckOutput = NoFsckOutput
+	AllDuplicateEntriesWarning <> AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
+	AllDuplicateEntriesWarning <> NoFsckOutput = AllDuplicateEntriesWarning
+	NoFsckOutput <> AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
+
 instance Monoid FsckOutput where
 	mempty = NoFsckOutput
-	mappend (FsckOutput s1 t1) (FsckOutput s2 t2) = FsckOutput (S.union s1 s2) (t1 || t2)
-	mappend (FsckOutput s t) _ = FsckOutput s t
-	mappend _ (FsckOutput s t) = FsckOutput s t
-	mappend NoFsckOutput NoFsckOutput = NoFsckOutput
-	mappend AllDuplicateEntriesWarning AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
-	mappend AllDuplicateEntriesWarning NoFsckOutput = AllDuplicateEntriesWarning
-	mappend NoFsckOutput AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
 
 {- Runs fsck to find some of the broken objects in the repository.
  - May not find all broken objects, if fsck fails on bad data in some of
diff --git a/Types/DesktopNotify.hs b/Types/DesktopNotify.hs
index e6df05ab1..0b2da9377 100644
--- a/Types/DesktopNotify.hs
+++ b/Types/DesktopNotify.hs
@@ -1,6 +1,7 @@
 {- git-annex DesktopNotify type
  -
  - Copyright 2014 Joey Hess <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -16,10 +17,12 @@ data DesktopNotify = DesktopNotify
 	}
 	deriving (Show)
 
+instance Semigroup DesktopNotify where
+	DesktopNotify s1 f1 <> DesktopNotify s2 f2 =
+		DesktopNotify (s1 || s2) (f1 || f2)
+
 instance Monoid DesktopNotify where
 	mempty = DesktopNotify False False
-	mappend (DesktopNotify s1 f1) (DesktopNotify s2 f2) =
-		DesktopNotify (s1 || s2) (f1 || f2)
 
 mkNotifyStart :: DesktopNotify
 mkNotifyStart = DesktopNotify True False
diff --git a/Types/Difference.hs b/Types/Difference.hs
index 4abc75c44..8516a3df7 100644
--- a/Types/Difference.hs
+++ b/Types/Difference.hs
@@ -1,6 +1,7 @@
 {- git-annex repository differences
  -
  - Copyright 2015 Joey Hess <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -67,14 +68,16 @@ instance Eq Differences where
 		, oneLevelBranchHash
 		]
 
-instance Monoid Differences where
-	mempty = Differences False False False
-	mappend a@(Differences {}) b@(Differences {}) = a
+instance Semigroup Differences where
+	a@(Differences {}) <> b@(Differences {}) = a
 		{ objectHashLower = objectHashLower a || objectHashLower b
 		, oneLevelObjectHash = oneLevelObjectHash a || oneLevelObjectHash b
 		, oneLevelBranchHash = oneLevelBranchHash a || oneLevelBranchHash b
 		}
-	mappend _ _ = UnknownDifferences
+	_ <> _ = UnknownDifferences
+
+instance Monoid Differences where
+	mempty = Differences False False False
 
 readDifferences :: String -> Differences
 readDifferences = maybe UnknownDifferences mkDifferences . readish
diff --git a/Types/Test.hs b/Types/Test.hs
index 50c460f50..0179474b4 100644
--- a/Types/Test.hs
+++ b/Types/Test.hs
@@ -1,6 +1,7 @@
 {- git-annex test data types.
  -
  - Copyright 2011-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2022 Benjamin Barenblat <bbarenblat@gmail.com>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -19,13 +20,15 @@ data TestOptions = TestOptions
 	, internalData :: CmdParams
 	}
 
-instance Monoid TestOptions where
-	mempty = TestOptions mempty False False mempty
-	mappend a b = TestOptions
+instance Semigroup TestOptions where
+	a <> b = TestOptions
 		(tastyOptionSet a <> tastyOptionSet b)
 		(keepFailuresOption a || keepFailuresOption b)
 		(fakeSsh a || fakeSsh b)
 		(internalData a <> internalData b)
 
+instance Monoid TestOptions where
+	mempty = TestOptions mempty False False mempty
+
 
 type TestRunner = TestOptions -> IO ()
diff --git a/git-annex.cabal b/git-annex.cabal
index 403fb65c2..d51c73003 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.9 && < 5.0),
+   base (>= 4.11 && < 5.0),
    optparse-applicative (>= 0.11.0), 
    containers (>= 0.5.0.0),
    exceptions (>= 0.6),