diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# 0.0.4.3 + +- Moved all modules from `monoidmap-internal` to main library. + # 0.0.4.2 - Removed the dependency on `nonempty-containers`. diff --git a/components/monoidmap-internal/Data/MonoidMap/Internal.hs b/components/monoidmap-internal/Data/MonoidMap/Internal.hs deleted file mode 100644 --- a/components/monoidmap-internal/Data/MonoidMap/Internal.hs +++ /dev/null @@ -1,3521 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -{-# OPTIONS_GHC -fno-warn-unused-imports #-} -{-# OPTIONS_HADDOCK not-home #-} -{- HLINT ignore "Avoid lambda" -} -{- HLINT ignore "Avoid lambda using `infix`" -} -{- HLINT ignore "Redundant bracket" -} - --- | --- Copyright: © 2022–2025 Jonathan Knowles --- License: Apache-2.0 --- --- Provides /internal/ operations for the 'MonoidMap' type. --- -module Data.MonoidMap.Internal - ( - -- * Types - MonoidMap (..) - , NonNull (..) - - -- * General operations - - -- ** Construction - , empty - , fromList - , fromListWith - , fromMap - , fromMapWith - , fromSet - , singleton - - -- ** Deconstruction - , toList - , toMap - - -- ** Lookup - , get - - -- ** Modification - , set - , adjust - , nullify - - -- ** Membership - , null - , nullKey - , nonNull - , nonNullCount - , nonNullKey - , nonNullKeys - - -- ** Slicing - , take - , drop - , splitAt - - -- ** Filtering - , filter - , filterKeys - , filterWithKey - - -- ** Partitioning - , partition - , partitionKeys - , partitionWithKey - - -- ** Mapping - , map - , mapKeys - , mapKeysWith - , mapWithKey - - -- ** Folding - , foldl - , foldl' - , foldr - , foldr' - , foldlWithKey - , foldlWithKey' - , foldrWithKey - , foldrWithKey' - , foldMapWithKey - , foldMapWithKey' - - -- ** Traversal - , traverse - , traverseWithKey - , mapAccumL - , mapAccumLWithKey - , mapAccumR - , mapAccumRWithKey - - -- * Monoidal operations - - -- ** Association - , append - - -- ** Subtraction - , minus - , minusMaybe - , monus - - -- ** Inversion - , invert - - -- ** Exponentiation - , power - - -- ** Comparison - , isSubmapOf - , isSubmapOfBy - , disjoint - , disjointBy - - -- ** Intersection - , intersection - , intersectionWith - , intersectionWithA - - -- ** Union - , union - , unionWith - , unionWithA - - -- ** Prefixes - , isPrefixOf - , stripPrefix - , commonPrefix - , stripCommonPrefix - - -- ** Suffixes - , isSuffixOf - , stripSuffix - , commonSuffix - , stripCommonSuffix - - -- ** Overlap - , overlap - , stripPrefixOverlap - , stripSuffixOverlap - , stripOverlap - ) - where - -import Prelude hiding - ( drop - , filter - , foldl - , foldl' - , foldr - , lookup - , map - , null - , splitAt - , subtract - , take - , traverse - ) - -import Control.Applicative - ( Applicative (..) ) -import Control.DeepSeq - ( NFData ) -import Data.Bifoldable - ( Bifoldable ) -import Data.Coerce - ( coerce ) -import Data.Function - ( (&) ) -import Data.Functor.Classes - ( Eq1, Eq2, Show1, Show2 ) -import Data.Functor.Identity - ( Identity (..) ) -import Data.Group - ( Abelian, Group ) -import Data.Map.Strict - ( Map, lookup ) -import Data.Maybe - ( fromMaybe, isJust ) -import Data.Monoid.GCD - ( DistributiveGCDMonoid - , GCDMonoid - , LeftDistributiveGCDMonoid - , LeftGCDMonoid - , OverlappingGCDMonoid - , RightDistributiveGCDMonoid - , RightGCDMonoid - ) -import Data.Monoid.LCM - ( DistributiveLCMMonoid, LCMMonoid ) -import Data.Monoid.Monus - ( Monus (..) ) -import Data.Monoid.Null - ( MonoidNull, PositiveMonoid ) -import Data.Semigroup - ( stimes ) -import Data.Semigroup.Cancellative - ( Cancellative - , Commutative - , LeftCancellative - , LeftReductive - , Reductive (..) - , RightCancellative - , RightReductive - ) -import Data.Set - ( Set ) -import GHC.Exts - ( IsList (Item) ) -import NoThunks.Class - ( NoThunks ) -import Text.Read - ( Read (..) ) - -import qualified Data.Bifunctor as B -import qualified Data.Foldable as F -import qualified Data.List as L -import qualified Data.List.NonEmpty as NE -import qualified Data.Map.Merge.Strict as Map -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set -import qualified GHC.Exts as GHC -import qualified Data.Traversable as Traversable - -import qualified Data.Group as C -import qualified Data.Monoid.GCD as C -import qualified Data.Monoid.LCM as C -import qualified Data.Monoid.Null as C -import qualified Data.Semigroup.Cancellative as C - --------------------------------------------------------------------------------- --- Type --------------------------------------------------------------------------------- - -newtype MonoidMap k v = MonoidMap (Map k (NonNull v)) - deriving (Eq, Show, NFData, NoThunks) - via Map k v - deriving (Eq1, Show1, Foldable) - via Map k - deriving (Eq2, Show2, Bifoldable) - via Map - --- Internal alias used when extra brevity is required. -type MM = MonoidMap - --------------------------------------------------------------------------------- --- Non-null values --------------------------------------------------------------------------------- - -newtype NonNull v = UnsafeNonNull {getNonNull :: v} - -maybeNonNull :: MonoidNull v => v -> Maybe (NonNull v) -maybeNonNull !v - | C.null v = Nothing - | otherwise = Just (UnsafeNonNull v) -{-# INLINE maybeNonNull #-} - -applyNonNull :: (v -> a) -> (NonNull v -> a) -applyNonNull = coerce -{-# INLINE applyNonNull #-} - -applyNonNull2 :: (v1 -> v2 -> a) -> (NonNull v1 -> NonNull v2 -> a) -applyNonNull2 = coerce -{-# INLINE applyNonNull2 #-} - --------------------------------------------------------------------------------- --- Instances --------------------------------------------------------------------------------- - -instance (Ord k, MonoidNull v) => - IsList (MonoidMap k v) - where - type Item (MonoidMap k v) = (k, v) - fromList = fromList - toList = toList - -instance (Ord k, Read k, MonoidNull v, Read v) => - Read (MonoidMap k v) - where - readPrec = fromMap <$> readPrec - --------------------------------------------------------------------------------- --- Instances: Semigroup and subclasses --------------------------------------------------------------------------------- - -instance (Ord k, MonoidNull v) => - Semigroup (MonoidMap k v) - where - (<>) = append - stimes 0 = const mempty - stimes 1 = id - stimes n = map (stimes n) - -instance (Ord k, MonoidNull v, Commutative v) => - Commutative (MonoidMap k v) - -instance (Ord k, MonoidNull v, LeftReductive v) => - LeftReductive (MonoidMap k v) - where - isPrefixOf = isPrefixOf - stripPrefix = stripPrefix - -instance (Ord k, MonoidNull v, RightReductive v) => - RightReductive (MonoidMap k v) - where - isSuffixOf = isSuffixOf - stripSuffix = stripSuffix - -instance (Ord k, MonoidNull v, Reductive v) => - Reductive (MonoidMap k v) - where - () = minusMaybe - -instance (Ord k, MonoidNull v, LeftCancellative v) => - LeftCancellative (MonoidMap k v) - -instance (Ord k, MonoidNull v, RightCancellative v) => - RightCancellative (MonoidMap k v) - -instance (Ord k, MonoidNull v, Cancellative v) => - Cancellative (MonoidMap k v) - --------------------------------------------------------------------------------- --- Instances: Monoid and subclasses --------------------------------------------------------------------------------- - -instance (Ord k, MonoidNull v) => - Monoid (MonoidMap k v) - where - mempty = empty - -instance (Ord k, MonoidNull v) => - MonoidNull (MonoidMap k v) - where - null = null - -instance (Ord k, PositiveMonoid v) => - PositiveMonoid (MonoidMap k v) - -instance (Ord k, MonoidNull v, LeftGCDMonoid v) => - LeftGCDMonoid (MonoidMap k v) - where - commonPrefix = commonPrefix - -instance (Ord k, MonoidNull v, LeftDistributiveGCDMonoid v) => - LeftDistributiveGCDMonoid (MonoidMap k v) - -instance (Ord k, MonoidNull v, RightGCDMonoid v) => - RightGCDMonoid (MonoidMap k v) - where - commonSuffix = commonSuffix - -instance (Ord k, MonoidNull v, RightDistributiveGCDMonoid v) => - RightDistributiveGCDMonoid (MonoidMap k v) - -instance (Ord k, MonoidNull v, OverlappingGCDMonoid v) => - OverlappingGCDMonoid (MonoidMap k v) - where - overlap = overlap - stripPrefixOverlap = stripPrefixOverlap - stripSuffixOverlap = stripSuffixOverlap - stripOverlap = stripOverlap - -instance (Ord k, MonoidNull v, GCDMonoid v) => - GCDMonoid (MonoidMap k v) - where - gcd = intersection - -instance (Ord k, MonoidNull v, DistributiveGCDMonoid v) => - DistributiveGCDMonoid (MonoidMap k v) - -instance (Ord k, MonoidNull v, LCMMonoid v) => - LCMMonoid (MonoidMap k v) - where - lcm = union - -instance (Ord k, MonoidNull v, DistributiveLCMMonoid v) => - DistributiveLCMMonoid (MonoidMap k v) - -instance (Ord k, MonoidNull v, Monus v) => - Monus (MonoidMap k v) - where - (<\>) = monus - --------------------------------------------------------------------------------- --- Instances: Group and subclasses --------------------------------------------------------------------------------- - -instance (Ord k, MonoidNull v, Group v) => - Group (MonoidMap k v) - where - invert = invert - (~~) = minus - pow = power - -instance (Ord k, MonoidNull v, Abelian v) => - Abelian (MonoidMap k v) - --------------------------------------------------------------------------------- --- Construction --------------------------------------------------------------------------------- - --- | \(O(1)\). The empty 'MonoidMap'. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k 'empty' '==' 'mempty' --- @ --- --- Provides the definition of 'mempty' for the 'MonoidMap' instance of --- 'Monoid'. --- -empty :: MonoidMap k v -empty = MonoidMap Map.empty - --- | \(O(n \log n)\). Constructs a 'MonoidMap' from a list of key-value pairs. --- --- If the list contains more than one value for the same key, values are --- combined together in the order that they appear with the '(<>)' operator. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('fromList' kvs) '==' --- 'foldMap' 'snd' ('L.filter' (('==' k) . fst) kvs) --- @ --- --- Satisfies the following round-trip property: --- --- @ --- 'fromList' ('toList' m) '==' m --- @ --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> 'fromList' [(1,"a"), (2,"x"), (1,"b"), (2,"y"), (1,"c"), (2,"z")] --- 'fromList' [(1,"abc"), (2,"xyz")] --- @ --- -fromList :: (Ord k, MonoidNull v) => [(k, v)] -> MonoidMap k v -fromList = fromListWith (<>) - --- | \(O(n \log n)\). Constructs a 'MonoidMap' from a list of key-value pairs, --- with a combining function for values. --- --- If the list contains more than one value for the same key, values are --- combined together in the order that they appear with the given combining --- function. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('fromListWith' f kvs) '==' --- 'maybe' 'mempty' ('F.foldl1' f) --- ('NE.nonEmpty' ('snd' '<$>' 'L.filter' (('==' k) . fst) kvs)) --- @ --- -fromListWith - :: (Ord k, MonoidNull v) - => (v -> v -> v) - -- ^ Function with which to combine values for duplicate keys. - -> [(k, v)] - -> MonoidMap k v -fromListWith f = - -- The 'Map.fromListWith' function combines values for duplicate keys in - -- /reverse order/, so we must flip the provided combining function. - fromMap . Map.fromListWith (flip f) - --- | \(O(n)\). Constructs a 'MonoidMap' from an ordinary 'Map'. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('fromMap' m) '==' 'Map'.'Map.findWithDefault' 'mempty' k m --- @ --- --- This function performs canonicalisation of 'C.null' values, and has a time --- complexity that is linear in the size of the map. --- -fromMap :: MonoidNull v => Map k v -> MonoidMap k v -fromMap = MonoidMap . Map.mapMaybe maybeNonNull - --- | \(O(n)\). Constructs a 'MonoidMap' from an ordinary 'Map', applying --- the given function to all values. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('fromMapWith' f m) '==' 'maybe' 'mempty' f ('Map'.'Map.lookup' k m) --- @ --- --- This function performs canonicalisation of 'C.null' values, and has a time --- complexity that is linear in the size of the map. --- --- @since 0.0.4.0 --- -fromMapWith :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> MonoidMap k v2 -fromMapWith f = MonoidMap . Map.mapMaybe (maybeNonNull . f) - --- | \(O(n)\). Constructs a 'MonoidMap' from a 'Set' and a function from --- keys to values. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('fromSet' f ks) '==' --- if 'Set'.'Set.member' k ks --- then f k --- else 'mempty' --- @ --- --- This function performs canonicalisation of 'C.null' values, and has a time --- complexity that is linear in the 'Set.size' of the set. --- --- @since 0.0.2.0 --- -fromSet :: MonoidNull v => (k -> v) -> Set k -> MonoidMap k v -fromSet f = fromMap . Map.fromSet f - --- | \(O(1)\). Constructs a 'MonoidMap' from a single key-value pair. --- --- Satisfies the following property: --- --- @ --- 'get' k ('singleton' k v) '==' v --- @ --- --- Nullifying the value for key __@k@__ produces an 'empty' map: --- --- @ --- 'nullify' k ('singleton' k v) '==' 'empty' --- @ --- -singleton :: (Ord k, MonoidNull v) => k -> v -> MonoidMap k v -singleton k v = set k v mempty - --------------------------------------------------------------------------------- --- Deconstruction --------------------------------------------------------------------------------- - --- | \(O(n)\). Converts a 'MonoidMap' to a list of key-value pairs, where the --- keys are in ascending order. --- --- The result only includes entries with values that are not 'C.null'. --- --- Satisfies the following round-trip property: --- --- @ --- 'fromList' ('toList' m) '==' m --- @ --- --- The resulting list is sorted in ascending key order: --- --- @ --- 'L.sortOn' 'fst' ('toList' m) '==' 'toList' m --- @ --- -toList :: MonoidMap k v -> [(k, v)] -toList = Map.toAscList . toMap - --- | \(O(1)\). Converts a 'MonoidMap' to an ordinary 'Map'. --- --- The result only includes entries with values that are not 'C.null'. --- --- Satisfies the following round-trip property: --- --- @ --- 'fromMap' ('toMap' m) '==' m --- @ --- -toMap :: forall k v. MonoidMap k v -> Map k v -toMap = coerce - --------------------------------------------------------------------------------- --- Lookup --------------------------------------------------------------------------------- - --- | \(O(\log n)\). Gets the value associated with the given key. --- --- By default, every key in an 'empty' map is associated with a value of --- 'mempty': --- --- @ --- ∀ k. 'get' k 'empty' '==' 'mempty' --- @ --- -get :: (Ord k, Monoid v) => k -> MonoidMap k v -> v -get k m = fromMaybe mempty $ Map.lookup k $ toMap m - --------------------------------------------------------------------------------- --- Modification --------------------------------------------------------------------------------- - --- | \(O(\log n)\). Sets the value associated with the given key. --- --- Satisfies the following property: --- --- @ --- 'get' k ('set' k v m) '==' v --- @ --- -set :: (Ord k, MonoidNull v) => k -> v -> MonoidMap k v -> MonoidMap k v -set k v (MonoidMap m) = MonoidMap $ case maybeNonNull v of - Just v0 -> Map.insert k v0 m - Nothing -> Map.delete k m - --- | \(O(\log n)\). Adjusts the value associated with the given key. --- --- Satisfies the following property: --- --- @ --- 'adjust' f k m '==' 'set' k (f ('get' k m)) m --- @ --- -adjust - :: (Ord k, MonoidNull v) - => (v -> v) - -> k - -> MonoidMap k v - -> MonoidMap k v -adjust f k (MonoidMap m) = MonoidMap $ - Map.alter (maybeNonNull . maybe (f mempty) (applyNonNull f)) k m - --- | \(O(\log n)\). Sets the value associated with the given key to 'mempty'. --- --- Satisfies the following property: --- --- @ --- 'get' k ('nullify' k m) '==' 'mempty' --- @ --- -nullify :: Ord k => k -> MonoidMap k v -> MonoidMap k v -nullify k (MonoidMap m) = MonoidMap $ Map.delete k m - --------------------------------------------------------------------------------- --- Membership --------------------------------------------------------------------------------- - --- | \(O(1)\). Returns 'True' if (and only if) all values in the map are --- 'C.null'. --- --- Satisfies the following property: --- --- @ --- 'null' m '==' (∀ k. 'nullKey' k m) --- @ --- --- Provides the definition of 'C.null' for the 'MonoidMap' instance of --- 'MonoidNull'. --- -null :: MonoidMap k v -> Bool -null = Map.null . toMap - --- | \(O(\log n)\). Returns 'True' if (and only if) the given key is associated --- with a value that is 'C.null'. --- --- Satisfies the following property: --- --- @ --- 'nullKey' k m '==' 'C.null' ('get' k m) --- @ --- -nullKey :: Ord k => k -> MonoidMap k v -> Bool -nullKey k = Map.notMember k . toMap - --- | \(O(1)\). Returns 'True' if (and only if) the map contains at least one --- value that is not 'C.null'. --- --- Satisfies the following property: --- --- @ --- 'nonNull' m '==' (∃ k. 'nonNullKey' k m) --- @ --- -nonNull :: MonoidMap k v -> Bool -nonNull = not . null - --- | \(O(1)\). Returns a count of all values in the map that are not 'C.null'. --- --- Satisfies the following property: --- --- @ --- 'nonNullCount' m '==' 'Set.size' ('nonNullKeys' m) --- @ --- -nonNullCount :: MonoidMap k v -> Int -nonNullCount = Map.size . toMap - --- | \(O(\log n)\). Returns 'True' if (and only if) the given key is associated --- with a value that is not 'C.null'. --- --- Satisfies the following property: --- --- @ --- 'nonNullKey' k m '==' 'not' ('C.null' ('get' k m)) --- @ --- -nonNullKey :: Ord k => k -> MonoidMap k v -> Bool -nonNullKey k = Map.member k . toMap - --- | \(O(n)\). Returns the set of keys associated with values that are not --- 'C.null'. --- --- Satisfies the following property: --- --- @ --- k '`Set.member`' ('nonNullKeys' m) '==' 'nonNullKey' k m --- @ --- -nonNullKeys :: MonoidMap k v -> Set k -nonNullKeys = Map.keysSet . toMap - --------------------------------------------------------------------------------- --- Slicing --------------------------------------------------------------------------------- - --- | \(O(\log n)\). /Takes/ a slice from a map. --- --- This function takes a given number of non-'C.null' entries from a map, --- producing a new map from the entries that were /taken/. --- --- Entries are taken in /key order/, beginning with the /smallest/ keys. --- --- Satifies the following property: --- --- @ --- 'take' n '==' 'fromList' . 'Prelude.take' n . 'toList' --- @ --- -take :: Int -> MonoidMap k v -> MonoidMap k v -take i (MonoidMap m) = MonoidMap (Map.take i m) - --- | \(O(\log n)\). /Drops/ a slice from a map. --- --- This function drops a given number of non-'C.null' entries from a map, --- producing a new map from the entries that /remain/. --- --- Entries are dropped in /key order/, beginning with the /smallest/ keys. --- --- Satifies the following property: --- --- @ --- 'drop' n '==' 'fromList' . 'Prelude.drop' n . 'toList' --- @ --- -drop :: Int -> MonoidMap k v -> MonoidMap k v -drop i (MonoidMap m) = MonoidMap (Map.drop i m) - --- | \(O(\log n)\). /Splits/ a map into /two/ slices. --- --- This function is equivalent to a combination of 'take' and 'drop': --- --- @ --- 'splitAt' n m '==' ('take' n m, 'drop' n m) --- @ --- --- The resulting maps can be combined to reproduce the original map: --- --- @ --- 'splitAt' n m '&' --- \\(m1, m2) -> m1 '<>' m2 '==' m --- @ --- --- The resulting maps have disjoint sets of non-'C.null' entries: --- --- @ --- 'splitAt' n m '&' --- \\(m1, m2) -> 'Set.disjoint' ('nonNullKeys' m1) ('nonNullKeys' m2) --- @ --- -splitAt :: Int -> MonoidMap k a -> (MonoidMap k a, MonoidMap k a) -splitAt i m = (take i m, drop i m) - --------------------------------------------------------------------------------- --- Filtering --------------------------------------------------------------------------------- - --- | \(O(n)\). Filters a map according to a predicate on /values/. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('filter' f m) '==' --- if f ('get' k m) --- then 'get' k m --- else 'mempty' --- @ --- --- The resulting map is identical to that obtained by constructing a map from a --- filtered list of key-value pairs: --- --- @ --- 'filter' f m '==' 'fromList' ('L.filter' (f . 'snd') ('toList' m)) --- @ --- -filter :: (v -> Bool) -> MonoidMap k v -> MonoidMap k v -filter f (MonoidMap m) = MonoidMap $ Map.filter (applyNonNull f) m - --- | \(O(n)\). Filters a map according to a predicate on /keys/. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('filterKeys' f m) '==' --- if f k --- then 'get' k m --- else 'mempty' --- @ --- --- The resulting map is identical to that obtained by constructing a map from a --- filtered list of key-value pairs: --- --- @ --- 'filter' f m '==' 'fromList' ('L.filter' (f . 'fst') ('toList' m)) --- @ --- -filterKeys :: (k -> Bool) -> MonoidMap k v -> MonoidMap k v -filterKeys f (MonoidMap m) = MonoidMap $ Map.filterWithKey (\k _ -> f k) m - --- | \(O(n)\). Filters a map according to a predicate on /keys and values/. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('filterWithKey' f m) '==' --- if f k ('get' k m) --- then 'get' k m --- else 'mempty' --- @ --- --- The resulting map is identical to that obtained by constructing a map from a --- filtered list of key-value pairs: --- --- @ --- 'filterWithKey' f m '==' 'fromList' ('L.filter' ('uncurry' f) ('toList' m)) --- @ --- -filterWithKey :: (k -> v -> Bool) -> MonoidMap k v -> MonoidMap k v -filterWithKey f (MonoidMap m) = - MonoidMap $ Map.filterWithKey (applyNonNull . f) m - --------------------------------------------------------------------------------- --- Partitioning --------------------------------------------------------------------------------- - --- | \(O(n)\). Partitions a map according to a predicate on /values/. --- --- Satisfies the following property: --- --- @ --- 'partition' f m '==' --- ( 'filter' \ \ f m --- , 'filter' ('not' . f) m --- ) --- @ --- --- The resulting maps can be combined to reproduce the original map: --- --- @ --- 'partition' f m '&' \\(m1, m2) -> --- m1 '<>' m2 '==' m --- @ --- --- The resulting maps have disjoint sets of non-'C.null' entries: --- --- @ --- 'partition' f m '&' \\(m1, m2) -> --- 'Set.disjoint' --- ('nonNullKeys' m1) --- ('nonNullKeys' m2) --- @ --- -partition :: (v -> Bool) -> MonoidMap k v -> (MonoidMap k v, MonoidMap k v) -partition f (MonoidMap m) = - B.bimap MonoidMap MonoidMap $ Map.partition (applyNonNull f) m - --- | \(O(n)\). Partitions a map according to a predicate on /keys/. --- --- Satisfies the following property: --- --- @ --- 'partitionKeys' f m '==' --- ( 'filterKeys' \ \ f m --- , 'filterKeys' ('not' . f) m --- ) --- @ --- --- The resulting maps can be combined to reproduce the original map: --- --- @ --- 'partitionKeys' f m '&' \\(m1, m2) -> --- m1 '<>' m2 '==' m --- @ --- --- The resulting maps have disjoint sets of non-'C.null' entries: --- --- @ --- 'partitionKeys' f m '&' \\(m1, m2) -> --- 'Set.disjoint' --- ('nonNullKeys' m1) --- ('nonNullKeys' m2) --- @ --- -partitionKeys - :: (k -> Bool) -> MonoidMap k v -> (MonoidMap k v, MonoidMap k v) -partitionKeys f (MonoidMap m) = - B.bimap MonoidMap MonoidMap $ Map.partitionWithKey (\k _ -> f k) m - --- | \(O(n)\). Partitions a map according to a predicate on /keys and values/. --- --- Satisfies the following property: --- --- @ --- 'partitionWithKey' f m '==' --- ( 'filterWithKey' \ \ \ \ \ \ f m --- , 'filterWithKey' (('fmap' . 'fmap') 'not' f) m --- ) --- @ --- --- The resulting maps can be combined to reproduce the original map: --- --- @ --- 'partitionWithKey' f m '&' \\(m1, m2) -> --- m1 '<>' m2 '==' m --- @ --- --- The resulting maps have disjoint sets of non-'C.null' entries: --- --- @ --- 'partitionWithKey' f m '&' \\(m1, m2) -> --- 'Set.disjoint' --- ('nonNullKeys' m1) --- ('nonNullKeys' m2) --- @ --- -partitionWithKey - :: (k -> v -> Bool) -> MonoidMap k v -> (MonoidMap k v, MonoidMap k v) -partitionWithKey f (MonoidMap m) = - B.bimap MonoidMap MonoidMap $ Map.partitionWithKey (applyNonNull . f) m - --------------------------------------------------------------------------------- --- Mapping --------------------------------------------------------------------------------- - --- | \(O(n)\). Applies a function to all non-'C.null' values of a 'MonoidMap'. --- --- Satisfies the following properties for all functions __@f@__: --- --- @ --- ('get' k m '==' 'mempty') ==> ('get' k ('map' f m) '==' 'mempty' ) --- ('get' k m '/=' 'mempty') ==> ('get' k ('map' f m) '==' f ('get' k m)) --- @ --- --- === Conditional properties --- --- If applying function __@f@__ to 'mempty' produces 'mempty', then the --- following additional properties hold: --- --- @ --- (f 'mempty' '==' 'mempty') --- ==> --- (∀ k. 'get' k ('map' f m) '==' f ('get' k m)) --- @ --- --- @ --- (f 'mempty' '==' 'mempty') --- ==> --- (∀ g. 'map' (f . g) m '==' 'map' f ('map' g m)) --- @ --- -map - :: MonoidNull v2 - => (v1 -> v2) - -> MonoidMap k v1 - -> MonoidMap k v2 -map f (MonoidMap m) = - MonoidMap $ Map.mapMaybe (maybeNonNull . applyNonNull f) m - --- | \(O(n \log n)\). Applies a function to all the keys of a 'MonoidMap' that --- are associated with non-'C.null' values. --- --- If the resultant map would contain more than one value for the same key, --- values are combined together in ascending key order with the '(<>)' --- operator. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('mapKeys' f m) '==' --- 'F.foldMap' --- ('`get`' m) --- ('Set.filter' (('==') k . f) ('nonNullKeys' m)) --- @ --- -mapKeys - :: (Ord k2, MonoidNull v) - => (k1 -> k2) - -> MonoidMap k1 v - -> MonoidMap k2 v -mapKeys = mapKeysWith (<>) - --- | \(O(n \log n)\). Applies a function to all the keys of a 'MonoidMap' that --- are associated with non-'C.null' values, with a combining function for --- values. --- --- If the resultant map would contain more than one value for the same key, --- values are combined together in ascending key order with the given --- combining function. --- --- Satisfies the following property: --- --- @ --- 'mapKeysWith' c f '==' 'fromListWith' c . 'fmap' ('B.first' f) . 'toList' --- @ --- -mapKeysWith - :: (Ord k2, MonoidNull v) - => (v -> v -> v) - -- ^ Function with which to combine values for duplicate keys. - -> (k1 -> k2) - -> MonoidMap k1 v - -> MonoidMap k2 v -mapKeysWith combine fk = fromListWith combine . fmap (B.first fk) . toList - --- | \(O(n)\). Applies a key-dependent function to all non-'C.null' values of --- a 'MonoidMap'. --- --- Satisfies the following properties for all functions __@f@__: --- --- @ --- ('nonNullKey' k m) ==> ('get' k ('mapWithKey' f m) '==' f k ('get' k m)) --- ( 'nullKey' k m) ==> ('get' k ('mapWithKey' f m) '==' 'mempty' ) --- @ --- --- @since 0.0.3.0 --- -mapWithKey - :: MonoidNull v2 - => (k -> v1 -> v2) - -> MonoidMap k v1 - -> MonoidMap k v2 -mapWithKey f (MonoidMap m) = - MonoidMap . runIdentity $ - Map.traverseMaybeWithKey - (\k v -> Identity $ maybeNonNull $ applyNonNull (f k) v) m - --------------------------------------------------------------------------------- --- Lazy folding --------------------------------------------------------------------------------- - --- | \(O(n)\). Folds over the values in the map using the given --- left-associative binary operator. --- --- Satisfies the following property: --- --- @ --- 'foldl' f r m '==' 'Map'.'Map.foldl' f r ('toMap' m) --- @ --- --- @since 0.0.1.7 --- -foldl :: (r -> v -> r) -> r -> MonoidMap k v -> r -foldl = - (coerce - :: ((r -> v -> r) -> r -> Map k v -> r) - -> ((r -> v -> r) -> r -> MonoidMap k v -> r) - ) - Map.foldl -{-# INLINE foldl #-} - --- | \(O(n)\). Folds over the values in the map using the given --- right-associative binary operator. --- --- Satisfies the following property: --- --- @ --- 'foldr' f r m '==' 'Map'.'Map.foldr' f r ('toMap' m) --- @ --- --- @since 0.0.1.7 --- -foldr :: (v -> r -> r) -> r -> MonoidMap k v -> r -foldr = - (coerce - :: ((v -> r -> r) -> r -> Map k v -> r) - -> ((v -> r -> r) -> r -> MonoidMap k v -> r) - ) - Map.foldr -{-# INLINE foldr #-} - --- | \(O(n)\). Folds over the keys and values in the map using the given --- left-associative binary operator. --- --- Satisfies the following property: --- --- @ --- 'foldlWithKey' f r m '==' 'Map'.'Map.foldlWithKey' f r ('toMap' m) --- @ --- --- @since 0.0.1.7 --- -foldlWithKey :: (r -> k -> v -> r) -> r -> MonoidMap k v -> r -foldlWithKey = - (coerce - :: ((r -> k -> v -> r) -> r -> Map k v -> r) - -> ((r -> k -> v -> r) -> r -> MonoidMap k v -> r) - ) - Map.foldlWithKey -{-# INLINE foldlWithKey #-} - --- | \(O(n)\). Folds over the keys and values in the map using the given --- right-associative binary operator. --- --- Satisfies the following property: --- --- @ --- 'foldrWithKey' f r m '==' 'Map'.'Map.foldrWithKey' f r ('toMap' m) --- @ --- --- @since 0.0.1.7 --- -foldrWithKey :: (k -> v -> r -> r) -> r -> MonoidMap k v -> r -foldrWithKey = - (coerce - :: ((k -> v -> r -> r) -> r -> Map k v -> r) - -> ((k -> v -> r -> r) -> r -> MonoidMap k v -> r) - ) - Map.foldrWithKey -{-# INLINE foldrWithKey #-} - --- | \(O(n)\). Folds over the keys and values in the map using the given --- monoid. --- --- Satisfies the following property: --- --- @ --- 'foldMapWithKey' f m '==' 'Map'.'Map.foldMapWithKey' f ('toMap' m) --- @ --- --- @since 0.0.1.7 --- -foldMapWithKey :: Monoid r => (k -> v -> r) -> MonoidMap k v -> r -foldMapWithKey = - (coerce - :: ((k -> v -> r) -> Map k v -> r) - -> ((k -> v -> r) -> MonoidMap k v -> r) - ) - Map.foldMapWithKey -{-# INLINE foldMapWithKey #-} - --------------------------------------------------------------------------------- --- Strict folding --------------------------------------------------------------------------------- - --- | \(O(n)\). A strict version of 'foldl'. --- --- Each application of the operator is evaluated before using the result in the --- next application. This function is strict in the starting value. --- --- @since 0.0.1.7 --- -foldl' :: (r -> v -> r) -> r -> MonoidMap k v -> r -foldl' = - (coerce - :: ((r -> v -> r) -> r -> Map k v -> r) - -> ((r -> v -> r) -> r -> MonoidMap k v -> r) - ) - Map.foldl' -{-# INLINE foldl' #-} - --- | \(O(n)\). A strict version of 'foldr'. --- --- Each application of the operator is evaluated before using the result in the --- next application. This function is strict in the starting value. --- --- @since 0.0.1.7 --- -foldr' :: (v -> r -> r) -> r -> MonoidMap k v -> r -foldr' = - (coerce - :: ((v -> r -> r) -> r -> Map k v -> r) - -> ((v -> r -> r) -> r -> MonoidMap k v -> r) - ) - Map.foldr' -{-# INLINE foldr' #-} - --- | \(O(n)\). A strict version of 'foldlWithKey'. --- --- Each application of the operator is evaluated before using the result in the --- next application. This function is strict in the starting value. --- --- @since 0.0.1.7 --- -foldlWithKey' :: (r -> k -> v -> r) -> r -> MonoidMap k v -> r -foldlWithKey' = - (coerce - :: ((r -> k -> v -> r) -> r -> Map k v -> r) - -> ((r -> k -> v -> r) -> r -> MonoidMap k v -> r) - ) - Map.foldlWithKey' -{-# INLINE foldlWithKey' #-} - --- | \(O(n)\). A strict version of 'foldrWithKey'. --- --- Each application of the operator is evaluated before using the result in the --- next application. This function is strict in the starting value. --- --- @since 0.0.1.7 --- -foldrWithKey' :: (k -> v -> r -> r) -> r -> MonoidMap k v -> r -foldrWithKey' = - (coerce - :: ((k -> v -> r -> r) -> r -> Map k v -> r) - -> ((k -> v -> r -> r) -> r -> MonoidMap k v -> r) - ) - Map.foldrWithKey' -{-# INLINE foldrWithKey' #-} - --- | \(O(n)\). A strict version of 'foldMapWithKey'. --- --- Each application of `mappend` is evaluated before using the result in the --- next application. --- --- @since 0.0.1.8 --- -foldMapWithKey' :: Monoid r => (k -> v -> r) -> MonoidMap k v -> r -foldMapWithKey' f = foldlWithKey' (\r k v -> r <> f k v) mempty -{-# INLINE foldMapWithKey' #-} - --------------------------------------------------------------------------------- --- Traversal --------------------------------------------------------------------------------- - --- | \(O(n)\). Traverses over the values of a map using the given function. --- --- Satisfies the following property: --- --- @ --- 'traverse' f m '==' --- 'fmap' 'fromMap' ('Traversable'.'Traversable.traverse' f ('toMap' m)) --- @ --- --- @since 0.0.1.9 --- -traverse - :: Applicative t - => MonoidNull v2 - => (v1 -> t v2) - -> MonoidMap k v1 - -> t (MonoidMap k v2) -traverse f = traverseWithKey (const f) -{-# INLINE traverse #-} - --- | \(O(n)\). Traverses over the keys and values of a map using the given --- function. --- --- Satisfies the following property: --- --- @ --- 'traverseWithKey' f m '==' --- 'fmap' 'fromMap' ('Map'.'Map.traverseWithKey' f ('toMap' m)) --- @ --- --- @since 0.0.1.9 --- -traverseWithKey - :: Applicative t - => MonoidNull v2 - => (k -> v1 -> t v2) - -> MonoidMap k v1 - -> t (MonoidMap k v2) -traverseWithKey f (MonoidMap m) = - MonoidMap <$> - Map.traverseMaybeWithKey - (\k v -> maybeNonNull <$> applyNonNull (f k) v) m -{-# INLINE traverseWithKey #-} - --- | \(O(n)\). Threads an accumulating argument through the map in ascending --- order of keys. --- --- Satisfies the following property: --- --- @ --- 'mapAccumL' f s m '==' --- 'fmap' 'fromMap' ('Traversable'.'Traversable.mapAccumL' f s ('toMap' m)) --- @ --- --- @since 0.0.1.9 --- -mapAccumL - :: MonoidNull v2 - => (s -> v1 -> (s, v2)) - -> s - -> MonoidMap k v1 - -> (s, MonoidMap k v2) -mapAccumL f s m = - (coerce - :: ((v1 -> StateL s v2 ) -> MM k v1 -> StateL s (MM k v2)) - -> ((v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2)) - ) - traverse (flip f) m s -{-# INLINE mapAccumL #-} - --- | \(O(n)\). Threads an accumulating argument through the map in descending --- order of keys. --- --- Satisfies the following property: --- --- @ --- 'mapAccumR' f s m '==' --- 'fmap' 'fromMap' ('Traversable'.'Traversable.mapAccumR' f s ('toMap' m)) --- @ --- --- @since 0.0.1.9 --- -mapAccumR - :: MonoidNull v2 - => (s -> v1 -> (s, v2)) - -> s - -> MonoidMap k v1 - -> (s, MonoidMap k v2) -mapAccumR f s m = - (coerce - :: ((v1 -> StateR s v2 ) -> MM k v1 -> StateR s (MM k v2)) - -> ((v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2)) - ) - traverse (flip f) m s -{-# INLINE mapAccumR #-} - --- | \(O(n)\). Threads an accumulating argument through the map in ascending --- order of keys. --- --- Satisfies the following property: --- --- @ --- 'mapAccumLWithKey' f s m '==' --- 'fmap' 'fromMap' ('Map'.'Map.mapAccumWithKey' f s ('toMap' m)) --- @ --- --- @since 0.0.1.9 --- -mapAccumLWithKey - :: MonoidNull v2 - => (s -> k -> v1 -> (s, v2)) - -> s - -> MonoidMap k v1 - -> (s, MonoidMap k v2) -mapAccumLWithKey f s0 m = - (coerce - :: ((k -> v1 -> StateL s v2 ) -> MM k v1 -> StateL s (MM k v2)) - -> ((k -> v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2)) - ) - traverseWithKey (\k v1 s -> f s k v1) m s0 -{-# INLINE mapAccumLWithKey #-} - --- | \(O(n)\). Threads an accumulating argument through the map in descending --- order of keys. --- --- Satisfies the following property: --- --- @ --- 'mapAccumRWithKey' f s m '==' --- 'fmap' 'fromMap' ('Map'.'Map.mapAccumRWithKey' f s ('toMap' m)) --- @ --- --- @since 0.0.1.9 --- -mapAccumRWithKey - :: MonoidNull v2 - => (s -> k -> v1 -> (s, v2)) - -> s - -> MonoidMap k v1 - -> (s, MonoidMap k v2) -mapAccumRWithKey f s0 m = - (coerce - :: ((k -> v1 -> StateR s v2 ) -> MM k v1 -> StateR s (MM k v2)) - -> ((k -> v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2)) - ) - traverseWithKey (\k v1 s -> f s k v1) m s0 -{-# INLINE mapAccumRWithKey #-} - --------------------------------------------------------------------------------- --- Comparison --------------------------------------------------------------------------------- - --- | Indicates whether or not the first map is a /submap/ of the second. --- --- Map __@m1@__ is a submap of map __@m2@__ if (and only if) __@m1@__ can be --- subtracted from __@m2@__ with the 'minusMaybe' operation: --- --- @ --- m1 '`isSubmapOf`' m2 '==' 'isJust' (m2 '`minusMaybe`' m1) --- @ --- --- Equivalently, map __@m1@__ is a submap of map __@m2@__ if (and only if) for --- all possible keys __@k@__, the value for __@k@__ in __@m1@__ can be --- subtracted from the value for __@k@__ in __@m2@__ with the '()' operator: --- --- @ --- m1 '`isSubmapOf`' m2 '==' (∀ k. 'isJust' ('get' k m2 '' 'get' k m1)) --- @ --- -isSubmapOf - :: (Ord k, Monoid v, Reductive v) - => MonoidMap k v - -> MonoidMap k v - -> Bool -isSubmapOf = isSubmapOfBy $ \v1 v2 -> isJust (v2 v1) -{-# INLINE isSubmapOf #-} - --- | Indicates whether or not the first map is a /submap/ of the second, using --- the given function to compare values for matching keys. --- --- Satisfies the following property: --- --- @ --- 'isSubmapOfBy' f m1 m2 '==' --- 'all' (\\k -> f ('get' k m1) ('get' k m2)) ('nonNullKeys' m1) --- @ --- --- === Conditional totality --- --- /If/ the given comparison function __@f@__ /always/ evaluates to 'True' --- when its first argument is 'mempty': --- --- @ --- ∀ v. f 'mempty' v --- @ --- --- /Then/ the following property holds: --- --- @ --- 'isSubmapOfBy' f m1 m2 '==' (∀ k. f ('get' k m1) ('get' k m2)) --- @ --- -isSubmapOfBy - :: (Ord k, Monoid v1, Monoid v2) - => (v1 -> v2 -> Bool) - -- ^ Function with which to compare values for matching keys. - -> MonoidMap k v1 - -> MonoidMap k v2 - -> Bool -isSubmapOfBy leq m1 m2 = - all - (\k -> get k m1 `leq` get k m2) - (nonNullKeys m1) -{-# INLINE isSubmapOfBy #-} - --- | Indicates whether or not a pair of maps are /disjoint/. --- --- Maps __@m1@__ and __@m2@__ are disjoint if (and only if) their intersection --- is empty: --- --- @ --- 'disjoint' m1 m2 '==' ('intersection' m1 m2 '==' 'mempty') --- @ --- --- Equivalently, maps __@m1@__ and __@m2@__ are disjoint if (and only if) for --- all possible keys __@k@__, the values for __@k@__ in __@m1@__ and __@m2@__ --- have a 'C.gcd' that is 'C.null': --- --- @ --- 'disjoint' m1 m2 '==' (∀ k. 'C.null' ('C.gcd' ('get' k m1) ('get' k m2))) --- @ --- -disjoint - :: (Ord k, GCDMonoid v, MonoidNull v) - => MonoidMap k v - -> MonoidMap k v - -> Bool -disjoint = disjointBy (\v1 v2 -> C.null (C.gcd v1 v2)) -{-# INLINE disjoint #-} - --- | Indicates whether or not a pair of maps are /disjoint/ using the given --- indicator function to test pairs of values for matching keys. --- --- Satisfies the following property: --- --- @ --- 'disjointBy' f m1 m2 '==' --- 'all' --- (\\k -> f ('get' k m1) ('get' k m2)) --- ('Set.intersection' ('nonNullKeys' m1) ('nonNullKeys' m2)) --- @ --- --- === Conditional totality --- --- /If/ the given indicator function __@f@__ /always/ evaluates to 'True' --- when /either/ or /both/ of its arguments are 'mempty': --- --- @ --- ∀ v. (f v 'mempty') '&&' (f 'mempty' v) --- @ --- --- /Then/ the following property holds: --- --- @ --- 'disjointBy' f m1 m2 '==' (∀ k. f ('get' k m1) ('get' k m2)) --- @ --- -disjointBy - :: (Ord k, Monoid v1, Monoid v2) - => (v1 -> v2 -> Bool) - -- ^ Function with which to test pairs of values for matching keys. - -> MonoidMap k v1 - -> MonoidMap k v2 - -> Bool -disjointBy f m1 m2 = - all - (\k -> f (get k m1) (get k m2)) - (Set.intersection (nonNullKeys m1) (nonNullKeys m2)) -{-# INLINE disjointBy #-} - --------------------------------------------------------------------------------- --- Association --------------------------------------------------------------------------------- - --- | Appends a pair of maps together. --- --- Uses the 'Semigroup' operator '(<>)' to append each value in the first map --- to its matching value in the second map. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('append' m1 m2) '==' 'get' k m1 '<>' 'get' k m2 --- @ --- --- This function provides the definition of '(<>)' for the 'MonoidMap' instance --- of 'Semigroup'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> m1 = 'fromList' [(1, "abc"), (2, "ij" ), (3, "p" ) ] --- >>> m2 = 'fromList' [ (2, " k"), (3, "qr"), (4, "xyz")] --- >>> m3 = 'fromList' [(1, "abc"), (2, "ijk"), (3, "pqr"), (4, "xyz")] --- @ --- @ --- >>> 'append' m1 m2 '==' m3 --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 4), ("b", 2), ("c", 1) ] --- >>> m2 = 'fromList' [ ("b", 1), ("c", 2), ("d", 4)] --- >>> m3 = 'fromList' [("a", 4), ("b", 3), ("c", 3), ("d", 4)] --- @ --- @ --- >>> 'append' m1 m2 '==' m3 --- 'True' --- @ --- -append - :: (Ord k, MonoidNull v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -append = merge MergeStrategy - { withNonNullL = - keepNonNull - -- Justification: - -- - -- v <> mempty ≡ v - - , withNonNullR = - keepNonNull - -- Justification: - -- - -- mempty <> v ≡ v - - , withNonNullP = - withBoth (<>) - } -{-# INLINE append #-} - --------------------------------------------------------------------------------- --- Prefixes and suffixes --------------------------------------------------------------------------------- - --- | Indicates whether or not the first map is a /prefix/ of the second. --- --- 'MonoidMap' __@m1@__ is a /prefix/ of 'MonoidMap' __@m2@__ if (and only if) --- for all possible keys __@k@__, the value for __@k@__ in __@m1@__ is a --- /prefix/ of the value for __@k@__ in __@m2@__: --- --- @ --- m1 '`isPrefixOf`' m2 '==' (∀ k. 'get' k m1 '`C.isPrefixOf`' 'get' k m2) --- @ --- --- This function provides the definition of 'C.isPrefixOf' for the 'MonoidMap' --- instance of 'LeftReductive'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> m1 = 'fromList' [(1, "a" ), (2, "p" ), (3, "x" )] --- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")] --- >>> m1 '`isPrefixOf`' m2 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [ (2, "p" ) ] --- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")] --- >>> m1 '`isPrefixOf`' m2 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [(1, "abc"), (2, "p" ), (3, "x" )] --- >>> m2 = 'fromList' [(1, "a" ), (2, "pqr"), (3, "xyz")] --- >>> m1 '`isPrefixOf`' m2 --- 'False' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 1), ("b", 1), ("c", 1)] --- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)] --- >>> m1 '`isPrefixOf`' m2 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [ ("b", 1) ] --- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)] --- >>> m1 '`isPrefixOf`' m2 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", 2), ("b", 1), ("c", 1)] --- >>> m2 = 'fromList' [("a", 1), ("b", 4), ("c", 8)] --- >>> m1 '`isPrefixOf`' m2 --- 'False' --- @ --- -isPrefixOf - :: (Ord k, Monoid v, LeftReductive v) - => MonoidMap k v - -> MonoidMap k v - -> Bool -isPrefixOf = isSubmapOfBy C.isPrefixOf - -- Note that in practice, it's sufficient to check the following property: - -- - -- @ - -- m1 '`isPrefixOf`' m2 '==' - -- 'all' - -- (\\k -> 'get' k m1 '`C.isPrefixOf`' 'get' k m2) - -- ('nonNullKeys' m1) - -- @ - -- - -- ==== Justification - -- - -- According to the laws for 'LeftReductive': - -- - -- @ - -- ∀ a b. b '`C.isPrefixOf`' (b '<>' a) - -- @ - -- - -- Substituting 'mempty' for @b@: - -- - -- @ - -- ∀ a. 'mempty' '`C.isPrefixOf`' ('mempty' '<>' a) - -- @ - -- - -- According to the left identity law for 'Monoid': - -- - -- @ - -- ∀ a. 'mempty' '<>' a '==' a - -- @ - -- - -- We can therefore assert that: - -- - -- @ - -- ∀ a. 'mempty' '`C.isPrefixOf`' a - -- @ - -- - -- Since 'mempty' is /always/ a valid prefix, we only need to consider - -- values in 'm1' that are /not/ 'mempty'. - -- - -- The 'nonNullKeys' function, when applied to 'm1', gives us /precisely/ - -- the set of keys that are not associated with 'mempty' in 'm1': - -- - -- @ - -- (k '`Data.Set.member`' 'nonNullKeys' m1) '==' ('get' k m1 '/=' 'mempty') - -- @ - -- -{-# INLINE isPrefixOf #-} - --- | Indicates whether or not the first map is a /suffix/ of the second. --- --- 'MonoidMap' __@m1@__ is a /suffix/ of 'MonoidMap' __@m2@__ if (and only if) --- for all possible keys __@k@__, the value for __@k@__ in __@m1@__ is a --- /suffix/ of the value for __@k@__ in __@m2@__: --- --- @ --- m1 '`isSuffixOf`' m2 '==' (∀ k. 'get' k m1 '`C.isSuffixOf`' 'get' k m2) --- @ --- --- This function provides the definition of 'C.isSuffixOf' for the 'MonoidMap' --- instance of 'RightReductive'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> m1 = 'fromList' [(1, "c"), (2, "r"), (3, "z")] --- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")] --- >>> m1 '`isSuffixOf`' m2 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [ (2, "r") ] --- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")] --- >>> m1 '`isSuffixOf`' m2 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [(1, "abc"), (2, "r"), (3, "z")] --- >>> m2 = 'fromList' [(1, "c"), (2, "pqr"), (3, "xyz")] --- >>> m1 '`isSuffixOf`' m2 --- 'False' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 1), ("b", 1), ("c", 1)] --- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)] --- >>> m1 '`isSuffixOf`' m2 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [ ("b", 1) ] --- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)] --- >>> m1 '`isSuffixOf`' m2 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", 2), ("b", 1), ("c", 1)] --- >>> m2 = 'fromList' [("a", 1), ("b", 4), ("c", 8)] --- >>> m1 '`isSuffixOf`' m2 --- 'False' --- @ --- -isSuffixOf - :: (Ord k, Monoid v, RightReductive v) - => MonoidMap k v - -> MonoidMap k v - -> Bool -isSuffixOf = isSubmapOfBy C.isSuffixOf - -- Note that in practice, it's sufficient to check the following property: - -- - -- @ - -- m1 '`isSuffixOf`' m2 '==' - -- 'all' - -- (\\k -> 'get' k m1 '`C.isSuffixOf`' 'get' k m2) - -- ('nonNullKeys' m1) - -- @ - -- - -- ==== Justification - -- - -- According to the laws for 'RightReductive': - -- - -- @ - -- ∀ a b. b '`C.isSuffixOf`' (a '<>' b) - -- @ - -- - -- Substituting 'mempty' for @b@: - -- - -- @ - -- ∀ a. 'mempty' '`C.isSuffixOf`' (a '<>' 'mempty') - -- @ - -- - -- According to the right identity law for 'Monoid': - -- - -- @ - -- ∀ a. a '<>' 'mempty' '==' a - -- @ - -- - -- We can therefore assert that: - -- - -- @ - -- ∀ a. 'mempty' '`C.isSuffixOf`' a - -- @ - -- - -- Since 'mempty' is /always/ a valid suffix, we only need to consider - -- values in 'm1' that are /not/ 'mempty'. - -- - -- The 'nonNullKeys' function, when applied to 'm1', gives us /precisely/ - -- the set of keys that are not associated with 'mempty' in 'm1': - -- - -- @ - -- (k '`Data.Set.member`' 'nonNullKeys' m1) '==' ('get' k m1 '/=' 'mempty') - -- @ - -- -{-# INLINE isSuffixOf #-} - --- | Strips a /prefix/ from a 'MonoidMap'. --- --- If map __@m1@__ is a /prefix/ of map __@m2@__, then 'stripPrefix' __@m1@__ --- __@m2@__ will produce a /reduced/ map where prefix __@m1@__ is /stripped/ --- from __@m2@__. --- --- === Properties --- --- The 'stripPrefix' function, when applied to maps __@m1@__ and __@m2@__, --- produces a result if (and only if) __@m1@__ is a prefix of __@m2@__: --- --- @ --- 'isJust' ('stripPrefix' m1 m2) '==' m1 '`isPrefixOf`' m2 --- @ --- --- The value for any key __@k@__ in the result is /identical/ to the result of --- stripping the value for __@k@__ in map __@m1@__ from the value for __@k@__ --- in map __@m2@__: --- --- @ --- 'all' --- (\\r -> 'Just' ('get' k r) '==' 'C.stripPrefix' ('get' k m1) ('get' k m2)) --- ('stripPrefix' m1 m2) --- @ --- --- If we append prefix __@m1@__ to the /left-hand/ side of the result, we can --- always recover the original map __@m2@__: --- --- @ --- 'all' --- (\\r -> m1 '<>' r '==' m2) --- ('stripPrefix' m1 m2) --- @ --- --- This function provides the definition of 'C.stripPrefix' for the 'MonoidMap' --- instance of 'LeftReductive'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> __m1__ = 'fromList' [(1, "" ), (2, "i" ), (3, "pq" ), (4, "xyz")] --- >>> __m2__ = 'fromList' [(1, "abc"), (2, "ijk"), (3, "pqr"), (4, "xyz")] --- >>> __m3__ = 'fromList' [(1, "abc"), (2, "jk"), (3, "r"), (4, "")] --- @ --- @ --- >>> 'stripPrefix' __m1__ __m2__ '==' 'Just' __m3__ --- 'True' --- @ --- @ --- >>> 'stripPrefix' __m2__ __m1__ '==' 'Nothing' --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural' values: --- --- @ --- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> __m2__ = 'fromList' [("a", 3), ("b", 3), ("c", 3), ("d", 3)] --- >>> __m3__ = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)] --- @ --- @ --- >>> 'stripPrefix' __m1__ __m2__ '==' 'Just' __m3__ --- 'True' --- @ --- @ --- >>> 'stripPrefix' __m2__ __m1__ '==' 'Nothing' --- 'True' --- @ --- -stripPrefix - :: (Ord k, MonoidNull v, LeftReductive v) - => MonoidMap k v - -> MonoidMap k v - -> Maybe (MonoidMap k v) -stripPrefix = mergeA MergeStrategy - { withNonNullL = - withNonNullA (\v -> C.stripPrefix v mempty) - - , withNonNullR = - keepNonNull - -- Justification: - -- - -- stripPrefix mempty a ≡ a - - , withNonNullP = - withBothA C.stripPrefix - } -{-# INLINE stripPrefix #-} - --- | Strips a /suffix/ from a 'MonoidMap'. --- --- If map __@m1@__ is a /suffix/ of map __@m2@__, then 'stripSuffix' __@m1@__ --- __@m2@__ will produce a /reduced/ map where suffix __@m1@__ is /stripped/ --- from __@m2@__. --- --- === Properties --- --- The 'stripSuffix' function, when applied to maps __@m1@__ and __@m2@__, --- produces a result if (and only if) __@m1@__ is a suffix of __@m2@__: --- --- @ --- 'isJust' ('stripSuffix' m1 m2) '==' m1 '`isSuffixOf`' m2 --- @ --- --- The value for any key __@k@__ in the result is /identical/ to the result of --- stripping the value for __@k@__ in map __@m1@__ from the value for __@k@__ --- in map __@m2@__: --- --- @ --- 'all' --- (\\r -> 'Just' ('get' k r) '==' 'C.stripSuffix' ('get' k m1) ('get' k m2)) --- ('stripSuffix' m1 m2) --- @ --- --- If we append suffix __@m1@__ to the /right-hand/ side of the result, we can --- always recover the original map __@m2@__: --- --- @ --- 'all' --- (\\r -> r '<>' m1 '==' m2) --- ('stripSuffix' m1 m2) --- @ --- --- This function provides the definition of 'C.stripSuffix' for the 'MonoidMap' --- instance of 'RightReductive'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> __m1__ = 'fromList' [(1, ""), (2, "k"), (3, "qr"), (4, "xyz")] --- >>> __m2__ = 'fromList' [(1, "abc"), (2, "ijk"), (3, "pqr"), (4, "xyz")] --- >>> __m3__ = 'fromList' [(1, "abc"), (2, "ij" ), (3, "p" ), (4, "" )] --- @ --- @ --- >>> 'stripSuffix' __m1__ __m2__ '==' 'Just' __m3__ --- 'True' --- @ --- @ --- >>> 'stripSuffix' __m2__ __m1__ '==' 'Nothing' --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural' values: --- --- @ --- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> __m2__ = 'fromList' [("a", 3), ("b", 3), ("c", 3), ("d", 3)] --- >>> __m3__ = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)] --- @ --- @ --- >>> 'stripSuffix' __m1__ __m2__ '==' 'Just' __m3__ --- 'True' --- @ --- @ --- >>> 'stripSuffix' __m2__ __m1__ '==' 'Nothing' --- 'True' --- @ --- -stripSuffix - :: (Ord k, MonoidNull v, RightReductive v) - => MonoidMap k v - -> MonoidMap k v - -> Maybe (MonoidMap k v) -stripSuffix = mergeA MergeStrategy - { withNonNullL = - withNonNullA (\v -> C.stripSuffix v mempty) - - , withNonNullR = - keepNonNull - -- Justification: - -- - -- stripSuffix mempty a ≡ a - - , withNonNullP = - withBothA C.stripSuffix - } -{-# INLINE stripSuffix #-} - --- | Finds the /greatest common prefix/ of two maps. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('commonPrefix' m1 m2) --- '==' 'C.commonPrefix' ('get' k m1) ('get' k m2) --- @ --- --- This function provides the definition of 'C.commonPrefix' for the --- 'MonoidMap' instance of 'LeftGCDMonoid'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> __m1__ = 'fromList' [(1, "+++"), (2, "b++"), (3, "cc+"), (4, "ddd")] --- >>> __m2__ = 'fromList' [(1, "---"), (2, "b--"), (3, "cc-"), (4, "ddd")] --- >>> __m3__ = 'fromList' [(1, "" ), (2, "b" ), (3, "cc" ), (4, "ddd")] --- @ --- @ --- >>> 'commonPrefix' __m1__ __m2__ '==' __m3__ --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural' values: --- --- @ --- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> __m2__ = 'fromList' [("a", 2), ("b", 2), ("c", 2), ("d", 2)] --- >>> __m3__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 2)] --- @ --- @ --- >>> 'commonPrefix' __m1__ __m2__ '==' __m3__ --- 'True' --- @ --- -commonPrefix - :: (Ord k, MonoidNull v, LeftGCDMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -commonPrefix = merge MergeStrategy - { withNonNullL = - keepNull - -- Justification: - -- - -- commonPrefix a mempty ≡ mempty - - , withNonNullR = - keepNull - -- Justification: - -- - -- commonPrefix mempty a ≡ mempty - - , withNonNullP = - withBoth C.commonPrefix - } -{-# INLINE commonPrefix #-} - --- | Finds the /greatest common suffix/ of two maps. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('commonSuffix' m1 m2) --- '==' 'C.commonSuffix' ('get' k m1) ('get' k m2) --- @ --- --- This function provides the definition of 'C.commonSuffix' for the --- 'MonoidMap' instance of 'RightGCDMonoid'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> __m1__ = 'fromList' [(1, "+++"), (2, "++b"), (3, "+cc"), (4, "ddd")] --- >>> __m2__ = 'fromList' [(1, "---"), (2, "--b"), (3, "-cc"), (4, "ddd")] --- >>> __m3__ = 'fromList' [(1, ""), (2, "b"), (3, "cc"), (4, "ddd")] --- @ --- @ --- >>> 'commonSuffix' __m1__ __m2__ '==' __m3__ --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural' values: --- --- @ --- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> __m2__ = 'fromList' [("a", 2), ("b", 2), ("c", 2), ("d", 2)] --- >>> __m3__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 2)] --- @ --- @ --- >>> 'commonSuffix' __m1__ __m2__ '==' __m3__ --- 'True' --- @ --- -commonSuffix - :: (Ord k, MonoidNull v, RightGCDMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -commonSuffix = merge MergeStrategy - { withNonNullL = - keepNull - -- Justification: - -- - -- commonSuffix a mempty ≡ mempty - - , withNonNullR = - keepNull - -- Justification: - -- - -- commonSuffix mempty a ≡ mempty - - , withNonNullP = - withBoth C.commonSuffix - } -{-# INLINE commonSuffix #-} - --- | Strips the /greatest common prefix/ from a pair of maps. --- --- Given two maps __@m1@__ and __@m2@__, 'stripCommonPrefix' produces a --- tuple __@(p, r1, r2)@__, where: --- --- - __@p@__ is the /greatest common prefix/ of __@m1@__ and __@m2@__ --- - __@r1@__ is the /remainder/ of stripping prefix __@p@__ from __@m1@__ --- - __@r2@__ is the /remainder/ of stripping prefix __@p@__ from __@m2@__ --- --- The resulting prefix __@p@__ can be appended to the /left-hand/ side of --- either remainder __@r1@__ or __@r2@__ to /reproduce/ either of the original --- maps __@m1@__ or __@m2@__ respectively: --- --- @ --- 'stripCommonPrefix' m1 m2 --- '&' \\(p, r1, _) -> p '<>' r1 '==' m1 --- 'stripCommonPrefix' m1 m2 --- '&' \\(p, _, r2) -> p '<>' r2 '==' m2 --- @ --- --- Prefix __@p@__ is /identical/ to the result of applying 'commonPrefix' to --- __@m1@__ and __@m2@__: --- --- @ --- 'stripCommonPrefix' m1 m2 --- '&' \\(p, _, _) -> p '==' 'commonPrefix' m1 m2 --- @ --- --- Remainders __@r1@__ and __@r2@__ are /identical/ to the results of applying --- 'stripPrefix' to __@p@__ and __@m1@__ or to __@p@__ and __@m2@__ --- respectively: --- --- @ --- 'stripCommonPrefix' m1 m2 --- '&' \\(p, r1, _) -> 'Just' r1 '==' 'stripPrefix' p m1 --- 'stripCommonPrefix' m1 m2 --- '&' \\(p, _, r2) -> 'Just' r2 '==' 'stripPrefix' p m2 --- @ --- --- This function provides the definition of 'C.stripCommonPrefix' for the --- 'MonoidMap' instance of 'LeftGCDMonoid'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> m1 = 'fromList' [(1, "+++"), (2, "a++"), (3, "aa+"), (4, "aaa")] --- >>> m2 = 'fromList' [(1, "---"), (2, "a--"), (3, "aa-"), (4, "aaa")] --- @ --- @ --- >>> p = 'fromList' [(1, "" ), (2, "a" ), (3, "aa" ), (4, "aaa")] --- >>> r1 = 'fromList' [(1, "+++"), (2, "++"), (3, "+"), (4, "")] --- >>> r2 = 'fromList' [(1, "---"), (2, "--"), (3, "-"), (4, "")] --- @ --- @ --- >>> 'stripCommonPrefix' m1 m2 '==' (p, r1, r2) --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] --- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] --- @ --- @ --- >>> p = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 1), ("e", 0)] --- >>> r1 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 2), ("e", 4)] --- >>> r2 = 'fromList' [("a", 4), ("b", 2), ("c", 0), ("d", 0), ("e", 0)] --- @ --- @ --- >>> 'stripCommonPrefix' m1 m2 '==' (p, r1, r2) --- 'True' --- @ --- -stripCommonPrefix - :: (Ord k, MonoidNull v, LeftGCDMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> (MonoidMap k v, MonoidMap k v, MonoidMap k v) -stripCommonPrefix = C.stripCommonPrefix - --- | Strips the /greatest common suffix/ from a pair of maps. --- --- Given two maps __@m1@__ and __@m2@__, 'stripCommonSuffix' produces a --- tuple __@(r1, r2, s)@__, where: --- --- - __@s@__ is the /greatest common suffix/ of __@m1@__ and __@m2@__ --- - __@r1@__ is the /remainder/ of stripping suffix __@s@__ from __@m1@__ --- - __@r2@__ is the /remainder/ of stripping suffix __@s@__ from __@m2@__ --- --- The resulting suffix __@s@__ can be appended to the /right-hand/ side of --- either remainder __@r1@__ or __@r2@__ to /reproduce/ either of the original --- maps __@m1@__ or __@m2@__ respectively: --- --- @ --- 'stripCommonSuffix' m1 m2 --- '&' \\(r1, _, s) -> r1 '<>' s '==' m1 --- 'stripCommonSuffix' m1 m2 --- '&' \\(_, r2, s) -> r2 '<>' s '==' m2 --- @ --- --- Suffix __@s@__ is /identical/ to the result of applying 'commonSuffix' to --- __@m1@__ and __@m2@__: --- --- @ --- 'stripCommonSuffix' m1 m2 --- '&' \\(_, _, s) -> s '==' 'commonSuffix' m1 m2 --- @ --- --- Remainders __@r1@__ and __@r2@__ are /identical/ to the results of applying --- 'stripSuffix' to __@s@__ and __@m1@__ or to __@s@__ and __@m2@__ --- respectively: --- --- @ --- 'stripCommonSuffix' m1 m2 --- '&' \\(r1, _, s) -> 'Just' r1 '==' 'stripSuffix' s m1 --- 'stripCommonSuffix' m1 m2 --- '&' \\(_, r2, s) -> 'Just' r2 '==' 'stripSuffix' s m2 --- @ --- --- This function provides the definition of 'C.stripCommonSuffix' for the --- 'MonoidMap' instance of 'RightGCDMonoid'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> m1 = 'fromList' [(1, "+++"), (2, "++a"), (3, "+aa"), (4, "aaa")] --- >>> m2 = 'fromList' [(1, "---"), (2, "--a"), (3, "-aa"), (4, "aaa")] --- @ --- @ --- >>> r1 = 'fromList' [(1, "+++"), (2, "++" ), (3, "+" ), (4, "" )] --- >>> r2 = 'fromList' [(1, "---"), (2, "--" ), (3, "-" ), (4, "" )] --- >>> s = 'fromList' [(1, ""), (2, "a"), (3, "aa"), (4, "aaa")] --- @ --- @ --- >>> 'stripCommonSuffix' m1 m2 '==' (r1, r2, s) --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] --- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] --- @ --- @ --- >>> r1 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 2), ("e", 4)] --- >>> r2 = 'fromList' [("a", 4), ("b", 2), ("c", 0), ("d", 0), ("e", 0)] --- >>> s = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 1), ("e", 0)] --- @ --- @ --- >>> 'stripCommonSuffix' m1 m2 '==' (r1, r2, s) --- 'True' --- @ --- -stripCommonSuffix - :: (Ord k, MonoidNull v, RightGCDMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> (MonoidMap k v, MonoidMap k v, MonoidMap k v) -stripCommonSuffix = C.stripCommonSuffix - --------------------------------------------------------------------------------- --- Overlap --------------------------------------------------------------------------------- - --- | Finds the /greatest overlap/ of two maps. --- --- The /greatest overlap/ __@o@__ of maps __@m1@__ and __@m2@__ is the /unique/ --- greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ of __@m2@__: --- --- @ --- m1 '==' r1 '<>' o \ \ --- m2 '==' \ \ o '<>' r2 --- @ --- --- Where: --- --- - __@r1@__ is the /remainder/ obtained by stripping /suffix overlap/ --- __@o@__ from __@m1@__. --- --- (see 'stripSuffixOverlap') --- --- - __@r2@__ is the /remainder/ obtained by stripping /prefix overlap/ --- __@o@__ from __@m2@__. --- --- (see 'stripPrefixOverlap') --- --- This function satisfies the following property: --- --- @ --- 'get' k ('overlap' m1 m2) '==' 'C.overlap' ('get' k m1) ('get' k m2) --- @ --- --- This function provides the definition of 'C.overlap' for the 'MonoidMap' --- instance of 'OverlappingGCDMonoid'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> m1 = 'fromList' [(1,"abc" ), (2,"abcd" ), (3,"abcde "), (4,"abcdef")] --- >>> m2 = 'fromList' [(1, "def"), (2, "cdef"), (3," bcdef"), (4,"abcdef")] --- >>> m3 = 'fromList' [(1, "" ), (2, "cd" ), (3," bcde" ), (4,"abcdef")] --- @ --- @ --- >>> 'overlap' m1 m2 '==' m3 --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] --- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] --- >>> m3 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 1), ("e", 0)] --- @ --- @ --- >>> 'overlap' m1 m2 '==' m3 --- 'True' --- @ --- -overlap - :: (Ord k, MonoidNull v, OverlappingGCDMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -overlap = merge MergeStrategy - { withNonNullL = - keepNull - -- Justification: - -- - -- overlap a mempty ≡ mempty - - , withNonNullR = - keepNull - -- Justification: - -- - -- overlap mempty a ≡ mempty - - , withNonNullP = - withBoth C.overlap - } -{-# INLINE overlap #-} - --- | /Strips/ from the second map its /greatest prefix overlap/ with suffixes --- of the first map. --- --- Evaluating 'stripPrefixOverlap' __@m1@__ __@m2@__ produces the /remainder/ --- __@r2@__: --- --- @ --- m1 '==' r1 '<>' o \ \ --- m2 '==' \ \ o '<>' r2 --- @ --- --- Where __@o@__ is the /greatest overlap/ of maps __@m1@__ and __@m2@__: the --- /unique/ greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ of --- __@m2@__. --- --- This function satisfies the following property: --- --- @ --- 'get' k ('stripPrefixOverlap' m1 m2) --- '==' 'C.stripPrefixOverlap' ('get' k m1) ('get' k m2) --- @ --- --- This function provides the definition of 'C.stripPrefixOverlap' for the --- 'MonoidMap' instance of 'OverlappingGCDMonoid'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> m1 = 'fromList' [(1,"abc" ), (2,"abcd" ), (3,"abcde" ), (4,"abcdef")] --- >>> m2 = 'fromList' [(1, "def"), (2, "cdef"), (3, "bcdef"), (4,"abcdef")] --- >>> m3 = 'fromList' [(1, "def"), (2, "ef"), (3, "f"), (4, "")] --- @ --- @ --- >>> 'stripPrefixOverlap' m1 m2 '==' m3 --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] --- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] --- >>> m3 = 'fromList' [("a", 4), ("b", 2), ("c", 0), ("d", 0), ("e", 0)] --- @ --- @ --- >>> 'stripPrefixOverlap' m1 m2 '==' m3 --- 'True' --- @ --- -stripPrefixOverlap - :: (Ord k, MonoidNull v, OverlappingGCDMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -stripPrefixOverlap = merge MergeStrategy - { withNonNullL = - keepNull - -- Justification: - -- - -- overlap a b <> stripPrefixOverlap a b ≡ b - -- overlap a mempty <> stripPrefixOverlap a mempty ≡ mempty - -- mempty <> stripPrefixOverlap a mempty ≡ mempty - -- stripPrefixOverlap a mempty ≡ mempty - - , withNonNullR = - keepNonNull - -- Justification: - -- - -- overlap a b <> stripPrefixOverlap a b ≡ b - -- overlap mempty b <> stripPrefixOverlap mempty b ≡ b - -- mempty <> stripPrefixOverlap mempty b ≡ b - -- stripPrefixOverlap mempty b ≡ b - - , withNonNullP = - withBoth C.stripPrefixOverlap - } -{-# INLINE stripPrefixOverlap #-} - --- | /Strips/ from the second map its /greatest suffix overlap/ with prefixes --- of the first map. --- --- Evaluating 'stripSuffixOverlap' __@m2@__ __@m1@__ produces the /remainder/ --- __@r1@__: --- --- @ --- m1 '==' r1 '<>' o \ \ --- m2 '==' \ \ o '<>' r2 --- @ --- --- Where __@o@__ is the /greatest overlap/ of maps __@m1@__ and __@m2@__: the --- /unique/ greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ of --- __@m2@__. --- --- This function satisfies the following property: --- --- @ --- 'get' k ('stripSuffixOverlap' m2 m1) --- '==' 'C.stripSuffixOverlap' ('get' k m2) ('get' k m1) --- @ --- --- This function provides the definition of 'C.stripSuffixOverlap' for the --- 'MonoidMap' instance of 'OverlappingGCDMonoid'. --- --- === __Examples__ --- --- With 'String' values: --- --- @ --- >>> m1 = 'fromList' [(1,"abc" ), (2,"abcd" ), (3,"abcde" ), (4,"abcdef")] --- >>> m2 = 'fromList' [(1, "def"), (2, "cdef"), (3, "bcdef"), (4,"abcdef")] --- >>> m3 = 'fromList' [(1,"abc" ), (2,"ab" ), (3,"a" ), (4,"" )] --- @ --- @ --- >>> 'stripSuffixOverlap' m2 m1 '==' m3 --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] --- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] --- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 2), ("e", 4)] --- @ --- @ --- >>> 'stripSuffixOverlap' m2 m1 '==' m3 --- 'True' --- @ --- -stripSuffixOverlap - :: (Ord k, MonoidNull v, OverlappingGCDMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -stripSuffixOverlap = merge MergeStrategy - { withNonNullL = - keepNull - -- Justification: - -- - -- stripSuffixOverlap b a <> overlap a b ≡ a - -- stripSuffixOverlap b mempty <> overlap mempty b ≡ mempty - -- stripSuffixOverlap b mempty <> mempty ≡ mempty - -- stripSuffixOverlap b mempty ≡ mempty - - , withNonNullR = - keepNonNull - -- Justification: - -- - -- stripSuffixOverlap b a <> overlap a b ≡ a - -- stripSuffixOverlap mempty a <> overlap a mempty ≡ a - -- stripSuffixOverlap mempty a <> mempty ≡ a - -- stripSuffixOverlap mempty a ≡ a - - , withNonNullP = - withBoth C.stripSuffixOverlap - } -{-# INLINE stripSuffixOverlap #-} - --- | Finds the /greatest overlap/ of two maps and /strips/ it from both maps. --- --- Evaluating 'stripOverlap' __@m1@__ __@m2@__ produces the tuple --- __@(r1, o, r2)@__, where: --- --- @ --- m1 '==' r1 '<>' o \ \ --- m2 '==' \ \ o '<>' r2 --- @ --- --- Where: --- --- - __@o@__ is the /greatest overlap/ of maps __@m1@__ and __@m2@__: the --- /unique/ greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ --- of __@m2@__. --- --- (see 'overlap') --- --- - __@r1@__ is the /remainder/ obtained by stripping /suffix overlap/ --- __@o@__ from __@m1@__. --- --- (see 'stripSuffixOverlap') --- --- - __@r2@__ is the /remainder/ obtained by stripping /prefix overlap/ --- __@o@__ from __@m2@__. --- --- (see 'stripPrefixOverlap') --- --- This function satisfies the following property: --- --- @ --- 'stripOverlap' m1 m2 '==' --- ( 'stripSuffixOverlap' m2 m1 --- , 'overlap' m1 m2 --- , 'stripPrefixOverlap' m1 m2 --- ) --- @ --- --- This function provides the definition of 'C.stripOverlap' for the --- 'MonoidMap' instance of 'OverlappingGCDMonoid'. --- -stripOverlap - :: (Ord k, MonoidNull v, OverlappingGCDMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> (MonoidMap k v, MonoidMap k v, MonoidMap k v) -stripOverlap m1 m2 = - ( stripSuffixOverlap m2 m1 - , m1 `overlap` m2 - , stripPrefixOverlap m1 m2 - ) - --------------------------------------------------------------------------------- --- Intersection --------------------------------------------------------------------------------- - --- | Finds the /intersection/ of two maps. --- --- The intersection of maps __@m1@__ and __@m2@__ is the greatest single map --- __@m@__ that is a /submap/ of both __@m1@__ /and/ __@m2@__: --- --- @ --- 'intersection' m1 m2 '`isSubmapOf`' m1 --- 'intersection' m1 m2 '`isSubmapOf`' m2 --- @ --- --- The intersection is /unique/: --- --- @ --- 'and' --- [ 'intersection' m1 m2 '`isSubmapOf`' m --- , \ \ \ \ m '`isSubmapOf`' m1 --- , \ \ \ \ m '`isSubmapOf`' m2 --- ] --- ==> --- (m '==' 'intersection' m1 m2) --- @ --- --- The following property holds for all possible keys __@k@__: --- --- @ --- 'get' k ('intersection' m1 m2) '==' 'C.gcd' ('get' k m1) ('get' k m2) --- @ --- --- This function provides the definition of 'C.gcd' for the 'MonoidMap' --- instance of 'GCDMonoid'. --- --- === __Examples__ --- --- With 'Data.Monoid.Product' 'Numeric.Natural.Natural' values, this function --- computes the /greatest common divisor/ of each pair of matching values: --- --- @ --- >>> m1 = 'fromList' [("a", 2), ("b", 6), ("c", 15), ("d", 35)] --- >>> m2 = 'fromList' [("a", 6), ("b", 15), ("c", 35), ("d", 77)] --- >>> m3 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 7)] --- @ --- @ --- >>> 'intersection' m1 m2 '==' m3 --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function --- computes the /minimum/ of each pair of matching values: --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> m2 = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)] --- >>> m3 = 'fromList' [("a", 0), ("b", 1), ("c", 1), ("d", 0)] --- @ --- @ --- >>> 'intersection' m1 m2 '==' m3 --- 'True' --- @ --- --- With 'Set' 'Numeric.Natural.Natural' values, this function computes the --- /set/ /intersection/ of each pair of matching values: --- --- @ --- f xs = 'fromList' ('Set.fromList' '<$>' xs) --- @ --- --- @ --- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2 ]), ("c", [0,1,2 ])] --- >>> m2 = f [("a", [0,1,2]), ("b", [ 1,2,3]), ("c", [ 2,3,4])] --- >>> m3 = f [("a", [0,1,2]), ("b", [ 1,2 ]), ("c", [ 2 ])] --- @ --- @ --- >>> 'intersection' m1 m2 '==' m3 --- 'True' --- @ --- -intersection - :: (Ord k, MonoidNull v, GCDMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -intersection = merge MergeStrategy - { withNonNullL = - keepNull - -- Justification: - -- - -- gcd a mempty ≡ mempty - - , withNonNullR = - keepNull - -- Justification: - -- - -- gcd mempty b ≡ mempty - - , withNonNullP = - withBoth C.gcd - } -{-# INLINE intersection #-} - --------------------------------------------------------------------------------- --- Union --------------------------------------------------------------------------------- - --- | Finds the /union/ of two maps. --- --- The union of maps __@m1@__ and __@m2@__ is the smallest single map __@m@__ --- that includes both __@m1@__ /and/ __@m2@__ as /submaps/: --- --- @ --- m1 '`isSubmapOf`' 'union' m1 m2 --- m2 '`isSubmapOf`' 'union' m1 m2 --- @ --- --- The union is /unique/: --- --- @ --- 'and' --- [ m1 '`isSubmapOf`' m --- , m2 '`isSubmapOf`' m --- , \ \ m '`isSubmapOf`' 'union' m1 m2 --- ] --- ==> --- (m '==' 'union' m1 m2) --- @ --- --- The following property holds for all possible keys __@k@__: --- --- @ --- 'get' k ('union' m1 m2) '==' 'C.lcm' ('get' k m1) ('get' k m2) --- @ --- --- This function provides the definition of 'C.lcm' for the 'MonoidMap' --- instance of 'LCMMonoid'. --- --- === __Examples__ --- --- With 'Data.Monoid.Product' 'Numeric.Natural.Natural' values, this function --- computes the /least common multiple/ of each pair of matching values: --- --- @ --- >>> m1 = 'fromList' [("a", 2), ("b", 6), ("c", 15), ("d", 35)] --- >>> m2 = 'fromList' [("a", 6), ("b", 15), ("c", 35), ("d", 77)] --- >>> m3 = 'fromList' [("a", 6), ("b", 30), ("c", 105), ("d", 385)] --- @ --- @ --- >>> 'union' m1 m2 '==' m3 --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function --- computes the /maximum/ of each pair of matching values: --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> m2 = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)] --- >>> m3 = 'fromList' [("a", 3), ("b", 2), ("c", 2), ("d", 3)] --- @ --- @ --- >>> 'union' m1 m2 '==' m3 --- 'True' --- @ --- --- With 'Set' 'Numeric.Natural.Natural' values, this function computes the --- /set/ /union/ of each pair of matching values: --- --- @ --- f xs = 'fromList' ('Set.fromList' '<$>' xs) --- @ --- --- @ --- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2 ]), ("c", [0,1,2 ])] --- >>> m2 = f [("a", [0,1,2]), ("b", [ 1,2,3]), ("c", [ 2,3,4])] --- >>> m3 = f [("a", [0,1,2]), ("b", [0,1,2,3]), ("c", [0,1,2,3,4])] --- @ --- @ --- >>> 'union' m1 m2 '==' m3 --- 'True' --- @ --- -union - :: (Ord k, MonoidNull v, LCMMonoid v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -union = merge MergeStrategy - { withNonNullL = - keepNonNull - -- Justification: - -- - -- lcm a mempty ≡ a - - , withNonNullR = - keepNonNull - -- Justification: - -- - -- lcm mempty a ≡ a - - , withNonNullP = - withBoth C.lcm - } -{-# INLINE union #-} - --------------------------------------------------------------------------------- --- Subtraction --------------------------------------------------------------------------------- - --- | Performs /group subtraction/ of the second map from the first. --- --- Uses the 'Group' subtraction operator '(C.~~)' to subtract each value in the --- second map from its matching value in the first map. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k (m1 '`minus`' m2) '==' 'get' k m1 'C.~~' 'get' k m2 --- @ --- --- This function provides the definition of '(C.~~)' for the 'MonoidMap' --- instance of 'Group'. --- --- === __Examples__ --- --- With 'Data.Monoid.Sum' 'Integer' values, this function performs normal --- integer subtraction of matching values: --- --- @ --- >>> m1 = 'fromList' [("a", (-1)), ("b", 0 ), ("c", 1)] --- >>> m2 = 'fromList' [("a", 1 ), ("b", 1 ), ("c", 1)] --- >>> m3 = 'fromList' [("a", (-2)), ("b", (-1)), ("c", 0)] --- @ --- @ --- >>> m1 '`minus`' m2 '==' m3 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", (-1)), ("b", 0 ), ("c", 1 )] --- >>> m2 = 'fromList' [("a", (-1)), ("b", (-1)), ("c", (-1))] --- >>> m3 = 'fromList' [("a", 0 ), ("b", 1 ), ("c", 2 )] --- @ --- @ --- >>> m1 '`minus`' m2 '==' m3 --- 'True' --- @ --- -minus - :: (Ord k, MonoidNull v, Group v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -minus = merge MergeStrategy - { withNonNullL = - keepNonNull - -- Justification: - -- - -- a ~~ mempty ≡ a - - , withNonNullR = - withNonNull C.invert - -- Justification: - -- - -- a ~~ b ≡ a <> invert b - -- mempty ~~ b ≡ mempty <> invert b - -- mempty ~~ b ≡ invert b - - , withNonNullP = - withBoth (C.~~) - } -{-# INLINE minus #-} - --- | Performs /reductive subtraction/ of the second map from the first. --- --- Uses the 'Reductive' subtraction operator '()' to subtract each value in --- the second map from its matching value in the first map. --- --- This function produces a result if (and only if) for all possible keys --- __@k@__, it is possible to subtract the value for __@k@__ in the second map --- from the value for __@k@__ in the first map: --- --- @ --- 'isJust' (m1 '`minusMaybe`' m2) --- '==' (∀ k. 'isJust' ('get' k m1 '' 'get' k m2)) --- @ --- --- Otherwise, this function returns 'Nothing'. --- --- This function satisfies the following property: --- --- @ --- 'all' --- (\\r -> 'Just' ('get' k r) '==' 'get' k m1 '' 'get' k m2) --- (m1 '`minusMaybe`' m2) --- @ --- --- This function provides the definition of '()' for the 'MonoidMap' --- instance of 'Reductive'. --- --- === __Examples__ --- --- With 'Set' 'Numeric.Natural.Natural' values, this function performs /set/ --- /subtraction/ of matching values, succeeding if (and only if) each value --- from the second map is a subset of its matching value from the first map: --- --- @ --- f xs = 'fromList' ('Set.fromList' '<$>' xs) --- @ --- --- @ --- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2])] --- >>> m2 = f [("a", [ ]), ("b", [0,1,2])] --- >>> m3 = f [("a", [0,1,2]), ("b", [ ])] --- @ --- @ --- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 --- 'True' --- @ --- --- @ --- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2]), ("c", [0,1,2])] --- >>> m2 = f [("a", [0 ]), ("b", [ 1 ]), ("c", [ 2])] --- >>> m3 = f [("a", [ 1,2]), ("b", [0, 2]), ("c", [0,1 ])] --- @ --- @ --- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 --- 'True' --- @ --- --- @ --- >>> m1 = f [("a", [0,1,2 ]), ("b", [0,1,2 ]), ("c", [0,1,2 ])] --- >>> m2 = f [("a", [ 2,3,4]), ("b", [ 1,2,3,4]), ("c", [0,1,2,3,4])] --- @ --- @ --- >>> m1 '`minusMaybe`' m2 '==' 'Nothing' --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function --- performs /ordinary/ /subtraction/ of matching values, succeeding if (and only --- if) each value from the second map is less than or equal to its matching --- value from the first map: --- --- @ --- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] --- >>> m2 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)] --- >>> m3 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] --- @ --- @ --- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] --- >>> m2 = 'fromList' [("a", 1), ("b", 2), ("c", 3), ("d", 5)] --- >>> m3 = 'fromList' [("a", 1), ("b", 1), ("c", 2), ("d", 3)] --- @ --- @ --- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] --- >>> m2 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] --- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)] --- @ --- @ --- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] --- >>> m2 = 'fromList' [("a", 3), ("b", 3), ("c", 5), ("d", 8)] --- @ --- @ --- >>> m1 '`minusMaybe`' m2 '==' 'Nothing' --- 'True' --- @ --- -minusMaybe - :: (Ord k, MonoidNull v, Reductive v) - => MonoidMap k v - -> MonoidMap k v - -> Maybe (MonoidMap k v) -minusMaybe = mergeA MergeStrategy - { withNonNullL = - keepNonNull - -- Justification: - -- - -- According to laws for Reductive: - -- maybe a (b <>) (a b ) ≡ a - -- maybe a (mempty <>) (a mempty) ≡ a - -- maybe a (id ) (a mempty) ≡ a - -- (a mempty) ∈ {Just a, Nothing} - -- - -- According to laws for LeftReductive and RightReductive: - -- isJust (a b ) ≡ b `isPrefixOf` a ≡ b `isSuffixOf` a - -- isJust (a mempty) ≡ mempty `isPrefixOf` a ≡ mempty `isSuffixOf` a - -- - -- According to laws for LeftReductive and RightReductive: - -- b `isPrefixOf` (b <> a) - -- mempty `isPrefixOf` (mempty <> a) - -- mempty `isPrefixOf` a - -- - -- Therefore: - -- a mempty ≡ Just a - - , withNonNullR = - withNonNullA (\v -> mempty v) - - , withNonNullP = - withBothA () - } -{-# INLINE minusMaybe #-} - --- | Performs /monus subtraction/ of the second map from the first. --- --- Uses the 'Monus' subtraction operator '(<\>)' to subtract each value in --- the second map from its matching value in the first map. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k (m1 '`monus`' m2) '==' 'get' k m1 '<\>' 'get' k m2 --- @ --- --- This function provides the definition of '(<\>)' for the 'MonoidMap' --- instance of 'Monus'. --- --- === __Examples__ --- --- With 'Set' 'Numeric.Natural.Natural' values, this function performs /set/ --- /subtraction/ of matching values: --- --- @ --- f xs = 'fromList' ('Set.fromList' '<$>' xs) --- @ --- --- @ --- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2])] --- >>> m2 = f [("a", [ ]), ("b", [0,1,2])] --- >>> m3 = f [("a", [0,1,2]), ("b", [ ])] --- @ --- @ --- >>> m1 '`monus`' m2 '==' m3 --- 'True' --- @ --- --- @ --- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2]), ("c", [0,1,2])] --- >>> m2 = f [("a", [0 ]), ("b", [ 1 ]), ("c", [ 2])] --- >>> m3 = f [("a", [ 1,2]), ("b", [0, 2]), ("c", [0,1 ])] --- @ --- @ --- >>> m1 '`monus`' m2 '==' m3 --- 'True' --- @ --- --- @ --- >>> m1 = f [("a", [0,1,2 ]), ("b", [0,1,2 ]), ("c", [0,1,2 ])] --- >>> m2 = f [("a", [ 2,3,4]), ("b", [ 1,2,3,4]), ("c", [0,1,2,3,4])] --- >>> m3 = f [("a", [0,1 ]), ("b", [0 ]), ("c", [ ])] --- @ --- @ --- >>> m1 '`monus`' m2 '==' m3 --- 'True' --- @ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function --- performs /truncated/ /subtraction/ of matching values: --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> m2 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)] --- >>> m3 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- @ --- @ --- >>> m1 '`monus`' m2 '==' m3 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> m2 = 'fromList' [("a", 1), ("b", 1), ("c", 1), ("d", 1)] --- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 1), ("d", 2)] --- @ --- @ --- >>> m1 '`monus`' m2 '==' m3 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> m2 = 'fromList' [("a", 2), ("b", 2), ("c", 2), ("d", 2)] --- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 1)] --- @ --- @ --- >>> m1 '`monus`' m2 '==' m3 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> m2 = 'fromList' [("a", 4), ("b", 4), ("c", 4), ("d", 4)] --- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)] --- @ --- @ --- >>> m1 '`monus`' m2 '==' m3 --- 'True' --- @ --- -monus - :: (Ord k, MonoidNull v, Monus v) - => MonoidMap k v - -> MonoidMap k v - -> MonoidMap k v -monus = merge MergeStrategy - { withNonNullL = - keepNonNull - -- Justification: - -- - -- a <> (b <\> a ) ≡ b <> (a <\> b) - -- mempty <> (b <\> mempty) ≡ b <> (mempty <\> a) - -- b <\> mempty ≡ b <> (mempty <\> a) - -- b <\> mempty ≡ b <> mempty - -- b <\> mempty ≡ b - - , withNonNullR = - keepNull - -- Justification: - -- - -- mempty <\> a ≡ mempty - - , withNonNullP = - withBoth (<\>) - } -{-# INLINE monus #-} - --------------------------------------------------------------------------------- --- Inversion --------------------------------------------------------------------------------- - --- | Inverts every value in a map. --- --- Applies the 'Group' method 'C.invert' to every value in a map. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('invert' m) '==' 'C.invert' ('get' k m) --- @ --- --- This function provides the definition of 'C.invert' for the 'MonoidMap' --- instance of 'Group'. --- --- === __Examples__ --- --- With 'Data.Monoid.Sum' 'Integer' values, this function performs negation --- of values: --- --- @ --- >>> m1 = 'fromList' [("a", (-1)), ("b", 0), ("c", 1) ] --- >>> m2 = 'fromList' [("a", 1 ), ("b", 0), ("c", (-1))] --- @ --- @ --- >>> 'negate' m1 '==' m2 --- 'True' --- @ --- -invert - :: (MonoidNull v, Group v) - => MonoidMap k v - -> MonoidMap k v -invert = map C.invert -{-# INLINE invert #-} - --------------------------------------------------------------------------------- --- Exponentiation --------------------------------------------------------------------------------- - --- | Performs exponentiation of every value in a map. --- --- Uses the 'Group' exponentiation method 'C.pow' to raise every value in a map --- to the power of the given exponent. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k (m '`power`' i) '==' 'get' k m '`C.pow`' i --- @ --- --- This function provides the definition of 'C.pow' for the 'MonoidMap' --- instance of 'Group'. --- --- === __Examples__ --- --- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function --- performs /ordinary multiplication/ of all values by the given exponent: --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] --- >>> m2 = 'fromList' [("a", 0), ("b", 2), ("c", 4), ("d", 6)] --- @ --- @ --- >>> m1 '`power`' 2 '==' m2 --- 'True' --- @ --- --- @ --- >>> m1 = 'fromList' [("a", 0), ("b", 1 ), ("c", 2 ), ("d", 3 )] --- >>> m2 = 'fromList' [("a", 0), ("b", (-1)), ("c", (-2)), ("d", (-3))] --- @ --- @ --- >>> m1 '`power`' (-1) '==' m2 --- 'True' --- @ --- -power - :: (Integral i, MonoidNull v, Group v) - => MonoidMap k v - -> i - -> MonoidMap k v -power m i = map (`C.pow` i) m -{-# INLINE power #-} - --------------------------------------------------------------------------------- --- Intersection --------------------------------------------------------------------------------- - --- | Computes the /intersection/ of a pair of maps using the given function --- to combine values for matching keys. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('intersectionWith' f m1 m2) '==' --- if k '`Set.member`' --- 'Set.intersection' --- ('nonNullKeys' m1) --- ('nonNullKeys' m2) --- then f ('get' k m1) ('get' k m2) --- else 'mempty' --- @ --- --- === Conditional totality --- --- /If/ the given combining function __@f@__ /always/ produces 'mempty' when --- /either/ or /both/ of its arguments are 'mempty': --- --- @ --- (f v 'mempty' '==' 'mempty') '&&' --- (f 'mempty' v '==' 'mempty') --- @ --- --- /Then/ the following property holds for all possible keys __@k@__: --- --- @ --- 'get' k ('intersectionWith' f m1 m2) '==' f ('get' k m1) ('get' k m2) --- @ --- --- === __Examples__ --- --- With the 'Prelude.min' function applied to 'Data.Monoid.Sum' --- 'Numeric.Natural.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1) ] --- >>> m2 = 'fromList' [ ("b", 1), ("c", 2), ("d", 3), ("e", 4)] --- >>> m3 = 'fromList' [ ("b", 1), ("c", 2), ("d", 1) ] --- @ --- @ --- >>> 'intersectionWith' 'Prelude.min' m1 m2 '==' m3 --- 'True' --- @ --- -intersectionWith - :: (Ord k, MonoidNull v3) - => (v1 -> v2 -> v3) - -- ^ Function with which to combine values for matching keys. - -> MonoidMap k v1 - -> MonoidMap k v2 - -> MonoidMap k v3 -intersectionWith f = merge MergeStrategy - { withNonNullL = - keepNull - , withNonNullR = - keepNull - , withNonNullP = - withBoth f - } -{-# INLINE intersectionWith #-} - --- | An /applicative/ version of 'intersectionWith'. --- --- Satisfies the following property: --- --- @ --- 'runIdentity' ('intersectionWithA' (('fmap' . 'fmap') 'Identity' f) m1 m2) --- '==' ('intersectionWith' \ \ \ \ \ \ f m1 m2) --- @ --- -intersectionWithA - :: (Applicative f, Ord k, MonoidNull v3) - => (v1 -> v2 -> f v3) - -- ^ Function with which to combine values for matching keys. - -> MonoidMap k v1 - -> MonoidMap k v2 - -> f (MonoidMap k v3) -intersectionWithA f = mergeA MergeStrategy - { withNonNullL = - keepNull - , withNonNullR = - keepNull - , withNonNullP = - withBothA f - } -{-# INLINE intersectionWithA #-} - --------------------------------------------------------------------------------- --- Union --------------------------------------------------------------------------------- - --- | Computes the /union/ of a pair of maps using the given function to combine --- values for matching keys. --- --- Satisfies the following property for all possible keys __@k@__: --- --- @ --- 'get' k ('unionWith' f m1 m2) '==' --- if k '`Set.member`' --- 'Set.union' --- ('nonNullKeys' m1) --- ('nonNullKeys' m2) --- then f ('get' k m1) ('get' k m2) --- else 'mempty' --- @ --- --- === Conditional totality --- --- /If/ the given combining function __@f@__ /always/ produces 'mempty' when --- /both/ of its arguments are 'mempty': --- --- @ --- f 'mempty' 'mempty' '==' 'mempty' --- @ --- --- /Then/ the following property holds for all possible keys __@k@__: --- --- @ --- 'get' k ('unionWith' f m1 m2) '==' f ('get' k m1) ('get' k m2) --- @ --- --- === __Examples__ --- --- With the 'Prelude.max' function applied to 'Data.Monoid.Sum' --- 'Numeric.Natural.Natural' values: --- --- @ --- >>> m1 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1) ] --- >>> m2 = 'fromList' [ ("b", 1), ("c", 2), ("d", 3), ("e", 4)] --- >>> m3 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 3), ("e", 4)] --- @ --- @ --- >>> 'unionWith' 'Prelude.max' m1 m2 '==' m3 --- 'True' --- @ --- -unionWith - :: (Ord k, Monoid v1, Monoid v2, MonoidNull v3) - => (v1 -> v2 -> v3) - -- ^ Function with which to combine values for matching keys. - -> MonoidMap k v1 - -> MonoidMap k v2 - -> MonoidMap k v3 -unionWith f = merge MergeStrategy - { withNonNullL = - withNonNull (\v -> f v mempty) - , withNonNullR = - withNonNull (\v -> f mempty v) - , withNonNullP = - withBoth f - } -{-# INLINE unionWith #-} - --- | An /applicative/ version of 'unionWith'. --- --- Satisfies the following property: --- --- @ --- 'runIdentity' ('unionWithA' (('fmap' . 'fmap') 'Identity' f) m1 m2) --- '==' ('unionWith' \ \ \ \ \ \ f m1 m2) --- @ --- -unionWithA - :: (Applicative f, Ord k, Monoid v1, Monoid v2, MonoidNull v3) - => (v1 -> v2 -> f v3) - -- ^ Function with which to combine values for matching keys. - -> MonoidMap k v1 - -> MonoidMap k v2 - -> f (MonoidMap k v3) -unionWithA f = mergeA MergeStrategy - { withNonNullL = - withNonNullA (\v -> f v mempty) - , withNonNullR = - withNonNullA (\v -> f mempty v) - , withNonNullP = - withBothA f - } -{-# INLINE unionWithA #-} - --------------------------------------------------------------------------------- --- Merging --------------------------------------------------------------------------------- - -type WhenOneSideNull f k vx vr - = Map.WhenMissing f k (NonNull vx) (NonNull vr) -type WhenBothNonNull f k v1 v2 vr - = Map.WhenMatched f k (NonNull v1) (NonNull v2) (NonNull vr) - -data MergeStrategy f k v1 v2 v3 = MergeStrategy - { withNonNullL :: !(WhenOneSideNull f k v1 v3) - , withNonNullR :: !(WhenOneSideNull f k v2 v3) - , withNonNullP :: !(WhenBothNonNull f k v1 v2 v3) - } - -merge - :: Ord k - => MergeStrategy Identity k v1 v2 v3 - -> MonoidMap k v1 - -> MonoidMap k v2 - -> MonoidMap k v3 -merge (MergeStrategy nnl nnr nnp) (MonoidMap m1) (MonoidMap m2) = - MonoidMap $ Map.merge nnl nnr nnp m1 m2 -{-# INLINE merge #-} - -mergeA - :: (Applicative f, Ord k) - => MergeStrategy f k v1 v2 v3 - -> MonoidMap k v1 - -> MonoidMap k v2 - -> f (MonoidMap k v3) -mergeA (MergeStrategy nnl nnr nnp) (MonoidMap m1) (MonoidMap m2) = - MonoidMap <$> Map.mergeA nnl nnr nnp m1 m2 -{-# INLINE mergeA #-} - -keepNull - :: Applicative f - => WhenOneSideNull f k v1 v2 -keepNull = Map.dropMissing -{-# INLINE keepNull #-} - -keepNonNull - :: Applicative f - => WhenOneSideNull f k v v -keepNonNull = Map.preserveMissing -{-# INLINE keepNonNull #-} - -withNonNull - :: (Applicative f, MonoidNull v2) - => (v1 -> v2) - -> WhenOneSideNull f k v1 v2 -withNonNull f - = Map.mapMaybeMissing - $ \_k v -> maybeNonNull $ applyNonNull f v -{-# INLINE withNonNull #-} - -withNonNullA - :: (Applicative f, MonoidNull v2) - => (v1 -> f v2) - -> WhenOneSideNull f k v1 v2 -withNonNullA f - = Map.traverseMaybeMissing - $ \_k v -> maybeNonNull <$> applyNonNull f v -{-# INLINE withNonNullA #-} - -withBoth - :: (Applicative f, MonoidNull v3) - => (v1 -> v2 -> v3) - -> WhenBothNonNull f k v1 v2 v3 -withBoth f - = Map.zipWithMaybeMatched - $ \_k v1 v2 -> maybeNonNull $ applyNonNull2 f v1 v2 -{-# INLINE withBoth #-} - -withBothA - :: (Applicative f, MonoidNull v3) - => (v1 -> v2 -> f v3) - -> WhenBothNonNull f k v1 v2 v3 -withBothA f - = Map.zipWithMaybeAMatched - $ \_k v1 v2 -> maybeNonNull <$> applyNonNull2 f v1 v2 -{-# INLINE withBothA #-} - --------------------------------------------------------------------------------- --- State --------------------------------------------------------------------------------- - -newtype StateL s a = StateL (s -> (s, a)) -newtype StateR s a = StateR (s -> (s, a)) - -instance Functor (StateL s) where - fmap f (StateL kx) = - StateL $ \s -> let (s', x) = kx s in (s', f x) - -instance Functor (StateR s) where - fmap f (StateR kx) = - StateR $ \s -> let (s', x) = kx s in (s', f x) - -instance Applicative (StateL s) where - pure a = StateL $ - \s -> (s, a) - StateL kf <*> StateL kx = StateL $ - \s -> - let (s' , f ) = kf s - (s'', x) = kx s' - in (s'', f x) - liftA2 f (StateL kx) (StateL ky) = StateL $ - \s -> - let (s' , x ) = kx s - (s'', y) = ky s' - in (s'', f x y) - -instance Applicative (StateR s) where - pure a = StateR $ - \s -> (s, a) - StateR kf <*> StateR kx = StateR $ - \s -> - let (s', x) = kx s - (s'', f ) = kf s' - in (s'', f x) - liftA2 f (StateR kx) (StateR ky) = StateR $ - \s -> - let (s' , y) = ky s - (s'', x ) = kx s' - in (s'', f x y) diff --git a/components/monoidmap-internal/Data/MonoidMap/Unsafe.hs b/components/monoidmap-internal/Data/MonoidMap/Unsafe.hs deleted file mode 100644 --- a/components/monoidmap-internal/Data/MonoidMap/Unsafe.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} - --- | --- Copyright: © 2022–2025 Jonathan Knowles --- License: Apache-2.0 --- --- Provides /unsafe/ operations for the 'MonoidMap' type. --- -module Data.MonoidMap.Unsafe - ( - -- * Construction - unsafeFromMap - ) - where - -import Prelude - -import Data.Coerce - ( coerce ) -import Data.Map.Strict - ( Map ) -import Data.MonoidMap.Internal - ( MonoidMap (..), NonNull (..), fromMap ) - -import qualified Data.Foldable as F -import qualified Data.Monoid.Null as Null -import qualified Data.MonoidMap.Internal as Internal - --------------------------------------------------------------------------------- --- Unsafe construction --------------------------------------------------------------------------------- - --- | \(O(1)\). /Unsafely/ constructs a 'MonoidMap' from an ordinary 'Map'. --- --- Constructs a 'MonoidMap' in /constant time/, without imposing the burden --- of a canonicalisation step to remove 'null' values. --- --- When applied to a given 'Map' @m@, this function /expects/ but does /not/ --- check the following pre-condition: --- --- @ --- 'F.all' ('not' . 'Null.null') m --- @ --- --- Not satisfying this pre-condition will result in undefined behaviour. --- --- See 'fromMap' for a safe version of this function. --- -unsafeFromMap :: Map k v -> MonoidMap k v -unsafeFromMap = coerce diff --git a/components/monoidmap/Data/MonoidMap/Internal.hs b/components/monoidmap/Data/MonoidMap/Internal.hs new file mode 100644 --- /dev/null +++ b/components/monoidmap/Data/MonoidMap/Internal.hs @@ -0,0 +1,3521 @@ +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_HADDOCK not-home #-} +{- HLINT ignore "Avoid lambda" -} +{- HLINT ignore "Avoid lambda using `infix`" -} +{- HLINT ignore "Redundant bracket" -} + +-- | +-- Copyright: © 2022–2025 Jonathan Knowles +-- License: Apache-2.0 +-- +-- Provides /internal/ operations for the 'MonoidMap' type. +-- +module Data.MonoidMap.Internal + ( + -- * Types + MonoidMap (..) + , NonNull (..) + + -- * General operations + + -- ** Construction + , empty + , fromList + , fromListWith + , fromMap + , fromMapWith + , fromSet + , singleton + + -- ** Deconstruction + , toList + , toMap + + -- ** Lookup + , get + + -- ** Modification + , set + , adjust + , nullify + + -- ** Membership + , null + , nullKey + , nonNull + , nonNullCount + , nonNullKey + , nonNullKeys + + -- ** Slicing + , take + , drop + , splitAt + + -- ** Filtering + , filter + , filterKeys + , filterWithKey + + -- ** Partitioning + , partition + , partitionKeys + , partitionWithKey + + -- ** Mapping + , map + , mapKeys + , mapKeysWith + , mapWithKey + + -- ** Folding + , foldl + , foldl' + , foldr + , foldr' + , foldlWithKey + , foldlWithKey' + , foldrWithKey + , foldrWithKey' + , foldMapWithKey + , foldMapWithKey' + + -- ** Traversal + , traverse + , traverseWithKey + , mapAccumL + , mapAccumLWithKey + , mapAccumR + , mapAccumRWithKey + + -- * Monoidal operations + + -- ** Association + , append + + -- ** Subtraction + , minus + , minusMaybe + , monus + + -- ** Inversion + , invert + + -- ** Exponentiation + , power + + -- ** Comparison + , isSubmapOf + , isSubmapOfBy + , disjoint + , disjointBy + + -- ** Intersection + , intersection + , intersectionWith + , intersectionWithA + + -- ** Union + , union + , unionWith + , unionWithA + + -- ** Prefixes + , isPrefixOf + , stripPrefix + , commonPrefix + , stripCommonPrefix + + -- ** Suffixes + , isSuffixOf + , stripSuffix + , commonSuffix + , stripCommonSuffix + + -- ** Overlap + , overlap + , stripPrefixOverlap + , stripSuffixOverlap + , stripOverlap + ) + where + +import Prelude hiding + ( drop + , filter + , foldl + , foldl' + , foldr + , lookup + , map + , null + , splitAt + , subtract + , take + , traverse + ) + +import Control.Applicative + ( Applicative (..) ) +import Control.DeepSeq + ( NFData ) +import Data.Bifoldable + ( Bifoldable ) +import Data.Coerce + ( coerce ) +import Data.Function + ( (&) ) +import Data.Functor.Classes + ( Eq1, Eq2, Show1, Show2 ) +import Data.Functor.Identity + ( Identity (..) ) +import Data.Group + ( Abelian, Group ) +import Data.Map.Strict + ( Map, lookup ) +import Data.Maybe + ( fromMaybe, isJust ) +import Data.Monoid.GCD + ( DistributiveGCDMonoid + , GCDMonoid + , LeftDistributiveGCDMonoid + , LeftGCDMonoid + , OverlappingGCDMonoid + , RightDistributiveGCDMonoid + , RightGCDMonoid + ) +import Data.Monoid.LCM + ( DistributiveLCMMonoid, LCMMonoid ) +import Data.Monoid.Monus + ( Monus (..) ) +import Data.Monoid.Null + ( MonoidNull, PositiveMonoid ) +import Data.Semigroup + ( stimes ) +import Data.Semigroup.Cancellative + ( Cancellative + , Commutative + , LeftCancellative + , LeftReductive + , Reductive (..) + , RightCancellative + , RightReductive + ) +import Data.Set + ( Set ) +import GHC.Exts + ( IsList (Item) ) +import NoThunks.Class + ( NoThunks ) +import Text.Read + ( Read (..) ) + +import qualified Data.Bifunctor as B +import qualified Data.Foldable as F +import qualified Data.List as L +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Merge.Strict as Map +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import qualified GHC.Exts as GHC +import qualified Data.Traversable as Traversable + +import qualified Data.Group as C +import qualified Data.Monoid.GCD as C +import qualified Data.Monoid.LCM as C +import qualified Data.Monoid.Null as C +import qualified Data.Semigroup.Cancellative as C + +-------------------------------------------------------------------------------- +-- Type +-------------------------------------------------------------------------------- + +newtype MonoidMap k v = MonoidMap (Map k (NonNull v)) + deriving (Eq, Show, NFData, NoThunks) + via Map k v + deriving (Eq1, Show1, Foldable) + via Map k + deriving (Eq2, Show2, Bifoldable) + via Map + +-- Internal alias used when extra brevity is required. +type MM = MonoidMap + +-------------------------------------------------------------------------------- +-- Non-null values +-------------------------------------------------------------------------------- + +newtype NonNull v = UnsafeNonNull {getNonNull :: v} + +maybeNonNull :: MonoidNull v => v -> Maybe (NonNull v) +maybeNonNull !v + | C.null v = Nothing + | otherwise = Just (UnsafeNonNull v) +{-# INLINE maybeNonNull #-} + +applyNonNull :: (v -> a) -> (NonNull v -> a) +applyNonNull = coerce +{-# INLINE applyNonNull #-} + +applyNonNull2 :: (v1 -> v2 -> a) -> (NonNull v1 -> NonNull v2 -> a) +applyNonNull2 = coerce +{-# INLINE applyNonNull2 #-} + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance (Ord k, MonoidNull v) => + IsList (MonoidMap k v) + where + type Item (MonoidMap k v) = (k, v) + fromList = fromList + toList = toList + +instance (Ord k, Read k, MonoidNull v, Read v) => + Read (MonoidMap k v) + where + readPrec = fromMap <$> readPrec + +-------------------------------------------------------------------------------- +-- Instances: Semigroup and subclasses +-------------------------------------------------------------------------------- + +instance (Ord k, MonoidNull v) => + Semigroup (MonoidMap k v) + where + (<>) = append + stimes 0 = const mempty + stimes 1 = id + stimes n = map (stimes n) + +instance (Ord k, MonoidNull v, Commutative v) => + Commutative (MonoidMap k v) + +instance (Ord k, MonoidNull v, LeftReductive v) => + LeftReductive (MonoidMap k v) + where + isPrefixOf = isPrefixOf + stripPrefix = stripPrefix + +instance (Ord k, MonoidNull v, RightReductive v) => + RightReductive (MonoidMap k v) + where + isSuffixOf = isSuffixOf + stripSuffix = stripSuffix + +instance (Ord k, MonoidNull v, Reductive v) => + Reductive (MonoidMap k v) + where + () = minusMaybe + +instance (Ord k, MonoidNull v, LeftCancellative v) => + LeftCancellative (MonoidMap k v) + +instance (Ord k, MonoidNull v, RightCancellative v) => + RightCancellative (MonoidMap k v) + +instance (Ord k, MonoidNull v, Cancellative v) => + Cancellative (MonoidMap k v) + +-------------------------------------------------------------------------------- +-- Instances: Monoid and subclasses +-------------------------------------------------------------------------------- + +instance (Ord k, MonoidNull v) => + Monoid (MonoidMap k v) + where + mempty = empty + +instance (Ord k, MonoidNull v) => + MonoidNull (MonoidMap k v) + where + null = null + +instance (Ord k, PositiveMonoid v) => + PositiveMonoid (MonoidMap k v) + +instance (Ord k, MonoidNull v, LeftGCDMonoid v) => + LeftGCDMonoid (MonoidMap k v) + where + commonPrefix = commonPrefix + +instance (Ord k, MonoidNull v, LeftDistributiveGCDMonoid v) => + LeftDistributiveGCDMonoid (MonoidMap k v) + +instance (Ord k, MonoidNull v, RightGCDMonoid v) => + RightGCDMonoid (MonoidMap k v) + where + commonSuffix = commonSuffix + +instance (Ord k, MonoidNull v, RightDistributiveGCDMonoid v) => + RightDistributiveGCDMonoid (MonoidMap k v) + +instance (Ord k, MonoidNull v, OverlappingGCDMonoid v) => + OverlappingGCDMonoid (MonoidMap k v) + where + overlap = overlap + stripPrefixOverlap = stripPrefixOverlap + stripSuffixOverlap = stripSuffixOverlap + stripOverlap = stripOverlap + +instance (Ord k, MonoidNull v, GCDMonoid v) => + GCDMonoid (MonoidMap k v) + where + gcd = intersection + +instance (Ord k, MonoidNull v, DistributiveGCDMonoid v) => + DistributiveGCDMonoid (MonoidMap k v) + +instance (Ord k, MonoidNull v, LCMMonoid v) => + LCMMonoid (MonoidMap k v) + where + lcm = union + +instance (Ord k, MonoidNull v, DistributiveLCMMonoid v) => + DistributiveLCMMonoid (MonoidMap k v) + +instance (Ord k, MonoidNull v, Monus v) => + Monus (MonoidMap k v) + where + (<\>) = monus + +-------------------------------------------------------------------------------- +-- Instances: Group and subclasses +-------------------------------------------------------------------------------- + +instance (Ord k, MonoidNull v, Group v) => + Group (MonoidMap k v) + where + invert = invert + (~~) = minus + pow = power + +instance (Ord k, MonoidNull v, Abelian v) => + Abelian (MonoidMap k v) + +-------------------------------------------------------------------------------- +-- Construction +-------------------------------------------------------------------------------- + +-- | \(O(1)\). The empty 'MonoidMap'. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k 'empty' '==' 'mempty' +-- @ +-- +-- Provides the definition of 'mempty' for the 'MonoidMap' instance of +-- 'Monoid'. +-- +empty :: MonoidMap k v +empty = MonoidMap Map.empty + +-- | \(O(n \log n)\). Constructs a 'MonoidMap' from a list of key-value pairs. +-- +-- If the list contains more than one value for the same key, values are +-- combined together in the order that they appear with the '(<>)' operator. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('fromList' kvs) '==' +-- 'foldMap' 'snd' ('L.filter' (('==' k) . fst) kvs) +-- @ +-- +-- Satisfies the following round-trip property: +-- +-- @ +-- 'fromList' ('toList' m) '==' m +-- @ +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> 'fromList' [(1,"a"), (2,"x"), (1,"b"), (2,"y"), (1,"c"), (2,"z")] +-- 'fromList' [(1,"abc"), (2,"xyz")] +-- @ +-- +fromList :: (Ord k, MonoidNull v) => [(k, v)] -> MonoidMap k v +fromList = fromListWith (<>) + +-- | \(O(n \log n)\). Constructs a 'MonoidMap' from a list of key-value pairs, +-- with a combining function for values. +-- +-- If the list contains more than one value for the same key, values are +-- combined together in the order that they appear with the given combining +-- function. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('fromListWith' f kvs) '==' +-- 'maybe' 'mempty' ('F.foldl1' f) +-- ('NE.nonEmpty' ('snd' '<$>' 'L.filter' (('==' k) . fst) kvs)) +-- @ +-- +fromListWith + :: (Ord k, MonoidNull v) + => (v -> v -> v) + -- ^ Function with which to combine values for duplicate keys. + -> [(k, v)] + -> MonoidMap k v +fromListWith f = + -- The 'Map.fromListWith' function combines values for duplicate keys in + -- /reverse order/, so we must flip the provided combining function. + fromMap . Map.fromListWith (flip f) + +-- | \(O(n)\). Constructs a 'MonoidMap' from an ordinary 'Map'. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('fromMap' m) '==' 'Map'.'Map.findWithDefault' 'mempty' k m +-- @ +-- +-- This function performs canonicalisation of 'C.null' values, and has a time +-- complexity that is linear in the size of the map. +-- +fromMap :: MonoidNull v => Map k v -> MonoidMap k v +fromMap = MonoidMap . Map.mapMaybe maybeNonNull + +-- | \(O(n)\). Constructs a 'MonoidMap' from an ordinary 'Map', applying +-- the given function to all values. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('fromMapWith' f m) '==' 'maybe' 'mempty' f ('Map'.'Map.lookup' k m) +-- @ +-- +-- This function performs canonicalisation of 'C.null' values, and has a time +-- complexity that is linear in the size of the map. +-- +-- @since 0.0.4.0 +-- +fromMapWith :: MonoidNull v2 => (v1 -> v2) -> Map k v1 -> MonoidMap k v2 +fromMapWith f = MonoidMap . Map.mapMaybe (maybeNonNull . f) + +-- | \(O(n)\). Constructs a 'MonoidMap' from a 'Set' and a function from +-- keys to values. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('fromSet' f ks) '==' +-- if 'Set'.'Set.member' k ks +-- then f k +-- else 'mempty' +-- @ +-- +-- This function performs canonicalisation of 'C.null' values, and has a time +-- complexity that is linear in the 'Set.size' of the set. +-- +-- @since 0.0.2.0 +-- +fromSet :: MonoidNull v => (k -> v) -> Set k -> MonoidMap k v +fromSet f = fromMap . Map.fromSet f + +-- | \(O(1)\). Constructs a 'MonoidMap' from a single key-value pair. +-- +-- Satisfies the following property: +-- +-- @ +-- 'get' k ('singleton' k v) '==' v +-- @ +-- +-- Nullifying the value for key __@k@__ produces an 'empty' map: +-- +-- @ +-- 'nullify' k ('singleton' k v) '==' 'empty' +-- @ +-- +singleton :: (Ord k, MonoidNull v) => k -> v -> MonoidMap k v +singleton k v = set k v mempty + +-------------------------------------------------------------------------------- +-- Deconstruction +-------------------------------------------------------------------------------- + +-- | \(O(n)\). Converts a 'MonoidMap' to a list of key-value pairs, where the +-- keys are in ascending order. +-- +-- The result only includes entries with values that are not 'C.null'. +-- +-- Satisfies the following round-trip property: +-- +-- @ +-- 'fromList' ('toList' m) '==' m +-- @ +-- +-- The resulting list is sorted in ascending key order: +-- +-- @ +-- 'L.sortOn' 'fst' ('toList' m) '==' 'toList' m +-- @ +-- +toList :: MonoidMap k v -> [(k, v)] +toList = Map.toAscList . toMap + +-- | \(O(1)\). Converts a 'MonoidMap' to an ordinary 'Map'. +-- +-- The result only includes entries with values that are not 'C.null'. +-- +-- Satisfies the following round-trip property: +-- +-- @ +-- 'fromMap' ('toMap' m) '==' m +-- @ +-- +toMap :: forall k v. MonoidMap k v -> Map k v +toMap = coerce + +-------------------------------------------------------------------------------- +-- Lookup +-------------------------------------------------------------------------------- + +-- | \(O(\log n)\). Gets the value associated with the given key. +-- +-- By default, every key in an 'empty' map is associated with a value of +-- 'mempty': +-- +-- @ +-- ∀ k. 'get' k 'empty' '==' 'mempty' +-- @ +-- +get :: (Ord k, Monoid v) => k -> MonoidMap k v -> v +get k m = fromMaybe mempty $ Map.lookup k $ toMap m + +-------------------------------------------------------------------------------- +-- Modification +-------------------------------------------------------------------------------- + +-- | \(O(\log n)\). Sets the value associated with the given key. +-- +-- Satisfies the following property: +-- +-- @ +-- 'get' k ('set' k v m) '==' v +-- @ +-- +set :: (Ord k, MonoidNull v) => k -> v -> MonoidMap k v -> MonoidMap k v +set k v (MonoidMap m) = MonoidMap $ case maybeNonNull v of + Just v0 -> Map.insert k v0 m + Nothing -> Map.delete k m + +-- | \(O(\log n)\). Adjusts the value associated with the given key. +-- +-- Satisfies the following property: +-- +-- @ +-- 'adjust' f k m '==' 'set' k (f ('get' k m)) m +-- @ +-- +adjust + :: (Ord k, MonoidNull v) + => (v -> v) + -> k + -> MonoidMap k v + -> MonoidMap k v +adjust f k (MonoidMap m) = MonoidMap $ + Map.alter (maybeNonNull . maybe (f mempty) (applyNonNull f)) k m + +-- | \(O(\log n)\). Sets the value associated with the given key to 'mempty'. +-- +-- Satisfies the following property: +-- +-- @ +-- 'get' k ('nullify' k m) '==' 'mempty' +-- @ +-- +nullify :: Ord k => k -> MonoidMap k v -> MonoidMap k v +nullify k (MonoidMap m) = MonoidMap $ Map.delete k m + +-------------------------------------------------------------------------------- +-- Membership +-------------------------------------------------------------------------------- + +-- | \(O(1)\). Returns 'True' if (and only if) all values in the map are +-- 'C.null'. +-- +-- Satisfies the following property: +-- +-- @ +-- 'null' m '==' (∀ k. 'nullKey' k m) +-- @ +-- +-- Provides the definition of 'C.null' for the 'MonoidMap' instance of +-- 'MonoidNull'. +-- +null :: MonoidMap k v -> Bool +null = Map.null . toMap + +-- | \(O(\log n)\). Returns 'True' if (and only if) the given key is associated +-- with a value that is 'C.null'. +-- +-- Satisfies the following property: +-- +-- @ +-- 'nullKey' k m '==' 'C.null' ('get' k m) +-- @ +-- +nullKey :: Ord k => k -> MonoidMap k v -> Bool +nullKey k = Map.notMember k . toMap + +-- | \(O(1)\). Returns 'True' if (and only if) the map contains at least one +-- value that is not 'C.null'. +-- +-- Satisfies the following property: +-- +-- @ +-- 'nonNull' m '==' (∃ k. 'nonNullKey' k m) +-- @ +-- +nonNull :: MonoidMap k v -> Bool +nonNull = not . null + +-- | \(O(1)\). Returns a count of all values in the map that are not 'C.null'. +-- +-- Satisfies the following property: +-- +-- @ +-- 'nonNullCount' m '==' 'Set.size' ('nonNullKeys' m) +-- @ +-- +nonNullCount :: MonoidMap k v -> Int +nonNullCount = Map.size . toMap + +-- | \(O(\log n)\). Returns 'True' if (and only if) the given key is associated +-- with a value that is not 'C.null'. +-- +-- Satisfies the following property: +-- +-- @ +-- 'nonNullKey' k m '==' 'not' ('C.null' ('get' k m)) +-- @ +-- +nonNullKey :: Ord k => k -> MonoidMap k v -> Bool +nonNullKey k = Map.member k . toMap + +-- | \(O(n)\). Returns the set of keys associated with values that are not +-- 'C.null'. +-- +-- Satisfies the following property: +-- +-- @ +-- k '`Set.member`' ('nonNullKeys' m) '==' 'nonNullKey' k m +-- @ +-- +nonNullKeys :: MonoidMap k v -> Set k +nonNullKeys = Map.keysSet . toMap + +-------------------------------------------------------------------------------- +-- Slicing +-------------------------------------------------------------------------------- + +-- | \(O(\log n)\). /Takes/ a slice from a map. +-- +-- This function takes a given number of non-'C.null' entries from a map, +-- producing a new map from the entries that were /taken/. +-- +-- Entries are taken in /key order/, beginning with the /smallest/ keys. +-- +-- Satifies the following property: +-- +-- @ +-- 'take' n '==' 'fromList' . 'Prelude.take' n . 'toList' +-- @ +-- +take :: Int -> MonoidMap k v -> MonoidMap k v +take i (MonoidMap m) = MonoidMap (Map.take i m) + +-- | \(O(\log n)\). /Drops/ a slice from a map. +-- +-- This function drops a given number of non-'C.null' entries from a map, +-- producing a new map from the entries that /remain/. +-- +-- Entries are dropped in /key order/, beginning with the /smallest/ keys. +-- +-- Satifies the following property: +-- +-- @ +-- 'drop' n '==' 'fromList' . 'Prelude.drop' n . 'toList' +-- @ +-- +drop :: Int -> MonoidMap k v -> MonoidMap k v +drop i (MonoidMap m) = MonoidMap (Map.drop i m) + +-- | \(O(\log n)\). /Splits/ a map into /two/ slices. +-- +-- This function is equivalent to a combination of 'take' and 'drop': +-- +-- @ +-- 'splitAt' n m '==' ('take' n m, 'drop' n m) +-- @ +-- +-- The resulting maps can be combined to reproduce the original map: +-- +-- @ +-- 'splitAt' n m '&' +-- \\(m1, m2) -> m1 '<>' m2 '==' m +-- @ +-- +-- The resulting maps have disjoint sets of non-'C.null' entries: +-- +-- @ +-- 'splitAt' n m '&' +-- \\(m1, m2) -> 'Set.disjoint' ('nonNullKeys' m1) ('nonNullKeys' m2) +-- @ +-- +splitAt :: Int -> MonoidMap k a -> (MonoidMap k a, MonoidMap k a) +splitAt i m = (take i m, drop i m) + +-------------------------------------------------------------------------------- +-- Filtering +-------------------------------------------------------------------------------- + +-- | \(O(n)\). Filters a map according to a predicate on /values/. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('filter' f m) '==' +-- if f ('get' k m) +-- then 'get' k m +-- else 'mempty' +-- @ +-- +-- The resulting map is identical to that obtained by constructing a map from a +-- filtered list of key-value pairs: +-- +-- @ +-- 'filter' f m '==' 'fromList' ('L.filter' (f . 'snd') ('toList' m)) +-- @ +-- +filter :: (v -> Bool) -> MonoidMap k v -> MonoidMap k v +filter f (MonoidMap m) = MonoidMap $ Map.filter (applyNonNull f) m + +-- | \(O(n)\). Filters a map according to a predicate on /keys/. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('filterKeys' f m) '==' +-- if f k +-- then 'get' k m +-- else 'mempty' +-- @ +-- +-- The resulting map is identical to that obtained by constructing a map from a +-- filtered list of key-value pairs: +-- +-- @ +-- 'filter' f m '==' 'fromList' ('L.filter' (f . 'fst') ('toList' m)) +-- @ +-- +filterKeys :: (k -> Bool) -> MonoidMap k v -> MonoidMap k v +filterKeys f (MonoidMap m) = MonoidMap $ Map.filterWithKey (\k _ -> f k) m + +-- | \(O(n)\). Filters a map according to a predicate on /keys and values/. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('filterWithKey' f m) '==' +-- if f k ('get' k m) +-- then 'get' k m +-- else 'mempty' +-- @ +-- +-- The resulting map is identical to that obtained by constructing a map from a +-- filtered list of key-value pairs: +-- +-- @ +-- 'filterWithKey' f m '==' 'fromList' ('L.filter' ('uncurry' f) ('toList' m)) +-- @ +-- +filterWithKey :: (k -> v -> Bool) -> MonoidMap k v -> MonoidMap k v +filterWithKey f (MonoidMap m) = + MonoidMap $ Map.filterWithKey (applyNonNull . f) m + +-------------------------------------------------------------------------------- +-- Partitioning +-------------------------------------------------------------------------------- + +-- | \(O(n)\). Partitions a map according to a predicate on /values/. +-- +-- Satisfies the following property: +-- +-- @ +-- 'partition' f m '==' +-- ( 'filter' \ \ f m +-- , 'filter' ('not' . f) m +-- ) +-- @ +-- +-- The resulting maps can be combined to reproduce the original map: +-- +-- @ +-- 'partition' f m '&' \\(m1, m2) -> +-- m1 '<>' m2 '==' m +-- @ +-- +-- The resulting maps have disjoint sets of non-'C.null' entries: +-- +-- @ +-- 'partition' f m '&' \\(m1, m2) -> +-- 'Set.disjoint' +-- ('nonNullKeys' m1) +-- ('nonNullKeys' m2) +-- @ +-- +partition :: (v -> Bool) -> MonoidMap k v -> (MonoidMap k v, MonoidMap k v) +partition f (MonoidMap m) = + B.bimap MonoidMap MonoidMap $ Map.partition (applyNonNull f) m + +-- | \(O(n)\). Partitions a map according to a predicate on /keys/. +-- +-- Satisfies the following property: +-- +-- @ +-- 'partitionKeys' f m '==' +-- ( 'filterKeys' \ \ f m +-- , 'filterKeys' ('not' . f) m +-- ) +-- @ +-- +-- The resulting maps can be combined to reproduce the original map: +-- +-- @ +-- 'partitionKeys' f m '&' \\(m1, m2) -> +-- m1 '<>' m2 '==' m +-- @ +-- +-- The resulting maps have disjoint sets of non-'C.null' entries: +-- +-- @ +-- 'partitionKeys' f m '&' \\(m1, m2) -> +-- 'Set.disjoint' +-- ('nonNullKeys' m1) +-- ('nonNullKeys' m2) +-- @ +-- +partitionKeys + :: (k -> Bool) -> MonoidMap k v -> (MonoidMap k v, MonoidMap k v) +partitionKeys f (MonoidMap m) = + B.bimap MonoidMap MonoidMap $ Map.partitionWithKey (\k _ -> f k) m + +-- | \(O(n)\). Partitions a map according to a predicate on /keys and values/. +-- +-- Satisfies the following property: +-- +-- @ +-- 'partitionWithKey' f m '==' +-- ( 'filterWithKey' \ \ \ \ \ \ f m +-- , 'filterWithKey' (('fmap' . 'fmap') 'not' f) m +-- ) +-- @ +-- +-- The resulting maps can be combined to reproduce the original map: +-- +-- @ +-- 'partitionWithKey' f m '&' \\(m1, m2) -> +-- m1 '<>' m2 '==' m +-- @ +-- +-- The resulting maps have disjoint sets of non-'C.null' entries: +-- +-- @ +-- 'partitionWithKey' f m '&' \\(m1, m2) -> +-- 'Set.disjoint' +-- ('nonNullKeys' m1) +-- ('nonNullKeys' m2) +-- @ +-- +partitionWithKey + :: (k -> v -> Bool) -> MonoidMap k v -> (MonoidMap k v, MonoidMap k v) +partitionWithKey f (MonoidMap m) = + B.bimap MonoidMap MonoidMap $ Map.partitionWithKey (applyNonNull . f) m + +-------------------------------------------------------------------------------- +-- Mapping +-------------------------------------------------------------------------------- + +-- | \(O(n)\). Applies a function to all non-'C.null' values of a 'MonoidMap'. +-- +-- Satisfies the following properties for all functions __@f@__: +-- +-- @ +-- ('get' k m '==' 'mempty') ==> ('get' k ('map' f m) '==' 'mempty' ) +-- ('get' k m '/=' 'mempty') ==> ('get' k ('map' f m) '==' f ('get' k m)) +-- @ +-- +-- === Conditional properties +-- +-- If applying function __@f@__ to 'mempty' produces 'mempty', then the +-- following additional properties hold: +-- +-- @ +-- (f 'mempty' '==' 'mempty') +-- ==> +-- (∀ k. 'get' k ('map' f m) '==' f ('get' k m)) +-- @ +-- +-- @ +-- (f 'mempty' '==' 'mempty') +-- ==> +-- (∀ g. 'map' (f . g) m '==' 'map' f ('map' g m)) +-- @ +-- +map + :: MonoidNull v2 + => (v1 -> v2) + -> MonoidMap k v1 + -> MonoidMap k v2 +map f (MonoidMap m) = + MonoidMap $ Map.mapMaybe (maybeNonNull . applyNonNull f) m + +-- | \(O(n \log n)\). Applies a function to all the keys of a 'MonoidMap' that +-- are associated with non-'C.null' values. +-- +-- If the resultant map would contain more than one value for the same key, +-- values are combined together in ascending key order with the '(<>)' +-- operator. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('mapKeys' f m) '==' +-- 'F.foldMap' +-- ('`get`' m) +-- ('Set.filter' (('==') k . f) ('nonNullKeys' m)) +-- @ +-- +mapKeys + :: (Ord k2, MonoidNull v) + => (k1 -> k2) + -> MonoidMap k1 v + -> MonoidMap k2 v +mapKeys = mapKeysWith (<>) + +-- | \(O(n \log n)\). Applies a function to all the keys of a 'MonoidMap' that +-- are associated with non-'C.null' values, with a combining function for +-- values. +-- +-- If the resultant map would contain more than one value for the same key, +-- values are combined together in ascending key order with the given +-- combining function. +-- +-- Satisfies the following property: +-- +-- @ +-- 'mapKeysWith' c f '==' 'fromListWith' c . 'fmap' ('B.first' f) . 'toList' +-- @ +-- +mapKeysWith + :: (Ord k2, MonoidNull v) + => (v -> v -> v) + -- ^ Function with which to combine values for duplicate keys. + -> (k1 -> k2) + -> MonoidMap k1 v + -> MonoidMap k2 v +mapKeysWith combine fk = fromListWith combine . fmap (B.first fk) . toList + +-- | \(O(n)\). Applies a key-dependent function to all non-'C.null' values of +-- a 'MonoidMap'. +-- +-- Satisfies the following properties for all functions __@f@__: +-- +-- @ +-- ('nonNullKey' k m) ==> ('get' k ('mapWithKey' f m) '==' f k ('get' k m)) +-- ( 'nullKey' k m) ==> ('get' k ('mapWithKey' f m) '==' 'mempty' ) +-- @ +-- +-- @since 0.0.3.0 +-- +mapWithKey + :: MonoidNull v2 + => (k -> v1 -> v2) + -> MonoidMap k v1 + -> MonoidMap k v2 +mapWithKey f (MonoidMap m) = + MonoidMap . runIdentity $ + Map.traverseMaybeWithKey + (\k v -> Identity $ maybeNonNull $ applyNonNull (f k) v) m + +-------------------------------------------------------------------------------- +-- Lazy folding +-------------------------------------------------------------------------------- + +-- | \(O(n)\). Folds over the values in the map using the given +-- left-associative binary operator. +-- +-- Satisfies the following property: +-- +-- @ +-- 'foldl' f r m '==' 'Map'.'Map.foldl' f r ('toMap' m) +-- @ +-- +-- @since 0.0.1.7 +-- +foldl :: (r -> v -> r) -> r -> MonoidMap k v -> r +foldl = + (coerce + :: ((r -> v -> r) -> r -> Map k v -> r) + -> ((r -> v -> r) -> r -> MonoidMap k v -> r) + ) + Map.foldl +{-# INLINE foldl #-} + +-- | \(O(n)\). Folds over the values in the map using the given +-- right-associative binary operator. +-- +-- Satisfies the following property: +-- +-- @ +-- 'foldr' f r m '==' 'Map'.'Map.foldr' f r ('toMap' m) +-- @ +-- +-- @since 0.0.1.7 +-- +foldr :: (v -> r -> r) -> r -> MonoidMap k v -> r +foldr = + (coerce + :: ((v -> r -> r) -> r -> Map k v -> r) + -> ((v -> r -> r) -> r -> MonoidMap k v -> r) + ) + Map.foldr +{-# INLINE foldr #-} + +-- | \(O(n)\). Folds over the keys and values in the map using the given +-- left-associative binary operator. +-- +-- Satisfies the following property: +-- +-- @ +-- 'foldlWithKey' f r m '==' 'Map'.'Map.foldlWithKey' f r ('toMap' m) +-- @ +-- +-- @since 0.0.1.7 +-- +foldlWithKey :: (r -> k -> v -> r) -> r -> MonoidMap k v -> r +foldlWithKey = + (coerce + :: ((r -> k -> v -> r) -> r -> Map k v -> r) + -> ((r -> k -> v -> r) -> r -> MonoidMap k v -> r) + ) + Map.foldlWithKey +{-# INLINE foldlWithKey #-} + +-- | \(O(n)\). Folds over the keys and values in the map using the given +-- right-associative binary operator. +-- +-- Satisfies the following property: +-- +-- @ +-- 'foldrWithKey' f r m '==' 'Map'.'Map.foldrWithKey' f r ('toMap' m) +-- @ +-- +-- @since 0.0.1.7 +-- +foldrWithKey :: (k -> v -> r -> r) -> r -> MonoidMap k v -> r +foldrWithKey = + (coerce + :: ((k -> v -> r -> r) -> r -> Map k v -> r) + -> ((k -> v -> r -> r) -> r -> MonoidMap k v -> r) + ) + Map.foldrWithKey +{-# INLINE foldrWithKey #-} + +-- | \(O(n)\). Folds over the keys and values in the map using the given +-- monoid. +-- +-- Satisfies the following property: +-- +-- @ +-- 'foldMapWithKey' f m '==' 'Map'.'Map.foldMapWithKey' f ('toMap' m) +-- @ +-- +-- @since 0.0.1.7 +-- +foldMapWithKey :: Monoid r => (k -> v -> r) -> MonoidMap k v -> r +foldMapWithKey = + (coerce + :: ((k -> v -> r) -> Map k v -> r) + -> ((k -> v -> r) -> MonoidMap k v -> r) + ) + Map.foldMapWithKey +{-# INLINE foldMapWithKey #-} + +-------------------------------------------------------------------------------- +-- Strict folding +-------------------------------------------------------------------------------- + +-- | \(O(n)\). A strict version of 'foldl'. +-- +-- Each application of the operator is evaluated before using the result in the +-- next application. This function is strict in the starting value. +-- +-- @since 0.0.1.7 +-- +foldl' :: (r -> v -> r) -> r -> MonoidMap k v -> r +foldl' = + (coerce + :: ((r -> v -> r) -> r -> Map k v -> r) + -> ((r -> v -> r) -> r -> MonoidMap k v -> r) + ) + Map.foldl' +{-# INLINE foldl' #-} + +-- | \(O(n)\). A strict version of 'foldr'. +-- +-- Each application of the operator is evaluated before using the result in the +-- next application. This function is strict in the starting value. +-- +-- @since 0.0.1.7 +-- +foldr' :: (v -> r -> r) -> r -> MonoidMap k v -> r +foldr' = + (coerce + :: ((v -> r -> r) -> r -> Map k v -> r) + -> ((v -> r -> r) -> r -> MonoidMap k v -> r) + ) + Map.foldr' +{-# INLINE foldr' #-} + +-- | \(O(n)\). A strict version of 'foldlWithKey'. +-- +-- Each application of the operator is evaluated before using the result in the +-- next application. This function is strict in the starting value. +-- +-- @since 0.0.1.7 +-- +foldlWithKey' :: (r -> k -> v -> r) -> r -> MonoidMap k v -> r +foldlWithKey' = + (coerce + :: ((r -> k -> v -> r) -> r -> Map k v -> r) + -> ((r -> k -> v -> r) -> r -> MonoidMap k v -> r) + ) + Map.foldlWithKey' +{-# INLINE foldlWithKey' #-} + +-- | \(O(n)\). A strict version of 'foldrWithKey'. +-- +-- Each application of the operator is evaluated before using the result in the +-- next application. This function is strict in the starting value. +-- +-- @since 0.0.1.7 +-- +foldrWithKey' :: (k -> v -> r -> r) -> r -> MonoidMap k v -> r +foldrWithKey' = + (coerce + :: ((k -> v -> r -> r) -> r -> Map k v -> r) + -> ((k -> v -> r -> r) -> r -> MonoidMap k v -> r) + ) + Map.foldrWithKey' +{-# INLINE foldrWithKey' #-} + +-- | \(O(n)\). A strict version of 'foldMapWithKey'. +-- +-- Each application of `mappend` is evaluated before using the result in the +-- next application. +-- +-- @since 0.0.1.8 +-- +foldMapWithKey' :: Monoid r => (k -> v -> r) -> MonoidMap k v -> r +foldMapWithKey' f = foldlWithKey' (\r k v -> r <> f k v) mempty +{-# INLINE foldMapWithKey' #-} + +-------------------------------------------------------------------------------- +-- Traversal +-------------------------------------------------------------------------------- + +-- | \(O(n)\). Traverses over the values of a map using the given function. +-- +-- Satisfies the following property: +-- +-- @ +-- 'traverse' f m '==' +-- 'fmap' 'fromMap' ('Traversable'.'Traversable.traverse' f ('toMap' m)) +-- @ +-- +-- @since 0.0.1.9 +-- +traverse + :: Applicative t + => MonoidNull v2 + => (v1 -> t v2) + -> MonoidMap k v1 + -> t (MonoidMap k v2) +traverse f = traverseWithKey (const f) +{-# INLINE traverse #-} + +-- | \(O(n)\). Traverses over the keys and values of a map using the given +-- function. +-- +-- Satisfies the following property: +-- +-- @ +-- 'traverseWithKey' f m '==' +-- 'fmap' 'fromMap' ('Map'.'Map.traverseWithKey' f ('toMap' m)) +-- @ +-- +-- @since 0.0.1.9 +-- +traverseWithKey + :: Applicative t + => MonoidNull v2 + => (k -> v1 -> t v2) + -> MonoidMap k v1 + -> t (MonoidMap k v2) +traverseWithKey f (MonoidMap m) = + MonoidMap <$> + Map.traverseMaybeWithKey + (\k v -> maybeNonNull <$> applyNonNull (f k) v) m +{-# INLINE traverseWithKey #-} + +-- | \(O(n)\). Threads an accumulating argument through the map in ascending +-- order of keys. +-- +-- Satisfies the following property: +-- +-- @ +-- 'mapAccumL' f s m '==' +-- 'fmap' 'fromMap' ('Traversable'.'Traversable.mapAccumL' f s ('toMap' m)) +-- @ +-- +-- @since 0.0.1.9 +-- +mapAccumL + :: MonoidNull v2 + => (s -> v1 -> (s, v2)) + -> s + -> MonoidMap k v1 + -> (s, MonoidMap k v2) +mapAccumL f s m = + (coerce + :: ((v1 -> StateL s v2 ) -> MM k v1 -> StateL s (MM k v2)) + -> ((v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2)) + ) + traverse (flip f) m s +{-# INLINE mapAccumL #-} + +-- | \(O(n)\). Threads an accumulating argument through the map in descending +-- order of keys. +-- +-- Satisfies the following property: +-- +-- @ +-- 'mapAccumR' f s m '==' +-- 'fmap' 'fromMap' ('Traversable'.'Traversable.mapAccumR' f s ('toMap' m)) +-- @ +-- +-- @since 0.0.1.9 +-- +mapAccumR + :: MonoidNull v2 + => (s -> v1 -> (s, v2)) + -> s + -> MonoidMap k v1 + -> (s, MonoidMap k v2) +mapAccumR f s m = + (coerce + :: ((v1 -> StateR s v2 ) -> MM k v1 -> StateR s (MM k v2)) + -> ((v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2)) + ) + traverse (flip f) m s +{-# INLINE mapAccumR #-} + +-- | \(O(n)\). Threads an accumulating argument through the map in ascending +-- order of keys. +-- +-- Satisfies the following property: +-- +-- @ +-- 'mapAccumLWithKey' f s m '==' +-- 'fmap' 'fromMap' ('Map'.'Map.mapAccumWithKey' f s ('toMap' m)) +-- @ +-- +-- @since 0.0.1.9 +-- +mapAccumLWithKey + :: MonoidNull v2 + => (s -> k -> v1 -> (s, v2)) + -> s + -> MonoidMap k v1 + -> (s, MonoidMap k v2) +mapAccumLWithKey f s0 m = + (coerce + :: ((k -> v1 -> StateL s v2 ) -> MM k v1 -> StateL s (MM k v2)) + -> ((k -> v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2)) + ) + traverseWithKey (\k v1 s -> f s k v1) m s0 +{-# INLINE mapAccumLWithKey #-} + +-- | \(O(n)\). Threads an accumulating argument through the map in descending +-- order of keys. +-- +-- Satisfies the following property: +-- +-- @ +-- 'mapAccumRWithKey' f s m '==' +-- 'fmap' 'fromMap' ('Map'.'Map.mapAccumRWithKey' f s ('toMap' m)) +-- @ +-- +-- @since 0.0.1.9 +-- +mapAccumRWithKey + :: MonoidNull v2 + => (s -> k -> v1 -> (s, v2)) + -> s + -> MonoidMap k v1 + -> (s, MonoidMap k v2) +mapAccumRWithKey f s0 m = + (coerce + :: ((k -> v1 -> StateR s v2 ) -> MM k v1 -> StateR s (MM k v2)) + -> ((k -> v1 -> s -> (s, v2)) -> MM k v1 -> s -> (s, MM k v2)) + ) + traverseWithKey (\k v1 s -> f s k v1) m s0 +{-# INLINE mapAccumRWithKey #-} + +-------------------------------------------------------------------------------- +-- Comparison +-------------------------------------------------------------------------------- + +-- | Indicates whether or not the first map is a /submap/ of the second. +-- +-- Map __@m1@__ is a submap of map __@m2@__ if (and only if) __@m1@__ can be +-- subtracted from __@m2@__ with the 'minusMaybe' operation: +-- +-- @ +-- m1 '`isSubmapOf`' m2 '==' 'isJust' (m2 '`minusMaybe`' m1) +-- @ +-- +-- Equivalently, map __@m1@__ is a submap of map __@m2@__ if (and only if) for +-- all possible keys __@k@__, the value for __@k@__ in __@m1@__ can be +-- subtracted from the value for __@k@__ in __@m2@__ with the '()' operator: +-- +-- @ +-- m1 '`isSubmapOf`' m2 '==' (∀ k. 'isJust' ('get' k m2 '' 'get' k m1)) +-- @ +-- +isSubmapOf + :: (Ord k, Monoid v, Reductive v) + => MonoidMap k v + -> MonoidMap k v + -> Bool +isSubmapOf = isSubmapOfBy $ \v1 v2 -> isJust (v2 v1) +{-# INLINE isSubmapOf #-} + +-- | Indicates whether or not the first map is a /submap/ of the second, using +-- the given function to compare values for matching keys. +-- +-- Satisfies the following property: +-- +-- @ +-- 'isSubmapOfBy' f m1 m2 '==' +-- 'all' (\\k -> f ('get' k m1) ('get' k m2)) ('nonNullKeys' m1) +-- @ +-- +-- === Conditional totality +-- +-- /If/ the given comparison function __@f@__ /always/ evaluates to 'True' +-- when its first argument is 'mempty': +-- +-- @ +-- ∀ v. f 'mempty' v +-- @ +-- +-- /Then/ the following property holds: +-- +-- @ +-- 'isSubmapOfBy' f m1 m2 '==' (∀ k. f ('get' k m1) ('get' k m2)) +-- @ +-- +isSubmapOfBy + :: (Ord k, Monoid v1, Monoid v2) + => (v1 -> v2 -> Bool) + -- ^ Function with which to compare values for matching keys. + -> MonoidMap k v1 + -> MonoidMap k v2 + -> Bool +isSubmapOfBy leq m1 m2 = + all + (\k -> get k m1 `leq` get k m2) + (nonNullKeys m1) +{-# INLINE isSubmapOfBy #-} + +-- | Indicates whether or not a pair of maps are /disjoint/. +-- +-- Maps __@m1@__ and __@m2@__ are disjoint if (and only if) their intersection +-- is empty: +-- +-- @ +-- 'disjoint' m1 m2 '==' ('intersection' m1 m2 '==' 'mempty') +-- @ +-- +-- Equivalently, maps __@m1@__ and __@m2@__ are disjoint if (and only if) for +-- all possible keys __@k@__, the values for __@k@__ in __@m1@__ and __@m2@__ +-- have a 'C.gcd' that is 'C.null': +-- +-- @ +-- 'disjoint' m1 m2 '==' (∀ k. 'C.null' ('C.gcd' ('get' k m1) ('get' k m2))) +-- @ +-- +disjoint + :: (Ord k, GCDMonoid v, MonoidNull v) + => MonoidMap k v + -> MonoidMap k v + -> Bool +disjoint = disjointBy (\v1 v2 -> C.null (C.gcd v1 v2)) +{-# INLINE disjoint #-} + +-- | Indicates whether or not a pair of maps are /disjoint/ using the given +-- indicator function to test pairs of values for matching keys. +-- +-- Satisfies the following property: +-- +-- @ +-- 'disjointBy' f m1 m2 '==' +-- 'all' +-- (\\k -> f ('get' k m1) ('get' k m2)) +-- ('Set.intersection' ('nonNullKeys' m1) ('nonNullKeys' m2)) +-- @ +-- +-- === Conditional totality +-- +-- /If/ the given indicator function __@f@__ /always/ evaluates to 'True' +-- when /either/ or /both/ of its arguments are 'mempty': +-- +-- @ +-- ∀ v. (f v 'mempty') '&&' (f 'mempty' v) +-- @ +-- +-- /Then/ the following property holds: +-- +-- @ +-- 'disjointBy' f m1 m2 '==' (∀ k. f ('get' k m1) ('get' k m2)) +-- @ +-- +disjointBy + :: (Ord k, Monoid v1, Monoid v2) + => (v1 -> v2 -> Bool) + -- ^ Function with which to test pairs of values for matching keys. + -> MonoidMap k v1 + -> MonoidMap k v2 + -> Bool +disjointBy f m1 m2 = + all + (\k -> f (get k m1) (get k m2)) + (Set.intersection (nonNullKeys m1) (nonNullKeys m2)) +{-# INLINE disjointBy #-} + +-------------------------------------------------------------------------------- +-- Association +-------------------------------------------------------------------------------- + +-- | Appends a pair of maps together. +-- +-- Uses the 'Semigroup' operator '(<>)' to append each value in the first map +-- to its matching value in the second map. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('append' m1 m2) '==' 'get' k m1 '<>' 'get' k m2 +-- @ +-- +-- This function provides the definition of '(<>)' for the 'MonoidMap' instance +-- of 'Semigroup'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> m1 = 'fromList' [(1, "abc"), (2, "ij" ), (3, "p" ) ] +-- >>> m2 = 'fromList' [ (2, " k"), (3, "qr"), (4, "xyz")] +-- >>> m3 = 'fromList' [(1, "abc"), (2, "ijk"), (3, "pqr"), (4, "xyz")] +-- @ +-- @ +-- >>> 'append' m1 m2 '==' m3 +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 4), ("b", 2), ("c", 1) ] +-- >>> m2 = 'fromList' [ ("b", 1), ("c", 2), ("d", 4)] +-- >>> m3 = 'fromList' [("a", 4), ("b", 3), ("c", 3), ("d", 4)] +-- @ +-- @ +-- >>> 'append' m1 m2 '==' m3 +-- 'True' +-- @ +-- +append + :: (Ord k, MonoidNull v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +append = merge MergeStrategy + { withNonNullL = + keepNonNull + -- Justification: + -- + -- v <> mempty ≡ v + + , withNonNullR = + keepNonNull + -- Justification: + -- + -- mempty <> v ≡ v + + , withNonNullP = + withBoth (<>) + } +{-# INLINE append #-} + +-------------------------------------------------------------------------------- +-- Prefixes and suffixes +-------------------------------------------------------------------------------- + +-- | Indicates whether or not the first map is a /prefix/ of the second. +-- +-- 'MonoidMap' __@m1@__ is a /prefix/ of 'MonoidMap' __@m2@__ if (and only if) +-- for all possible keys __@k@__, the value for __@k@__ in __@m1@__ is a +-- /prefix/ of the value for __@k@__ in __@m2@__: +-- +-- @ +-- m1 '`isPrefixOf`' m2 '==' (∀ k. 'get' k m1 '`C.isPrefixOf`' 'get' k m2) +-- @ +-- +-- This function provides the definition of 'C.isPrefixOf' for the 'MonoidMap' +-- instance of 'LeftReductive'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> m1 = 'fromList' [(1, "a" ), (2, "p" ), (3, "x" )] +-- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")] +-- >>> m1 '`isPrefixOf`' m2 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [ (2, "p" ) ] +-- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")] +-- >>> m1 '`isPrefixOf`' m2 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [(1, "abc"), (2, "p" ), (3, "x" )] +-- >>> m2 = 'fromList' [(1, "a" ), (2, "pqr"), (3, "xyz")] +-- >>> m1 '`isPrefixOf`' m2 +-- 'False' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 1), ("b", 1), ("c", 1)] +-- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)] +-- >>> m1 '`isPrefixOf`' m2 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [ ("b", 1) ] +-- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)] +-- >>> m1 '`isPrefixOf`' m2 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", 2), ("b", 1), ("c", 1)] +-- >>> m2 = 'fromList' [("a", 1), ("b", 4), ("c", 8)] +-- >>> m1 '`isPrefixOf`' m2 +-- 'False' +-- @ +-- +isPrefixOf + :: (Ord k, Monoid v, LeftReductive v) + => MonoidMap k v + -> MonoidMap k v + -> Bool +isPrefixOf = isSubmapOfBy C.isPrefixOf + -- Note that in practice, it's sufficient to check the following property: + -- + -- @ + -- m1 '`isPrefixOf`' m2 '==' + -- 'all' + -- (\\k -> 'get' k m1 '`C.isPrefixOf`' 'get' k m2) + -- ('nonNullKeys' m1) + -- @ + -- + -- ==== Justification + -- + -- According to the laws for 'LeftReductive': + -- + -- @ + -- ∀ a b. b '`C.isPrefixOf`' (b '<>' a) + -- @ + -- + -- Substituting 'mempty' for @b@: + -- + -- @ + -- ∀ a. 'mempty' '`C.isPrefixOf`' ('mempty' '<>' a) + -- @ + -- + -- According to the left identity law for 'Monoid': + -- + -- @ + -- ∀ a. 'mempty' '<>' a '==' a + -- @ + -- + -- We can therefore assert that: + -- + -- @ + -- ∀ a. 'mempty' '`C.isPrefixOf`' a + -- @ + -- + -- Since 'mempty' is /always/ a valid prefix, we only need to consider + -- values in 'm1' that are /not/ 'mempty'. + -- + -- The 'nonNullKeys' function, when applied to 'm1', gives us /precisely/ + -- the set of keys that are not associated with 'mempty' in 'm1': + -- + -- @ + -- (k '`Data.Set.member`' 'nonNullKeys' m1) '==' ('get' k m1 '/=' 'mempty') + -- @ + -- +{-# INLINE isPrefixOf #-} + +-- | Indicates whether or not the first map is a /suffix/ of the second. +-- +-- 'MonoidMap' __@m1@__ is a /suffix/ of 'MonoidMap' __@m2@__ if (and only if) +-- for all possible keys __@k@__, the value for __@k@__ in __@m1@__ is a +-- /suffix/ of the value for __@k@__ in __@m2@__: +-- +-- @ +-- m1 '`isSuffixOf`' m2 '==' (∀ k. 'get' k m1 '`C.isSuffixOf`' 'get' k m2) +-- @ +-- +-- This function provides the definition of 'C.isSuffixOf' for the 'MonoidMap' +-- instance of 'RightReductive'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> m1 = 'fromList' [(1, "c"), (2, "r"), (3, "z")] +-- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")] +-- >>> m1 '`isSuffixOf`' m2 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [ (2, "r") ] +-- >>> m2 = 'fromList' [(1, "abc"), (2, "pqr"), (3, "xyz")] +-- >>> m1 '`isSuffixOf`' m2 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [(1, "abc"), (2, "r"), (3, "z")] +-- >>> m2 = 'fromList' [(1, "c"), (2, "pqr"), (3, "xyz")] +-- >>> m1 '`isSuffixOf`' m2 +-- 'False' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 1), ("b", 1), ("c", 1)] +-- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)] +-- >>> m1 '`isSuffixOf`' m2 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [ ("b", 1) ] +-- >>> m2 = 'fromList' [("a", 2), ("b", 4), ("c", 8)] +-- >>> m1 '`isSuffixOf`' m2 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", 2), ("b", 1), ("c", 1)] +-- >>> m2 = 'fromList' [("a", 1), ("b", 4), ("c", 8)] +-- >>> m1 '`isSuffixOf`' m2 +-- 'False' +-- @ +-- +isSuffixOf + :: (Ord k, Monoid v, RightReductive v) + => MonoidMap k v + -> MonoidMap k v + -> Bool +isSuffixOf = isSubmapOfBy C.isSuffixOf + -- Note that in practice, it's sufficient to check the following property: + -- + -- @ + -- m1 '`isSuffixOf`' m2 '==' + -- 'all' + -- (\\k -> 'get' k m1 '`C.isSuffixOf`' 'get' k m2) + -- ('nonNullKeys' m1) + -- @ + -- + -- ==== Justification + -- + -- According to the laws for 'RightReductive': + -- + -- @ + -- ∀ a b. b '`C.isSuffixOf`' (a '<>' b) + -- @ + -- + -- Substituting 'mempty' for @b@: + -- + -- @ + -- ∀ a. 'mempty' '`C.isSuffixOf`' (a '<>' 'mempty') + -- @ + -- + -- According to the right identity law for 'Monoid': + -- + -- @ + -- ∀ a. a '<>' 'mempty' '==' a + -- @ + -- + -- We can therefore assert that: + -- + -- @ + -- ∀ a. 'mempty' '`C.isSuffixOf`' a + -- @ + -- + -- Since 'mempty' is /always/ a valid suffix, we only need to consider + -- values in 'm1' that are /not/ 'mempty'. + -- + -- The 'nonNullKeys' function, when applied to 'm1', gives us /precisely/ + -- the set of keys that are not associated with 'mempty' in 'm1': + -- + -- @ + -- (k '`Data.Set.member`' 'nonNullKeys' m1) '==' ('get' k m1 '/=' 'mempty') + -- @ + -- +{-# INLINE isSuffixOf #-} + +-- | Strips a /prefix/ from a 'MonoidMap'. +-- +-- If map __@m1@__ is a /prefix/ of map __@m2@__, then 'stripPrefix' __@m1@__ +-- __@m2@__ will produce a /reduced/ map where prefix __@m1@__ is /stripped/ +-- from __@m2@__. +-- +-- === Properties +-- +-- The 'stripPrefix' function, when applied to maps __@m1@__ and __@m2@__, +-- produces a result if (and only if) __@m1@__ is a prefix of __@m2@__: +-- +-- @ +-- 'isJust' ('stripPrefix' m1 m2) '==' m1 '`isPrefixOf`' m2 +-- @ +-- +-- The value for any key __@k@__ in the result is /identical/ to the result of +-- stripping the value for __@k@__ in map __@m1@__ from the value for __@k@__ +-- in map __@m2@__: +-- +-- @ +-- 'all' +-- (\\r -> 'Just' ('get' k r) '==' 'C.stripPrefix' ('get' k m1) ('get' k m2)) +-- ('stripPrefix' m1 m2) +-- @ +-- +-- If we append prefix __@m1@__ to the /left-hand/ side of the result, we can +-- always recover the original map __@m2@__: +-- +-- @ +-- 'all' +-- (\\r -> m1 '<>' r '==' m2) +-- ('stripPrefix' m1 m2) +-- @ +-- +-- This function provides the definition of 'C.stripPrefix' for the 'MonoidMap' +-- instance of 'LeftReductive'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> __m1__ = 'fromList' [(1, "" ), (2, "i" ), (3, "pq" ), (4, "xyz")] +-- >>> __m2__ = 'fromList' [(1, "abc"), (2, "ijk"), (3, "pqr"), (4, "xyz")] +-- >>> __m3__ = 'fromList' [(1, "abc"), (2, "jk"), (3, "r"), (4, "")] +-- @ +-- @ +-- >>> 'stripPrefix' __m1__ __m2__ '==' 'Just' __m3__ +-- 'True' +-- @ +-- @ +-- >>> 'stripPrefix' __m2__ __m1__ '==' 'Nothing' +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural' values: +-- +-- @ +-- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> __m2__ = 'fromList' [("a", 3), ("b", 3), ("c", 3), ("d", 3)] +-- >>> __m3__ = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)] +-- @ +-- @ +-- >>> 'stripPrefix' __m1__ __m2__ '==' 'Just' __m3__ +-- 'True' +-- @ +-- @ +-- >>> 'stripPrefix' __m2__ __m1__ '==' 'Nothing' +-- 'True' +-- @ +-- +stripPrefix + :: (Ord k, MonoidNull v, LeftReductive v) + => MonoidMap k v + -> MonoidMap k v + -> Maybe (MonoidMap k v) +stripPrefix = mergeA MergeStrategy + { withNonNullL = + withNonNullA (\v -> C.stripPrefix v mempty) + + , withNonNullR = + keepNonNull + -- Justification: + -- + -- stripPrefix mempty a ≡ a + + , withNonNullP = + withBothA C.stripPrefix + } +{-# INLINE stripPrefix #-} + +-- | Strips a /suffix/ from a 'MonoidMap'. +-- +-- If map __@m1@__ is a /suffix/ of map __@m2@__, then 'stripSuffix' __@m1@__ +-- __@m2@__ will produce a /reduced/ map where suffix __@m1@__ is /stripped/ +-- from __@m2@__. +-- +-- === Properties +-- +-- The 'stripSuffix' function, when applied to maps __@m1@__ and __@m2@__, +-- produces a result if (and only if) __@m1@__ is a suffix of __@m2@__: +-- +-- @ +-- 'isJust' ('stripSuffix' m1 m2) '==' m1 '`isSuffixOf`' m2 +-- @ +-- +-- The value for any key __@k@__ in the result is /identical/ to the result of +-- stripping the value for __@k@__ in map __@m1@__ from the value for __@k@__ +-- in map __@m2@__: +-- +-- @ +-- 'all' +-- (\\r -> 'Just' ('get' k r) '==' 'C.stripSuffix' ('get' k m1) ('get' k m2)) +-- ('stripSuffix' m1 m2) +-- @ +-- +-- If we append suffix __@m1@__ to the /right-hand/ side of the result, we can +-- always recover the original map __@m2@__: +-- +-- @ +-- 'all' +-- (\\r -> r '<>' m1 '==' m2) +-- ('stripSuffix' m1 m2) +-- @ +-- +-- This function provides the definition of 'C.stripSuffix' for the 'MonoidMap' +-- instance of 'RightReductive'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> __m1__ = 'fromList' [(1, ""), (2, "k"), (3, "qr"), (4, "xyz")] +-- >>> __m2__ = 'fromList' [(1, "abc"), (2, "ijk"), (3, "pqr"), (4, "xyz")] +-- >>> __m3__ = 'fromList' [(1, "abc"), (2, "ij" ), (3, "p" ), (4, "" )] +-- @ +-- @ +-- >>> 'stripSuffix' __m1__ __m2__ '==' 'Just' __m3__ +-- 'True' +-- @ +-- @ +-- >>> 'stripSuffix' __m2__ __m1__ '==' 'Nothing' +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural' values: +-- +-- @ +-- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> __m2__ = 'fromList' [("a", 3), ("b", 3), ("c", 3), ("d", 3)] +-- >>> __m3__ = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)] +-- @ +-- @ +-- >>> 'stripSuffix' __m1__ __m2__ '==' 'Just' __m3__ +-- 'True' +-- @ +-- @ +-- >>> 'stripSuffix' __m2__ __m1__ '==' 'Nothing' +-- 'True' +-- @ +-- +stripSuffix + :: (Ord k, MonoidNull v, RightReductive v) + => MonoidMap k v + -> MonoidMap k v + -> Maybe (MonoidMap k v) +stripSuffix = mergeA MergeStrategy + { withNonNullL = + withNonNullA (\v -> C.stripSuffix v mempty) + + , withNonNullR = + keepNonNull + -- Justification: + -- + -- stripSuffix mempty a ≡ a + + , withNonNullP = + withBothA C.stripSuffix + } +{-# INLINE stripSuffix #-} + +-- | Finds the /greatest common prefix/ of two maps. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('commonPrefix' m1 m2) +-- '==' 'C.commonPrefix' ('get' k m1) ('get' k m2) +-- @ +-- +-- This function provides the definition of 'C.commonPrefix' for the +-- 'MonoidMap' instance of 'LeftGCDMonoid'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> __m1__ = 'fromList' [(1, "+++"), (2, "b++"), (3, "cc+"), (4, "ddd")] +-- >>> __m2__ = 'fromList' [(1, "---"), (2, "b--"), (3, "cc-"), (4, "ddd")] +-- >>> __m3__ = 'fromList' [(1, "" ), (2, "b" ), (3, "cc" ), (4, "ddd")] +-- @ +-- @ +-- >>> 'commonPrefix' __m1__ __m2__ '==' __m3__ +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural' values: +-- +-- @ +-- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> __m2__ = 'fromList' [("a", 2), ("b", 2), ("c", 2), ("d", 2)] +-- >>> __m3__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 2)] +-- @ +-- @ +-- >>> 'commonPrefix' __m1__ __m2__ '==' __m3__ +-- 'True' +-- @ +-- +commonPrefix + :: (Ord k, MonoidNull v, LeftGCDMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +commonPrefix = merge MergeStrategy + { withNonNullL = + keepNull + -- Justification: + -- + -- commonPrefix a mempty ≡ mempty + + , withNonNullR = + keepNull + -- Justification: + -- + -- commonPrefix mempty a ≡ mempty + + , withNonNullP = + withBoth C.commonPrefix + } +{-# INLINE commonPrefix #-} + +-- | Finds the /greatest common suffix/ of two maps. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('commonSuffix' m1 m2) +-- '==' 'C.commonSuffix' ('get' k m1) ('get' k m2) +-- @ +-- +-- This function provides the definition of 'C.commonSuffix' for the +-- 'MonoidMap' instance of 'RightGCDMonoid'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> __m1__ = 'fromList' [(1, "+++"), (2, "++b"), (3, "+cc"), (4, "ddd")] +-- >>> __m2__ = 'fromList' [(1, "---"), (2, "--b"), (3, "-cc"), (4, "ddd")] +-- >>> __m3__ = 'fromList' [(1, ""), (2, "b"), (3, "cc"), (4, "ddd")] +-- @ +-- @ +-- >>> 'commonSuffix' __m1__ __m2__ '==' __m3__ +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural' values: +-- +-- @ +-- >>> __m1__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> __m2__ = 'fromList' [("a", 2), ("b", 2), ("c", 2), ("d", 2)] +-- >>> __m3__ = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 2)] +-- @ +-- @ +-- >>> 'commonSuffix' __m1__ __m2__ '==' __m3__ +-- 'True' +-- @ +-- +commonSuffix + :: (Ord k, MonoidNull v, RightGCDMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +commonSuffix = merge MergeStrategy + { withNonNullL = + keepNull + -- Justification: + -- + -- commonSuffix a mempty ≡ mempty + + , withNonNullR = + keepNull + -- Justification: + -- + -- commonSuffix mempty a ≡ mempty + + , withNonNullP = + withBoth C.commonSuffix + } +{-# INLINE commonSuffix #-} + +-- | Strips the /greatest common prefix/ from a pair of maps. +-- +-- Given two maps __@m1@__ and __@m2@__, 'stripCommonPrefix' produces a +-- tuple __@(p, r1, r2)@__, where: +-- +-- - __@p@__ is the /greatest common prefix/ of __@m1@__ and __@m2@__ +-- - __@r1@__ is the /remainder/ of stripping prefix __@p@__ from __@m1@__ +-- - __@r2@__ is the /remainder/ of stripping prefix __@p@__ from __@m2@__ +-- +-- The resulting prefix __@p@__ can be appended to the /left-hand/ side of +-- either remainder __@r1@__ or __@r2@__ to /reproduce/ either of the original +-- maps __@m1@__ or __@m2@__ respectively: +-- +-- @ +-- 'stripCommonPrefix' m1 m2 +-- '&' \\(p, r1, _) -> p '<>' r1 '==' m1 +-- 'stripCommonPrefix' m1 m2 +-- '&' \\(p, _, r2) -> p '<>' r2 '==' m2 +-- @ +-- +-- Prefix __@p@__ is /identical/ to the result of applying 'commonPrefix' to +-- __@m1@__ and __@m2@__: +-- +-- @ +-- 'stripCommonPrefix' m1 m2 +-- '&' \\(p, _, _) -> p '==' 'commonPrefix' m1 m2 +-- @ +-- +-- Remainders __@r1@__ and __@r2@__ are /identical/ to the results of applying +-- 'stripPrefix' to __@p@__ and __@m1@__ or to __@p@__ and __@m2@__ +-- respectively: +-- +-- @ +-- 'stripCommonPrefix' m1 m2 +-- '&' \\(p, r1, _) -> 'Just' r1 '==' 'stripPrefix' p m1 +-- 'stripCommonPrefix' m1 m2 +-- '&' \\(p, _, r2) -> 'Just' r2 '==' 'stripPrefix' p m2 +-- @ +-- +-- This function provides the definition of 'C.stripCommonPrefix' for the +-- 'MonoidMap' instance of 'LeftGCDMonoid'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> m1 = 'fromList' [(1, "+++"), (2, "a++"), (3, "aa+"), (4, "aaa")] +-- >>> m2 = 'fromList' [(1, "---"), (2, "a--"), (3, "aa-"), (4, "aaa")] +-- @ +-- @ +-- >>> p = 'fromList' [(1, "" ), (2, "a" ), (3, "aa" ), (4, "aaa")] +-- >>> r1 = 'fromList' [(1, "+++"), (2, "++"), (3, "+"), (4, "")] +-- >>> r2 = 'fromList' [(1, "---"), (2, "--"), (3, "-"), (4, "")] +-- @ +-- @ +-- >>> 'stripCommonPrefix' m1 m2 '==' (p, r1, r2) +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] +-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] +-- @ +-- @ +-- >>> p = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 1), ("e", 0)] +-- >>> r1 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 2), ("e", 4)] +-- >>> r2 = 'fromList' [("a", 4), ("b", 2), ("c", 0), ("d", 0), ("e", 0)] +-- @ +-- @ +-- >>> 'stripCommonPrefix' m1 m2 '==' (p, r1, r2) +-- 'True' +-- @ +-- +stripCommonPrefix + :: (Ord k, MonoidNull v, LeftGCDMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> (MonoidMap k v, MonoidMap k v, MonoidMap k v) +stripCommonPrefix = C.stripCommonPrefix + +-- | Strips the /greatest common suffix/ from a pair of maps. +-- +-- Given two maps __@m1@__ and __@m2@__, 'stripCommonSuffix' produces a +-- tuple __@(r1, r2, s)@__, where: +-- +-- - __@s@__ is the /greatest common suffix/ of __@m1@__ and __@m2@__ +-- - __@r1@__ is the /remainder/ of stripping suffix __@s@__ from __@m1@__ +-- - __@r2@__ is the /remainder/ of stripping suffix __@s@__ from __@m2@__ +-- +-- The resulting suffix __@s@__ can be appended to the /right-hand/ side of +-- either remainder __@r1@__ or __@r2@__ to /reproduce/ either of the original +-- maps __@m1@__ or __@m2@__ respectively: +-- +-- @ +-- 'stripCommonSuffix' m1 m2 +-- '&' \\(r1, _, s) -> r1 '<>' s '==' m1 +-- 'stripCommonSuffix' m1 m2 +-- '&' \\(_, r2, s) -> r2 '<>' s '==' m2 +-- @ +-- +-- Suffix __@s@__ is /identical/ to the result of applying 'commonSuffix' to +-- __@m1@__ and __@m2@__: +-- +-- @ +-- 'stripCommonSuffix' m1 m2 +-- '&' \\(_, _, s) -> s '==' 'commonSuffix' m1 m2 +-- @ +-- +-- Remainders __@r1@__ and __@r2@__ are /identical/ to the results of applying +-- 'stripSuffix' to __@s@__ and __@m1@__ or to __@s@__ and __@m2@__ +-- respectively: +-- +-- @ +-- 'stripCommonSuffix' m1 m2 +-- '&' \\(r1, _, s) -> 'Just' r1 '==' 'stripSuffix' s m1 +-- 'stripCommonSuffix' m1 m2 +-- '&' \\(_, r2, s) -> 'Just' r2 '==' 'stripSuffix' s m2 +-- @ +-- +-- This function provides the definition of 'C.stripCommonSuffix' for the +-- 'MonoidMap' instance of 'RightGCDMonoid'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> m1 = 'fromList' [(1, "+++"), (2, "++a"), (3, "+aa"), (4, "aaa")] +-- >>> m2 = 'fromList' [(1, "---"), (2, "--a"), (3, "-aa"), (4, "aaa")] +-- @ +-- @ +-- >>> r1 = 'fromList' [(1, "+++"), (2, "++" ), (3, "+" ), (4, "" )] +-- >>> r2 = 'fromList' [(1, "---"), (2, "--" ), (3, "-" ), (4, "" )] +-- >>> s = 'fromList' [(1, ""), (2, "a"), (3, "aa"), (4, "aaa")] +-- @ +-- @ +-- >>> 'stripCommonSuffix' m1 m2 '==' (r1, r2, s) +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] +-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] +-- @ +-- @ +-- >>> r1 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 2), ("e", 4)] +-- >>> r2 = 'fromList' [("a", 4), ("b", 2), ("c", 0), ("d", 0), ("e", 0)] +-- >>> s = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 1), ("e", 0)] +-- @ +-- @ +-- >>> 'stripCommonSuffix' m1 m2 '==' (r1, r2, s) +-- 'True' +-- @ +-- +stripCommonSuffix + :: (Ord k, MonoidNull v, RightGCDMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> (MonoidMap k v, MonoidMap k v, MonoidMap k v) +stripCommonSuffix = C.stripCommonSuffix + +-------------------------------------------------------------------------------- +-- Overlap +-------------------------------------------------------------------------------- + +-- | Finds the /greatest overlap/ of two maps. +-- +-- The /greatest overlap/ __@o@__ of maps __@m1@__ and __@m2@__ is the /unique/ +-- greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ of __@m2@__: +-- +-- @ +-- m1 '==' r1 '<>' o \ \ +-- m2 '==' \ \ o '<>' r2 +-- @ +-- +-- Where: +-- +-- - __@r1@__ is the /remainder/ obtained by stripping /suffix overlap/ +-- __@o@__ from __@m1@__. +-- +-- (see 'stripSuffixOverlap') +-- +-- - __@r2@__ is the /remainder/ obtained by stripping /prefix overlap/ +-- __@o@__ from __@m2@__. +-- +-- (see 'stripPrefixOverlap') +-- +-- This function satisfies the following property: +-- +-- @ +-- 'get' k ('overlap' m1 m2) '==' 'C.overlap' ('get' k m1) ('get' k m2) +-- @ +-- +-- This function provides the definition of 'C.overlap' for the 'MonoidMap' +-- instance of 'OverlappingGCDMonoid'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> m1 = 'fromList' [(1,"abc" ), (2,"abcd" ), (3,"abcde "), (4,"abcdef")] +-- >>> m2 = 'fromList' [(1, "def"), (2, "cdef"), (3," bcdef"), (4,"abcdef")] +-- >>> m3 = 'fromList' [(1, "" ), (2, "cd" ), (3," bcde" ), (4,"abcdef")] +-- @ +-- @ +-- >>> 'overlap' m1 m2 '==' m3 +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] +-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] +-- >>> m3 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 1), ("e", 0)] +-- @ +-- @ +-- >>> 'overlap' m1 m2 '==' m3 +-- 'True' +-- @ +-- +overlap + :: (Ord k, MonoidNull v, OverlappingGCDMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +overlap = merge MergeStrategy + { withNonNullL = + keepNull + -- Justification: + -- + -- overlap a mempty ≡ mempty + + , withNonNullR = + keepNull + -- Justification: + -- + -- overlap mempty a ≡ mempty + + , withNonNullP = + withBoth C.overlap + } +{-# INLINE overlap #-} + +-- | /Strips/ from the second map its /greatest prefix overlap/ with suffixes +-- of the first map. +-- +-- Evaluating 'stripPrefixOverlap' __@m1@__ __@m2@__ produces the /remainder/ +-- __@r2@__: +-- +-- @ +-- m1 '==' r1 '<>' o \ \ +-- m2 '==' \ \ o '<>' r2 +-- @ +-- +-- Where __@o@__ is the /greatest overlap/ of maps __@m1@__ and __@m2@__: the +-- /unique/ greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ of +-- __@m2@__. +-- +-- This function satisfies the following property: +-- +-- @ +-- 'get' k ('stripPrefixOverlap' m1 m2) +-- '==' 'C.stripPrefixOverlap' ('get' k m1) ('get' k m2) +-- @ +-- +-- This function provides the definition of 'C.stripPrefixOverlap' for the +-- 'MonoidMap' instance of 'OverlappingGCDMonoid'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> m1 = 'fromList' [(1,"abc" ), (2,"abcd" ), (3,"abcde" ), (4,"abcdef")] +-- >>> m2 = 'fromList' [(1, "def"), (2, "cdef"), (3, "bcdef"), (4,"abcdef")] +-- >>> m3 = 'fromList' [(1, "def"), (2, "ef"), (3, "f"), (4, "")] +-- @ +-- @ +-- >>> 'stripPrefixOverlap' m1 m2 '==' m3 +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] +-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] +-- >>> m3 = 'fromList' [("a", 4), ("b", 2), ("c", 0), ("d", 0), ("e", 0)] +-- @ +-- @ +-- >>> 'stripPrefixOverlap' m1 m2 '==' m3 +-- 'True' +-- @ +-- +stripPrefixOverlap + :: (Ord k, MonoidNull v, OverlappingGCDMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +stripPrefixOverlap = merge MergeStrategy + { withNonNullL = + keepNull + -- Justification: + -- + -- overlap a b <> stripPrefixOverlap a b ≡ b + -- overlap a mempty <> stripPrefixOverlap a mempty ≡ mempty + -- mempty <> stripPrefixOverlap a mempty ≡ mempty + -- stripPrefixOverlap a mempty ≡ mempty + + , withNonNullR = + keepNonNull + -- Justification: + -- + -- overlap a b <> stripPrefixOverlap a b ≡ b + -- overlap mempty b <> stripPrefixOverlap mempty b ≡ b + -- mempty <> stripPrefixOverlap mempty b ≡ b + -- stripPrefixOverlap mempty b ≡ b + + , withNonNullP = + withBoth C.stripPrefixOverlap + } +{-# INLINE stripPrefixOverlap #-} + +-- | /Strips/ from the second map its /greatest suffix overlap/ with prefixes +-- of the first map. +-- +-- Evaluating 'stripSuffixOverlap' __@m2@__ __@m1@__ produces the /remainder/ +-- __@r1@__: +-- +-- @ +-- m1 '==' r1 '<>' o \ \ +-- m2 '==' \ \ o '<>' r2 +-- @ +-- +-- Where __@o@__ is the /greatest overlap/ of maps __@m1@__ and __@m2@__: the +-- /unique/ greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ of +-- __@m2@__. +-- +-- This function satisfies the following property: +-- +-- @ +-- 'get' k ('stripSuffixOverlap' m2 m1) +-- '==' 'C.stripSuffixOverlap' ('get' k m2) ('get' k m1) +-- @ +-- +-- This function provides the definition of 'C.stripSuffixOverlap' for the +-- 'MonoidMap' instance of 'OverlappingGCDMonoid'. +-- +-- === __Examples__ +-- +-- With 'String' values: +-- +-- @ +-- >>> m1 = 'fromList' [(1,"abc" ), (2,"abcd" ), (3,"abcde" ), (4,"abcdef")] +-- >>> m2 = 'fromList' [(1, "def"), (2, "cdef"), (3, "bcdef"), (4,"abcdef")] +-- >>> m3 = 'fromList' [(1,"abc" ), (2,"ab" ), (3,"a" ), (4,"" )] +-- @ +-- @ +-- >>> 'stripSuffixOverlap' m2 m1 '==' m3 +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3), ("e", 4)] +-- >>> m2 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1), ("e", 0)] +-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 2), ("e", 4)] +-- @ +-- @ +-- >>> 'stripSuffixOverlap' m2 m1 '==' m3 +-- 'True' +-- @ +-- +stripSuffixOverlap + :: (Ord k, MonoidNull v, OverlappingGCDMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +stripSuffixOverlap = merge MergeStrategy + { withNonNullL = + keepNull + -- Justification: + -- + -- stripSuffixOverlap b a <> overlap a b ≡ a + -- stripSuffixOverlap b mempty <> overlap mempty b ≡ mempty + -- stripSuffixOverlap b mempty <> mempty ≡ mempty + -- stripSuffixOverlap b mempty ≡ mempty + + , withNonNullR = + keepNonNull + -- Justification: + -- + -- stripSuffixOverlap b a <> overlap a b ≡ a + -- stripSuffixOverlap mempty a <> overlap a mempty ≡ a + -- stripSuffixOverlap mempty a <> mempty ≡ a + -- stripSuffixOverlap mempty a ≡ a + + , withNonNullP = + withBoth C.stripSuffixOverlap + } +{-# INLINE stripSuffixOverlap #-} + +-- | Finds the /greatest overlap/ of two maps and /strips/ it from both maps. +-- +-- Evaluating 'stripOverlap' __@m1@__ __@m2@__ produces the tuple +-- __@(r1, o, r2)@__, where: +-- +-- @ +-- m1 '==' r1 '<>' o \ \ +-- m2 '==' \ \ o '<>' r2 +-- @ +-- +-- Where: +-- +-- - __@o@__ is the /greatest overlap/ of maps __@m1@__ and __@m2@__: the +-- /unique/ greatest map that is both a /suffix/ of __@m1@__ and a /prefix/ +-- of __@m2@__. +-- +-- (see 'overlap') +-- +-- - __@r1@__ is the /remainder/ obtained by stripping /suffix overlap/ +-- __@o@__ from __@m1@__. +-- +-- (see 'stripSuffixOverlap') +-- +-- - __@r2@__ is the /remainder/ obtained by stripping /prefix overlap/ +-- __@o@__ from __@m2@__. +-- +-- (see 'stripPrefixOverlap') +-- +-- This function satisfies the following property: +-- +-- @ +-- 'stripOverlap' m1 m2 '==' +-- ( 'stripSuffixOverlap' m2 m1 +-- , 'overlap' m1 m2 +-- , 'stripPrefixOverlap' m1 m2 +-- ) +-- @ +-- +-- This function provides the definition of 'C.stripOverlap' for the +-- 'MonoidMap' instance of 'OverlappingGCDMonoid'. +-- +stripOverlap + :: (Ord k, MonoidNull v, OverlappingGCDMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> (MonoidMap k v, MonoidMap k v, MonoidMap k v) +stripOverlap m1 m2 = + ( stripSuffixOverlap m2 m1 + , m1 `overlap` m2 + , stripPrefixOverlap m1 m2 + ) + +-------------------------------------------------------------------------------- +-- Intersection +-------------------------------------------------------------------------------- + +-- | Finds the /intersection/ of two maps. +-- +-- The intersection of maps __@m1@__ and __@m2@__ is the greatest single map +-- __@m@__ that is a /submap/ of both __@m1@__ /and/ __@m2@__: +-- +-- @ +-- 'intersection' m1 m2 '`isSubmapOf`' m1 +-- 'intersection' m1 m2 '`isSubmapOf`' m2 +-- @ +-- +-- The intersection is /unique/: +-- +-- @ +-- 'and' +-- [ 'intersection' m1 m2 '`isSubmapOf`' m +-- , \ \ \ \ m '`isSubmapOf`' m1 +-- , \ \ \ \ m '`isSubmapOf`' m2 +-- ] +-- ==> +-- (m '==' 'intersection' m1 m2) +-- @ +-- +-- The following property holds for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('intersection' m1 m2) '==' 'C.gcd' ('get' k m1) ('get' k m2) +-- @ +-- +-- This function provides the definition of 'C.gcd' for the 'MonoidMap' +-- instance of 'GCDMonoid'. +-- +-- === __Examples__ +-- +-- With 'Data.Monoid.Product' 'Numeric.Natural.Natural' values, this function +-- computes the /greatest common divisor/ of each pair of matching values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 2), ("b", 6), ("c", 15), ("d", 35)] +-- >>> m2 = 'fromList' [("a", 6), ("b", 15), ("c", 35), ("d", 77)] +-- >>> m3 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 7)] +-- @ +-- @ +-- >>> 'intersection' m1 m2 '==' m3 +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function +-- computes the /minimum/ of each pair of matching values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> m2 = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)] +-- >>> m3 = 'fromList' [("a", 0), ("b", 1), ("c", 1), ("d", 0)] +-- @ +-- @ +-- >>> 'intersection' m1 m2 '==' m3 +-- 'True' +-- @ +-- +-- With 'Set' 'Numeric.Natural.Natural' values, this function computes the +-- /set/ /intersection/ of each pair of matching values: +-- +-- @ +-- f xs = 'fromList' ('Set.fromList' '<$>' xs) +-- @ +-- +-- @ +-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2 ]), ("c", [0,1,2 ])] +-- >>> m2 = f [("a", [0,1,2]), ("b", [ 1,2,3]), ("c", [ 2,3,4])] +-- >>> m3 = f [("a", [0,1,2]), ("b", [ 1,2 ]), ("c", [ 2 ])] +-- @ +-- @ +-- >>> 'intersection' m1 m2 '==' m3 +-- 'True' +-- @ +-- +intersection + :: (Ord k, MonoidNull v, GCDMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +intersection = merge MergeStrategy + { withNonNullL = + keepNull + -- Justification: + -- + -- gcd a mempty ≡ mempty + + , withNonNullR = + keepNull + -- Justification: + -- + -- gcd mempty b ≡ mempty + + , withNonNullP = + withBoth C.gcd + } +{-# INLINE intersection #-} + +-------------------------------------------------------------------------------- +-- Union +-------------------------------------------------------------------------------- + +-- | Finds the /union/ of two maps. +-- +-- The union of maps __@m1@__ and __@m2@__ is the smallest single map __@m@__ +-- that includes both __@m1@__ /and/ __@m2@__ as /submaps/: +-- +-- @ +-- m1 '`isSubmapOf`' 'union' m1 m2 +-- m2 '`isSubmapOf`' 'union' m1 m2 +-- @ +-- +-- The union is /unique/: +-- +-- @ +-- 'and' +-- [ m1 '`isSubmapOf`' m +-- , m2 '`isSubmapOf`' m +-- , \ \ m '`isSubmapOf`' 'union' m1 m2 +-- ] +-- ==> +-- (m '==' 'union' m1 m2) +-- @ +-- +-- The following property holds for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('union' m1 m2) '==' 'C.lcm' ('get' k m1) ('get' k m2) +-- @ +-- +-- This function provides the definition of 'C.lcm' for the 'MonoidMap' +-- instance of 'LCMMonoid'. +-- +-- === __Examples__ +-- +-- With 'Data.Monoid.Product' 'Numeric.Natural.Natural' values, this function +-- computes the /least common multiple/ of each pair of matching values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 2), ("b", 6), ("c", 15), ("d", 35)] +-- >>> m2 = 'fromList' [("a", 6), ("b", 15), ("c", 35), ("d", 77)] +-- >>> m3 = 'fromList' [("a", 6), ("b", 30), ("c", 105), ("d", 385)] +-- @ +-- @ +-- >>> 'union' m1 m2 '==' m3 +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function +-- computes the /maximum/ of each pair of matching values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> m2 = 'fromList' [("a", 3), ("b", 2), ("c", 1), ("d", 0)] +-- >>> m3 = 'fromList' [("a", 3), ("b", 2), ("c", 2), ("d", 3)] +-- @ +-- @ +-- >>> 'union' m1 m2 '==' m3 +-- 'True' +-- @ +-- +-- With 'Set' 'Numeric.Natural.Natural' values, this function computes the +-- /set/ /union/ of each pair of matching values: +-- +-- @ +-- f xs = 'fromList' ('Set.fromList' '<$>' xs) +-- @ +-- +-- @ +-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2 ]), ("c", [0,1,2 ])] +-- >>> m2 = f [("a", [0,1,2]), ("b", [ 1,2,3]), ("c", [ 2,3,4])] +-- >>> m3 = f [("a", [0,1,2]), ("b", [0,1,2,3]), ("c", [0,1,2,3,4])] +-- @ +-- @ +-- >>> 'union' m1 m2 '==' m3 +-- 'True' +-- @ +-- +union + :: (Ord k, MonoidNull v, LCMMonoid v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +union = merge MergeStrategy + { withNonNullL = + keepNonNull + -- Justification: + -- + -- lcm a mempty ≡ a + + , withNonNullR = + keepNonNull + -- Justification: + -- + -- lcm mempty a ≡ a + + , withNonNullP = + withBoth C.lcm + } +{-# INLINE union #-} + +-------------------------------------------------------------------------------- +-- Subtraction +-------------------------------------------------------------------------------- + +-- | Performs /group subtraction/ of the second map from the first. +-- +-- Uses the 'Group' subtraction operator '(C.~~)' to subtract each value in the +-- second map from its matching value in the first map. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k (m1 '`minus`' m2) '==' 'get' k m1 'C.~~' 'get' k m2 +-- @ +-- +-- This function provides the definition of '(C.~~)' for the 'MonoidMap' +-- instance of 'Group'. +-- +-- === __Examples__ +-- +-- With 'Data.Monoid.Sum' 'Integer' values, this function performs normal +-- integer subtraction of matching values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", (-1)), ("b", 0 ), ("c", 1)] +-- >>> m2 = 'fromList' [("a", 1 ), ("b", 1 ), ("c", 1)] +-- >>> m3 = 'fromList' [("a", (-2)), ("b", (-1)), ("c", 0)] +-- @ +-- @ +-- >>> m1 '`minus`' m2 '==' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", (-1)), ("b", 0 ), ("c", 1 )] +-- >>> m2 = 'fromList' [("a", (-1)), ("b", (-1)), ("c", (-1))] +-- >>> m3 = 'fromList' [("a", 0 ), ("b", 1 ), ("c", 2 )] +-- @ +-- @ +-- >>> m1 '`minus`' m2 '==' m3 +-- 'True' +-- @ +-- +minus + :: (Ord k, MonoidNull v, Group v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +minus = merge MergeStrategy + { withNonNullL = + keepNonNull + -- Justification: + -- + -- a ~~ mempty ≡ a + + , withNonNullR = + withNonNull C.invert + -- Justification: + -- + -- a ~~ b ≡ a <> invert b + -- mempty ~~ b ≡ mempty <> invert b + -- mempty ~~ b ≡ invert b + + , withNonNullP = + withBoth (C.~~) + } +{-# INLINE minus #-} + +-- | Performs /reductive subtraction/ of the second map from the first. +-- +-- Uses the 'Reductive' subtraction operator '()' to subtract each value in +-- the second map from its matching value in the first map. +-- +-- This function produces a result if (and only if) for all possible keys +-- __@k@__, it is possible to subtract the value for __@k@__ in the second map +-- from the value for __@k@__ in the first map: +-- +-- @ +-- 'isJust' (m1 '`minusMaybe`' m2) +-- '==' (∀ k. 'isJust' ('get' k m1 '' 'get' k m2)) +-- @ +-- +-- Otherwise, this function returns 'Nothing'. +-- +-- This function satisfies the following property: +-- +-- @ +-- 'all' +-- (\\r -> 'Just' ('get' k r) '==' 'get' k m1 '' 'get' k m2) +-- (m1 '`minusMaybe`' m2) +-- @ +-- +-- This function provides the definition of '()' for the 'MonoidMap' +-- instance of 'Reductive'. +-- +-- === __Examples__ +-- +-- With 'Set' 'Numeric.Natural.Natural' values, this function performs /set/ +-- /subtraction/ of matching values, succeeding if (and only if) each value +-- from the second map is a subset of its matching value from the first map: +-- +-- @ +-- f xs = 'fromList' ('Set.fromList' '<$>' xs) +-- @ +-- +-- @ +-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2])] +-- >>> m2 = f [("a", [ ]), ("b", [0,1,2])] +-- >>> m3 = f [("a", [0,1,2]), ("b", [ ])] +-- @ +-- @ +-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2]), ("c", [0,1,2])] +-- >>> m2 = f [("a", [0 ]), ("b", [ 1 ]), ("c", [ 2])] +-- >>> m3 = f [("a", [ 1,2]), ("b", [0, 2]), ("c", [0,1 ])] +-- @ +-- @ +-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = f [("a", [0,1,2 ]), ("b", [0,1,2 ]), ("c", [0,1,2 ])] +-- >>> m2 = f [("a", [ 2,3,4]), ("b", [ 1,2,3,4]), ("c", [0,1,2,3,4])] +-- @ +-- @ +-- >>> m1 '`minusMaybe`' m2 '==' 'Nothing' +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function +-- performs /ordinary/ /subtraction/ of matching values, succeeding if (and only +-- if) each value from the second map is less than or equal to its matching +-- value from the first map: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] +-- >>> m2 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)] +-- >>> m3 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] +-- @ +-- @ +-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] +-- >>> m2 = 'fromList' [("a", 1), ("b", 2), ("c", 3), ("d", 5)] +-- >>> m3 = 'fromList' [("a", 1), ("b", 1), ("c", 2), ("d", 3)] +-- @ +-- @ +-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] +-- >>> m2 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] +-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)] +-- @ +-- @ +-- >>> m1 '`minusMaybe`' m2 '==' 'Just' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", 2), ("b", 3), ("c", 5), ("d", 8)] +-- >>> m2 = 'fromList' [("a", 3), ("b", 3), ("c", 5), ("d", 8)] +-- @ +-- @ +-- >>> m1 '`minusMaybe`' m2 '==' 'Nothing' +-- 'True' +-- @ +-- +minusMaybe + :: (Ord k, MonoidNull v, Reductive v) + => MonoidMap k v + -> MonoidMap k v + -> Maybe (MonoidMap k v) +minusMaybe = mergeA MergeStrategy + { withNonNullL = + keepNonNull + -- Justification: + -- + -- According to laws for Reductive: + -- maybe a (b <>) (a b ) ≡ a + -- maybe a (mempty <>) (a mempty) ≡ a + -- maybe a (id ) (a mempty) ≡ a + -- (a mempty) ∈ {Just a, Nothing} + -- + -- According to laws for LeftReductive and RightReductive: + -- isJust (a b ) ≡ b `isPrefixOf` a ≡ b `isSuffixOf` a + -- isJust (a mempty) ≡ mempty `isPrefixOf` a ≡ mempty `isSuffixOf` a + -- + -- According to laws for LeftReductive and RightReductive: + -- b `isPrefixOf` (b <> a) + -- mempty `isPrefixOf` (mempty <> a) + -- mempty `isPrefixOf` a + -- + -- Therefore: + -- a mempty ≡ Just a + + , withNonNullR = + withNonNullA (\v -> mempty v) + + , withNonNullP = + withBothA () + } +{-# INLINE minusMaybe #-} + +-- | Performs /monus subtraction/ of the second map from the first. +-- +-- Uses the 'Monus' subtraction operator '(<\>)' to subtract each value in +-- the second map from its matching value in the first map. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k (m1 '`monus`' m2) '==' 'get' k m1 '<\>' 'get' k m2 +-- @ +-- +-- This function provides the definition of '(<\>)' for the 'MonoidMap' +-- instance of 'Monus'. +-- +-- === __Examples__ +-- +-- With 'Set' 'Numeric.Natural.Natural' values, this function performs /set/ +-- /subtraction/ of matching values: +-- +-- @ +-- f xs = 'fromList' ('Set.fromList' '<$>' xs) +-- @ +-- +-- @ +-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2])] +-- >>> m2 = f [("a", [ ]), ("b", [0,1,2])] +-- >>> m3 = f [("a", [0,1,2]), ("b", [ ])] +-- @ +-- @ +-- >>> m1 '`monus`' m2 '==' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = f [("a", [0,1,2]), ("b", [0,1,2]), ("c", [0,1,2])] +-- >>> m2 = f [("a", [0 ]), ("b", [ 1 ]), ("c", [ 2])] +-- >>> m3 = f [("a", [ 1,2]), ("b", [0, 2]), ("c", [0,1 ])] +-- @ +-- @ +-- >>> m1 '`monus`' m2 '==' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = f [("a", [0,1,2 ]), ("b", [0,1,2 ]), ("c", [0,1,2 ])] +-- >>> m2 = f [("a", [ 2,3,4]), ("b", [ 1,2,3,4]), ("c", [0,1,2,3,4])] +-- >>> m3 = f [("a", [0,1 ]), ("b", [0 ]), ("c", [ ])] +-- @ +-- @ +-- >>> m1 '`monus`' m2 '==' m3 +-- 'True' +-- @ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function +-- performs /truncated/ /subtraction/ of matching values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> m2 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)] +-- >>> m3 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- @ +-- @ +-- >>> m1 '`monus`' m2 '==' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> m2 = 'fromList' [("a", 1), ("b", 1), ("c", 1), ("d", 1)] +-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 1), ("d", 2)] +-- @ +-- @ +-- >>> m1 '`monus`' m2 '==' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> m2 = 'fromList' [("a", 2), ("b", 2), ("c", 2), ("d", 2)] +-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 1)] +-- @ +-- @ +-- >>> m1 '`monus`' m2 '==' m3 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> m2 = 'fromList' [("a", 4), ("b", 4), ("c", 4), ("d", 4)] +-- >>> m3 = 'fromList' [("a", 0), ("b", 0), ("c", 0), ("d", 0)] +-- @ +-- @ +-- >>> m1 '`monus`' m2 '==' m3 +-- 'True' +-- @ +-- +monus + :: (Ord k, MonoidNull v, Monus v) + => MonoidMap k v + -> MonoidMap k v + -> MonoidMap k v +monus = merge MergeStrategy + { withNonNullL = + keepNonNull + -- Justification: + -- + -- a <> (b <\> a ) ≡ b <> (a <\> b) + -- mempty <> (b <\> mempty) ≡ b <> (mempty <\> a) + -- b <\> mempty ≡ b <> (mempty <\> a) + -- b <\> mempty ≡ b <> mempty + -- b <\> mempty ≡ b + + , withNonNullR = + keepNull + -- Justification: + -- + -- mempty <\> a ≡ mempty + + , withNonNullP = + withBoth (<\>) + } +{-# INLINE monus #-} + +-------------------------------------------------------------------------------- +-- Inversion +-------------------------------------------------------------------------------- + +-- | Inverts every value in a map. +-- +-- Applies the 'Group' method 'C.invert' to every value in a map. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('invert' m) '==' 'C.invert' ('get' k m) +-- @ +-- +-- This function provides the definition of 'C.invert' for the 'MonoidMap' +-- instance of 'Group'. +-- +-- === __Examples__ +-- +-- With 'Data.Monoid.Sum' 'Integer' values, this function performs negation +-- of values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", (-1)), ("b", 0), ("c", 1) ] +-- >>> m2 = 'fromList' [("a", 1 ), ("b", 0), ("c", (-1))] +-- @ +-- @ +-- >>> 'negate' m1 '==' m2 +-- 'True' +-- @ +-- +invert + :: (MonoidNull v, Group v) + => MonoidMap k v + -> MonoidMap k v +invert = map C.invert +{-# INLINE invert #-} + +-------------------------------------------------------------------------------- +-- Exponentiation +-------------------------------------------------------------------------------- + +-- | Performs exponentiation of every value in a map. +-- +-- Uses the 'Group' exponentiation method 'C.pow' to raise every value in a map +-- to the power of the given exponent. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k (m '`power`' i) '==' 'get' k m '`C.pow`' i +-- @ +-- +-- This function provides the definition of 'C.pow' for the 'MonoidMap' +-- instance of 'Group'. +-- +-- === __Examples__ +-- +-- With 'Data.Monoid.Sum' 'Numeric.Natural.Natural' values, this function +-- performs /ordinary multiplication/ of all values by the given exponent: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1), ("c", 2), ("d", 3)] +-- >>> m2 = 'fromList' [("a", 0), ("b", 2), ("c", 4), ("d", 6)] +-- @ +-- @ +-- >>> m1 '`power`' 2 '==' m2 +-- 'True' +-- @ +-- +-- @ +-- >>> m1 = 'fromList' [("a", 0), ("b", 1 ), ("c", 2 ), ("d", 3 )] +-- >>> m2 = 'fromList' [("a", 0), ("b", (-1)), ("c", (-2)), ("d", (-3))] +-- @ +-- @ +-- >>> m1 '`power`' (-1) '==' m2 +-- 'True' +-- @ +-- +power + :: (Integral i, MonoidNull v, Group v) + => MonoidMap k v + -> i + -> MonoidMap k v +power m i = map (`C.pow` i) m +{-# INLINE power #-} + +-------------------------------------------------------------------------------- +-- Intersection +-------------------------------------------------------------------------------- + +-- | Computes the /intersection/ of a pair of maps using the given function +-- to combine values for matching keys. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('intersectionWith' f m1 m2) '==' +-- if k '`Set.member`' +-- 'Set.intersection' +-- ('nonNullKeys' m1) +-- ('nonNullKeys' m2) +-- then f ('get' k m1) ('get' k m2) +-- else 'mempty' +-- @ +-- +-- === Conditional totality +-- +-- /If/ the given combining function __@f@__ /always/ produces 'mempty' when +-- /either/ or /both/ of its arguments are 'mempty': +-- +-- @ +-- (f v 'mempty' '==' 'mempty') '&&' +-- (f 'mempty' v '==' 'mempty') +-- @ +-- +-- /Then/ the following property holds for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('intersectionWith' f m1 m2) '==' f ('get' k m1) ('get' k m2) +-- @ +-- +-- === __Examples__ +-- +-- With the 'Prelude.min' function applied to 'Data.Monoid.Sum' +-- 'Numeric.Natural.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1) ] +-- >>> m2 = 'fromList' [ ("b", 1), ("c", 2), ("d", 3), ("e", 4)] +-- >>> m3 = 'fromList' [ ("b", 1), ("c", 2), ("d", 1) ] +-- @ +-- @ +-- >>> 'intersectionWith' 'Prelude.min' m1 m2 '==' m3 +-- 'True' +-- @ +-- +intersectionWith + :: (Ord k, MonoidNull v3) + => (v1 -> v2 -> v3) + -- ^ Function with which to combine values for matching keys. + -> MonoidMap k v1 + -> MonoidMap k v2 + -> MonoidMap k v3 +intersectionWith f = merge MergeStrategy + { withNonNullL = + keepNull + , withNonNullR = + keepNull + , withNonNullP = + withBoth f + } +{-# INLINE intersectionWith #-} + +-- | An /applicative/ version of 'intersectionWith'. +-- +-- Satisfies the following property: +-- +-- @ +-- 'runIdentity' ('intersectionWithA' (('fmap' . 'fmap') 'Identity' f) m1 m2) +-- '==' ('intersectionWith' \ \ \ \ \ \ f m1 m2) +-- @ +-- +intersectionWithA + :: (Applicative f, Ord k, MonoidNull v3) + => (v1 -> v2 -> f v3) + -- ^ Function with which to combine values for matching keys. + -> MonoidMap k v1 + -> MonoidMap k v2 + -> f (MonoidMap k v3) +intersectionWithA f = mergeA MergeStrategy + { withNonNullL = + keepNull + , withNonNullR = + keepNull + , withNonNullP = + withBothA f + } +{-# INLINE intersectionWithA #-} + +-------------------------------------------------------------------------------- +-- Union +-------------------------------------------------------------------------------- + +-- | Computes the /union/ of a pair of maps using the given function to combine +-- values for matching keys. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('unionWith' f m1 m2) '==' +-- if k '`Set.member`' +-- 'Set.union' +-- ('nonNullKeys' m1) +-- ('nonNullKeys' m2) +-- then f ('get' k m1) ('get' k m2) +-- else 'mempty' +-- @ +-- +-- === Conditional totality +-- +-- /If/ the given combining function __@f@__ /always/ produces 'mempty' when +-- /both/ of its arguments are 'mempty': +-- +-- @ +-- f 'mempty' 'mempty' '==' 'mempty' +-- @ +-- +-- /Then/ the following property holds for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('unionWith' f m1 m2) '==' f ('get' k m1) ('get' k m2) +-- @ +-- +-- === __Examples__ +-- +-- With the 'Prelude.max' function applied to 'Data.Monoid.Sum' +-- 'Numeric.Natural.Natural' values: +-- +-- @ +-- >>> m1 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 1) ] +-- >>> m2 = 'fromList' [ ("b", 1), ("c", 2), ("d", 3), ("e", 4)] +-- >>> m3 = 'fromList' [("a", 4), ("b", 3), ("c", 2), ("d", 3), ("e", 4)] +-- @ +-- @ +-- >>> 'unionWith' 'Prelude.max' m1 m2 '==' m3 +-- 'True' +-- @ +-- +unionWith + :: (Ord k, Monoid v1, Monoid v2, MonoidNull v3) + => (v1 -> v2 -> v3) + -- ^ Function with which to combine values for matching keys. + -> MonoidMap k v1 + -> MonoidMap k v2 + -> MonoidMap k v3 +unionWith f = merge MergeStrategy + { withNonNullL = + withNonNull (\v -> f v mempty) + , withNonNullR = + withNonNull (\v -> f mempty v) + , withNonNullP = + withBoth f + } +{-# INLINE unionWith #-} + +-- | An /applicative/ version of 'unionWith'. +-- +-- Satisfies the following property: +-- +-- @ +-- 'runIdentity' ('unionWithA' (('fmap' . 'fmap') 'Identity' f) m1 m2) +-- '==' ('unionWith' \ \ \ \ \ \ f m1 m2) +-- @ +-- +unionWithA + :: (Applicative f, Ord k, Monoid v1, Monoid v2, MonoidNull v3) + => (v1 -> v2 -> f v3) + -- ^ Function with which to combine values for matching keys. + -> MonoidMap k v1 + -> MonoidMap k v2 + -> f (MonoidMap k v3) +unionWithA f = mergeA MergeStrategy + { withNonNullL = + withNonNullA (\v -> f v mempty) + , withNonNullR = + withNonNullA (\v -> f mempty v) + , withNonNullP = + withBothA f + } +{-# INLINE unionWithA #-} + +-------------------------------------------------------------------------------- +-- Merging +-------------------------------------------------------------------------------- + +type WhenOneSideNull f k vx vr + = Map.WhenMissing f k (NonNull vx) (NonNull vr) +type WhenBothNonNull f k v1 v2 vr + = Map.WhenMatched f k (NonNull v1) (NonNull v2) (NonNull vr) + +data MergeStrategy f k v1 v2 v3 = MergeStrategy + { withNonNullL :: !(WhenOneSideNull f k v1 v3) + , withNonNullR :: !(WhenOneSideNull f k v2 v3) + , withNonNullP :: !(WhenBothNonNull f k v1 v2 v3) + } + +merge + :: Ord k + => MergeStrategy Identity k v1 v2 v3 + -> MonoidMap k v1 + -> MonoidMap k v2 + -> MonoidMap k v3 +merge (MergeStrategy nnl nnr nnp) (MonoidMap m1) (MonoidMap m2) = + MonoidMap $ Map.merge nnl nnr nnp m1 m2 +{-# INLINE merge #-} + +mergeA + :: (Applicative f, Ord k) + => MergeStrategy f k v1 v2 v3 + -> MonoidMap k v1 + -> MonoidMap k v2 + -> f (MonoidMap k v3) +mergeA (MergeStrategy nnl nnr nnp) (MonoidMap m1) (MonoidMap m2) = + MonoidMap <$> Map.mergeA nnl nnr nnp m1 m2 +{-# INLINE mergeA #-} + +keepNull + :: Applicative f + => WhenOneSideNull f k v1 v2 +keepNull = Map.dropMissing +{-# INLINE keepNull #-} + +keepNonNull + :: Applicative f + => WhenOneSideNull f k v v +keepNonNull = Map.preserveMissing +{-# INLINE keepNonNull #-} + +withNonNull + :: (Applicative f, MonoidNull v2) + => (v1 -> v2) + -> WhenOneSideNull f k v1 v2 +withNonNull f + = Map.mapMaybeMissing + $ \_k v -> maybeNonNull $ applyNonNull f v +{-# INLINE withNonNull #-} + +withNonNullA + :: (Applicative f, MonoidNull v2) + => (v1 -> f v2) + -> WhenOneSideNull f k v1 v2 +withNonNullA f + = Map.traverseMaybeMissing + $ \_k v -> maybeNonNull <$> applyNonNull f v +{-# INLINE withNonNullA #-} + +withBoth + :: (Applicative f, MonoidNull v3) + => (v1 -> v2 -> v3) + -> WhenBothNonNull f k v1 v2 v3 +withBoth f + = Map.zipWithMaybeMatched + $ \_k v1 v2 -> maybeNonNull $ applyNonNull2 f v1 v2 +{-# INLINE withBoth #-} + +withBothA + :: (Applicative f, MonoidNull v3) + => (v1 -> v2 -> f v3) + -> WhenBothNonNull f k v1 v2 v3 +withBothA f + = Map.zipWithMaybeAMatched + $ \_k v1 v2 -> maybeNonNull <$> applyNonNull2 f v1 v2 +{-# INLINE withBothA #-} + +-------------------------------------------------------------------------------- +-- State +-------------------------------------------------------------------------------- + +newtype StateL s a = StateL (s -> (s, a)) +newtype StateR s a = StateR (s -> (s, a)) + +instance Functor (StateL s) where + fmap f (StateL kx) = + StateL $ \s -> let (s', x) = kx s in (s', f x) + +instance Functor (StateR s) where + fmap f (StateR kx) = + StateR $ \s -> let (s', x) = kx s in (s', f x) + +instance Applicative (StateL s) where + pure a = StateL $ + \s -> (s, a) + StateL kf <*> StateL kx = StateL $ + \s -> + let (s' , f ) = kf s + (s'', x) = kx s' + in (s'', f x) + liftA2 f (StateL kx) (StateL ky) = StateL $ + \s -> + let (s' , x ) = kx s + (s'', y) = ky s' + in (s'', f x y) + +instance Applicative (StateR s) where + pure a = StateR $ + \s -> (s, a) + StateR kf <*> StateR kx = StateR $ + \s -> + let (s', x) = kx s + (s'', f ) = kf s' + in (s'', f x) + liftA2 f (StateR kx) (StateR ky) = StateR $ + \s -> + let (s' , y) = ky s + (s'', x ) = kx s' + in (s'', f x y) diff --git a/components/monoidmap/Data/MonoidMap/Unsafe.hs b/components/monoidmap/Data/MonoidMap/Unsafe.hs new file mode 100644 --- /dev/null +++ b/components/monoidmap/Data/MonoidMap/Unsafe.hs @@ -0,0 +1,50 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +-- | +-- Copyright: © 2022–2025 Jonathan Knowles +-- License: Apache-2.0 +-- +-- Provides /unsafe/ operations for the 'MonoidMap' type. +-- +module Data.MonoidMap.Unsafe + ( + -- * Construction + unsafeFromMap + ) + where + +import Prelude + +import Data.Coerce + ( coerce ) +import Data.Map.Strict + ( Map ) +import Data.MonoidMap.Internal + ( MonoidMap (..), NonNull (..), fromMap ) + +import qualified Data.Foldable as F +import qualified Data.Monoid.Null as Null +import qualified Data.MonoidMap.Internal as Internal + +-------------------------------------------------------------------------------- +-- Unsafe construction +-------------------------------------------------------------------------------- + +-- | \(O(1)\). /Unsafely/ constructs a 'MonoidMap' from an ordinary 'Map'. +-- +-- Constructs a 'MonoidMap' in /constant time/, without imposing the burden +-- of a canonicalisation step to remove 'null' values. +-- +-- When applied to a given 'Map' @m@, this function /expects/ but does /not/ +-- check the following pre-condition: +-- +-- @ +-- 'F.all' ('not' . 'Null.null') m +-- @ +-- +-- Not satisfying this pre-condition will result in undefined behaviour. +-- +-- See 'fromMap' for a safe version of this function. +-- +unsafeFromMap :: Map k v -> MonoidMap k v +unsafeFromMap = coerce diff --git a/monoidmap.cabal b/monoidmap.cabal --- a/monoidmap.cabal +++ b/monoidmap.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: monoidmap -version: 0.0.4.2 +version: 0.0.4.3 bug-reports: https://github.com/jonathanknowles/monoidmap/issues license: Apache-2.0 license-file: LICENSE @@ -77,15 +77,18 @@ import: , dependency-base , dependency-containers + , dependency-deepseq , dependency-groups , dependency-monoid-subclasses + , dependency-nothunks , extensions - build-depends: - , monoidmap-internal hs-source-dirs: components/monoidmap exposed-modules: Data.MonoidMap + other-modules: + Data.MonoidMap.Internal + Data.MonoidMap.Unsafe default-language: Haskell2010 @@ -133,25 +136,6 @@ Examples.MultiSet Examples.NestedMonoidMap Examples.RecoveredMap - default-language: - Haskell2010 - -library monoidmap-internal - import: - , dependency-base - , dependency-containers - , dependency-deepseq - , dependency-groups - , dependency-monoid-subclasses - , dependency-nothunks - , extensions - visibility: - private - hs-source-dirs: - components/monoidmap-internal - exposed-modules: - Data.MonoidMap.Internal - Data.MonoidMap.Unsafe default-language: Haskell2010