@@ -23,7 +23,6 @@ import Data.Semigroup (Semigroup (..))
2323#endif
2424import GHC.Generics
2525
26−import Data.Semigroup.Additive as X
2726import Data.Patch.Class as X
2827import Data.Patch.DMap as X hiding (getDeletions)
2928import Data.Patch.DMapWithMove as X
@@ -46,6 +45,9 @@ class (Semigroup q, Monoid q) => Group q where
4645 (~~) :: q -> q -> q
4746 r ~~ s = r <> negateG s
4847
48+-- | An 'Additive' 'Semigroup' is one where (<>) is commutative
49+class Semigroup q => Additive q where
50+
4951-- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
5052newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }
5153
@@ -56,15 +58,19 @@ instance Additive p => Patch (AdditivePatch p) where
5658instance (Ord k, Group q) => Group (MonoidalMap k q) where
5759 negateG = fmap negateG
5860
61+instance (Ord k, Additive q) => Additive (MonoidalMap k q)
62+
5963-- | Trivial group.
6064instance Group () where
6165 negateG _ = ()
6266 _ ~~ _ = ()
67+instance Additive ()
6368
6469-- | Product group. A Pair of groups gives rise to a group
6570instance (Group a, Group b) => Group (a, b) where
6671 negateG (a, b) = (negateG a, negateG b)
6772 (a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
73+instance (Additive a, Additive b) => Additive (a, b)
6874
6975-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
7076-- Base does not define Monoid (Compose f g a) so this is the best we can
@@ -72,24 +78,29 @@ instance (Group a, Group b) => Group (a, b) where
7278instance Group (f (g a)) => Group ((f :.: g) a) where
7379 negateG (Comp1 xs) = Comp1 (negateG xs)
7480 Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
81+instance Additive (f (g a)) => Additive ((f :.: g) a)
7582
7683-- | Product of groups, Functor style.
7784instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
7885 negateG (a :*: b) = negateG a :*: negateG b
7986 (a :*: b) ~~ (c :*: d) = (a ~~ c) :*: (b ~~ d)
87+instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a)
8088
8189-- | Trivial group, Functor style
8290instance Group (Proxy x) where
8391 negateG _ = Proxy
8492 _ ~~ _ = Proxy
93+instance Additive (Proxy x)
8594
8695-- | Const lifts groups into a functor.
8796deriving instance Group a => Group (Const a x)
88−
89−-- | Identity lifts groups pointwise (at only one point)
97+instance Additive a => Additive (Const a x)
98+-- | Ideitnty lifts groups pointwise (at only one point)
9099deriving instance Group a => Group (Identity a)
100+instance Additive a => Additive (Identity a)
91101
92102-- | Functions lift groups pointwise.
93103instance Group b => Group (a -> b) where
94104 negateG f = negateG . f
95105 (~~) = liftA2 (~~)
106+instance Additive b => Additive (a -> b)