@@ -1,8 +1,6 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3−{-# LANGUAGE StandaloneDeriving #-}
4−{-# LANGUAGE TypeFamilies #-}
52{-# LANGUAGE TypeOperators #-}
3+{-# LANGUAGE TypeFamilies #-}
64-- |
75-- Module:
86-- Data.Patch
@@ -13,15 +11,9 @@ module Data.Patch
1311 , module X
1412 ) where
1513
16−import Control.Applicative
17−import Data.Functor.Const (Const (..))
18−import Data.Functor.Identity
19−import Data.Map.Monoidal (MonoidalMap)
20−import Data.Proxy
2114#if !MIN_VERSION_base(4,11,0)
2215import Data.Semigroup (Semigroup (..))
2316#endif
24−import GHC.Generics
2517
2618import Data.Semigroup.Additive as X
2719import Data.Patch.Class as X
@@ -40,56 +32,9 @@ import Data.Patch.MapWithMove as X
4032 , unsafePatchMapWithMove
4133 )
4234
43−-- | A 'Group' is a 'Monoid' where every element has an inverse.
44−class (Semigroup q, Monoid q) => Group q where
45− negateG :: q -> q
46− (~~) :: q -> q -> q
47− r ~~ s = r <> negateG s
48−
4935-- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
5036newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }
5137
5238instance Additive p => Patch (AdditivePatch p) where
5339 type PatchTarget (AdditivePatch p) = p
5440 apply (AdditivePatch p) q = Just $ p <> q
55−
56−instance (Ord k, Group q) => Group (MonoidalMap k q) where
57− negateG = fmap negateG
58−
59−-- | Trivial group.
60−instance Group () where
61− negateG _ = ()
62− _ ~~ _ = ()
63−
64−-- | Product group. A Pair of groups gives rise to a group
65−instance (Group a, Group b) => Group (a, b) where
66− negateG (a, b) = (negateG a, negateG b)
67− (a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
68−
69−-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
70−-- Base does not define Monoid (Compose f g a) so this is the best we can
71−-- really do for functor composition.
72−instance Group (f (g a)) => Group ((f :.: g) a) where
73− negateG (Comp1 xs) = Comp1 (negateG xs)
74− Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
75−
76−-- | Product of groups, Functor style.
77−instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
78− negateG (a :*: b) = negateG a :*: negateG b
79− (a :*: b) ~~ (c :*: d) = (a ~~ c) :*: (b ~~ d)
80−
81−-- | Trivial group, Functor style
82−instance Group (Proxy x) where
83− negateG _ = Proxy
84− _ ~~ _ = Proxy
85−
86−-- | Const lifts groups into a functor.
87−deriving instance Group a => Group (Const a x)
88−
89−-- | Identity lifts groups pointwise (at only one point)
90−deriving instance Group a => Group (Identity a)
91−
92−-- | Functions lift groups pointwise.
93−instance Group b => Group (a -> b) where
94− negateG f = negateG . f
95− (~~) = liftA2 (~~)