patch 0.0.5.2 → 0.0.6.0

raw patch · 11 files changed

+175/−49 lines, 11 filesdep +indexed-traversabledep ~basedep ~hlintdep ~lensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: indexed-traversable

Dependency ranges changed: base, hlint, lens, semialign, transformers

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• patch.cabal +9/−7
• src/Data/Functor/Misc.hs +10/−8
• src/Data/Monoid/DecidablyEmpty.hs +2/−0
• src/Data/Patch.hs +1/−1
• src/Data/Patch/DMapWithMove.hs +2/−1
• src/Data/Patch/IntMap.hs +14/−3
• src/Data/Patch/Map.hs +16/−5
• src/Data/Patch/MapWithMove.hs +33/−23
• src/Data/Patch/MapWithPatchingMove.hs +1/−1
• src/Data/Patch/PatchOrReplacement.hs +80/−0

@@ -1,5 +1,12 @@ # Revision history for patch +## 0.0.6.0 - 2022-06-10++* Add `PatchOrReplacement`, patch which either is some other patch type or a+  new replacement value.++* Support GHC 9.2+ ## 0.0.5.2 - 2022-01-09  * Correct field order of `PatchMapWithMove.NodeInfo`.

@@ -1,5 +1,5 @@ Name: patch-Version: 0.0.5.2+Version: 0.0.6.0 Synopsis: Data structures for describing changes to other data structures. Description:   Data structures for describing changes to other data structures.@@ -22,7 +22,7 @@   ChangeLog.md  tested-with:-  GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1+  GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.2   GHCJS ==8.4  flag split-these@@ -33,14 +33,15 @@ library   hs-source-dirs: src   default-language: Haskell2010-  build-depends: base >= 4.9 && < 4.15+  build-depends: base >= 4.9 && < 4.17                , constraints-extras >= 0.3 && < 0.4                , containers >= 0.6 && < 0.7                , dependent-map >= 0.3 && < 0.5                , dependent-sum >= 0.6 && < 0.8-               , lens >= 4.7 && < 5+               , lens >= 4.7 && < 5.2+               , indexed-traversable >= 0.1 && < 0.2                , semigroupoids >= 4.0 && < 6-               , transformers >= 0.5.6.0 && < 0.6+               , transformers >= 0.5.6.0 && < 0.7                , witherable >= 0.3 && < 0.5    if impl(ghc < 8.6) -- really, if base < 8.12@@ -56,6 +57,7 @@                  , Data.Patch.Map                  , Data.Patch.MapWithMove                  , Data.Patch.MapWithPatchingMove+                 , Data.Patch.PatchOrReplacement                  , Data.Semigroup.Additive    ghc-options: -Wall -fwarn-redundant-constraints -fwarn-tabs@@ -63,7 +65,7 @@    if flag(split-these)     build-depends: these >= 1 && <1.2-                 , semialign >=1 && <1.2+                 , semialign >=1 && <1.3                  , monoidal-containers >= 0.6 && < 0.7   else     build-depends: these >= 0.4 && <0.9@@ -91,7 +93,7 @@                , directory                , filepath                , filemanip-               , hlint (< 2.1 || >= 2.2.2) && < 3.3+               , hlint (< 2.1 || >= 2.2.2) && < 3.5   if impl(ghcjs)     buildable: False 

