Get rid of Group, with the intention that the groups library is used instead

ChangeLog.md

@@ -1,5 +1,23 @@
 # Revision history for patch
 
+## Unreleased
+
+* Remove the `split-these` flag.
+  We do not need it as we only use the `These` datatype which is provided in all versions.
+
+* Stop defining `Group`; `Group` from the `groups` package can be used instead.
+
+  Most of the instances are provided by `groups`, except the `Group
+  MonoidalMap` instance, which is not lawful.  `reflex` might provide it as an
+  orphan for backwards compat, temporarily, but it should eventually be removed
+  everywhere.
+
+* `Applicative` is still defined, because the `Abelian` from `groups` has too
+  stringent a constraint.
+
+* `Additive` now lives in `Data.Semigroup.Additive`, but is still reexported
+  from `Data.Patch` for compatability.
+
 ## 0.0.3.2
 
 * Update version bounds

dep/reflex-platform/default.nix

@@ -1,8 +1,2 @@
 # DO NOT HAND-EDIT THIS FILE
-let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
-  if !fetchSubmodules && !private then builtins.fetchTarball {
-    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
-  } else (import <nixpkgs> {}).fetchFromGitHub {
-    inherit owner repo rev sha256 fetchSubmodules private;
-  };
-in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))
+import (import ./thunk.nix)

dep/reflex-platform/github.json

@@ -3,6 +3,6 @@
   "repo": "reflex-platform",
   "branch": "master",
   "private": false,
-  "rev": "c9d11db1b98855fe8ab24a3ff6a5dbe0ad902ad9",
-  "sha256": "0sfzkqdvyah5mwvmli0wq1nl0b8cvk2cmfgfy4rz57wv42x3099y"
+  "rev": "efc6d923c633207d18bd4d8cae3e20110a377864",
+  "sha256": "121rmnkx8nwiy96ipfyyv6vrgysv0zpr2br46y70zf4d0y1h1lz5"
 }

dep/reflex-platform/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

patch.cabal

@@ -1,5 +1,5 @@
 Name: patch
-Version: 0.0.3.2
+Version: 0.1.0.0
 Synopsis: Data structures for describing changes to other data structures.
 Description:
   Data structures for describing changes to other data structures.
@@ -25,11 +25,6 @@ tested-with:
   GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1
   GHCJS ==8.4
 
-flag split-these
-  description: Use split these/semialign packages
-  manual:      False
-  default:     True
-
 library
   hs-source-dirs: src
   default-language: Haskell2010
@@ -40,9 +35,13 @@ library
                , dependent-sum >= 0.6 && < 0.8
                , lens >= 4.7 && < 5
                , semigroupoids >= 4.0 && < 6
+               , these >= 0.4 && < 1.2
                , transformers >= 0.5.6.0 && < 0.6
                , witherable >= 0.3 && < 0.4
 
+  if impl(ghc < 8.6) -- really, if base < 8.12
+    build-depends: base-orphans >= 0.8 && < 0.9
+
   exposed-modules: Data.Functor.Misc
                  , Data.Monoid.DecidablyEmpty
                  , Data.Patch
@@ -53,17 +52,10 @@ library
                  , Data.Patch.Map
                  , Data.Patch.MapWithMove
                  , Data.Patch.MapWithPatchingMove
+                 , Data.Semigroup.Additive
 
   ghc-options: -Wall -fwarn-redundant-constraints -fwarn-tabs
 
-  if flag(split-these)
-    build-depends: these >= 1 && <1.2
-                 , semialign >=1 && <1.2
-                 , monoidal-containers >= 0.6 && < 0.7
-  else
-    build-depends: these >= 0.4 && <0.9
-                 , monoidal-containers == 0.4.0.0
-
 test-suite hlint
   default-language: Haskell2010
   type: exitcode-stdio-1.0

src/Data/Patch.hs

@@ -1,8 +1,6 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module:
 --   Data.Patch
@@ -13,16 +11,11 @@ module Data.Patch
   , module X
   ) where
 
-import Control.Applicative
-import Data.Functor.Const (Const (..))
-import Data.Functor.Identity
-import Data.Map.Monoidal (MonoidalMap)
-import Data.Proxy
 #if !MIN_VERSION_base(4,11,0)
 import Data.Semigroup (Semigroup (..))
 #endif
-import GHC.Generics
 
