Skip to content

Commit 78799a6

Browse files
committed
Pull Additive into its own module
1 parent 0019cce commit 78799a6

File tree

4 files changed

+55
-13
lines changed

4 files changed

+55
-13
lines changed

ChangeLog.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,9 @@
22

33
## Unreleased
44

5+
* `Additive` now lives in `Data.Semigroup.Additive`, but is still reexported
6+
from `Data.Patch` for compatability.
7+
58
* Rewrite `PatchMapWithMove` in terms of `PatchMapWithPatchingMove`.
69
Care is taken to make this not a breaking change.
710
In particular, `PatchMapWithMove` is a newtype of `PatchMapWithPatchingMove`, as is the `NodeInfo` and `From` of `PatchMapWithPatchingMove`'s versions of those.

patch.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,7 @@ library
5353
, Data.Patch.Map
5454
, Data.Patch.MapWithMove
5555
, Data.Patch.MapWithPatchingMove
56+
, Data.Semigroup.Additive
5657

5758
ghc-options: -Wall -fwarn-redundant-constraints -fwarn-tabs
5859
default-extensions: PolyKinds

src/Data/Patch.hs

Lines changed: 1 addition & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ import Data.Semigroup (Semigroup (..))
2323
#endif
2424
import GHC.Generics
2525

26+
import Data.Semigroup.Additive as X
2627
import Data.Patch.Class as X
2728
import Data.Patch.DMap as X hiding (getDeletions)
2829
import Data.Patch.DMapWithMove as X
@@ -45,9 +46,6 @@ class (Semigroup q, Monoid q) => Group q where
4546
(~~) :: q -> q -> q
4647
r ~~ s = r <> negateG s
4748

48-
-- | An 'Additive' 'Semigroup' is one where (<>) is commutative
49-
class Semigroup q => Additive q where
50-
5149
-- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
5250
newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }
5351

@@ -58,49 +56,39 @@ instance Additive p => Patch (AdditivePatch p) where
5856
instance (Ord k, Group q) => Group (MonoidalMap k q) where
5957
negateG = fmap negateG
6058

61-
instance (Ord k, Additive q) => Additive (MonoidalMap k q)
62-
6359
-- | Trivial group.
6460
instance Group () where
6561
negateG _ = ()
6662
_ ~~ _ = ()
67-
instance Additive ()
6863

6964
-- | Product group. A Pair of groups gives rise to a group
7065
instance (Group a, Group b) => Group (a, b) where
7166
negateG (a, b) = (negateG a, negateG b)
7267
(a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
73-
instance (Additive a, Additive b) => Additive (a, b)
7468

7569
-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
7670
-- Base does not define Monoid (Compose f g a) so this is the best we can
7771
-- really do for functor composition.
7872
instance Group (f (g a)) => Group ((f :.: g) a) where
7973
negateG (Comp1 xs) = Comp1 (negateG xs)
8074
Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
81-
instance Additive (f (g a)) => Additive ((f :.: g) a)
8275

8376
-- | Product of groups, Functor style.
8477
instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
8578
negateG (a :*: b) = negateG a :*: negateG b
8679
(a :*: b) ~~ (c :*: d) = (a ~~ c) :*: (b ~~ d)
87-
instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a)
8880

8981
-- | Trivial group, Functor style
9082
instance Group (Proxy x) where
9183
negateG _ = Proxy
9284
_ ~~ _ = Proxy
93-
instance Additive (Proxy x)
9485

9586
-- | Const lifts groups into a functor.
9687
deriving instance Group a => Group (Const a x)
97-
instance Additive a => Additive (Const a x)
9888
-- | Ideitnty lifts groups pointwise (at only one point)
9989
deriving instance Group a => Group (Identity a)
100-
instance Additive a => Additive (Identity a)
10190

10291
-- | Functions lift groups pointwise.
10392
instance Group b => Group (a -> b) where
10493
negateG f = negateG . f
10594
(~~) = liftA2 (~~)
106-
instance Additive b => Additive (a -> b)

src/Data/Semigroup/Additive.hs

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE TypeOperators #-}
3+
{-# LANGUAGE TypeFamilies #-}
4+
-- |
5+
-- Module:
6+
-- Data.Semigroup.Additive
7+
-- Description:
8+
-- This module defines a class for commutative semigroups, until it is moved
9+
-- to another library.
10+
module Data.Semigroup.Additive
11+
( Additive
12+
) where
13+
14+
import Data.Functor.Const (Const (..))
15+
import Data.Functor.Identity
16+
-- For base-orphans, TODO don't cheat.
17+
import Data.Map.Monoidal ()
18+
import Data.Proxy
19+
#if !MIN_VERSION_base(4,11,0)
20+
import Data.Semigroup (Semigroup (..))
21+
#endif
22+
import GHC.Generics
23+
24+
-- | An 'Additive' 'Semigroup' is one where (<>) is commutative
25+
class Semigroup q => Additive q where
26+
27+
-- | Trivial group.
28+
instance Additive ()
29+
30+
-- | Product group. A Pair of groups gives rise to a group
31+
instance (Additive a, Additive b) => Additive (a, b)
32+
33+
-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
34+
-- Base does not define Monoid (Compose f g a) so this is the best we can
35+
-- really do for functor composition.
36+
instance Additive (f (g a)) => Additive ((f :.: g) a)
37+
38+
-- | Product of groups, Functor style.
39+
instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a)
40+
41+
-- | Trivial group, Functor style
42+
instance Additive (Proxy x)
43+
44+
-- | Const lifts groups into a functor.
45+
instance Additive a => Additive (Const a x)
46+
-- | Ideitnty lifts groups pointwise (at only one point)
47+
instance Additive a => Additive (Identity a)
48+
49+
-- | Functions lift groups pointwise.
50+
instance Additive b => Additive (a -> b)

0 commit comments

Comments
 (0)