on develop help sign in
Pull `Additive` into its own module
807269fJohn Ericson
ChangeLog.md+3
@@ -2,6 +2,9 @@
2
2
3## Unreleased
3## Unreleased
4
4
5+* `Additive` now lives in `Data.Semigroup.Additive`, but is still reexported
6+ from `Data.Patch` for compatability.
7+
5* Rewrite `PatchMapWithMove` in terms of `PatchMapWithPatchingMove`.
8* Rewrite `PatchMapWithMove` in terms of `PatchMapWithPatchingMove`.
6 Care is taken to make this not a breaking change.
9 Care is taken to make this not a breaking change.
7 In particular, `PatchMapWithMove` is a newtype of `PatchMapWithPatchingMove`, as is the `NodeInfo` and `From` of `PatchMapWithPatchingMove`'s versions of those.
10 In particular, `PatchMapWithMove` is a newtype of `PatchMapWithPatchingMove`, as is the `NodeInfo` and `From` of `PatchMapWithPatchingMove`'s versions of those.
patch.cabal+1
@@ -53,6 +53,7 @@ library
53 , Data.Patch.Map
53 , Data.Patch.Map
54 , Data.Patch.MapWithMove
54 , Data.Patch.MapWithMove
55 , Data.Patch.MapWithPatchingMove
55 , Data.Patch.MapWithPatchingMove
56+ , Data.Semigroup.Additive
56
57
57 ghc-options: -Wall -fwarn-redundant-constraints -fwarn-tabs
58 ghc-options: -Wall -fwarn-redundant-constraints -fwarn-tabs
58 default-extensions: PolyKinds
59 default-extensions: PolyKinds
src/Data/Patch.hs+1−13
@@ -23,6 +23,7 @@ import Data.Semigroup (Semigroup (..))
23#endif
23#endif
24import GHC.Generics
24import GHC.Generics
25
25
26+import Data.Semigroup.Additive as X
26import Data.Patch.Class as X
27import Data.Patch.Class as X
27import Data.Patch.DMap as X hiding (getDeletions)
28import Data.Patch.DMap as X hiding (getDeletions)
28import Data.Patch.DMapWithMove as X
29import Data.Patch.DMapWithMove as X
@@ -45,9 +46,6 @@ class (Semigroup q, Monoid q) => Group q where
45 (~~) :: q -> q -> q
46 (~~) :: q -> q -> q
46 r ~~ s = r <> negateG s
47 r ~~ s = r <> negateG s
47
48
48−-- | An 'Additive' 'Semigroup' is one where (<>) is commutative
49−class Semigroup q => Additive q where
50−
51-- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
49-- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
52newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }
50newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }
53
51
@@ -58,19 +56,15 @@ instance Additive p => Patch (AdditivePatch p) where
58instance (Ord k, Group q) => Group (MonoidalMap k q) where
56instance (Ord k, Group q) => Group (MonoidalMap k q) where
59 negateG = fmap negateG
57 negateG = fmap negateG
60
58
61−instance (Ord k, Additive q) => Additive (MonoidalMap k q)
62−
63-- | Trivial group.
59-- | Trivial group.
64instance Group () where
60instance Group () where
65 negateG _ = ()
61 negateG _ = ()
66 _ ~~ _ = ()
62 _ ~~ _ = ()
67−instance Additive ()
68
63
69-- | Product group. A Pair of groups gives rise to a group
64-- | Product group. A Pair of groups gives rise to a group
70instance (Group a, Group b) => Group (a, b) where
65instance (Group a, Group b) => Group (a, b) where
71 negateG (a, b) = (negateG a, negateG b)
66 negateG (a, b) = (negateG a, negateG b)
72 (a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
67 (a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
73−instance (Additive a, Additive b) => Additive (a, b)
74
68
75-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
69-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
76-- Base does not define Monoid (Compose f g a) so this is the best we can
70-- Base does not define Monoid (Compose f g a) so this is the best we can
@@ -78,29 +72,23 @@ instance (Additive a, Additive b) => Additive (a, b)
78instance Group (f (g a)) => Group ((f :.: g) a) where
72instance Group (f (g a)) => Group ((f :.: g) a) where
79 negateG (Comp1 xs) = Comp1 (negateG xs)
73 negateG (Comp1 xs) = Comp1 (negateG xs)
80 Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
74 Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
81−instance Additive (f (g a)) => Additive ((f :.: g) a)
82
75
83-- | Product of groups, Functor style.
76-- | Product of groups, Functor style.
84instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
77instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
85 negateG (a :*: b) = negateG a :*: negateG b
78 negateG (a :*: b) = negateG a :*: negateG b
86 (a :*: b) ~~ (c :*: d) = (a ~~ c) :*: (b ~~ d)
79 (a :*: b) ~~ (c :*: d) = (a ~~ c) :*: (b ~~ d)
87−instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a)
88
80
89-- | Trivial group, Functor style
81-- | Trivial group, Functor style
90instance Group (Proxy x) where
82instance Group (Proxy x) where
91 negateG _ = Proxy
83 negateG _ = Proxy
92 _ ~~ _ = Proxy
84 _ ~~ _ = Proxy
93−instance Additive (Proxy x)
94
85
95-- | Const lifts groups into a functor.
86-- | Const lifts groups into a functor.
96deriving instance Group a => Group (Const a x)
87deriving instance Group a => Group (Const a x)
97−instance Additive a => Additive (Const a x)
98-- | Ideitnty lifts groups pointwise (at only one point)
88-- | Ideitnty lifts groups pointwise (at only one point)
99deriving instance Group a => Group (Identity a)
89deriving instance Group a => Group (Identity a)
100−instance Additive a => Additive (Identity a)
101
90
102-- | Functions lift groups pointwise.
91-- | Functions lift groups pointwise.
103instance Group b => Group (a -> b) where
92instance Group b => Group (a -> b) where
104 negateG f = negateG . f
93 negateG f = negateG . f
105 (~~) = liftA2 (~~)
94 (~~) = liftA2 (~~)
106−instance Additive b => Additive (a -> b)
src/Data/Semigroup/Additive.hsnew file+50
@@ -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)