@@ -41,7 +41,6 @@   , ComposeMaybe (..)   ) where -import Control.Applicative ((<$>)) import Data.Dependent.Map (DMap) import qualified Data.Dependent.Map as DMap import Data.Dependent.Sum@@ -50,6 +49,7 @@ import Data.GADT.Show import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap+import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map as Map import Data.Some (Some, mkSome)@@ -61,9 +61,10 @@ -- Const2 -------------------------------------------------------------------------------- --- | 'Const2' stores a value of a given type 'k' and ensures that a particular--- type 'v' is always given for the last type parameter-data Const2 :: * -> x -> x -> * where+-- | @'Const2' k v v@ stores a value of a given type @k@ and ensures+-- that a particular type @v@ is always given for the last type+-- parameter+data Const2 :: Type -> x -> x -> Type where   Const2 :: k -> Const2 k v v   deriving (Typeable) @@ -130,7 +131,7 @@ -- | 'WrapArg' can be used to tag a value in one functor with a type -- representing another functor.  This was primarily used with dependent-map < -- 0.2, in which the value type was not wrapped in a separate functor.-data WrapArg :: (k -> *) -> (k -> *) -> * -> * where+data WrapArg :: (k -> Type) -> (k -> Type) -> Type -> Type where   WrapArg :: f a -> WrapArg g f (g a)  deriving instance Eq (f a) => Eq (WrapArg g f (g' a))@@ -227,9 +228,10 @@ -- ComposeMaybe -------------------------------------------------------------------------------- --- | We can't use @Compose Maybe@ instead of 'ComposeMaybe', because that would--- make the 'f' parameter have a nominal type role.  We need f to be--- representational so that we can use safe 'coerce'.+-- | We can't use @'Data.Functor.Compose.Compose' 'Maybe'@ instead of @'ComposeMaybe'@,+-- because that would make the @f@ parameter have a nominal type role.+-- We need @f@ to be representational so that we can use safe+-- @'Data.Coerce.coerce'@. newtype ComposeMaybe f a =   ComposeMaybe { getComposeMaybe :: Maybe (f a) } deriving (Show, Eq, Ord) 

@@ -69,8 +69,10 @@ instance DecidablyEmpty (Last a) where   isEmpty (Last a) = isNothing a deriving instance DecidablyEmpty a => DecidablyEmpty (Identity a)+#if !MIN_VERSION_base(4,16,0) instance Semigroup a => DecidablyEmpty (Option a) where   isEmpty (Option a) = isNothing a+#endif deriving instance DecidablyEmpty m => DecidablyEmpty (WrappedMonoid m) instance (Ord a, Bounded a) => DecidablyEmpty (Max a) instance (Ord a, Bounded a) => DecidablyEmpty (Min a)

@@ -13,7 +13,7 @@   , module X   ) where -import Control.Applicative+import Control.Applicative (liftA2) import Data.Functor.Const (Const (..)) import Data.Functor.Identity import Data.Map.Monoidal (MonoidalMap)

@@ -33,6 +33,7 @@ import Data.Functor.Product import Data.GADT.Compare (GEq (..), GCompare (..)) import Data.GADT.Show (GShow, gshow)+import Data.Kind (Type) import qualified Data.Map as Map import Data.Maybe import Data.Monoid.DecidablyEmpty@@ -67,7 +68,7 @@  -- |Structure describing a particular change to a key, be it inserting a new key (@From_Insert@), updating an existing key (@From_Insert@ again), deleting a -- key (@From_Delete@), or moving a key (@From_Move@).-data From (k :: a -> *) (v :: a -> *) :: a -> * where+data From (k :: a -> Type) (v :: a -> Type) :: a -> Type where   -- |Insert a new or update an existing key with the given value @v a@   From_Insert :: v a -> From k v a   -- |Delete the existing key

@@ -14,7 +14,10 @@ -} module Data.Patch.IntMap where -import Control.Lens+import Control.Lens hiding  (FunctorWithIndex, FoldableWithIndex, TraversableWithIndex)+#if !MIN_VERSION_lens(5,0,0)+import qualified Control.Lens as L+#endif import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IntMap import Data.Maybe@@ -23,6 +26,9 @@ import Data.Semigroup (Semigroup (..)) #endif import Data.Patch.Class+import Data.Functor.WithIndex+import Data.Foldable.WithIndex+import Data.Traversable.WithIndex  -- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping. -- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update@@ -51,8 +57,13 @@ instance FunctorWithIndex Int PatchIntMap instance FoldableWithIndex Int PatchIntMap instance TraversableWithIndex Int PatchIntMap where-  itraverse = itraversed . Indexed-  itraversed = _Wrapped .> itraversed <. traversed+  itraverse = (_Wrapped .> itraversed <. traversed) . Indexed++#if !MIN_VERSION_lens(5,0,0)+instance L.FunctorWithIndex     Int PatchIntMap where imap = Data.Functor.WithIndex.imap+instance L.FoldableWithIndex    Int PatchIntMap where ifoldMap = Data.Foldable.WithIndex.ifoldMap+instance L.TraversableWithIndex Int PatchIntMap where itraverse = Data.Traversable.WithIndex.itraverse+#endif  -- | Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@ -- (that is, all inserts/updates), producing a @PatchIntMap b@.