+import Data.Semigroup.Additive as X
 import Data.Patch.Class as X
 import Data.Patch.DMap as X hiding (getDeletions)
 import Data.Patch.DMapWithMove as X
@@ -39,68 +32,9 @@ import Data.Patch.MapWithMove as X
   , unsafePatchMapWithMove
   )
 
--- | A 'Group' is a 'Monoid' where every element has an inverse.
-class (Semigroup q, Monoid q) => Group q where
-  negateG :: q -> q
-  (~~) :: q -> q -> q
-  r ~~ s = r <> negateG s
-
--- | An 'Additive' 'Semigroup' is one where (<>) is commutative
-class Semigroup q => Additive q where
-
 -- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
 newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }
 
 instance Additive p => Patch (AdditivePatch p) where
   type PatchTarget (AdditivePatch p) = p
   apply (AdditivePatch p) q = Just $ p <> q
-
-instance (Ord k, Group q) => Group (MonoidalMap k q) where
-  negateG = fmap negateG
-
-instance (Ord k, Additive q) => Additive (MonoidalMap k q)
-
--- | Trivial group.
-instance Group () where
-  negateG _ = ()
-  _ ~~ _ = ()
-instance Additive ()
-
--- | Product group.  A Pair of groups gives rise to a group
-instance (Group a, Group b) => Group (a, b) where
-  negateG (a, b) = (negateG a, negateG b)
-  (a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
-instance (Additive a, Additive b) => Additive (a, b)
-
--- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
--- Base does not define Monoid (Compose f g a) so this is the best we can
--- really do for functor composition.
-instance Group (f (g a)) => Group ((f :.: g) a) where
-  negateG (Comp1 xs) = Comp1 (negateG xs)
-  Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
-instance Additive (f (g a)) => Additive ((f :.: g) a)
-
--- | Product of groups, Functor style.
-instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
-  negateG (a :*: b) = negateG a :*: negateG b
-  (a :*: b) ~~ (c :*: d) = (a ~~ c) :*: (b ~~ d)
-instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a)
-
--- | Trivial group, Functor style
-instance Group (Proxy x) where
-  negateG _ = Proxy
-  _ ~~ _ = Proxy
-instance Additive (Proxy x)
-
--- | Const lifts groups into a functor.
-deriving instance Group a => Group (Const a x)
-instance Additive a => Additive (Const a x)
--- | Ideitnty lifts groups pointwise (at only one point)
-deriving instance Group a => Group (Identity a)
-instance Additive a => Additive (Identity a)
-
--- | Functions lift groups pointwise.
-instance Group b => Group (a -> b) where
-  negateG f = negateG . f
-  (~~) = liftA2 (~~)
-instance Additive b => Additive (a -> b)

src/Data/Semigroup/Additive.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+-- |
+-- Module:
+--   Data.Semigroup.Additive
+-- Description:
+--   This module defines a class for commutative semigroups, until it is moved
+--   to another library.
+module Data.Semigroup.Additive
+  ( Additive
+  ) where
+
+import Data.Functor.Const (Const (..))
+import Data.Functor.Identity
+import Data.Proxy
+#if !MIN_VERSION_base(4,12,0)
+-- for :*: and :.: semigroup instances
+import Data.Orphans ()
+#endif
+#if !MIN_VERSION_base(4,11,0)
+import Data.Semigroup (Semigroup (..))
+#endif
+import GHC.Generics
+
+-- | An 'Additive' 'Semigroup' is one where (<>) is commutative
+class Semigroup q => Additive q where
+
+-- | Trivial group.
+instance Additive ()
+
+-- | Product group.  A Pair of groups gives rise to a group
+instance (Additive a, Additive b) => Additive (a, b)
+
+-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
+-- Base does not define Monoid (Compose f g a) so this is the best we can
+-- really do for functor composition.
+instance Additive (f (g a)) => Additive ((f :.: g) a)
+
+-- | Product of groups, Functor style.
+instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a)
+
+-- | Trivial group, Functor style
+instance Additive (Proxy x)
+
+-- | Const lifts groups into a functor.
+instance Additive a => Additive (Const a x)
+-- | Ideitnty lifts groups pointwise (at only one point)
+instance Additive a => Additive (Identity a)
+
+-- | Functions lift groups pointwise.
+instance Additive b => Additive (a -> b)