Skip to content

Commit

Permalink
Use groups package for group, a breaking change
Browse files Browse the repository at this point in the history
TODO group's abelian should have Semigroup superclass.

The MonoidalMap instance was deleted because it is not lawful. But it
might need to be added to reflex.

The version in the cabal file is bumped to remind whoever does the
future release that this is breaking change.

Closes #4.
  • Loading branch information
Ericson2314 committed Dec 9, 2020
1 parent 485c592 commit c7d86e9
Show file tree
Hide file tree
Showing 3 changed files with 15 additions and 85 deletions.
8 changes: 8 additions & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,13 @@
# Revision history for patch

## Unreleased

* Remove `Group`, which is unused by the rest of this library and best defined elsewhere.
It shouldn't have been included when this library was split from `reflex`.

* Remove the `split-these` flag.
We no longer need it as we only use the `These` datatype which is provided in all versions.

## 0.0.3.2

* Update version bounds
Expand Down
17 changes: 3 additions & 14 deletions patch.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
Name: patch
Version: 0.0.3.2
Version: 0.1.0.0
Synopsis: Data structures for describing changes to other data structures.
Description:
Data structures for describing changes to other data structures.
Expand All @@ -25,11 +25,6 @@ tested-with:
GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1
GHCJS ==8.4

flag split-these
description: Use split these/semialign packages
manual: False
default: True

library
hs-source-dirs: src
default-language: Haskell2010
Expand All @@ -38,8 +33,10 @@ library
, containers >= 0.6 && < 0.7
, dependent-map >= 0.3 && < 0.5
, dependent-sum >= 0.6 && < 0.8
, groups >= 0.5 && < 0.7
, lens >= 4.7 && < 5
, semigroupoids >= 4.0 && < 6
, these >= 0.4 && < 1.2
, transformers >= 0.5.6.0 && < 0.6
, witherable >= 0.3 && < 0.4

Expand All @@ -56,14 +53,6 @@ library

ghc-options: -Wall -fwarn-redundant-constraints -fwarn-tabs

if flag(split-these)
build-depends: these >= 1 && <1.2
, semialign >=1 && <1.2
, monoidal-containers >= 0.6 && < 0.7
else
build-depends: these >= 0.4 && <0.9
, monoidal-containers == 0.4.0.0

test-suite hlint
default-language: Haskell2010
type: exitcode-stdio-1.0
Expand Down
75 changes: 4 additions & 71 deletions src/Data/Patch.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- |
-- Module:
-- Data.Patch
Expand All @@ -13,15 +11,7 @@ module Data.Patch
, module X
) where

import Control.Applicative
import Data.Functor.Const (Const (..))
import Data.Functor.Identity
import Data.Map.Monoidal (MonoidalMap)
import Data.Proxy
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup (..))
#endif
import GHC.Generics
import Data.Group as X

import Data.Patch.Class as X
import Data.Patch.DMap as X hiding (getDeletions)
Expand All @@ -39,68 +29,11 @@ import Data.Patch.MapWithMove as X
, unsafePatchMapWithMove
)

-- | A 'Group' is a 'Monoid' where every element has an inverse.
class (Semigroup q, Monoid q) => Group q where
negateG :: q -> q
(~~) :: q -> q -> q
r ~~ s = r <> negateG s

-- | An 'Additive' 'Semigroup' is one where (<>) is commutative
class Semigroup q => Additive q where
type Additive = Abelian

-- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }

instance Additive p => Patch (AdditivePatch p) where
instance Abelian p => Patch (AdditivePatch p) where
type PatchTarget (AdditivePatch p) = p
apply (AdditivePatch p) q = Just $ p <> q

instance (Ord k, Group q) => Group (MonoidalMap k q) where
negateG = fmap negateG

instance (Ord k, Additive q) => Additive (MonoidalMap k q)

-- | Trivial group.
instance Group () where
negateG _ = ()
_ ~~ _ = ()
instance Additive ()

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

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

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

-- | Trivial group, Functor style
instance Group (Proxy x) where
negateG _ = Proxy
_ ~~ _ = Proxy
instance Additive (Proxy x)

-- | Const lifts groups into a functor.
deriving instance Group a => Group (Const a x)
instance Additive a => Additive (Const a x)
-- | Ideitnty lifts groups pointwise (at only one point)
deriving instance Group a => Group (Identity a)
instance Additive a => Additive (Identity a)

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

0 comments on commit c7d86e9

Please sign in to comment.