@@ -18,12 +18,18 @@  import Data.Patch.Class -import Control.Lens+import Control.Lens hiding  (FunctorWithIndex, FoldableWithIndex, TraversableWithIndex)+#if !MIN_VERSION_lens(5,0,0)+import qualified Control.Lens as L+#endif import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe import Data.Monoid.DecidablyEmpty import Data.Semigroup (Semigroup (..), stimesIdempotentMonoid)+import Data.Functor.WithIndex+import Data.Foldable.WithIndex+import Data.Traversable.WithIndex  -- | A set of changes to a 'Map'.  Any element may be inserted/updated or -- deleted.  Insertions are represented as values wrapped in 'Just', while@@ -59,12 +65,19 @@             Nothing -> Just ()             Just _ -> Nothing +makeWrapped ''PatchMap+ instance FunctorWithIndex k (PatchMap k) instance FoldableWithIndex k (PatchMap k) instance TraversableWithIndex k (PatchMap k) where-  itraverse = itraversed . Indexed-  itraversed = _Wrapped .> itraversed <. traversed+  itraverse = (_Wrapped .> itraversed <. traversed) . Indexed +#if !MIN_VERSION_lens(5,0,0)+instance L.FunctorWithIndex k    (PatchMap k) where imap = Data.Functor.WithIndex.imap+instance L.FoldableWithIndex k   (PatchMap k) where ifoldMap = Data.Foldable.WithIndex.ifoldMap+instance L.TraversableWithIndex k (PatchMap k) where itraverse = Data.Traversable.WithIndex.itraverse+#endif+ -- | Returns all the new elements that will be added to the 'Map' patchMapNewElements :: PatchMap k v -> [v] patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p@@ -72,5 +85,3 @@ -- | Returns all the new elements that will be added to the 'Map' patchMapNewElementsMap :: PatchMap k v -> Map k v patchMapNewElementsMap (PatchMap p) = Map.mapMaybe id p--makeWrapped ''PatchMap

