1
1
{-# LANGUAGE CPP #-}
2
- {-# LANGUAGE GeneralizedNewtypeDeriving #-}
3
- {-# LANGUAGE StandaloneDeriving #-}
4
- {-# LANGUAGE TypeFamilies #-}
5
2
{-# LANGUAGE TypeOperators #-}
3
+ {-# LANGUAGE TypeFamilies #-}
6
4
-- |
7
5
-- Module:
8
6
-- Data.Patch
@@ -13,10 +11,8 @@ module Data.Patch
13
11
, module X
14
12
) where
15
13
16
- import Control.Applicative
17
14
import Data.Functor.Const (Const (.. ))
18
15
import Data.Functor.Identity
19
- import Data.Map.Monoidal (MonoidalMap )
20
16
import Data.Proxy
21
17
#if !MIN_VERSION_base(4,11,0)
22
18
import Data.Semigroup (Semigroup (.. ))
@@ -39,12 +35,6 @@ import Data.Patch.MapWithMove as X
39
35
, unsafePatchMapWithMove
40
36
)
41
37
42
- -- | A 'Group' is a 'Monoid' where every element has an inverse.
43
- class (Semigroup q , Monoid q ) => Group q where
44
- negateG :: q -> q
45
- (~~) :: q -> q -> q
46
- r ~~ s = r <> negateG s
47
-
48
38
-- | An 'Additive' 'Semigroup' is one where (<>) is commutative
49
39
class Semigroup q => Additive q where
50
40
@@ -55,52 +45,27 @@ instance Additive p => Patch (AdditivePatch p) where
55
45
type PatchTarget (AdditivePatch p ) = p
56
46
apply (AdditivePatch p) q = Just $ p <> q
57
47
58
- instance (Ord k , Group q ) => Group (MonoidalMap k q ) where
59
- negateG = fmap negateG
60
-
61
- instance (Ord k , Additive q ) => Additive (MonoidalMap k q )
62
-
63
48
-- | Trivial group.
64
- instance Group () where
65
- negateG _ = ()
66
- _ ~~ _ = ()
67
49
instance Additive ()
68
50
69
51
-- | Product group. A Pair of groups gives rise to a group
70
- instance (Group a , Group b ) => Group (a , b ) where
71
- negateG (a, b) = (negateG a, negateG b)
72
- (a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
73
52
instance (Additive a , Additive b ) => Additive (a , b )
74
53
75
54
-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
76
55
-- Base does not define Monoid (Compose f g a) so this is the best we can
77
56
-- really do for functor composition.
78
- instance Group (f (g a )) => Group ((f :.: g ) a ) where
79
- negateG (Comp1 xs) = Comp1 (negateG xs)
80
- Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
81
57
instance Additive (f (g a )) => Additive ((f :.: g ) a )
82
58
83
59
-- | Product of groups, Functor style.
84
- instance (Group (f a ), Group (g a )) => Group ((f :*: g ) a ) where
85
- negateG (a :*: b) = negateG a :*: negateG b
86
- (a :*: b) ~~ (c :*: d) = (a ~~ c) :*: (b ~~ d)
87
60
instance (Additive (f a ), Additive (g a )) => Additive ((f :*: g ) a )
88
61
89
62
-- | Trivial group, Functor style
90
- instance Group (Proxy x ) where
91
- negateG _ = Proxy
92
- _ ~~ _ = Proxy
93
63
instance Additive (Proxy x )
94
64
95
65
-- | Const lifts groups into a functor.
96
- deriving instance Group a => Group (Const a x )
97
66
instance Additive a => Additive (Const a x )
98
67
-- | Ideitnty lifts groups pointwise (at only one point)
99
- deriving instance Group a => Group (Identity a )
100
68
instance Additive a => Additive (Identity a )
101
69
102
70
-- | Functions lift groups pointwise.
103
- instance Group b => Group (a -> b ) where
104
- negateG f = negateG . f
105
- (~~) = liftA2 (~~)
106
71
instance Additive b => Additive (a -> b )
0 commit comments