ef51a75 · patch · git.iko.soy

git.iko.soy/patch

Document DecidablyEmpty and add missing instances

commitef51a75a5c5820a7a9dc3bfc4f196cde7a68fbed authorJohn Ericson <John.Ericson@Obsidian.Systems> dateWed 22 Jan 2020, 18:05 (7 years ago) parent2565222

7 files changed+122−15

compare with develop

unifiedsplit

ChangeLog.md+2 src/Data/Monoid/DecidablyEmpty.hs+91−2 src/Data/Patch/DMap.hs+6 src/Data/Patch/DMapWithMove.hs+5 src/Data/Patch/IntMap.hs+9−6 src/Data/Patch/Map.hs+7−7 src/Data/Patch/MapWithPatchingMove.hs+2

ChangeLog.md+2

@@ -4,6 +4,8 @@

55* Create `PatchMapWithPatchingMove` variant which supports moves with a patch.

7+* Create `DecidablyEmpty` subclass of `Monoid`.

79## 0.0.2.0

810

911* Consistently provide:

src/Data/Monoid/DecidablyEmpty.hs+91−2

@@ -1,14 +1,103 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DefaultSignatures #-}

3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE StandaloneDeriving #-}

5+{-# LANGUAGE TypeOperators #-}

37-- TODO upstream somwhere else?

48module Data.Monoid.DecidablyEmpty where

10+import Data.Functor.Identity

11+import Data.Functor.Const

12+import Data.Monoid

13+import Data.Maybe (isNothing)

14+import Data.Ord

615import Data.Proxy

16+import Data.Semigroup hiding (First, Last)

17+import GHC.Generics

718

19+import qualified Data.IntSet as IntSet

20+import qualified Data.IntMap as IntMap

21+import qualified Data.Map as Map

22+import qualified Data.Sequence as Seq

23+import qualified Data.Set as Set

24+

25+import Data.GADT.Compare

26+import qualified Data.Dependent.Map as DMap

27+

28+-- | A 'DecidablyEmpty' is one where it can be computed whether or not an

29+-- arbitrary value is 'mempty'.

30+--

31+-- By using this class rather than 'Eq', we avoid unnecessary constraining the

32+-- contents of 'Functor's. This makes it possible to efficiently combine and/or

33+-- nest patch maps with 'Eq'-lacking values (e.g. functions) at the leaves.

834class Monoid a => DecidablyEmpty a where

935 isEmpty :: a -> Bool

1036 default isEmpty :: Eq a => a -> Bool

1137 isEmpty = (==) mempty

1238

13−instance DecidablyEmpty (Proxy a) where

14− isEmpty ~Proxy = True

39+-- base

40+

41+instance DecidablyEmpty Ordering

42+instance DecidablyEmpty ()

43+instance DecidablyEmpty Any

44+instance DecidablyEmpty All

45+-- instance DecidablyEmpty Lifetime

46+-- instance DecidablyEmpty Event

47+instance DecidablyEmpty [a] where

48+ isEmpty = null

49+instance Semigroup a => DecidablyEmpty (Maybe a) where

50+ isEmpty = isNothing

51+#if MIN_VERSION_base(4,11,0)

52+deriving instance DecidablyEmpty a => DecidablyEmpty (Down a)

53+#endif

54+deriving instance (Num a, DecidablyEmpty a) => DecidablyEmpty (Product a)

55+deriving instance (DecidablyEmpty a, Num a) => DecidablyEmpty (Sum a)

56+deriving instance DecidablyEmpty a => DecidablyEmpty (Dual a)

57+deriving instance Semigroup a => DecidablyEmpty (First a)

58+deriving instance Semigroup a => DecidablyEmpty (Last a)

59+deriving instance DecidablyEmpty a => DecidablyEmpty (Identity a)

60+deriving instance Semigroup a => DecidablyEmpty (Option a)

61+deriving instance DecidablyEmpty m => DecidablyEmpty (WrappedMonoid m)

62+instance (Ord a, Bounded a) => DecidablyEmpty (Max a)

63+instance (Ord a, Bounded a) => DecidablyEmpty (Min a)

64+instance DecidablyEmpty (U1 p)

65+instance DecidablyEmpty (Proxy s)

66+#if MIN_VERSION_base(4,12,0)

67+deriving instance DecidablyEmpty (f p) => DecidablyEmpty (Rec1 f p)

68+#endif

69+deriving instance DecidablyEmpty a => DecidablyEmpty (Const a b)

70+deriving instance DecidablyEmpty c => DecidablyEmpty (K1 i c p)

71+instance (DecidablyEmpty (f p), DecidablyEmpty (g p)) => DecidablyEmpty ((f :*: g) p) where

72+ isEmpty (x :*: y) = isEmpty x && isEmpty y

73+#if MIN_VERSION_base(4,12,0)

74+deriving instance DecidablyEmpty (f p) => DecidablyEmpty (M1 i c f p)

75+deriving instance DecidablyEmpty (f (g p)) => DecidablyEmpty ((f :.: g) p)

76+#endif

77+

78+instance (DecidablyEmpty a, DecidablyEmpty b) => DecidablyEmpty (a, b) where

79+ isEmpty (a, b) = isEmpty a && isEmpty b

80+instance (DecidablyEmpty a, DecidablyEmpty b, DecidablyEmpty c) => DecidablyEmpty (a, b, c) where

81+ isEmpty (a, b, c) = isEmpty a && isEmpty b && isEmpty c

82+instance (DecidablyEmpty a, DecidablyEmpty b, DecidablyEmpty c, DecidablyEmpty d) => DecidablyEmpty (a, b, c, d) where

83+ isEmpty (a, b, c, d) = isEmpty a && isEmpty b && isEmpty c && isEmpty d

84+instance (DecidablyEmpty a, DecidablyEmpty b, DecidablyEmpty c, DecidablyEmpty d, DecidablyEmpty e) => DecidablyEmpty (a, b, c, d, e) where

85+ isEmpty (a, b, c, d, e) = isEmpty a && isEmpty b && isEmpty c && isEmpty d && isEmpty e

86+

87+-- containers

88+

89+instance DecidablyEmpty IntSet.IntSet where

90+ isEmpty = IntSet.null

91+instance DecidablyEmpty (IntMap.IntMap v) where

92+ isEmpty = IntMap.null

93+instance Ord k => DecidablyEmpty (Map.Map k v) where

94+ isEmpty = Map.null

95+instance DecidablyEmpty (Seq.Seq v) where

96+ isEmpty = Seq.null

97+instance Ord k => DecidablyEmpty (Set.Set k) where

98+ isEmpty = Set.null

99+

100+-- dependent-map

101+

102+instance GCompare k => DecidablyEmpty (DMap.DMap k v) where

103+ isEmpty = DMap.null

src/Data/Patch/DMap.hs+6

@@ -5,6 +5,7 @@

55{-# LANGUAGE ScopedTypeVariables #-}

66{-# LANGUAGE StandaloneDeriving #-}

77{-# LANGUAGE TypeFamilies #-}

89-- | 'Patch'es on 'DMap' that consist only of insertions (or overwrites) and deletions.

910module Data.Patch.DMap where

1011

@@ -18,6 +19,7 @@ import Data.Functor.Constant

1819import Data.Functor.Misc

1920import qualified Data.IntMap as IntMap

2021import qualified Data.Map as Map

22+import Data.Monoid.DecidablyEmpty

2123import Data.Semigroup (Semigroup (..))

2224import Data.Some (Some)

2325

@@ -30,6 +32,10 @@ deriving instance GCompare k => Semigroup (PatchDMap k v)

3032

3133deriving instance GCompare k => Monoid (PatchDMap k v)

3234

35+-- It won't let me derive for some reason

36+instance GCompare k => DecidablyEmpty (PatchDMap k v) where

37+ isEmpty (PatchDMap m) = DMap.null m

38+

3339-- | Apply the insertions or deletions to a given 'DMap'.

3440instance GCompare k => Patch (PatchDMap k v) where

3541 type PatchTarget (PatchDMap k v) = DMap k v

src/Data/Patch/DMapWithMove.hs+5

@@ -29,6 +29,7 @@ import Data.GADT.Compare (GEq (..))

2929import Data.GADT.Show (GShow, gshow)

3030import qualified Data.Map as Map

3131import Data.Maybe

32+import Data.Monoid.DecidablyEmpty

3233import Data.Semigroup (Semigroup (..), (<>))

3334import Data.Some (Some(Some))

3435import Data.These

@@ -42,6 +43,10 @@ import Data.These

4243-- * A move should always be represented with both the destination key (as a 'From_Move') and the source key (as a @'ComposeMaybe' ('Just' destination)@)

4344newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))

4445

46+-- It won't let me derive for some reason

47+instance GCompare k => DecidablyEmpty (PatchDMapWithMove k v) where

48+ isEmpty (PatchDMapWithMove m) = DMap.null m

49+

4550-- |Structure which represents what changes apply to a particular key. @_nodeInfo_from@ specifies what happens to this key, and in particular what other key

4651-- the current key is moving from, while @_nodeInfo_to@ specifies what key the current key is moving to if involved in a move.

4752data NodeInfo k v a = NodeInfo

src/Data/Patch/IntMap.hs+9−6

@@ -1,7 +1,9 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DeriveTraversable #-}

23{-# LANGUAGE FlexibleInstances #-}

34{-# LANGUAGE GeneralizedNewtypeDeriving #-}

45{-# LANGUAGE MultiParamTypeClasses #-}

6+{-# LANGUAGE StandaloneDeriving #-}

57{-# LANGUAGE TemplateHaskell #-}

68{-# LANGUAGE TypeFamilies #-}

@@ -13,7 +15,10 @@ import Control.Lens

1315import Data.IntMap.Strict (IntMap)

1416import qualified Data.IntMap.Strict as IntMap

1517import Data.Maybe

16−import Data.Semigroup

18+import Data.Monoid.DecidablyEmpty

19+#if !MIN_VERSION_base(4,10,0)

20+import Data.Semigroup (Semigroup (..))

21+#endif

1722import Data.Patch.Class

1823

1924-- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping.

@@ -21,16 +26,14 @@ import Data.Patch.Class

2126-- and @Nothing@ means delete.

2227newtype PatchIntMap a = PatchIntMap { unPatchIntMap :: IntMap (Maybe a) }

2328 deriving ( Show, Read, Eq, Ord

24− , Functor, Foldable, Traversable, Monoid

29+ , Functor, Foldable, Traversable

30+ , Monoid, DecidablyEmpty

2531 )

2632

2733-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.

2834-- If the same key is modified by both patches, the one on the left will take

2935-- precedence.

30−instance Semigroup (PatchIntMap v) where

31− PatchIntMap a <> PatchIntMap b = PatchIntMap $ a `mappend` b --TODO: Add a semigroup instance for Map

32− -- PatchMap is idempotent, so stimes n is id for every n

33− stimes = stimesIdempotentMonoid

36+deriving instance Semigroup (PatchIntMap v)

3437

3538makeWrapped ''PatchIntMap

3639

src/Data/Patch/Map.hs+7−7

@@ -1,5 +1,6 @@

11{-# LANGUAGE DeriveTraversable #-}

22{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

34{-# LANGUAGE LambdaCase #-}

45{-# LANGUAGE MultiParamTypeClasses #-}

56{-# LANGUAGE StandaloneDeriving #-}

@@ -16,6 +17,7 @@ import Control.Lens

1617import Data.Map (Map)

1718import qualified Data.Map as Map

1819import Data.Maybe

20+import Data.Monoid.DecidablyEmpty

1921import Data.Semigroup

2022

2123-- | A set of changes to a 'Map'. Any element may be inserted/updated or

@@ -24,11 +26,14 @@ import Data.Semigroup

2426newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }

2527 deriving ( Show, Read, Eq, Ord

2628 , Foldable, Traversable

29+ , DecidablyEmpty

2730 )

2831

2932-- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert.

3033-- Deletions are unaffected.

3134deriving instance Functor (PatchMap k)

35+-- | The empty 'PatchMap' contains no insertions or deletions

36+deriving instance Ord k => Monoid (PatchMap k v)

3237

3338-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.

3439-- If the same key is modified by both patches, the one on the left will take

@@ -38,8 +43,6 @@ instance Ord k => Semigroup (PatchMap k v) where

3843 -- PatchMap is idempotent, so stimes n is id for every n

3944 stimes = stimesIdempotentMonoid

4045

41−makeWrapped ''PatchMap

42−

4346-- | Apply the insertions or deletions to a given 'Map'.

4447instance Ord k => Patch (PatchMap k v) where

4548 type PatchTarget (PatchMap k v) = Map k v

@@ -57,11 +60,6 @@ instance TraversableWithIndex k (PatchMap k) where

5760 itraverse = itraversed . Indexed

5861 itraversed = _Wrapped .> itraversed <. traversed

5962

60−-- | The empty 'PatchMap' contains no insertions or deletions

61−instance Ord k => Monoid (PatchMap k v) where

62− mempty = PatchMap mempty

63− mappend = (<>)

64−

6563-- | Returns all the new elements that will be added to the 'Map'

6664patchMapNewElements :: PatchMap k v -> [v]

6765patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p

@@ -69,3 +67,5 @@ patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p

6967-- | Returns all the new elements that will be added to the 'Map'

7068patchMapNewElementsMap :: PatchMap k v -> Map k v

7169patchMapNewElementsMap (PatchMap p) = Map.mapMaybe id p

70+

71+makeWrapped ''PatchMap

src/Data/Patch/MapWithPatchingMove.hs+2

@@ -1,4 +1,5 @@

11{-# LANGUAGE CPP #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

23{-# LANGUAGE FlexibleContexts #-}

34{-# LANGUAGE FlexibleInstances #-}

45{-# LANGUAGE LambdaCase #-}

@@ -45,6 +46,7 @@ deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (PatchMapWithPa

4546deriving instance (Ord k, Read k, Read p, Read (PatchTarget p)) => Read (PatchMapWithPatchingMove k p)

4647deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (PatchMapWithPatchingMove k p)

4748deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (PatchMapWithPatchingMove k p)

49+deriving instance (Ord k, Monoid p, DecidablyEmpty p, Patch p) => DecidablyEmpty (PatchMapWithPatchingMove k p)

4850

4951-- | Holds the information about each key: where its new value should come from,

5052-- and where its old value should go to