@@ -70,7 +70,10 @@ import Data.Patch.MapWithPatchingMove (PatchMapWithPatchingMove(..), To) import qualified Data.Patch.MapWithPatchingMove as PM -- already a transparent synonym -import Control.Lens+import Control.Lens hiding  (FunctorWithIndex, FoldableWithIndex, TraversableWithIndex)+#if !MIN_VERSION_lens(5,0,0)+import qualified Control.Lens as L+#endif import Data.List import Data.Map (Map) import qualified Data.Map as Map@@ -79,6 +82,9 @@ import Data.Semigroup (Semigroup (..)) #endif import Data.Traversable (foldMapDefault)+import Data.Functor.WithIndex+import Data.Foldable.WithIndex+import Data.Traversable.WithIndex  -- | Patch a Map with additions, deletions, and moves.  Invariant: If key @k1@ -- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,@@ -105,8 +111,8 @@  {-# COMPLETE PatchMapWithMove #-} pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v--- | Extract the representation of the 'PatchMapWithMove' as a map of--- 'NodeInfo'.+-- | Extract the representation of the t'PatchMapWithMove' as a map of+-- t'NodeInfo'. unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v) pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove)) @@ -133,25 +139,27 @@ instance FunctorWithIndex k (PatchMapWithMove k) instance FoldableWithIndex k (PatchMapWithMove k) instance TraversableWithIndex k (PatchMapWithMove k) where-  itraverse = itraversed . Indexed-  itraversed =-    _PatchMapWithMove .>-    itraversed <.-    traverse+  itraverse = (_PatchMapWithMove .> itraversed <. traverse) . Indexed --- | Create a 'PatchMapWithMove', validating it+#if !MIN_VERSION_lens(5,0,0)+instance L.FunctorWithIndex k    (PatchMapWithMove k) where imap = Data.Functor.WithIndex.imap+instance L.FoldableWithIndex k   (PatchMapWithMove k) where ifoldMap = Data.Foldable.WithIndex.ifoldMap+instance L.TraversableWithIndex k (PatchMapWithMove k) where itraverse = Data.Traversable.WithIndex.itraverse+#endif++-- | Create a t'PatchMapWithMove', validating it patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v) patchMapWithMove = fmap PatchMapWithMove' . PM.patchMapWithPatchingMove . coerce --- | Create a 'PatchMapWithMove' that inserts everything in the given 'Map'+-- | Create a t'PatchMapWithMove' that inserts everything in the given 'Map' patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v patchMapWithMoveInsertAll = PatchMapWithMove' . PM.patchMapWithPatchingMoveInsertAll --- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.+-- | Make a @t'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'. insertMapKey :: k -> v -> PatchMapWithMove k v insertMapKey k v = PatchMapWithMove' $ PM.insertMapKey k v --- |Make a @'PatchMapWithMove' k v@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to:+-- |Make a @t'PatchMapWithMove' k v@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to: -- -- @ --     'Map.delete' src (maybe map ('Map.insert' dst) (Map.lookup src map))@@ -159,7 +167,7 @@ moveMapKey :: Ord k => k -> k -> PatchMapWithMove k v moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst --- |Make a @'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:+-- |Make a @t'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to: -- -- @ --     let aMay = Map.lookup a map@@ -171,13 +179,13 @@ swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v swapMapKey src dst = PatchMapWithMove' $ PM.swapMapKey src dst --- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.+-- |Make a @t'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'. deleteMapKey :: k -> PatchMapWithMove k v deleteMapKey = PatchMapWithMove' . PM.deleteMapKey --- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.+-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @t'PatchMapWithMove' k v@, without checking any invariants. ----- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.+-- __Warning:__ when using this function, you must ensure that the invariants of t'PatchMapWithMove' are preserved; they will not be checked. unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v unsafePatchMapWithMove = coerce PM.unsafePatchMapWithPatchingMove @@ -190,17 +198,17 @@ patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v] patchMapWithMoveNewElements = PM.patchMapWithPatchingMoveNewElements . unPatchMapWithMove' --- | Return a @'Map' k v@ with all the inserts/updates from the given @'PatchMapWithMove' k v@.+-- | Return a @'Map' k v@ with all the inserts/updates from the given @t'PatchMapWithMove' k v@. patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v patchMapWithMoveNewElementsMap = PM.patchMapWithPatchingMoveNewElementsMap . unPatchMapWithMove' --- | Create a 'PatchMapWithMove' that, if applied to the given 'Map', will sort+-- | Create a t'PatchMapWithMove' that, if applied to the given 'Map', will sort -- its values using the given ordering function.  The set keys of the 'Map' is -- not changed. patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v patchThatSortsMapWith cmp = PatchMapWithMove' . PM.patchThatSortsMapWith cmp --- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,+-- | Create a t'PatchMapWithMove' that, if applied to the first 'Map' provided, -- will produce a 'Map' with the same values as the second 'Map' but with the -- values sorted with the given ordering function. patchThatChangesAndSortsMapWith :: (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v@@ -208,7 +216,7 @@   where newList = Map.toList newByIndexUnsorted         newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList --- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,+-- | Create a t'PatchMapWithMove' that, if applied to the first 'Map' provided, -- will produce the second 'Map'. patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove k v patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $@@ -254,6 +262,7 @@ instance Traversable (NodeInfo k) where   traverse = bitraverseNodeInfo pure +-- | Like 'Data.Bitraversable.bitraverse' bitraverseNodeInfo   :: Applicative f   => (k0 -> f k1)@@ -263,11 +272,11 @@   . PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv   . coerce --- | Change the 'From' value of a 'NodeInfo'+-- | Change the 'From' value of a t'NodeInfo' nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v nodeInfoMapFrom f = coerce $ PM.nodeInfoMapFrom (unFrom' . f . From') --- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or+-- | Change the 'From' value of a t'NodeInfo', using a 'Functor' (or -- 'Applicative', 'Monad', etc.) action to get the new value nodeInfoMapMFrom   :: Functor f@@ -277,7 +286,7 @@   . PM.nodeInfoMapMFrom (fmap unFrom' . f . From')   . coerce --- | Set the 'To' field of a 'NodeInfo'+-- | Set the 'To' field of a t'NodeInfo' nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v nodeInfoSetTo = coerce . PM.nodeInfoSetTo @@ -302,6 +311,7 @@ pattern From_Move :: k -> From k v pattern From_Move k = From' (PM.From_Move k Proxy) +-- | Like 'Data.Bitraversable.bitraverse' bitraverseFrom   :: Applicative f   => (k0 -> f k1)

