git.iko.soy/patch
on develop help sign in
Merge pull request #6 from reflex-frp/extra-group-instances
911f6eaJohn Ericson
ChangeLog.md+2
compare with develop
unifiedsplit
@@ -4,6 +4,8 @@
4
4
5* Support older GHCs with `split-these` flag.
5* Support older GHCs with `split-these` flag.
6
6
7+* Additional instances for the `Group` class for basic types.
8+
7## 0.0.0.1
9## 0.0.0.1
8
10
9* Remove unneeded dependencies
11* Remove unneeded dependencies
src/Data/Patch.hs+53
@@ -1,4 +1,7 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE StandaloneDeriving #-}
1{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeFamilies #-}
4+{-# LANGUAGE TypeOperators #-}
2-- |
5-- |
3-- Module:
6-- Module:
4-- Data.Patch
7-- Data.Patch
@@ -22,6 +25,11 @@ import Data.Patch.MapWithMove as X (PatchMapWithMove, patchMapWithMoveNewElement
22 unsafePatchMapWithMove)
25 unsafePatchMapWithMove)
23import Data.Map.Monoidal (MonoidalMap)
26import Data.Map.Monoidal (MonoidalMap)
24import Data.Semigroup (Semigroup (..), (<>))
27import Data.Semigroup (Semigroup (..), (<>))
28+import GHC.Generics
29+import Data.Functor.Identity
30+import Data.Functor.Const
31+import Data.Proxy
32+import Control.Applicative
25
33
26-- | A 'Group' is a 'Monoid' where every element has an inverse.
34-- | A 'Group' is a 'Monoid' where every element has an inverse.
27class (Semigroup q, Monoid q) => Group q where
35class (Semigroup q, Monoid q) => Group q where
@@ -43,3 +51,48 @@ instance (Ord k, Group q) => Group (MonoidalMap k q) where
43 negateG = fmap negateG
51 negateG = fmap negateG
44
52
45instance (Ord k, Additive q) => Additive (MonoidalMap k q)
53instance (Ord k, Additive q) => Additive (MonoidalMap k q)
54+
55+-- | Trivial group.
56+instance Group () where
57+ negateG _ = ()
58+ _ ~~ _ = ()
59+instance Additive ()
60+
61+-- | Product group. A Pair of groups gives rise to a group
62+instance (Group a, Group b) => Group (a, b) where
63+ negateG (a, b) = (negateG a, negateG b)
64+ (a, b) ~~ (c, d) = (a ~~ c, b ~~ d)
65+instance (Additive a, Additive b) => Additive (a, b)
66+
67+-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
68+-- Base does not define Monoid (Compose f g a) so this is the best we can
69+-- really do for functor composition.
70+instance Group (f (g a)) => Group ((f :.: g) a) where
71+ negateG (Comp1 xs) = Comp1 (negateG xs)
72+ Comp1 xs ~~ Comp1 ys = Comp1 (xs ~~ ys)
73+instance Additive (f (g a)) => Additive ((f :.: g) a)
74+
75+-- | Product of groups, Functor style.
76+instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
77+ negateG (a :*: b) = negateG a :*: negateG b
78+ (a :*: b) ~~ (c :*: d) = (a ~~ c) :*: (b ~~ d)
79+instance (Additive (f a), Additive (g a)) => Additive ((f :*: g) a)
80+
81+-- | Trivial group, Functor style
82+instance Group (Proxy x) where
83+ negateG _ = Proxy
84+ _ ~~ _ = Proxy
85+instance Additive (Proxy x)
86+
87+-- | Const lifts groups into a functor.
88+deriving instance Group a => Group (Const a x)
89+instance Additive a => Additive (Const a x)
90+-- | Ideitnty lifts groups pointwise (at only one point)
91+deriving instance Group a => Group (Identity a)
92+instance Additive a => Additive (Identity a)
93+
94+-- | Functions lift groups pointwise.
95+instance Group b => Group (a -> b) where
96+ negateG f = negateG . f
97+ (~~) = liftA2 (~~)
98+instance Additive b => Additive (a -> b)