@@ -52,7 +52,7 @@  import Data.Patch.Class -import Control.Lens hiding (from, to)+import Control.Lens ((<&>)) import Control.Lens.TH (makeWrapped) import Data.Align (align) import Data.Foldable (toList)

@@ -0,0 +1,80 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{-|+Description: A 'Patch' combinator type for patching or replacing with a separate new value.+-}+module Data.Patch.PatchOrReplacement+  ( PatchOrReplacement (..)+  , _PatchOrReplacement_Patch+  , _PatchOrReplacement_Replacement+  , traversePatchOrReplacement+  ) where++import Control.Lens.TH (makePrisms)+import Data.Patch+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup (Semigroup (..))+#endif+import GHC.Generics++-- | Either a patch or a replacement value.+--+-- A good patch type will describe small changes very efficiently, but+-- that often comes at the cost of describing large change rather+-- inefficiently. 'PatchOrReplacement' can be used as an escape hatch:+-- when the change as a patch would be too big, just provide a new value+-- to replace the old one with instead.+--+-- @since 0.0.6+data PatchOrReplacement p+  = PatchOrReplacement_Patch p+  | PatchOrReplacement_Replacement (PatchTarget p)+  deriving (Generic)++deriving instance (Eq p, Eq (PatchTarget p)) => Eq (PatchOrReplacement p)+deriving instance (Ord p, Ord (PatchTarget p)) => Ord (PatchOrReplacement p)+deriving instance (Show p, Show (PatchTarget p)) => Show (PatchOrReplacement p)+deriving instance (Read p, Read (PatchTarget p)) => Read (PatchOrReplacement p)++-- | Traverse a 'PatchOrReplacement' with a function for each case+traversePatchOrReplacement+  :: Functor f+  => (a -> f b)+  -> (PatchTarget a -> f (PatchTarget b))+  -> PatchOrReplacement a -> f (PatchOrReplacement b)+traversePatchOrReplacement f g = \case+  PatchOrReplacement_Patch p -> PatchOrReplacement_Patch <$> f p+  PatchOrReplacement_Replacement p -> PatchOrReplacement_Replacement <$> g p++-- | To apply a @'PatchOrReplacement' p@ apply the the underlying @p@ or+-- substitute the replacement @'PatchTarget' p@.+instance Patch p => Patch (PatchOrReplacement p) where+  type PatchTarget (PatchOrReplacement p) = PatchTarget p+  apply = \case+    PatchOrReplacement_Patch p -> apply p+    PatchOrReplacement_Replacement v -> \_ -> Just v++instance ( Monoid p+#if !MIN_VERSION_base(4,11,0)+         , Semigroup p+#endif+         , Patch p+         ) => Monoid (PatchOrReplacement p) where+  mempty = PatchOrReplacement_Patch mempty+  mappend = (<>)++instance (Semigroup p, Patch p) => Semigroup (PatchOrReplacement p) where+  (<>) = curry $ \case+    (PatchOrReplacement_Patch a, PatchOrReplacement_Patch b) -> PatchOrReplacement_Patch $ a <> b+    (PatchOrReplacement_Patch a, PatchOrReplacement_Replacement b) -> PatchOrReplacement_Replacement $ applyAlways a b+    (PatchOrReplacement_Replacement a, _) -> PatchOrReplacement_Replacement a++makePrisms ''PatchOrReplacement