diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,19 @@ Changelog ========= +Version 0.4.0.0 +--------------- + +*September 27, 2026* + + + +* Add `Data.Map.NonEmpty.Lazy`, `Data.Map.NonEmpty.Strict`, + `Data.IntMap.NonEmpty.Lazy`, and `Data.IntMap.NonEmpty.Strict`. + The existing `Data.Map.NonEmpty` and `Data.IntMap.NonEmpty` modules + continue to re-export the lazy interfaces so the imports should be + backwards-compatible. + Version 0.3.6.0 --------------- diff --git a/nonempty-containers.cabal b/nonempty-containers.cabal --- a/nonempty-containers.cabal +++ b/nonempty-containers.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: nonempty-containers -version: 0.3.6.0 +version: 0.4.0.0 synopsis: Non-empty variants of containers data types, with full API description: Efficient and optimized non-empty versions of types from /containers/. @@ -39,10 +39,18 @@ Data.Containers.NonEmpty.List Data.IntMap.NonEmpty Data.IntMap.NonEmpty.Internal + Data.IntMap.NonEmpty.Lazy + Data.IntMap.NonEmpty.Lazy.Internal + Data.IntMap.NonEmpty.Strict + Data.IntMap.NonEmpty.Strict.Internal Data.IntSet.NonEmpty Data.IntSet.NonEmpty.Internal Data.Map.NonEmpty Data.Map.NonEmpty.Internal + Data.Map.NonEmpty.Lazy + Data.Map.NonEmpty.Lazy.Internal + Data.Map.NonEmpty.Strict + Data.Map.NonEmpty.Strict.Internal Data.Sequence.NonEmpty Data.Sequence.NonEmpty.Internal Data.Set.NonEmpty @@ -72,8 +80,10 @@ other-modules: Paths_nonempty_containers Tests.IntMap + Tests.IntMap.Strict Tests.IntSet Tests.Map + Tests.Map.Strict Tests.NonEmptyList Tests.Sequence Tests.Set diff --git a/src/Data/IntMap/NonEmpty.hs b/src/Data/IntMap/NonEmpty.hs --- a/src/Data/IntMap/NonEmpty.hs +++ b/src/Data/IntMap/NonEmpty.hs @@ -1,2075 +1,18 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ViewPatterns #-} - --- | --- Module : Data.IntMap.NonEmpty --- Copyright : (c) Justin Le 2018 --- License : BSD3 --- --- Maintainer : justin@jle.im --- Stability : experimental --- Portability : non-portable --- --- = Non-Empty Finite Integer-Indexed Maps (lazy interface) --- --- The @'NEIntMap' v@ type represents a non-empty finite map (sometimes --- called a dictionary) from integer keys to values of type @v@. --- An 'NEIntMap' is strict in its keys but lazy in its values. --- --- See documentation for 'NEIntMap' for information on how to convert and --- manipulate such non-empty maps. --- --- This module essentially re-imports the API of "Data.IntMap.Lazy" and its --- 'IntMap' type, along with semantics and asymptotics. In most --- situations, asymptotics are different only by a constant factor. In --- some situations, asmyptotics are even better (constant-time instead of --- log-time). --- --- Because 'NEIntMap' is implemented using 'IntMap', all of the caveats of using --- 'IntMap' apply (such as the limitation of the maximum size of maps). --- --- All functions take non-empty maps as inputs. In situations where their --- results can be guarunteed to also be non-empty, they also return --- non-empty maps. In situations where their results could potentially be --- empty, 'IntMap' is returned instead. --- --- Some variants of functions (like 'alter'', 'alterF'', 'adjustMin', --- 'adjustMax', 'adjustMinWithKey', 'adjustMaxWithKey') are provided in --- a way restructured to preserve guaruntees of non-empty maps being --- returned. --- --- Some functions (like 'mapEither', 'partition', 'split') --- have modified return types to account for possible configurations of --- non-emptiness. --- --- This module is intended to be imported qualified, to avoid name clashes with --- "Prelude" and "Data.IntMap" functions: --- --- > import qualified Data.IntMap.NonEmpty as NEIM --- --- Note that all asmyptotics /O(f(n))/ in this module are actually --- /O(min(W, f(n)))/, where @W@ is the number of bits in an 'Int' (32 or --- 64). That is, if @f(n)@ is greater than @W@, all operations are --- constant-time. --- --- At the moment, this package does not provide a variant strict on values --- for these functions, like /containers/ does. This is a planned future --- implementation (PR's are appreciated). For now, you can simulate --- a strict interface by manually forcing values before returning results. -module Data.IntMap.NonEmpty ( - -- * Non-Empty IntMap Type - NEIntMap, - Key, - - -- ** Conversions between empty and non-empty maps - pattern IsNonEmpty, - pattern IsEmpty, - nonEmptyMap, - toMap, - withNonEmpty, - insertMap, - insertMapWith, - insertMapWithKey, - insertMapMin, - insertMapMax, - unsafeFromMap, - - -- * Construction - singleton, - fromSet, - - -- ** From Unordered Lists - fromList, - fromListWith, - fromListWithKey, - - -- ** From Ascending Lists - fromAscList, - fromAscListWith, - fromAscListWithKey, - fromDistinctAscList, - - -- * Insertion - insert, - insertWith, - insertWithKey, - insertLookupWithKey, - - -- * Deletion\/Update - delete, - deleteMaybe, - adjust, - adjustWithKey, - update, - updateWithKey, - updateLookupWithKey, - alter, - alterF, - alter', - alterF', - - -- * Query - - -- ** Lookup - lookup, - (!?), - (!), - findWithDefault, - member, - notMember, - lookupLT, - lookupGT, - lookupLE, - lookupGE, - - -- ** Size - size, - - -- * Combine - - -- ** Union - union, - unionMapLeft, - unionMapRight, - unionWith, - unionMapWithLeft, - unionMapWithRight, - unionWithKey, - unionMapWithKeyLeft, - unionMapWithKeyRight, - unions, - unionsWith, - - -- ** Difference - difference, - (\\), - differenceWith, - differenceWithKey, - - -- ** Intersection - intersection, - intersectionWith, - intersectionWithKey, - -- -- ** Universal combining function - -- , mergeWithKey - - -- * Traversal - - -- ** Map - map, - mapWithKey, - traverseWithKey1, - traverseWithKey, - mapAccum, - mapAccumWithKey, - mapAccumRWithKey, - mapKeys, - mapKeysWith, - mapKeysMonotonic, - - -- * Folds - foldr, - foldl, - foldr1, - foldl1, - foldrWithKey, - foldlWithKey, - foldMapWithKey, - - -- ** Strict folds - foldr', - foldr1', - foldl', - foldl1', - foldrWithKey', - foldlWithKey', - - -- * Conversion - elems, - keys, - assocs, - keysSet, - - -- ** Lists - toList, - - -- ** Ordered lists - toAscList, - toDescList, - - -- * Filter - filter, - filterWithKey, - restrictKeys, - withoutKeys, - partition, - partitionWithKey, - mapMaybe, - mapMaybeWithKey, - mapEither, - mapEitherWithKey, - split, - splitLookup, - splitRoot, - - -- * Submap - isSubmapOf, - isSubmapOfBy, - isProperSubmapOf, - isProperSubmapOfBy, - - -- * Min\/Max - findMin, - findMax, - deleteMin, - deleteMax, - deleteFindMin, - deleteFindMax, - updateMin, - updateMax, - adjustMin, - adjustMax, - updateMinWithKey, - updateMaxWithKey, - adjustMinWithKey, - adjustMaxWithKey, - minView, - maxView, - - -- * Debugging - valid, -) where - -import Control.Applicative -import Data.Bifunctor -import qualified Data.Foldable as F -import Data.Functor.Identity -import qualified Data.IntMap as M -import Data.IntMap.Internal (IntMap (..)) -import Data.IntMap.NonEmpty.Internal -import Data.IntSet (IntSet) -import qualified Data.IntSet as S -import Data.IntSet.NonEmpty.Internal (NEIntSet (..)) -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NE -import Data.Maybe hiding (mapMaybe) -import qualified Data.Maybe as Maybe -import Data.Semigroup.Foldable (Foldable1) -import qualified Data.Semigroup.Foldable as F1 -import Data.These -import Prelude hiding (Foldable (..), filter, lookup, map) - --- | /O(1)/ match, /O(log n)/ usage of contents. The 'IsNonEmpty' and --- 'IsEmpty' patterns allow you to treat a 'IntMap' as if it were either --- a @'IsNonEmpty' n@ (where @n@ is a 'NEIntMap') or an 'IsEmpty'. --- --- For example, you can pattern match on a 'IntMap': --- --- @ --- myFunc :: 'IntMap' K X -> Y --- myFunc ('IsNonEmpty' n) = -- here, the user provided a non-empty map, and @n@ is the 'NEIntMap' --- myFunc 'IsEmpty' = -- here, the user provided an empty map. --- @ --- --- Matching on @'IsNonEmpty' n@ means that the original 'IntMap' was /not/ --- empty, and you have a verified-non-empty 'NEIntMap' @n@ to use. --- --- Note that patching on this pattern is /O(1)/. However, using the --- contents requires a /O(log n)/ cost that is deferred until after the --- pattern is matched on (and is not incurred at all if the contents are --- never used). --- --- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides --- complete coverage. --- --- This is a bidirectional pattern, so you can use 'IsNonEmpty' to convert --- a 'NEIntMap' back into a 'IntMap', obscuring its non-emptiness (see 'toMap'). -pattern IsNonEmpty :: NEIntMap a -> IntMap a -pattern IsNonEmpty n <- (nonEmptyMap -> Just n) - where - IsNonEmpty n = toMap n - --- | /O(1)/. The 'IsNonEmpty' and 'IsEmpty' patterns allow you to treat --- a 'IntMap' as if it were either a @'IsNonEmpty' n@ (where @n@ is --- a 'NEIntMap') or an 'IsEmpty'. --- --- Matching on 'IsEmpty' means that the original 'IntMap' was empty. --- --- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides --- complete coverage. --- --- This is a bidirectional pattern, so you can use 'IsEmpty' as an --- expression, and it will be interpreted as 'Data.IntMap.empty'. --- --- See 'IsNonEmpty' for more information. -pattern IsEmpty :: IntMap a -pattern IsEmpty <- (M.null -> True) - where - IsEmpty = M.empty - -{-# COMPLETE IsNonEmpty, IsEmpty #-} - --- | /O(log n)/. Unsafe version of 'nonEmptyMap'. Coerces a 'IntMap' into an --- 'NEIntMap', but is undefined (throws a runtime exception when evaluation is --- attempted) for an empty 'IntMap'. -unsafeFromMap :: - IntMap a -> - NEIntMap a -unsafeFromMap = withNonEmpty e id - where - e = errorWithoutStackTrace "NEIntMap.unsafeFromMap: empty map" -{-# INLINE unsafeFromMap #-} - --- | /O(log n)/. Convert a 'IntMap' into an 'NEIntMap' by adding a key-value --- pair. Because of this, we know that the map must have at least one --- element, and so therefore cannot be empty. If key is already present, --- will overwrite the original value. --- --- See 'insertMapMin' for a version that is constant-time if the new key is --- /strictly smaller than/ all keys in the original map. --- --- > insertMap 4 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) --- > insertMap 4 "c" Data.IntMap.empty == singleton 4 "c" -insertMap :: Key -> a -> IntMap a -> NEIntMap a -insertMap k v = withNonEmpty (singleton k v) (insert k v) -{-# INLINE insertMap #-} - --- | /O(log n)/. Convert a 'IntMap' into an 'NEIntMap' by adding a key-value --- pair. Because of this, we know that the map must have at least one --- element, and so therefore cannot be empty. Uses a combining function --- with the new value as the first argument if the key is already present. --- --- > insertMapWith (++) 4 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) --- > insertMapWith (++) 5 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"ca")]) -insertMapWith :: - (a -> a -> a) -> - Key -> - a -> - IntMap a -> - NEIntMap a -insertMapWith f k v = withNonEmpty (singleton k v) (insertWith f k v) -{-# INLINE insertMapWith #-} - --- | /O(log n)/. Convert a 'IntMap' into an 'NEIntMap' by adding a key-value --- pair. Because of this, we know that the map must have at least one --- element, and so therefore cannot be empty. Uses a combining function --- with the key and new value as the first and second arguments if the key --- is already present. --- --- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value --- > insertWithKey f 5 "xxx" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "5:xxx|a")]) --- > insertWithKey f 7 "xxx" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) --- > insertWithKey f 5 "xxx" Data.IntMap.empty == singleton 5 "xxx" -insertMapWithKey :: - (Key -> a -> a -> a) -> - Key -> - a -> - IntMap a -> - NEIntMap a -insertMapWithKey f k v = withNonEmpty (singleton k v) (insertWithKey f k v) -{-# INLINE insertMapWithKey #-} - --- | /O(1)/ Convert a 'IntMap' into an 'NEIntMap' by adding a key-value pair --- where the key is /strictly less than/ all keys in the input map. The --- keys in the original map must all be /strictly greater than/ the new --- key. /The precondition is not checked./ --- --- > insertMapMin 2 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((2,"c") :| [(3,"b"), (5,"a")]) --- > valid (insertMapMin 2 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == True --- > valid (insertMapMin 7 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False --- > valid (insertMapMin 3 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False -insertMapMin :: - Key -> - a -> - IntMap a -> - NEIntMap a -insertMapMin = NEIntMap -{-# INLINE insertMapMin #-} - --- | /O(log n)/ Convert a 'IntMap' into an 'NEIntMap' by adding a key-value pair --- where the key is /strictly greater than/ all keys in the input map. The --- keys in the original map must all be /strictly less than/ the new --- key. /The precondition is not checked./ --- --- At the current moment, this is identical simply 'insertMap'; however, --- it is left both for consistency and as a placeholder for a future --- version where optimizations are implemented to allow for a faster --- implementation. --- --- > insertMap 7 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"a"), (7,"c")]) - --- these currently are all valid, but shouldn't be --- > valid (insertMap 7 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == True --- > valid (insertMap 2 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False --- > valid (insertMap 5 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False -insertMapMax :: - Key -> - a -> - IntMap a -> - NEIntMap a -insertMapMax k v = withNonEmpty (singleton k v) go - where - go (NEIntMap k0 v0 m0) = NEIntMap k0 v0 . insertMaxMap k v $ m0 -{-# INLINE insertMapMax #-} - --- | /O(n)/. Build a non-empty map from a non-empty set of keys and --- a function which for each key computes its value. --- --- > fromSet (\k -> replicate k 'a') (Data.Set.NonEmpty.fromList (3 :| [5])) == fromList ((5,"aaaaa") :| [(3,"aaa")]) -fromSet :: - (Key -> a) -> - NEIntSet -> - NEIntMap a -fromSet f (NEIntSet k ks) = NEIntMap k (f k) (M.fromSet f ks) -{-# INLINE fromSet #-} - --- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs --- with a combining function. See also 'fromAscListWith'. --- --- > fromListWith (++) ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "ab") :| [(5, "aba")]) -fromListWith :: - (a -> a -> a) -> - NonEmpty (Key, a) -> - NEIntMap a -fromListWith f = fromListWithKey (const f) -{-# INLINE fromListWith #-} - --- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs --- with a combining function. See also 'fromAscListWithKey'. --- --- > let f k a1 a2 = (show k) ++ a1 ++ a2 --- > fromListWithKey f ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "3ab") :| [(5, "5a5ba")]) -fromListWithKey :: - (Key -> a -> a -> a) -> - NonEmpty (Key, a) -> - NEIntMap a -fromListWithKey f ((k0, v0) :| xs) = F.foldl' go (singleton k0 v0) xs - where - go m (k, v) = insertWithKey f k v m - {-# INLINE go #-} -{-# INLINE fromListWithKey #-} - --- | /O(n)/. Build a map from an ascending non-empty list in linear time. --- /The precondition (input list is ascending) is not checked./ --- --- > fromAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) --- > fromAscList ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "b")]) --- > valid (fromAscList ((3,"b") :| [(5,"a"), (5,"b")])) == True --- > valid (fromAscList ((5,"a") :| [(3,"b"), (5,"b")])) == False -fromAscList :: - NonEmpty (Key, a) -> - NEIntMap a -fromAscList = fromDistinctAscList . combineEq -{-# INLINE fromAscList #-} - --- | /O(n)/. Build a map from an ascending non-empty list in linear time --- with a combining function for equal keys. /The precondition (input list --- is ascending) is not checked./ --- --- > fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "ba")]) --- > valid (fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b"))]) == True --- > valid (fromAscListWith (++) ((5,"a") :| [(3,"b"), (5,"b"))]) == False -fromAscListWith :: - (a -> a -> a) -> - NonEmpty (Key, a) -> - NEIntMap a -fromAscListWith f = fromAscListWithKey (const f) -{-# INLINE fromAscListWith #-} - --- | /O(n)/. Build a map from an ascending non-empty list in linear time --- with a combining function for equal keys. /The precondition (input list --- is ascending) is not checked./ --- --- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 --- > fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")]) == fromList ((3, "b") :| [(5, "5:b5:ba")]) --- > valid (fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")])) == True --- > valid (fromAscListWithKey f ((5,"a") :| [(3,"b"), (5,"b"), (5,"b")])) == False -fromAscListWithKey :: - (Key -> a -> a -> a) -> - NonEmpty (Key, a) -> - NEIntMap a -fromAscListWithKey f = fromDistinctAscList . combineEqWith f -{-# INLINE fromAscListWithKey #-} - --- | /O(n)/. Build a map from an ascending non-empty list of distinct --- elements in linear time. /The precondition is not checked./ --- --- > fromDistinctAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) --- > valid (fromDistinctAscList ((3,"b") :| [(5,"a")])) == True --- > valid (fromDistinctAscList ((3,"b") :| [(5,"a"), (5,"b")])) == False -fromDistinctAscList :: NonEmpty (Key, a) -> NEIntMap a -fromDistinctAscList ((k, v) :| xs) = - insertMapMin k v - . M.fromDistinctAscList - $ xs -{-# INLINE fromDistinctAscList #-} - --- | /O(log n)/. Insert a new key and value in the map. --- If the key is already present in the map, the associated value is --- replaced with the supplied value. 'insert' is equivalent to --- @'insertWith' 'const'@. --- --- See 'insertMap' for a version where the first argument is a 'IntMap'. --- --- > insert 5 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'x')]) --- > insert 7 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'a'), (7, 'x')]) -insert :: - Key -> - a -> - NEIntMap a -> - NEIntMap a -insert k v n@(NEIntMap k0 v0 m) = case compare k k0 of - LT -> NEIntMap k v . toMap $ n - EQ -> NEIntMap k v m - GT -> NEIntMap k0 v0 . M.insert k v $ m -{-# INLINE insert #-} - --- | /O(log n)/. Insert with a function, combining key, new value and old --- value. @'insertWithKey' f key value mp@ will insert the pair (key, --- value) into @mp@ if key does not exist in the map. If the key does --- exist, the function will insert the pair @(key,f key new_value --- old_value)@. Note that the key passed to f is the same key passed to --- 'insertWithKey'. --- --- See 'insertMapWithKey' for a version where the first argument is a 'IntMap'. --- --- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value --- > insertWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:xxx|a")]) --- > insertWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) -insertWithKey :: - (Key -> a -> a -> a) -> - Key -> - a -> - NEIntMap a -> - NEIntMap a -insertWithKey f k v n@(NEIntMap k0 v0 m) = case compare k k0 of - LT -> NEIntMap k v . toMap $ n - EQ -> NEIntMap k (f k v v0) m - GT -> NEIntMap k0 v0 $ M.insertWithKey f k v m -{-# INLINE insertWithKey #-} - --- | /O(log n)/. Combines insert operation with old value retrieval. The --- expression (@'insertLookupWithKey' f k x map@) is a pair where the first --- element is equal to (@'lookup' k map@) and the second element equal to --- (@'insertWithKey' f k x map@). --- --- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value --- > insertLookupWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "5:xxx|a")])) --- > insertLookupWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "xxx")])) --- --- This is how to define @insertLookup@ using @insertLookupWithKey@: --- --- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t --- > insertLookup 5 "x" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "x")])) --- > insertLookup 7 "x" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "x")])) -insertLookupWithKey :: - (Key -> a -> a -> a) -> - Key -> - a -> - NEIntMap a -> - (Maybe a, NEIntMap a) -insertLookupWithKey f k v n@(NEIntMap k0 v0 m) = case compare k k0 of - LT -> (Nothing, NEIntMap k v . toMap $ n) - EQ -> (Just v, NEIntMap k (f k v v0) m) - GT -> NEIntMap k0 v0 <$> M.insertLookupWithKey f k v m -{-# INLINE insertLookupWithKey #-} - --- | /O(log n)/. Delete a key and its value from the non-empty map. --- A potentially empty map ('IntMap') is returned, since this might delete the --- last item in the 'NEIntMap'. When the key is not a member of the map, is --- equivalent to 'toMap'. --- --- > delete 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" --- > delete 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.Singleton [(3, "b"), (5, "a")] -delete :: Key -> NEIntMap a -> IntMap a -delete k n@(NEIntMap k0 v m) = case compare k k0 of - LT -> toMap n - EQ -> m - GT -> insertMinMap k0 v . M.delete k $ m -{-# INLINE delete #-} - --- | /O(log n)/. Delete a key and its value from the non-empty map, returning --- 'Nothing' if the result would be empty. --- --- This is more efficient than @'nonEmptyMap' . 'delete' k@ because it avoids --- converting the known-minimum representation back through 'IntMap' when the --- deleted key is not the minimum. --- --- @since 0.3.6.0 -deleteMaybe :: Key -> NEIntMap a -> Maybe (NEIntMap a) -deleteMaybe k n@(NEIntMap k0 v m) = case compare k k0 of - LT -> Just n - EQ -> nonEmptyMap m - GT -> Just . NEIntMap k0 v . M.delete k $ m -{-# INLINE deleteMaybe #-} - --- | /O(log n)/. Update a value at a specific key with the result of the --- provided function. When the key is not a member of the map, the original --- map is returned. --- --- > adjust ("new " ++) 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "new a")]) --- > adjust ("new " ++) 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) -adjust :: - (a -> a) -> - Key -> - NEIntMap a -> - NEIntMap a -adjust f = adjustWithKey (const f) -{-# INLINE adjust #-} - --- | /O(log n)/. Adjust a value at a specific key. When the key is not --- a member of the map, the original map is returned. --- --- > let f key x = (show key) ++ ":new " ++ x --- > adjustWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:new a")]) --- > adjustWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) -adjustWithKey :: - (Key -> a -> a) -> - Key -> - NEIntMap a -> - NEIntMap a -adjustWithKey f k n@(NEIntMap k0 v m) = case compare k k0 of - LT -> n - EQ -> NEIntMap k0 (f k0 v) m - GT -> NEIntMap k0 v . M.adjustWithKey f k $ m -{-# INLINE adjustWithKey #-} - --- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@ --- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is --- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. --- --- Returns a potentially empty map ('IntMap'), because we can't know ahead of --- time if the function returns 'Nothing' and deletes the final item in the --- 'NEIntMap'. --- --- > let f x = if x == "a" then Just "new a" else Nothing --- > update f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "new a")] --- > update f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a")] --- > update f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" -update :: - (a -> Maybe a) -> - Key -> - NEIntMap a -> - IntMap a -update f = updateWithKey (const f) -{-# INLINE update #-} - --- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the --- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing', --- the element is deleted. If it is (@'Just' y@), the key @k@ is bound --- to the new value @y@. --- --- Returns a potentially empty map ('IntMap'), because we can't know ahead of --- time if the function returns 'Nothing' and deletes the final item in the --- 'NEIntMap'. --- --- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing --- > updateWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "5:new a")] --- > updateWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a")] --- > updateWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" -updateWithKey :: - (Key -> a -> Maybe a) -> - Key -> - NEIntMap a -> - IntMap a -updateWithKey f k n@(NEIntMap k0 v m) = case compare k k0 of - LT -> toMap n - EQ -> maybe m (flip (insertMinMap k0) m) . f k0 $ v - GT -> insertMinMap k0 v . M.updateWithKey f k $ m -{-# INLINE updateWithKey #-} - --- | /O(min(n,W))/. Lookup and update. --- The function returns original value, if it is updated. --- This is different behavior than @Data.Map.NonEmpty.updateLookupWithKey@. --- Returns the original key value if the map entry is deleted. --- --- Returns a potentially empty map ('IntMap') in the case that we delete --- the final key of a singleton map. --- --- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing --- > updateLookupWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "5:new a", Data.IntMap.fromList ((3, "b") :| [(5, "5:new a")])) --- > updateLookupWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == (Nothing, Data.IntMap.fromList ((3, "b") :| [(5, "a")])) --- > updateLookupWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Data.IntMap.singleton 5 "a") -updateLookupWithKey :: - (Key -> a -> Maybe a) -> - Key -> - NEIntMap a -> - (Maybe a, IntMap a) -updateLookupWithKey f k n@(NEIntMap k0 v m) = case compare k k0 of - LT -> (Nothing, toMap n) - EQ -> - let u = f k0 v - in (Just v, maybe m (flip (insertMinMap k0) m) u) - GT -> fmap (insertMinMap k0 v) . M.updateLookupWithKey f k $ m -{-# INLINE updateLookupWithKey #-} - --- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at --- @k@, or absence thereof. 'alter' can be used to insert, delete, or --- update a value in a 'IntMap'. In short : @Data.IntMap.lookup k ('alter' --- f k m) = f ('lookup' k m)@. --- --- Returns a potentially empty map ('IntMap'), because we can't know ahead of --- time if the function returns 'Nothing' and deletes the final item in the --- 'NEIntMap'. --- --- See 'alterF'' for a version that disallows deletion, and so therefore --- can return 'NEIntMap'. --- --- > let f _ = Nothing --- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a")] --- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" --- > --- > let f _ = Just "c" --- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a"), (7, "c")] --- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "c")] -alter :: - (Maybe a -> Maybe a) -> - Key -> - NEIntMap a -> - IntMap a -alter f k n@(NEIntMap k0 v m) = case compare k k0 of - LT -> maybe id (insertMinMap k) (f Nothing) (toMap n) - EQ -> maybe id (insertMinMap k0) (f (Just v)) m - GT -> insertMinMap k0 v . M.alter f k $ m -{-# INLINE alter #-} - --- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ --- at @k@, or absence thereof. 'alterF' can be used to inspect, insert, --- delete, or update a value in a 'IntMap'. In short: @Data.IntMap.lookup --- k \<$\> 'alterF' f k m = f ('lookup' k m)@. --- --- Example: --- --- @ --- interactiveAlter :: Int -> NEIntMap Int String -> IO (IntMap Int String) --- interactiveAlter k m = alterF f k m where --- f Nothing = do --- putStrLn $ show k ++ --- " was not found in the map. Would you like to add it?" --- getUserResponse1 :: IO (Maybe String) --- f (Just old) = do --- putStrLn $ "The key is currently bound to " ++ show old ++ --- ". Would you like to change or delete it?" --- getUserResponse2 :: IO (Maybe String) --- @ --- --- Like @Data.IntMap.alterF@ for 'IntMap', 'alterF' can be considered --- to be a unifying generalization of 'lookup' and 'delete'; however, as --- a constrast, it cannot be used to implement 'insert', because it must --- return a 'IntMap' instead of an 'NEIntMap' (because the function might delete --- the final item in the 'NEIntMap'). When used with trivial functors like --- 'Identity' and 'Const', it is often slightly slower than --- specialized 'lookup' and 'delete'. However, when the functor is --- non-trivial and key comparison is not particularly cheap, it is the --- fastest way. --- --- See 'alterF'' for a version that disallows deletion, and so therefore --- can return 'NEIntMap' and be used to implement 'insert' --- --- Note on rewrite rules: --- --- This module includes GHC rewrite rules to optimize 'alterF' for --- the 'Const' and 'Identity' functors. In general, these rules --- improve performance. The sole exception is that when using --- 'Identity', deleting a key that is already absent takes longer --- than it would without the rules. If you expect this to occur --- a very large fraction of the time, you might consider using a --- private copy of the 'Identity' type. --- --- Note: Unlike @Data.IntMap.alterF@ for 'IntMap', 'alterF' is /not/ a flipped --- version of the 'Control.Lens.At.at' combinator from "Control.Lens.At". --- However, it match the shape expected from most functions expecting --- lenses, getters, and setters, so can be thought of as a "psuedo-lens", --- with virtually the same practical applications as a legitimate lens. -alterF :: - Functor f => - (Maybe a -> f (Maybe a)) -> - Key -> - NEIntMap a -> - f (IntMap a) -alterF f k n@(NEIntMap k0 v m) = case compare k k0 of - LT -> flip (maybe id (insertMinMap k)) (toMap n) <$> f Nothing - EQ -> flip (maybe id (insertMinMap k0)) m <$> f (Just v) - GT -> insertMinMap k0 v <$> M.alterF f k m -{-# INLINEABLE [2] alterF #-} - --- if f ~ Const b, it's a lookup -{-# RULES -"alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)). - alterF f k = - Const . getConst . f . lookup k - #-} - --- if f ~ Identity, it's an 'alter' -{-# RULES -"alterF/Identity" forall k (f :: Maybe a -> Identity (Maybe a)). - alterF f k = - Identity . alter (runIdentity . f) k - #-} - --- | /O(log n)/. Variant of 'alter' that disallows deletion. Allows us to --- guarantee that the result is also a non-empty IntMap. -alter' :: - (Maybe a -> a) -> - Key -> - NEIntMap a -> - NEIntMap a -alter' f k n@(NEIntMap k0 v m) = case compare k k0 of - LT -> NEIntMap k (f Nothing) . toMap $ n - EQ -> NEIntMap k0 (f (Just v)) m - GT -> NEIntMap k0 v . M.alter (Just . f) k $ m -{-# INLINE alter' #-} - --- | /O(log n)/. Variant of 'alterF' that disallows deletion. Allows us to --- guarantee that the result is also a non-empty IntMap. --- --- Like @Data.IntMap.alterF@ for 'IntMap', can be used to generalize and unify --- 'lookup' and 'insert'. However, because it disallows deletion, it --- cannot be used to implement 'delete'. --- --- See 'alterF' for usage information and caveats. --- --- Note: Neither 'alterF' nor 'alterF'' can be considered flipped versions --- of the 'Control.Lens.At.at' combinator from "Control.Lens.At". However, --- this can match the shape expected from most functions expecting lenses, --- getters, and setters, so can be thought of as a "psuedo-lens", with --- virtually the same practical applications as a legitimate lens. --- --- __WARNING__: The rewrite rule for 'Identity' exposes an inconsistency in --- undefined behavior for "Data.IntMap". @Data.IntMap.alterF@ will actually --- /maintain/ the original key in the map when used with 'Identity'; --- however, @Data.IntMap.insertWith@ will /replace/ the orginal key in the --- map. The rewrite rule for 'alterF'' has chosen to be faithful to --- @Data.IntMap.insertWith@, and /not/ @Data.IntMap.alterF@, for the sake of --- a cleaner implementation. -alterF' :: - Functor f => - (Maybe a -> f a) -> - Key -> - NEIntMap a -> - f (NEIntMap a) -alterF' f k n@(NEIntMap k0 v m) = case compare k k0 of - LT -> flip (NEIntMap k) (toMap n) <$> f Nothing - EQ -> flip (NEIntMap k0) m <$> f (Just v) - GT -> NEIntMap k0 v <$> M.alterF (fmap Just . f) k m -{-# INLINEABLE [2] alterF' #-} - --- if f ~ Const b, it's a lookup -{-# RULES -"alterF'/Const" forall k (f :: Maybe a -> Const b a). - alterF' f k = - Const . getConst . f . lookup k - #-} - --- if f ~ Identity, it's an insertWith -{-# RULES -"alterF'/Identity" forall k (f :: Maybe a -> Identity a). - alterF' f k = - Identity . insertWith (\_ -> runIdentity . f . Just) k (runIdentity (f Nothing)) - #-} - --- | /O(log n)/. Lookup the value at a key in the map. --- --- The function will return the corresponding value as @('Just' value)@, --- or 'Nothing' if the key isn't in the map. --- --- An example of using @lookup@: --- --- > import Prelude hiding (lookup) --- > import Data.Map.NonEmpty --- > --- > employeeDept = fromList (("John","Sales") :| [("Bob","IT")]) --- > deptCountry = fromList (("IT","USA") :| [("Sales","France")]) --- > countryCurrency = fromList (("USA", "Dollar") :| [("France", "Euro")]) --- > --- > employeeCurrency :: String -> Maybe String --- > employeeCurrency name = do --- > dept <- lookup name employeeDept --- > country <- lookup dept deptCountry --- > lookup country countryCurrency --- > --- > main = do --- > putStrLn $ "John's currency: " ++ (show (employeeCurrency "John")) --- > putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete")) --- --- The output of this program: --- --- > John's currency: Just "Euro" --- > Pete's currency: Nothing -lookup :: - Key -> - NEIntMap a -> - Maybe a -lookup k (NEIntMap k0 v m) = case compare k k0 of - LT -> Nothing - EQ -> Just v - GT -> M.lookup k m -{-# INLINE lookup #-} - --- | /O(log n)/. Find the value at a key. Returns 'Nothing' when the --- element can not be found. --- --- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 1 == Nothing --- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 5 == Just 'a' -(!?) :: NEIntMap a -> Key -> Maybe a -(!?) = flip lookup -{-# INLINE (!?) #-} - --- | /O(log n)/. Find the value at a key. Calls 'error' when the element --- can not be found. --- --- > fromList ((5,'a') :| [(3,'b')]) ! 1 Error: element not in the map --- > fromList ((5,'a') :| [(3,'b')]) ! 5 == 'a' -(!) :: NEIntMap a -> Key -> a -(!) m k = fromMaybe e $ m !? k - where - e = error "NEIntMap.!: given key is not an element in the map" -{-# INLINE (!) #-} - -infixl 9 !? -infixl 9 ! - --- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns --- the value at key @k@ or returns default value @def@ --- when the key is not in the map. --- --- > findWithDefault 'x' 1 (fromList ((5,'a') :| [(3,'b')])) == 'x' --- > findWithDefault 'x' 5 (fromList ((5,'a') :| [(3,'b')])) == 'a' -findWithDefault :: - a -> - Key -> - NEIntMap a -> - a -findWithDefault def k (NEIntMap k0 v m) = case compare k k0 of - LT -> def - EQ -> v - GT -> M.findWithDefault def k m -{-# INLINE findWithDefault #-} - --- | /O(log n)/. Is the key a member of the map? See also 'notMember'. --- --- > member 5 (fromList ((5,'a') :| [(3,'b')])) == True --- > member 1 (fromList ((5,'a') :| [(3,'b')])) == False -member :: Key -> NEIntMap a -> Bool -member k (NEIntMap k0 _ m) = case compare k k0 of - LT -> False - EQ -> True - GT -> M.member k m -{-# INLINE member #-} - --- | /O(log n)/. Is the key not a member of the map? See also 'member'. --- --- > notMember 5 (fromList ((5,'a') :| [(3,'b')])) == False --- > notMember 1 (fromList ((5,'a') :| [(3,'b')])) == True -notMember :: Key -> NEIntMap a -> Bool -notMember k (NEIntMap k0 _ m) = case compare k k0 of - LT -> True - EQ -> False - GT -> M.notMember k m -{-# INLINE notMember #-} - --- | /O(log n)/. Find largest key smaller than the given one and return the --- corresponding (key, value) pair. --- --- > lookupLT 3 (fromList ((3,'a') :| [(5,'b')])) == Nothing --- > lookupLT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') -lookupLT :: Key -> NEIntMap a -> Maybe (Key, a) -lookupLT k (NEIntMap k0 v m) = case compare k k0 of - LT -> Nothing - EQ -> Nothing - GT -> M.lookupLT k m <|> Just (k0, v) -{-# INLINE lookupLT #-} - --- | /O(log n)/. Find smallest key greater than the given one and return the --- corresponding (key, value) pair. --- --- > lookupGT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') --- > lookupGT 5 (fromList ((3,'a') :| [(5,'b')])) == Nothing -lookupGT :: Key -> NEIntMap a -> Maybe (Key, a) -lookupGT k (NEIntMap k0 v m) = case compare k k0 of - LT -> Just (k0, v) - EQ -> M.lookupMin m - GT -> M.lookupGT k m -{-# INLINE lookupGT #-} - --- | /O(log n)/. Find largest key smaller or equal to the given one and return --- the corresponding (key, value) pair. --- --- > lookupLE 2 (fromList ((3,'a') :| [(5,'b')])) == Nothing --- > lookupLE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') --- > lookupLE 5 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') -lookupLE :: Key -> NEIntMap a -> Maybe (Key, a) -lookupLE k (NEIntMap k0 v m) = case compare k k0 of - LT -> Nothing - EQ -> Just (k0, v) - GT -> M.lookupLE k m <|> Just (k0, v) -{-# INLINE lookupLE #-} - --- | /O(log n)/. Find smallest key greater or equal to the given one and return --- the corresponding (key, value) pair. --- --- > lookupGE 3 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') --- > lookupGE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') --- > lookupGE 6 (fromList ((3,'a') :| [(5,'b')])) == Nothing -lookupGE :: Key -> NEIntMap a -> Maybe (Key, a) -lookupGE k (NEIntMap k0 v m) = case compare k k0 of - LT -> Just (k0, v) - EQ -> Just (k0, v) - GT -> M.lookupGE k m -{-# INLINE lookupGE #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union with a combining function. --- --- > unionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "aA"), (7, "C")]) -unionWith :: - (a -> a -> a) -> - NEIntMap a -> - NEIntMap a -> - NEIntMap a -unionWith f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of - LT -> NEIntMap k1 v1 . M.unionWith f m1 . toMap $ n2 - EQ -> NEIntMap k1 (f v1 v2) . M.unionWith f m1 $ m2 - GT -> NEIntMap k2 v2 . M.unionWith f (toMap n1) $ m2 -{-# INLINE unionWith #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a possibly-empty --- 'IntMap' and a non-empty map. --- --- @since 0.3.6.0 -unionMapLeft :: IntMap a -> NEIntMap a -> NEIntMap a -unionMapLeft m n = withNonEmpty n (`union` n) m -{-# INLINE unionMapLeft #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a non-empty map and a --- possibly-empty 'IntMap'. --- --- @since 0.3.6.0 -unionMapRight :: NEIntMap a -> IntMap a -> NEIntMap a -unionMapRight n = withNonEmpty n (union n) -{-# INLINE unionMapRight #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'IntMap' and a --- non-empty map with a combining function. --- --- @since 0.3.6.0 -unionMapWithLeft :: (a -> a -> a) -> IntMap a -> NEIntMap a -> NEIntMap a -unionMapWithLeft f m n = withNonEmpty n (\m' -> unionWith f m' n) m -{-# INLINE unionMapWithLeft #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a --- possibly-empty 'IntMap' with a combining function. --- --- @since 0.3.6.0 -unionMapWithRight :: (a -> a -> a) -> NEIntMap a -> IntMap a -> NEIntMap a -unionMapWithRight f n = withNonEmpty n (unionWith f n) -{-# INLINE unionMapWithRight #-} - --- | /O(m*log(n\/m + 1)), m <= n/. --- Union with a combining function, given the matching key. --- --- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value --- > unionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "5:a|A"), (7, "C")]) -unionWithKey :: - (Key -> a -> a -> a) -> - NEIntMap a -> - NEIntMap a -> - NEIntMap a -unionWithKey f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of - LT -> NEIntMap k1 v1 . M.unionWithKey f m1 . toMap $ n2 - EQ -> NEIntMap k1 (f k1 v1 v2) . M.unionWithKey f m1 $ m2 - GT -> NEIntMap k2 v2 . M.unionWithKey f (toMap n1) $ m2 -{-# INLINE unionWithKey #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'IntMap' and a --- non-empty map with a combining function, given the matching key. --- --- @since 0.3.6.0 -unionMapWithKeyLeft :: - (Key -> a -> a -> a) -> - IntMap a -> - NEIntMap a -> - NEIntMap a -unionMapWithKeyLeft f m n = withNonEmpty n (\m' -> unionWithKey f m' n) m -{-# INLINE unionMapWithKeyLeft #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a --- possibly-empty 'IntMap' with a combining function, given the matching key. --- --- @since 0.3.6.0 -unionMapWithKeyRight :: - (Key -> a -> a -> a) -> - NEIntMap a -> - IntMap a -> - NEIntMap a -unionMapWithKeyRight f n = withNonEmpty n (unionWithKey f n) -{-# INLINE unionMapWithKeyRight #-} - --- | The union of a non-empty list of maps, with a combining operation: --- (@'unionsWith' f == 'Data.Foldable.foldl1' ('unionWith' f)@). --- --- > unionsWith (++) (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) --- > == fromList ((3, "bB3") :| [(5, "aAA3"), (7, "C")]) -unionsWith :: - Foldable1 f => - (a -> a -> a) -> - f (NEIntMap a) -> - NEIntMap a -unionsWith f (F1.toNonEmpty -> (m :| ms)) = F.foldl' (unionWith f) m ms -{-# INLINE unionsWith #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Difference of two maps. --- Return elements of the first map not existing in the second map. --- --- Returns a potentially empty map ('IntMap'), in case the first map is --- a subset of the second map. --- --- > difference (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 3 "b" -difference :: - NEIntMap a -> - NEIntMap b -> - IntMap a -difference n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 _ m2) = case compare k1 k2 of - -- k1 is not in n2, so cannot be deleted - LT -> insertMinMap k1 v1 $ m1 `M.difference` toMap n2 - -- k2 deletes k1, and only k1 - EQ -> m1 `M.difference` m2 - -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. - GT -> toMap n1 `M.difference` m2 -{-# INLINE difference #-} - --- | Same as 'difference'. -(\\) :: - NEIntMap a -> - NEIntMap b -> - IntMap a -(\\) = difference -{-# INLINE (\\) #-} - --- | /O(n+m)/. Difference with a combining function. --- When two equal keys are --- encountered, the combining function is applied to the values of these keys. --- If it returns 'Nothing', the element is discarded (proper set difference). If --- it returns (@'Just' y@), the element is updated with a new value @y@. --- --- Returns a potentially empty map ('IntMap'), in case the first map is --- a subset of the second map and the function returns 'Nothing' for every --- pair. --- --- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing --- > differenceWith f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (7, "C")])) --- > == Data.IntMap.singleton 3 "b:B" -differenceWith :: - (a -> b -> Maybe a) -> - NEIntMap a -> - NEIntMap b -> - IntMap a -differenceWith f = differenceWithKey (const f) -{-# INLINE differenceWith #-} - --- | /O(n+m)/. Difference with a combining function. When two equal keys are --- encountered, the combining function is applied to the key and both values. --- If it returns 'Nothing', the element is discarded (proper set difference). If --- it returns (@'Just' y@), the element is updated with a new value @y@. --- --- Returns a potentially empty map ('IntMap'), in case the first map is --- a subset of the second map and the function returns 'Nothing' for every --- pair. --- --- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing --- > differenceWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (10, "C")])) --- > == Data.IntMap.singleton 3 "3:b|B" -differenceWithKey :: - (Key -> a -> b -> Maybe a) -> - NEIntMap a -> - NEIntMap b -> - IntMap a -differenceWithKey f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of - -- k1 is not in n2, so cannot be deleted - LT -> insertMinMap k1 v1 $ M.differenceWithKey f m1 (toMap n2) - -- k2 deletes k1, and only k1 - EQ -> maybe id (insertMinMap k1) (f k1 v1 v2) (M.differenceWithKey f m1 m2) - -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. - GT -> M.differenceWithKey f (toMap n1) m2 -{-# INLINE differenceWithKey #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Intersection of two maps. --- Return data in the first map for the keys existing in both maps. --- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). --- --- Returns a potentially empty map ('IntMap'), in case the two maps share no --- keys in common. --- --- > intersection (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 5 "a" -intersection :: - NEIntMap a -> - NEIntMap b -> - IntMap a -intersection n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 _ m2) = case compare k1 k2 of - -- k1 is not in n2 - LT -> m1 `M.intersection` toMap n2 - -- k1 and k2 are a part of the result - EQ -> insertMinMap k1 v1 $ m1 `M.intersection` m2 - -- k2 is not in n1 - GT -> toMap n1 `M.intersection` m2 -{-# INLINE intersection #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. --- --- Returns a potentially empty map ('IntMap'), in case the two maps share no --- keys in common. --- --- > intersectionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 5 "aA" -intersectionWith :: - (a -> b -> c) -> - NEIntMap a -> - NEIntMap b -> - IntMap c -intersectionWith f = intersectionWithKey (const f) -{-# INLINE intersectionWith #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. --- --- Returns a potentially empty map ('IntMap'), in case the two maps share no --- keys in common. --- --- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar --- > intersectionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 5 "5:a|A" -intersectionWithKey :: - (Key -> a -> b -> c) -> - NEIntMap a -> - NEIntMap b -> - IntMap c -intersectionWithKey f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of - -- k1 is not in n2 - LT -> M.intersectionWithKey f m1 (toMap n2) - -- k1 and k2 are a part of the result - EQ -> insertMinMap k1 (f k1 v1 v2) $ M.intersectionWithKey f m1 m2 - -- k2 is not in n1 - GT -> M.intersectionWithKey f (toMap n1) m2 -{-# INLINE intersectionWithKey #-} - --- | /O(n)/. IntMap a function over all values in the map. --- --- > let f key x = (show key) ++ ":" ++ x --- > mapWithKey f (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "3:b") :| [(5, "5:a")]) -mapWithKey :: (Key -> a -> b) -> NEIntMap a -> NEIntMap b -mapWithKey f (NEIntMap k v m) = NEIntMap k (f k v) (M.mapWithKey f m) -{-# NOINLINE [1] mapWithKey #-} - -{-# RULES -"mapWithKey/mapWithKey" forall f g xs. - mapWithKey f (mapWithKey g xs) = - mapWithKey (\k a -> f k (g k a)) xs -"mapWithKey/map" forall f g xs. - mapWithKey f (map g xs) = - mapWithKey (\k a -> f k (g a)) xs -"map/mapWithKey" forall f g xs. - map f (mapWithKey g xs) = - mapWithKey (\k a -> f (g k a)) xs - #-} - --- | /O(n)/. The function 'mapAccum' threads an accumulating argument --- through the map in ascending order of keys. --- --- > let f a b = (a ++ b, b ++ "X") --- > mapAccum f "Everything: " (fromList ((5,"a") :| [(3,"b")])) == ("Everything: ba", fromList ((3, "bX") :| [(5, "aX")])) -mapAccum :: - (a -> b -> (a, c)) -> - a -> - NEIntMap b -> - (a, NEIntMap c) -mapAccum f = mapAccumWithKey (\x _ -> f x) -{-# INLINE mapAccum #-} - --- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating --- argument through the map in ascending order of keys. --- --- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X") --- > mapAccumWithKey f "Everything:" (fromList ((5,"a") :| [(3,"b")])) == ("Everything: 3-b 5-a", fromList ((3, "bX") :| [(5, "aX")])) -mapAccumWithKey :: - (a -> Key -> b -> (a, c)) -> - a -> - NEIntMap b -> - (a, NEIntMap c) -mapAccumWithKey f z0 (NEIntMap k v m) = (z2, NEIntMap k v' m') - where - ~(z1, v') = f z0 k v - ~(z2, m') = M.mapAccumWithKey f z1 m -{-# INLINE mapAccumWithKey #-} - --- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating --- argument through the map in descending order of keys. -mapAccumRWithKey :: - (a -> Key -> b -> (a, c)) -> - a -> - NEIntMap b -> - (a, NEIntMap c) -mapAccumRWithKey f z0 (NEIntMap k v m) = (z2, NEIntMap k v' m') - where - ~(z1, m') = M.mapAccumRWithKey f z0 m - ~(z2, v') = f z1 k v -{-# INLINE mapAccumRWithKey #-} - --- | /O(n*log n)/. --- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. --- --- The size of the result may be smaller if @f@ maps two or more distinct --- keys to the same new key. In this case the value at the greatest of the --- original keys is retained. --- --- While the size of the result map may be smaller than the input map, the --- output map is still guaranteed to be non-empty if the input map is --- non-empty. --- --- > mapKeys (+ 1) (fromList ((5,"a") :| [(3,"b")])) == fromList ((4, "b") :| [(6, "a")]) --- > mapKeys (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "c" --- > mapKeys (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "c" -mapKeys :: - (Key -> Key) -> - NEIntMap a -> - NEIntMap a -mapKeys f (NEIntMap k0 v0 m) = - fromListWith const - . ((f k0, v0) :|) - . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] - $ m -{-# INLINEABLE mapKeys #-} - --- | /O(n*log n)/. --- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. --- --- The size of the result may be smaller if @f@ maps two or more distinct --- keys to the same new key. In this case the associated values will be --- combined using @c@. The value at the greater of the two original keys --- is used as the first argument to @c@. --- --- While the size of the result map may be smaller than the input map, the --- output map is still guaranteed to be non-empty if the input map is --- non-empty. --- --- > mapKeysWith (++) (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "cdab" --- > mapKeysWith (++) (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "cdab" -mapKeysWith :: - (a -> a -> a) -> - (Key -> Key) -> - NEIntMap a -> - NEIntMap a -mapKeysWith c f (NEIntMap k0 v0 m) = - fromListWith c - . ((f k0, v0) :|) - . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] - $ m -{-# INLINEABLE mapKeysWith #-} - --- | /O(n)/. --- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ --- is strictly monotonic. --- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. --- /The precondition is not checked./ --- Semi-formally, we have: --- --- > and [x < y ==> f x < f y | x <- ls, y <- ls] --- > ==> mapKeysMonotonic f s == mapKeys f s --- > where ls = keys s --- --- This means that @f@ maps distinct original keys to distinct resulting keys. --- This function has better performance than 'mapKeys'. --- --- While the size of the result map may be smaller than the input map, the --- output map is still guaranteed to be non-empty if the input map is --- non-empty. --- --- > mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")])) == fromList ((6, "b") :| [(10, "a")]) --- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")]))) == True --- > valid (mapKeysMonotonic (\ _ -> 1) (fromList ((5,"a") :| [(3,"b")]))) == False -mapKeysMonotonic :: - (Key -> Key) -> - NEIntMap a -> - NEIntMap a -mapKeysMonotonic f (NEIntMap k v m) = - NEIntMap (f k) v - . M.mapKeysMonotonic f - $ m -{-# INLINE mapKeysMonotonic #-} - --- | /O(n)/. Fold the keys and values in the map using the given right-associative --- binary operator, such that --- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. --- --- For example, --- --- > keysList map = foldrWithKey (\k x ks -> k:ks) [] map -foldrWithKey :: (Key -> a -> b -> b) -> b -> NEIntMap a -> b -foldrWithKey f z (NEIntMap k v m) = f k v . M.foldrWithKey f z $ m -{-# INLINE foldrWithKey #-} - --- | /O(n)/. Fold the keys and values in the map using the given left-associative --- binary operator, such that --- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@. --- --- For example, --- --- > keysList = reverse . foldlWithKey (\ks k x -> k:ks) [] -foldlWithKey :: (a -> Key -> b -> a) -> a -> NEIntMap b -> a -foldlWithKey f z (NEIntMap k v m) = M.foldlWithKey f (f z k v) m -{-# INLINE foldlWithKey #-} - --- | /O(n)/. A strict version of 'foldr1'. Each application of the operator --- is evaluated before using the result in the next application. This --- function is strict in the starting value. -foldr1' :: (a -> a -> a) -> NEIntMap a -> a -foldr1' f (NEIntMap _ v m) = case M.maxView m of - Nothing -> v - Just (y, m') -> let !z = M.foldr' f y m' in v `f` z -{-# INLINE foldr1' #-} - --- | /O(n)/. A strict version of 'foldl1'. Each application of the operator --- is evaluated before using the result in the next application. This --- function is strict in the starting value. -foldl1' :: (a -> a -> a) -> NEIntMap a -> a -foldl1' f (NEIntMap _ v m) = M.foldl' f v m -{-# INLINE foldl1' #-} - --- | /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. -foldrWithKey' :: (Key -> a -> b -> b) -> b -> NEIntMap a -> b -foldrWithKey' f z (NEIntMap k v m) = f k v y - where - !y = M.foldrWithKey f z m -{-# INLINE foldrWithKey' #-} - --- | /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. -foldlWithKey' :: (a -> Key -> b -> a) -> a -> NEIntMap b -> a -foldlWithKey' f z (NEIntMap k v m) = M.foldlWithKey' f x m - where - !x = f z k v -{-# INLINE foldlWithKey' #-} - --- | /O(n)/. Return all keys of the map in ascending order. --- --- > keys (fromList ((5,"a") :| [(3,"b")])) == (3 :| [5]) -keys :: NEIntMap a -> NonEmpty Key -keys (NEIntMap k _ m) = k :| M.keys m -{-# INLINE keys #-} - --- | /O(n)/. An alias for 'toAscList'. Return all key\/value pairs in the map --- in ascending key order. --- --- > assocs (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) -assocs :: NEIntMap a -> NonEmpty (Key, a) -assocs = toList -{-# INLINE assocs #-} - --- | /O(n)/. The non-empty set of all keys of the map. --- --- > keysSet (fromList ((5,"a") :| [(3,"b")])) == Data.Set.NonEmpty.fromList (3 :| [5]) -keysSet :: NEIntMap a -> NEIntSet -keysSet (NEIntMap k _ m) = NEIntSet k (M.keysSet m) -{-# INLINE keysSet #-} - --- | /O(n)/. Convert the map to a list of key\/value pairs where the keys are --- in ascending order. --- --- > toAscList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) -toAscList :: NEIntMap a -> NonEmpty (Key, a) -toAscList = toList -{-# INLINE toAscList #-} - --- | /O(n)/. Convert the map to a list of key\/value pairs where the keys --- are in descending order. --- --- > toDescList (fromList ((5,"a") :| [(3,"b")])) == ((5,"a") :| [(3,"b")]) -toDescList :: NEIntMap a -> NonEmpty (Key, a) -toDescList (NEIntMap k0 v0 m) = M.foldlWithKey' go ((k0, v0) :| []) m - where - go xs k v = (k, v) NE.<| xs -{-# INLINE toDescList #-} - --- | /O(n)/. Filter all values that satisfy the predicate. --- --- Returns a potentially empty map ('IntMap'), because we could --- potentailly filter out all items in the original 'NEIntMap'. --- --- > filter (> "a") (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" --- > filter (> "x") (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.empty --- > filter (< "a") (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.empty -filter :: - (a -> Bool) -> - NEIntMap a -> - IntMap a -filter f (NEIntMap k v m) - | f v = insertMinMap k v . M.filter f $ m - | otherwise = M.filter f m -{-# INLINE filter #-} - --- | /O(n)/. Filter all keys\/values that satisfy the predicate. --- --- Returns a potentially empty map ('IntMap'), because we could --- potentailly filter out all items in the original 'NEIntMap'. --- --- > filterWithKey (\k _ -> k > 4) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" -filterWithKey :: - (Key -> a -> Bool) -> - NEIntMap a -> - IntMap a -filterWithKey f (NEIntMap k v m) - | f k v = insertMinMap k v . M.filterWithKey f $ m - | otherwise = M.filterWithKey f m -{-# INLINE filterWithKey #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Restrict an 'NEIntMap' to only those keys --- found in a 'Data.Set.Set'. --- --- @ --- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m --- m \`restrictKeys\` s = m ``intersection`` 'fromSet' (const ()) s --- @ -restrictKeys :: - NEIntMap a -> - IntSet -> - IntMap a -restrictKeys n@(NEIntMap k v m) xs = case S.minView xs of - Nothing -> M.empty - Just (y, ys) -> case compare k y of - -- k is not in xs - LT -> m `M.restrictKeys` xs - -- k and y are a part of the result - EQ -> insertMinMap k v $ m `M.restrictKeys` ys - -- y is not in m - GT -> toMap n `M.restrictKeys` ys -{-# INLINE restrictKeys #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Data.Set.Set' from --- an 'NEIntMap'. --- --- @ --- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m --- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s --- @ -withoutKeys :: - NEIntMap a -> - IntSet -> - IntMap a -withoutKeys n@(NEIntMap k v m) xs = case S.minView xs of - Nothing -> toMap n - Just (y, ys) -> case compare k y of - -- k is not in xs, so cannot be deleted - LT -> insertMinMap k v $ m `M.withoutKeys` xs - -- y deletes k, and only k - EQ -> m `M.withoutKeys` ys - -- y is not in n, so cannot delete anything, so we can just difference n and ys - GT -> toMap n `M.withoutKeys` ys -{-# INLINE withoutKeys #-} - --- | /O(n)/. Partition the map according to a predicate. --- --- Returns a 'These' with potentially two non-empty maps: --- --- * @'This' n1@ means that the predicate was true for all items. --- * @'That' n2@ means that the predicate was false for all items. --- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the --- predicate) and @n2@ (all of the items that were false for the --- predicate). --- --- See also 'split'. --- --- > partition (> "a") (fromList ((5,"a") :| [(3,"b")])) == These (singleton 3 "b") (singleton 5 "a") --- > partition (< "x") (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) --- > partition (> "x") (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) -partition :: - (a -> Bool) -> - NEIntMap a -> - These (NEIntMap a) (NEIntMap a) -partition f = partitionWithKey (const f) -{-# INLINE partition #-} - --- | /O(n)/. Partition the map according to a predicate. --- --- Returns a 'These' with potentially two non-empty maps: --- --- * @'This' n1@ means that the predicate was true for all items, --- returning the original map. --- * @'That' n2@ means that the predicate was false for all items, --- returning the original map. --- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the --- predicate) and @n2@ (all of the items that were false for the --- predicate). --- --- See also 'split'. --- --- > partitionWithKey (\ k _ -> k > 3) (fromList ((5,"a") :| [(3,"b")])) == These (singleton 5 "a") (singleton 3 "b") --- > partitionWithKey (\ k _ -> k < 7) (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) --- > partitionWithKey (\ k _ -> k > 7) (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) -partitionWithKey :: - (Key -> a -> Bool) -> - NEIntMap a -> - These (NEIntMap a) (NEIntMap a) -partitionWithKey f n@(NEIntMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) - | f k v -> This n - | otherwise -> That n - (Just n1, Nothing) - | f k v -> This n - | otherwise -> These n1 (singleton k v) - (Nothing, Just n2) - | f k v -> These (singleton k v) n2 - | otherwise -> That n - (Just n1, Just n2) - | f k v -> These (insertMapMin k v m1) n2 - | otherwise -> These n1 (insertMapMin k v m2) - where - (m1, m2) = M.partitionWithKey f m0 -{-# INLINEABLE partitionWithKey #-} - --- | /O(n)/. Map values and collect the 'Just' results. --- --- Returns a potentially empty map ('IntMap'), because the function could --- potentially return 'Nothing' on all items in the 'NEIntMap'. --- --- > let f x = if x == "a" then Just "new a" else Nothing --- > mapMaybe f (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "new a" -mapMaybe :: - (a -> Maybe b) -> - NEIntMap a -> - IntMap b -mapMaybe f = mapMaybeWithKey (const f) -{-# INLINE mapMaybe #-} - --- | /O(n)/. Map keys\/values and collect the 'Just' results. --- --- Returns a potentially empty map ('IntMap'), because the function could --- potentially return 'Nothing' on all items in the 'NEIntMap'. --- --- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing --- > mapMaybeWithKey f (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "key : 3" -mapMaybeWithKey :: - (Key -> a -> Maybe b) -> - NEIntMap a -> - IntMap b -mapMaybeWithKey f (NEIntMap k v m) = maybe id (insertMinMap k) (f k v) (M.mapMaybeWithKey f m) -{-# INLINE mapMaybeWithKey #-} - --- | /O(n)/. Map values and separate the 'Left' and 'Right' results. --- --- Returns a 'These' with potentially two non-empty maps: --- --- * @'This' n1@ means that the results were all 'Left'. --- * @'That' n2@ means that the results were all 'Right'. --- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') --- and @n2@ (the map where the results were 'Right') --- --- > let f a = if a < "c" then Left a else Right a --- > mapEither f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == These (fromList ((3,"b") :| [(5,"a")])) (fromList ((1,"x") :| [(7,"z")])) --- > --- > mapEither (\ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == That (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) -mapEither :: - (a -> Either b c) -> - NEIntMap a -> - These (NEIntMap b) (NEIntMap c) -mapEither f = mapEitherWithKey (const f) -{-# INLINE mapEither #-} - --- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results. --- --- Returns a 'These' with potentially two non-empty maps: --- --- * @'This' n1@ means that the results were all 'Left'. --- * @'That' n2@ means that the results were all 'Right'. --- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') --- and @n2@ (the map where the results were 'Right') --- --- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) --- > mapEitherWithKey f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == These (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) --- > --- > mapEitherWithKey (\_ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == That (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) -mapEitherWithKey :: - (Key -> a -> Either b c) -> - NEIntMap a -> - These (NEIntMap b) (NEIntMap c) -mapEitherWithKey f (NEIntMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> case f k v of - Left v' -> This (singleton k v') - Right v' -> That (singleton k v') - (Just n1, Nothing) -> case f k v of - Left v' -> This (insertMapMin k v' m1) - Right v' -> These n1 (singleton k v') - (Nothing, Just n2) -> case f k v of - Left v' -> These (singleton k v') n2 - Right v' -> That (insertMapMin k v' m2) - (Just n1, Just n2) -> case f k v of - Left v' -> These (insertMapMin k v' m1) n2 - Right v' -> These n1 (insertMapMin k v' m2) - where - (m1, m2) = M.mapEitherWithKey f m0 -{-# INLINEABLE mapEitherWithKey #-} - --- | /O(log n)/. The expression (@'split' k map@) is potentially a 'These' --- containing up to two 'NEIntMap's based on splitting the map into maps --- containing items before and after the given key @k@. It will never --- return a map that contains @k@ itself. --- --- * 'Nothing' means that @k@ was the only key in the the original map, --- and so there are no items before or after it. --- * @'Just' ('This' n1)@ means @k@ was larger than or equal to all items --- in the map, and @n1@ is the entire original map (minus @k@, if it was --- present) --- * @'Just' ('That' n2)@ means @k@ was smaller than or equal to all --- items in the map, and @n2@ is the entire original map (minus @k@, if --- it was present) --- * @'Just' ('These' n1 n2)@ gives @n1@ (the map of all keys from the --- original map less than @k@) and @n2@ (the map of all keys from the --- original map greater than @k@) --- --- > split 2 (fromList ((5,"a") :| [(3,"b")])) == Just (That (fromList ((3,"b") :| [(5,"a")])) ) --- > split 3 (fromList ((5,"a") :| [(3,"b")])) == Just (That (singleton 5 "a") ) --- > split 4 (fromList ((5,"a") :| [(3,"b")])) == Just (These (singleton 3 "b") (singleton 5 "a")) --- > split 5 (fromList ((5,"a") :| [(3,"b")])) == Just (This (singleton 3 "b") ) --- > split 6 (fromList ((5,"a") :| [(3,"b")])) == Just (This (fromList ((3,"b") :| [(5,"a")])) ) --- > split 5 (singleton 5 "a") == Nothing -split :: - Key -> - NEIntMap a -> - Maybe (These (NEIntMap a) (NEIntMap a)) -split k n@(NEIntMap k0 v m0) = case compare k k0 of - LT -> Just $ That n - EQ -> That <$> nonEmptyMap m0 - GT -> Just $ case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> This (singleton k0 v) - (Just _, Nothing) -> This (insertMapMin k0 v m1) - (Nothing, Just n2) -> These (singleton k0 v) n2 - (Just _, Just n2) -> These (insertMapMin k0 v m1) n2 - where - (m1, m2) = M.split k m0 -{-# INLINEABLE split #-} - --- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just --- like 'split' but also returns @'lookup' k map@, as the first field in --- the 'These': --- --- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == That (That (fromList ((3,"b") :| [(5,"a")]))) --- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == These "b" (That (singleton 5 "a")) --- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == That (These (singleton 3 "b") (singleton 5 "a")) --- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == These "a" (This (singleton 3 "b")) --- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == That (This (fromList ((3,"b") :| [(5,"a")]))) --- > splitLookup 5 (singleton 5 "a") == This "a" -splitLookup :: - Key -> - NEIntMap a -> - These a (These (NEIntMap a) (NEIntMap a)) -splitLookup k n@(NEIntMap k0 v0 m0) = case compare k k0 of - LT -> That . That $ n - EQ -> maybe (This v0) (These v0 . That) . nonEmptyMap $ m0 - GT -> maybe That These v $ case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> This (singleton k0 v0) - (Just _, Nothing) -> This (insertMapMin k0 v0 m1) - (Nothing, Just n2) -> These (singleton k0 v0) n2 - (Just _, Just n2) -> These (insertMapMin k0 v0 m1) n2 - where - (m1, v, m2) = M.splitLookup k m0 -{-# INLINEABLE splitLookup #-} - --- | /O(1)/. Decompose a map into pieces based on the structure of the --- underlying tree. This function is useful for consuming a map in --- parallel. --- --- No guarantee is made as to the sizes of the pieces; an internal, but --- deterministic process determines this. However, it is guaranteed that --- the pieces returned will be in ascending order (all elements in the --- first submap less than all elements in the second, and so on). --- --- Note that the current implementation does not return more than four --- submaps, but you should not depend on this behaviour because it can --- change in the future without notice. -splitRoot :: - NEIntMap a -> - NonEmpty (NEIntMap a) -splitRoot (NEIntMap k v m) = - singleton k v - :| Maybe.mapMaybe nonEmptyMap (M.splitRoot m) -{-# INLINE splitRoot #-} - --- | /O(m*log(n\/m + 1)), m <= n/. --- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). -isSubmapOf :: Eq a => NEIntMap a -> NEIntMap a -> Bool -isSubmapOf = isSubmapOfBy (==) -{-# INLINE isSubmapOf #-} - --- | /O(m*log(n\/m + 1)), m <= n/. --- The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if --- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when --- applied to their respective values. For example, the following --- expressions are all 'True': --- --- > isSubmapOfBy (==) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) --- > isSubmapOfBy (<=) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) --- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (fromList (('a',1) :| [('b',2)])) --- --- But the following are all 'False': --- --- > isSubmapOfBy (==) (singleton 'a' 2) (fromList (('a',1) :| [('b',2)])) --- > isSubmapOfBy (<) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) --- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (singleton 'a' 1) -isSubmapOfBy :: - (a -> b -> Bool) -> - NEIntMap a -> - NEIntMap b -> - Bool -isSubmapOfBy f (NEIntMap k v m0) (toMap -> m1) = - kvSub - && M.isSubmapOfBy f m0 m1 - where - kvSub = case M.lookup k m1 of - Just v0 -> f v v0 - Nothing -> False -{-# INLINE isSubmapOfBy #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap --- but not equal). Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' --- (==)@). -isProperSubmapOf :: Eq a => NEIntMap a -> NEIntMap a -> Bool -isProperSubmapOf = isProperSubmapOfBy (==) -{-# INLINE isProperSubmapOf #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap --- but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns --- 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, --- and when @f@ returns 'True' when applied to their respective values. For --- example, the following expressions are all 'True': --- --- > isProperSubmapOfBy (==) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) --- > isProperSubmapOfBy (<=) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) --- --- But the following are all 'False': --- --- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (fromList ((1,1) :| [(2,2)])) --- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (singleton 1 1)) --- > isProperSubmapOfBy (<) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) -isProperSubmapOfBy :: - (a -> b -> Bool) -> - NEIntMap a -> - NEIntMap b -> - Bool -isProperSubmapOfBy f m1 m2 = - M.size (neimIntMap m1) < M.size (neimIntMap m2) - && isSubmapOfBy f m1 m2 -{-# INLINE isProperSubmapOfBy #-} - --- | /O(1)/. The minimal key of the map. Note that this is total, making --- 'Data.IntMap.lookupMin' obsolete. It is constant-time, so has better --- asymptotics than @Data.IntMap.lookupMin@ and @Data.IntMap.findMin@, as well. --- --- > findMin (fromList ((5,"a") :| [(3,"b")])) == (3,"b") -findMin :: NEIntMap a -> (Key, a) -findMin (NEIntMap k v _) = (k, v) -{-# INLINE findMin #-} - --- | /O(log n)/. The maximal key of the map. Note that this is total, making --- 'Data.IntMap.lookupMin' obsolete. --- --- > findMax (fromList ((5,"a") :| [(3,"b")])) == (5,"a") -findMax :: NEIntMap a -> (Key, a) -findMax (NEIntMap k v m) = fromMaybe (k, v) . M.lookupMax $ m -{-# INLINE findMax #-} - --- | /O(1)/. Delete the minimal key. Returns a potentially empty map --- ('IntMap'), because we might end up deleting the final key in a singleton --- map. It is constant-time, so has better asymptotics than --- 'Data.IntMap.deleteMin'. --- --- > deleteMin (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.IntMap.fromList [(5,"a"), (7,"c")] --- > deleteMin (singleton 5 "a") == Data.IntMap.empty -deleteMin :: NEIntMap a -> IntMap a -deleteMin (NEIntMap _ _ m) = m -{-# INLINE deleteMin #-} - --- | /O(log n)/. Delete the maximal key. Returns a potentially empty map --- ('IntMap'), because we might end up deleting the final key in a singleton --- map. --- --- > deleteMax (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.IntMap.fromList [(3,"b"), (5,"a")] --- > deleteMax (singleton 5 "a") == Data.IntMap.empty -deleteMax :: NEIntMap a -> IntMap a -deleteMax (NEIntMap k v m) = case M.maxView m of - Nothing -> M.empty - Just (_, m') -> insertMinMap k v m' -{-# INLINE deleteMax #-} - --- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the --- minimal key. Returns a potentially empty map ('IntMap'), because we might --- end up deleting the final key in the map if the function returns --- 'Nothing'. See 'adjustMin' for a version that can guaruntee that we --- return a non-empty map. --- --- > updateMin (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "Xb"), (5, "a")] --- > updateMin (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" -updateMin :: (a -> Maybe a) -> NEIntMap a -> IntMap a -updateMin f = updateMinWithKey (const f) -{-# INLINE updateMin #-} - --- | /O(1)/. A version of 'updateMin' that disallows deletion, allowing us --- to guarantee that the result is also non-empty. -adjustMin :: (a -> a) -> NEIntMap a -> NEIntMap a -adjustMin f = adjustMinWithKey (const f) -{-# INLINE adjustMin #-} - --- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the --- minimal key. Returns a potentially empty map ('IntMap'), because we might --- end up deleting the final key in the map if the function returns --- 'Nothing'. See 'adjustMinWithKey' for a version that guaruntees --- a non-empty map. --- --- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3,"3:b"), (5,"a")] --- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" -updateMinWithKey :: (Key -> a -> Maybe a) -> NEIntMap a -> IntMap a -updateMinWithKey f (NEIntMap k v m) = maybe id (insertMinMap k) (f k v) m -{-# INLINE updateMinWithKey #-} - --- | /O(1)/. A version of 'adjustMaxWithKey' that disallows deletion, --- allowing us to guarantee that the result is also non-empty. Note that --- it also is able to have better asymptotics than 'updateMinWithKey' in --- general. -adjustMinWithKey :: (Key -> a -> a) -> NEIntMap a -> NEIntMap a -adjustMinWithKey f (NEIntMap k v m) = NEIntMap k (f k v) m -{-# INLINE adjustMinWithKey #-} - --- | /O(log n)/. Update the value at the maximal key. Returns --- a potentially empty map ('IntMap'), because we might end up deleting the --- final key in the map if the function returns 'Nothing'. See 'adjustMax' --- for a version that can guarantee that we return a non-empty map. --- --- > updateMax (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "Xa")] --- > updateMax (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" -updateMax :: (a -> Maybe a) -> NEIntMap a -> IntMap a -updateMax f = updateMaxWithKey (const f) -{-# INLINE updateMax #-} - --- | /O(log n)/. A version of 'updateMax' that disallows deletion, allowing --- us to guarantee that the result is also non-empty. -adjustMax :: (a -> a) -> NEIntMap a -> NEIntMap a -adjustMax f = adjustMaxWithKey (const f) -{-# INLINE adjustMax #-} - --- | /O(log n)/. Update the value at the maximal key. Returns --- a potentially empty map ('IntMap'), because we might end up deleting the --- final key in the map if the function returns 'Nothing'. See --- 'adjustMaxWithKey' for a version that guaruntees a non-empty map. --- --- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3,"3:b"), (5,"a")] --- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" -updateMaxWithKey :: (Key -> a -> Maybe a) -> NEIntMap a -> IntMap a -updateMaxWithKey f (NEIntMap k v m) - | M.null m = maybe m (M.singleton k) $ f k v - | otherwise = - insertMinMap k v - . M.updateMaxWithKey f - $ m -{-# INLINE updateMaxWithKey #-} - --- | /O(log n)/. A version of 'updateMaxWithKey' that disallows deletion, --- allowing us to guarantee that the result is also non-empty. -adjustMaxWithKey :: (Key -> a -> a) -> NEIntMap a -> NEIntMap a -adjustMaxWithKey f (NEIntMap k0 v m) - | M.null m = NEIntMap k0 (f k0 v) m - | otherwise = - insertMapMin k0 v - . M.updateMaxWithKey (\k -> Just . f k) - $ m -{-# INLINE adjustMaxWithKey #-} - --- | /O(1)/. Retrieves the value associated with minimal key of the --- map, and the map stripped of that element. It is constant-time, so has --- better asymptotics than @Data.IntMap.minView@ for 'IntMap'. --- --- Note that unlike @Data.IntMap.minView@ for 'IntMap', this cannot ever fail, --- so doesn't need to return in a 'Maybe'. However, the result 'IntMap' is --- potentially empty, since the original map might have contained just --- a single item. --- --- > minView (fromList ((5,"a") :| [(3,"b")])) == ("b", Data.IntMap.singleton 5 "a") -minView :: NEIntMap a -> (a, IntMap a) -minView = first snd . deleteFindMin -{-# INLINE minView #-} - --- | /O(1)/. Delete and find the minimal key-value pair. It is --- constant-time, so has better asymptotics that @Data.IntMap.minView@ for --- 'IntMap'. --- --- Note that unlike @Data.IntMap.deleteFindMin@ for 'IntMap', this cannot ever --- fail, and so is a total function. However, the result 'IntMap' is --- potentially empty, since the original map might have contained just --- a single item. --- --- > deleteFindMin (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((3,"b"), Data.IntMap.fromList [(5,"a"), (10,"c")]) -deleteFindMin :: NEIntMap a -> ((Key, a), IntMap a) -deleteFindMin (NEIntMap k v m) = ((k, v), m) -{-# INLINE deleteFindMin #-} - --- | /O(log n)/. Retrieves the value associated with maximal key of the --- map, and the map stripped of that element. --- --- Note that unlike @Data.IntMap.maxView@ from 'IntMap', this cannot ever fail, --- so doesn't need to return in a 'Maybe'. However, the result 'IntMap' is --- potentially empty, since the original map might have contained just --- a single item. --- --- > maxView (fromList ((5,"a") :| [(3,"b")])) == ("a", Data.IntMap.singleton 3 "b") -maxView :: NEIntMap a -> (a, IntMap a) -maxView = first snd . deleteFindMax -{-# INLINE maxView #-} - --- | /O(log n)/. Delete and find the minimal key-value pair. --- --- Note that unlike @Data.IntMap.deleteFindMax@ for 'IntMap', this cannot ever --- fail, and so is a total function. However, the result 'IntMap' is --- potentially empty, since the original map might have contained just --- a single item. --- --- > deleteFindMax (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((10,"c"), Data.IntMap.fromList [(3,"b"), (5,"a")]) -deleteFindMax :: NEIntMap a -> ((Key, a), IntMap a) -deleteFindMax (NEIntMap k v m) = - maybe ((k, v), M.empty) (second (insertMinMap k v)) - . M.maxViewWithKey - $ m -{-# INLINE deleteFindMax #-} - --- --------------------------- --- Combining functions --- --------------------------- --- --- Code comes from "Data.Map.Internal" from containers, modified slightly --- to work with NonEmpty --- --- Copyright : (c) Daan Leijen 2002 --- (c) Andriy Palamarchuk 2008 - -combineEq :: NonEmpty (Key, b) -> NonEmpty (Key, b) -combineEq = \case - x :| [] -> x :| [] - x :| xx@(_ : _) -> go x xx - where - go z [] = z :| [] - go z@(kz, _) (x@(kx, xx) : xs') - | kx == kz = go (kx, xx) xs' - | otherwise = z NE.<| go x xs' - -combineEqWith :: - (Key -> b -> b -> b) -> - NonEmpty (Key, b) -> - NonEmpty (Key, b) -combineEqWith f = \case - x :| [] -> x :| [] - x :| xx@(_ : _) -> go x xx - where - go z [] = z :| [] - go z@(kz, zz) (x@(kx, xx) : xs') - | kx == kz = let yy = f kx xx zz in go (kx, yy) xs' - | otherwise = z NE.<| go x xs' +-- | +-- Module : Data.IntMap.NonEmpty +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- = Non-Empty Finite Integer-Indexed Maps +-- +-- This module re-exports "Data.IntMap.NonEmpty.Lazy". Import +-- "Data.IntMap.NonEmpty.Strict" for the strict value interface. +module Data.IntMap.NonEmpty ( + module Data.IntMap.NonEmpty.Lazy, +) where + +import Data.IntMap.NonEmpty.Lazy diff --git a/src/Data/IntMap/NonEmpty/Internal.hs b/src/Data/IntMap/NonEmpty/Internal.hs --- a/src/Data/IntMap/NonEmpty/Internal.hs +++ b/src/Data/IntMap/NonEmpty/Internal.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_HADDOCK not-home #-} -- | @@ -15,725 +9,11 @@ -- Stability : experimental -- Portability : non-portable -- --- Unsafe internal-use functions used in the implementation of --- "Data.IntMap.NonEmpty". These functions can potentially be used to --- break the abstraction of 'NEIntMap' and produce unsound maps, so be --- wary! +-- Internal compatibility module for the lazy non-empty int map +-- implementation. Import "Data.IntMap.NonEmpty.Strict.Internal" for the +-- strict value variant. module Data.IntMap.NonEmpty.Internal ( - -- * Non-Empty IntMap type - NEIntMap (..), - Key, - singleton, - nonEmptyMap, - withNonEmpty, - fromList, - toList, - map, - insertWith, - union, - unions, - elems, - size, - toMap, - - -- * Folds - foldr, - foldr', - foldr1, - foldl, - foldl', - foldl1, - - -- * Traversals - traverseWithKey, - traverseWithKey1, - foldMapWithKey, - - -- * Unsafe IntMap Functions - insertMinMap, - insertMaxMap, - - -- * Debug - valid, + module Data.IntMap.NonEmpty.Lazy.Internal, ) where -import Control.Applicative -import Control.Comonad -import Control.DeepSeq -import Control.Monad -import qualified Data.Aeson as A -import Data.Coerce -import Data.Data -import qualified Data.Foldable as F -import Data.Foldable.WithIndex (FoldableWithIndex (..)) -import Data.Function -import Data.Functor.Alt -import Data.Functor.Classes -import Data.Functor.Invariant -import Data.Functor.WithIndex (FunctorWithIndex (..)) -import qualified Data.IntMap as M -import Data.IntMap.Internal (IntMap (..), Key) -import qualified Data.List as L -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Maybe -import Data.Semigroup -import Data.Semigroup.Foldable (Foldable1 (fold1)) -import qualified Data.Semigroup.Foldable as F1 -import Data.Semigroup.Traversable (Traversable1 (..)) -import Data.Traversable.WithIndex (TraversableWithIndex (..)) -import qualified GHC.Exts as Exts -import Text.Read -import Prelude hiding (Foldable (..), map) - --- | A non-empty (by construction) map from integer keys to values @a@. At --- least one key-value pair exists in an @'NEIntMap' v@ at all times. --- --- Functions that /take/ an 'NEIntMap' can safely operate on it with the --- assumption that it has at least one key-value pair. --- --- Functions that /return/ an 'NEIntMap' provide an assurance that the result --- has at least one key-value pair. --- --- "Data.IntMap.NonEmpty" re-exports the API of "Data.IntMap", faithfully --- reproducing asymptotics, typeclass constraints, and semantics. --- Functions that ensure that input and output maps are both non-empty --- (like 'Data.IntMap.NonEmpty.insert') return 'NEIntMap', but functions that --- might potentially return an empty map (like 'Data.IntMap.NonEmpty.delete') --- return a 'IntMap' instead. --- --- You can directly construct an 'NEIntMap' with the API from --- "Data.IntMap.NonEmpty"; it's more or less the same as constructing a normal --- 'IntMap', except you don't have access to 'Data.IntMap.empty'. There are also --- a few ways to construct an 'NEIntMap' from a 'IntMap': --- --- 1. The 'nonEmptyMap' smart constructor will convert a @'IntMap' k a@ into --- a @'Maybe' ('NEIntMap' k a)@, returning 'Nothing' if the original 'IntMap' --- was empty. --- 2. You can use the 'Data.IntMap.NonEmpty.insertIntMap' family of functions to --- insert a value into a 'IntMap' to create a guaranteed 'NEIntMap'. --- 3. You can use the 'Data.IntMap.NonEmpty.IsNonEmpty' and --- 'Data.IntMap.NonEmpty.IsEmpty' patterns to "pattern match" on a 'IntMap' --- to reveal it as either containing a 'NEIntMap' or an empty map. --- 4. 'withNonEmpty' offers a continuation-based interface for --- deconstructing a 'IntMap' and treating it as if it were an --- 'NEIntMap'. --- --- You can convert an 'NEIntMap' into a 'IntMap' with 'toMap' or --- 'Data.IntMap.NonEmpty.IsNonEmpty', essentially "obscuring" the non-empty --- property from the type. -data NEIntMap a - = NEIntMap - { neimK0 :: !Key - -- ^ invariant: must be smaller than smallest key in map - , neimV0 :: a - , neimIntMap :: !(IntMap a) - } - deriving (Typeable) - -instance Eq a => Eq (NEIntMap a) where - t1 == t2 = - M.size (neimIntMap t1) == M.size (neimIntMap t2) - && toList t1 == toList t2 - -instance Ord a => Ord (NEIntMap a) where - compare = compare `on` toList - (<) = (<) `on` toList - (>) = (>) `on` toList - (<=) = (<=) `on` toList - (>=) = (>=) `on` toList - --- | @since 0.3.6.0 -instance FunctorWithIndex Int NEIntMap where - imap f (NEIntMap k v m) = NEIntMap k (f k v) (M.mapWithKey f m) - --- | @since 0.3.6.0 -instance FoldableWithIndex Int NEIntMap where - ifoldMap = foldMapWithKey - --- | @since 0.3.6.0 -instance TraversableWithIndex Int NEIntMap where - itraverse f (NEIntMap k v m) = - NEIntMap k - <$> f k v - <*> M.traverseWithKey f m - --- | @since 0.3.6.0 -instance Exts.IsList (NEIntMap a) where - type Item (NEIntMap a) = (Key, a) - - fromList (a : as) = fromList (a :| as) - fromList [] = errorWithoutStackTrace "Data.IntMap.NonEmpty.fromList: empty list" - - toList = F.toList . toList - -instance Eq1 NEIntMap where - liftEq eq m1 m2 = - M.size (neimIntMap m1) == M.size (neimIntMap m2) - && liftEq (liftEq eq) (toList m1) (toList m2) - -instance Ord1 NEIntMap where - liftCompare cmp m n = - liftCompare (liftCompare cmp) (toList m) (toList n) - -instance Show1 NEIntMap where - liftShowsPrec sp sl d m = - showsUnaryWith (liftShowsPrec sp' sl') "fromList" d (toList m) - where - sp' = liftShowsPrec sp sl - sl' = liftShowList sp sl - -instance Read1 NEIntMap where - liftReadsPrec rp rl = - readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList - where - rp' = liftReadsPrec rp rl - rl' = liftReadList rp rl - -instance Read e => Read (NEIntMap e) where - readPrec = parens $ prec 10 $ do - Ident "fromList" <- lexP - xs <- parens . prec 10 $ readPrec - return (fromList xs) - readListPrec = readListPrecDefault - -instance Show a => Show (NEIntMap a) where - showsPrec d m = - showParen (d > 10) $ - showString "fromList (" . shows (toList m) . showString ")" - -instance NFData a => NFData (NEIntMap a) where - rnf (NEIntMap k v a) = rnf k `seq` rnf v `seq` rnf a - --- Data instance code from Data.IntMap.Internal --- --- Copyright : (c) Daan Leijen 2002 --- (c) Andriy Palamarchuk 2008 --- (c) wren romano 2016 -#if MIN_VERSION_base(4,16,0) -instance Data a => Data (NEIntMap a) where - gfoldl f z im = z fromList `f` toList im - toConstr _ = fromListConstr - gunfold k z c = case constrIndex c of - 1 -> k (z fromList) - _ -> error "gunfold" - dataTypeOf _ = intMapDataType - dataCast1 = gcast1 -#else -#ifndef __HLINT__ -instance Data a => Data (NEIntMap a) where - gfoldl f z im = z fromList `f` toList im - toConstr _ = fromListConstr - gunfold k z c = case constrIndex c of - 1 -> k (z fromList) - _ -> error "gunfold" - dataTypeOf _ = intMapDataType - dataCast1 f = gcast1 f -#endif -#endif - -fromListConstr :: Constr -fromListConstr = mkConstr intMapDataType "fromList" [] Prefix - -intMapDataType :: DataType -intMapDataType = mkDataType "Data.IntMap.NonEmpty.Internal.NEIntMap" [fromListConstr] - -instance A.ToJSON a => A.ToJSON (NEIntMap a) where - toJSON = A.toJSON . toMap - toEncoding = A.toEncoding . toMap - -instance A.FromJSON a => A.FromJSON (NEIntMap a) where - parseJSON = - withNonEmpty (fail err) pure - <=< A.parseJSON - where - err = "NEIntMap: Non-empty map expected, but empty map found" - --- | @since 0.3.4.4 -instance Alt NEIntMap where - () = union - --- | /O(n)/. Fold the values in the map using the given right-associative --- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@. --- --- > elemsList map = foldr (:) [] map --- --- > let f a len = len + (length a) --- > foldr f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4 -foldr :: (a -> b -> b) -> b -> NEIntMap a -> b -foldr f z (NEIntMap _ v m) = v `f` M.foldr f z m -{-# INLINE foldr #-} - --- | /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. -foldr' :: (a -> b -> b) -> b -> NEIntMap a -> b -foldr' f z (NEIntMap _ v m) = v `f` y - where - !y = M.foldr' f z m -{-# INLINE foldr' #-} - --- | /O(n)/. A version of 'foldr' that uses the value at the maximal key in --- the map as the starting value. --- --- Note that, unlike 'Data.Foldable.foldr1' for 'IntMap', this function is --- total if the input function is total. -foldr1 :: (a -> a -> a) -> NEIntMap a -> a -foldr1 f (NEIntMap _ v m) = - maybe v (f v . uncurry (M.foldr f)) - . M.maxView - $ m -{-# INLINE foldr1 #-} - --- | /O(n)/. Fold the values in the map using the given left-associative --- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@. --- --- > elemsList = reverse . foldl (flip (:)) [] --- --- > let f len a = len + (length a) --- > foldl f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4 -foldl :: (a -> b -> a) -> a -> NEIntMap b -> a -foldl f z (NEIntMap _ v m) = M.foldl f (f z v) m -{-# INLINE foldl #-} - --- | /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. -foldl' :: (a -> b -> a) -> a -> NEIntMap b -> a -foldl' f z (NEIntMap _ v m) = M.foldl' f x m - where - !x = f z v -{-# INLINE foldl' #-} - --- | /O(n)/. A version of 'foldl' that uses the value at the minimal key in --- the map as the starting value. --- --- Note that, unlike 'Data.Foldable.foldl1' for 'IntMap', this function is --- total if the input function is total. -foldl1 :: (a -> a -> a) -> NEIntMap a -> a -foldl1 f (NEIntMap _ v m) = M.foldl f v m -{-# INLINE foldl1 #-} - --- | /O(n)/. Fold the keys and values in the map using the given semigroup, --- such that --- --- @'foldMapWithKey' f = 'Data.Semigroup.Foldable.fold1' . 'Data.IntMap.NonEmpty.mapWithKey' f@ --- --- __WARNING__: Differs from @Data.IntMap.foldMapWithKey@, which traverses --- positive items first, then negative items. --- --- This can be an asymptotically faster than --- 'Data.IntMap.NonEmpty.foldrWithKey' or 'Data.IntMap.NonEmpty.foldlWithKey' for --- some monoids. - --- TODO: benchmark against maxView method -foldMapWithKey :: - Semigroup m => - (Key -> a -> m) -> - NEIntMap a -> - m -foldMapWithKey f = F1.foldMap1 (uncurry f) . toList -{-# INLINE foldMapWithKey #-} - --- | /O(n)/. IntMap a function over all values in the map. --- --- > map (++ "x") (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "bx") :| [(5, "ax")]) -map :: (a -> b) -> NEIntMap a -> NEIntMap b -map f (NEIntMap k0 v m) = NEIntMap k0 (f v) (M.map f m) -{-# NOINLINE [1] map #-} - -{-# RULES -"map/map" forall f g xs. map f (map g xs) = map (f . g) xs - #-} -{-# RULES -"map/coerce" map coerce = coerce - #-} - --- | /O(m*log(n\/m + 1)), m <= n/. --- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and --- @t2@. It prefers @t1@ when duplicate keys are encountered, i.e. --- (@'union' == 'Data.IntMap.NonEmpty.unionWith' 'const'@). --- --- > union (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "a"), (7, "C")]) -union :: - NEIntMap a -> - NEIntMap a -> - NEIntMap a -union n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of - LT -> NEIntMap k1 v1 . M.union m1 . toMap $ n2 - EQ -> NEIntMap k1 v1 . M.union m1 $ m2 - GT -> NEIntMap k2 v2 . M.union (toMap n1) $ m2 -{-# INLINE union #-} - --- | The left-biased union of a non-empty list of maps. --- --- > unions (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) --- > == fromList [(3, "b"), (5, "a"), (7, "C")] --- > unions (fromList ((5, "A3") :| [(3, "B3")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "a") :| [(3, "b")])]) --- > == fromList ((3, "B3") :| [(5, "A3"), (7, "C")]) -unions :: - Foldable1 f => - f (NEIntMap a) -> - NEIntMap a -unions (F1.toNonEmpty -> (m :| ms)) = F.foldl' union m ms -{-# INLINE unions #-} - --- | /O(n)/. --- Return all elements of the map in the ascending order of their keys. --- --- > elems (fromList ((5,"a") :| [(3,"b")])) == ("b" :| ["a"]) -elems :: NEIntMap a -> NonEmpty a -elems (NEIntMap _ v m) = v :| M.elems m -{-# INLINE elems #-} - --- | /O(1)/. The number of elements in the map. Guaranteed to be greater --- than zero. --- --- > size (singleton 1 'a') == 1 --- > size (fromList ((1,'a') :| [(2,'c'), (3,'b')])) == 3 -size :: NEIntMap a -> Int -size (NEIntMap _ _ m) = 1 + M.size m -{-# INLINE size #-} - --- | /O(log n)/. --- Convert a non-empty map back into a normal possibly-empty map, for usage --- with functions that expect 'IntMap'. --- --- Can be thought of as "obscuring" the non-emptiness of the map in its --- type. See the 'Data.IntMap.NonEmpty.IsNotEmpty' pattern. --- --- 'nonEmptyMap' and @'maybe' 'Data.IntMap.empty' 'toMap'@ form an isomorphism: they --- are perfect structure-preserving inverses of eachother. --- --- > toMap (fromList ((3,"a") :| [(5,"b")])) == Data.IntMap.fromList [(3,"a"), (5,"b")] -toMap :: NEIntMap a -> IntMap a -toMap (NEIntMap k v m) = insertMinMap k v m -{-# INLINE toMap #-} - --- | /O(n)/. --- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ --- That is, behaves exactly like a regular 'traverse' except that the traversing --- function also has access to the key associated with a value. --- --- /Use 'traverseWithKey1'/ whenever possible (if your 'Applicative' --- also has 'Apply' instance). This version is provided only for types --- that do not have 'Apply' instance, since 'Apply' is not at the moment --- (and might not ever be) an official superclass of 'Applicative'. --- --- __WARNING__: Differs from @Data.IntMap.traverseWithKey@, which traverses --- positive items first, then negative items. --- --- @ --- 'traverseWithKey' f = 'unwrapApplicative' . 'traverseWithKey1' (\\k -> WrapApplicative . f k) --- @ -traverseWithKey :: - Applicative t => - (Key -> a -> t b) -> - NEIntMap a -> - t (NEIntMap b) -traverseWithKey f (NEIntMap k v m0) = - NEIntMap k - <$> f k v - <*> M.traverseWithKey f m0 -{-# INLINE traverseWithKey #-} - --- | /O(n)/. --- @'traverseWithKey1' f m == 'fromList' <$> 'traverse1' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ --- --- That is, behaves exactly like a regular 'traverse1' except that the traversing --- function also has access to the key associated with a value. --- --- __WARNING__: Differs from @Data.IntMap.traverseWithKey@, which traverses --- positive items first, then negative items. --- --- Is more general than 'traverseWithKey', since works with all 'Apply', --- and not just 'Applicative'. - --- TODO: benchmark against maxView-based methods -traverseWithKey1 :: - Apply t => - (Key -> a -> t b) -> - NEIntMap a -> - t (NEIntMap b) -traverseWithKey1 f (NEIntMap k0 v m0) = case runMaybeApply m1 of - Left m2 -> NEIntMap k0 <$> f k0 v <.> m2 - Right m2 -> flip (NEIntMap k0) m2 <$> f k0 v - where - m1 = M.traverseWithKey (\k -> MaybeApply . Left . f k) m0 -{-# INLINEABLE traverseWithKey1 #-} - --- | /O(n)/. Convert the map to a non-empty list of key\/value pairs. --- --- > toList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) -toList :: NEIntMap a -> NonEmpty (Key, a) -toList (NEIntMap k v m) = (k, v) :| M.toList m -{-# INLINE toList #-} - --- | /O(log n)/. Smart constructor for an 'NEIntMap' from a 'IntMap'. Returns --- 'Nothing' if the 'IntMap' was originally actually empty, and @'Just' n@ --- with an 'NEIntMap', if the 'IntMap' was not empty. --- --- 'nonEmptyMap' and @'maybe' 'Data.IntMap.empty' 'toMap'@ form an --- isomorphism: they are perfect structure-preserving inverses of --- eachother. --- --- See 'Data.IntMap.NonEmpty.IsNonEmpty' for a pattern synonym that lets you --- "match on" the possiblity of a 'IntMap' being an 'NEIntMap'. --- --- > nonEmptyMap (Data.IntMap.fromList [(3,"a"), (5,"b")]) == Just (fromList ((3,"a") :| [(5,"b")])) -nonEmptyMap :: IntMap a -> Maybe (NEIntMap a) -nonEmptyMap = (fmap . uncurry . uncurry) NEIntMap . M.minViewWithKey -{-# INLINE nonEmptyMap #-} - --- | /O(log n)/. A general continuation-based way to consume a 'IntMap' as if --- it were an 'NEIntMap'. @'withNonEmpty' def f@ will take a 'IntMap'. If map is --- empty, it will evaluate to @def@. Otherwise, a non-empty map 'NEIntMap' --- will be fed to the function @f@ instead. --- --- @'nonEmptyMap' == 'withNonEmpty' 'Nothing' 'Just'@ -withNonEmpty :: - -- | value to return if map is empty - r -> - -- | function to apply if map is not empty - (NEIntMap a -> r) -> - IntMap a -> - r -withNonEmpty def f = maybe def f . nonEmptyMap -{-# INLINE withNonEmpty #-} - --- | /O(n*log n)/. Build a non-empty map from a non-empty list of --- key\/value pairs. See also 'Data.IntMap.NonEmpty.fromAscList'. If the list --- contains more than one value for the same key, the last value for the --- key is retained. --- --- > fromList ((5,"a") :| [(3,"b"), (5, "c")]) == fromList ((5,"c") :| [(3,"b")]) --- > fromList ((5,"c") :| [(3,"b"), (5, "a")]) == fromList ((5,"a") :| [(3,"b")]) - --- TODO: write manually and optimize to be equivalent to --- 'fromDistinctAscList' if items are ordered, just like the actual --- 'M.fromList'. -fromList :: NonEmpty (Key, a) -> NEIntMap a -fromList ((k, v) :| xs) = - withNonEmpty (singleton k v) (insertWith (const id) k v) - . M.fromList - $ xs -{-# INLINE fromList #-} - --- | /O(1)/. A map with a single element. --- --- > singleton 1 'a' == fromList ((1, 'a') :| []) --- > size (singleton 1 'a') == 1 -singleton :: Key -> a -> NEIntMap a -singleton k v = NEIntMap k v M.empty -{-# INLINE singleton #-} - --- | /O(log n)/. Insert with a function, combining new value and old value. --- @'insertWith' f key value mp@ will insert the pair (key, value) into --- @mp@ if key does not exist in the map. If the key does exist, the --- function will insert the pair @(key, f new_value old_value)@. --- --- See 'Data.IntMap.NonEmpty.insertIntMapWith' for a version where the first --- argument is a 'IntMap'. --- --- > insertWith (++) 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "xxxa")]) --- > insertWith (++) 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) -insertWith :: - (a -> a -> a) -> - Key -> - a -> - NEIntMap a -> - NEIntMap a -insertWith f k v n@(NEIntMap k0 v0 m) = case compare k k0 of - LT -> NEIntMap k v . toMap $ n - EQ -> NEIntMap k (f v v0) m - GT -> NEIntMap k0 v0 $ M.insertWith f k v m -{-# INLINE insertWith #-} - --- | Left-biased union -instance Semigroup (NEIntMap a) where - (<>) = union - {-# INLINE (<>) #-} - sconcat = unions - {-# INLINE sconcat #-} - -instance Functor NEIntMap where - fmap = map - {-# INLINE fmap #-} - x <$ NEIntMap k _ m = NEIntMap k x (x <$ m) - {-# INLINE (<$) #-} - --- | @since 0.3.4.4 -instance Invariant NEIntMap where - invmap f _ = fmap f - {-# INLINE invmap #-} - --- | Traverses elements in order of ascending keys. --- --- __WARNING:__ 'F.fold' and 'F.foldMap' are different than for the --- 'IntMap' instance. They traverse elements in order of ascending keys, --- while 'IntMap' traverses positive keys first, then negative keys. --- --- 'Data.Foldable.foldr1', 'Data.Foldable.foldl1', 'Data.Foldable.minimum', --- 'Data.Foldable.maximum' are all total. -#if MIN_VERSION_base(4,11,0) -instance F.Foldable NEIntMap where - fold (NEIntMap _ v m) = v <> F.fold (M.elems m) - {-# INLINE fold #-} - foldMap f (NEIntMap _ v m) = f v <> F.foldMap f (M.elems m) - {-# INLINE foldMap #-} - foldr = foldr - {-# INLINE foldr #-} - foldr' = foldr' - {-# INLINE foldr' #-} - foldr1 = foldr1 - {-# INLINE foldr1 #-} - foldl = foldl - {-# INLINE foldl #-} - foldl' = foldl' - {-# INLINE foldl' #-} - foldl1 = foldl1 - {-# INLINE foldl1 #-} - null _ = False - {-# INLINE null #-} - length = size - {-# INLINE length #-} - elem x (NEIntMap _ v m) = F.elem x m - || x == v - {-# INLINE elem #-} - -- TODO: use build - toList = F.toList . elems - {-# INLINE toList #-} -#else -instance F.Foldable NEIntMap where - fold (NEIntMap _ v m) = v `mappend` F.fold (M.elems m) - {-# INLINE fold #-} - foldMap f (NEIntMap _ v m) = f v `mappend` F.foldMap f (M.elems m) - {-# INLINE foldMap #-} - foldr = foldr - {-# INLINE foldr #-} - foldr' = foldr' - {-# INLINE foldr' #-} - foldr1 = foldr1 - {-# INLINE foldr1 #-} - foldl = foldl - {-# INLINE foldl #-} - foldl' = foldl' - {-# INLINE foldl' #-} - foldl1 = foldl1 - {-# INLINE foldl1 #-} - null _ = False - {-# INLINE null #-} - length = size - {-# INLINE length #-} - elem x (NEIntMap _ v m) = F.elem x m - || x == v - {-# INLINE elem #-} - -- TODO: use build - toList = F.toList . elems - {-# INLINE toList #-} -#endif - --- | Traverses elements in order of ascending keys --- --- __WARNING:__ Different than for the 'IntMap' instance. They traverse --- elements in order of ascending keys, while 'IntMap' traverses positive --- keys first, then negative keys. -instance Traversable NEIntMap where - traverse f = traverseWithKey (const f) - {-# INLINE traverse #-} - --- | Traverses elements in order of ascending keys --- --- __WARNING:__ 'F1.fold1' and 'F1.foldMap1' are different than 'F.fold' and --- 'F.foldMap' for the 'IntMap' instance of 'Foldable'. They traverse --- elements in order of ascending keys, while 'IntMap' traverses positive --- keys first, then negative keys. -#if MIN_VERSION_base(4,11,0) -instance Foldable1 NEIntMap where - fold1 (NEIntMap _ v m) = maybe v (v <>) - . F.foldMap Just - . M.elems - $ m - {-# INLINE fold1 #-} - foldMap1 f = foldMapWithKey (const f) - {-# INLINE foldMap1 #-} - toNonEmpty = elems - {-# INLINE toNonEmpty #-} -#else -instance Foldable1 NEIntMap where - fold1 (NEIntMap _ v m) = option v (v <>) - . F.foldMap (Option . Just) - . M.elems - $ m - {-# INLINE fold1 #-} - foldMap1 f = foldMapWithKey (const f) - {-# INLINE foldMap1 #-} - toNonEmpty = elems - {-# INLINE toNonEmpty #-} -#endif - --- | Traverses elements in order of ascending keys --- --- __WARNING:__ 'traverse1' and 'sequence1' are different 'traverse' and --- 'sequence' for the 'IntMap' instance of 'Traversable'. They traverse --- elements in order of ascending keys, while 'IntMap' traverses positive --- keys first, then negative keys. -instance Traversable1 NEIntMap where - traverse1 f = traverseWithKey1 (const f) - {-# INLINE traverse1 #-} - --- | 'extract' gets the value at the minimal key, and 'duplicate' produces --- a map of maps comprised of all keys from the original map greater than --- or equal to the current key. --- --- @since 0.1.1.0 -instance Comonad NEIntMap where - extract = neimV0 - {-# INLINE extract #-} - - -- We'd like to use 'M.mapAccumWithKey', but it traverses things in the - -- wrong order. - duplicate n0@(NEIntMap k0 _ m0) = - NEIntMap k0 n0 - . M.fromDistinctAscList - . snd - . L.mapAccumL go m0 - . M.toList - $ m0 - where - go m (k, v) = (m', (k, NEIntMap k v m')) - where - !m' = M.deleteMin m - {-# INLINE duplicate #-} - --- | /O(n)/. Test if the internal map structure is valid. -valid :: NEIntMap a -> Bool -valid (NEIntMap k _ m) = all ((k <) . fst . fst) (M.minViewWithKey m) - --- | /O(log n)/. Insert new key and value into a map where keys are --- /strictly greater than/ the new key. That is, the new key must be --- /strictly less than/ all keys present in the 'IntMap'. /The precondition --- is not checked./ --- --- At the moment this is simply an alias for @Data.IntSet.insert@, but it's --- left here as a placeholder in case this eventually gets implemented in --- a more efficient way. - --- TODO: implementation -insertMinMap :: Key -> a -> IntMap a -> IntMap a -insertMinMap = M.insert -{-# INLINEABLE insertMinMap #-} - --- | /O(log n)/. Insert new key and value into a map where keys are --- /strictly less than/ the new key. That is, the new key must be --- /strictly greater than/ all keys present in the 'IntMap'. /The --- precondition is not checked./ --- --- At the moment this is simply an alias for @Data.IntSet.insert@, but it's --- left here as a placeholder in case this eventually gets implemented in --- a more efficient way. - --- TODO: implementation -insertMaxMap :: Key -> a -> IntMap a -> IntMap a -insertMaxMap = M.insert -{-# INLINEABLE insertMaxMap #-} +import Data.IntMap.NonEmpty.Lazy.Internal diff --git a/src/Data/IntMap/NonEmpty/Lazy.hs b/src/Data/IntMap/NonEmpty/Lazy.hs new file mode 100644 --- /dev/null +++ b/src/Data/IntMap/NonEmpty/Lazy.hs @@ -0,0 +1,2072 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module : Data.IntMap.NonEmpty.Lazy +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- = Non-Empty Finite Integer-Indexed Maps (lazy interface) +-- +-- The @'NEIntMap' v@ type represents a non-empty finite map (sometimes +-- called a dictionary) from integer keys to values of type @v@. +-- An 'NEIntMap' is strict in its keys but lazy in its values. +-- +-- See documentation for 'NEIntMap' for information on how to convert and +-- manipulate such non-empty maps. +-- +-- This module essentially re-imports the API of "Data.IntMap.Lazy" and its +-- 'IntMap' type, along with semantics and asymptotics. In most +-- situations, asymptotics are different only by a constant factor. In +-- some situations, asmyptotics are even better (constant-time instead of +-- log-time). +-- +-- Because 'NEIntMap' is implemented using 'IntMap', all of the caveats of using +-- 'IntMap' apply (such as the limitation of the maximum size of maps). +-- +-- All functions take non-empty maps as inputs. In situations where their +-- results can be guarunteed to also be non-empty, they also return +-- non-empty maps. In situations where their results could potentially be +-- empty, 'IntMap' is returned instead. +-- +-- Some variants of functions (like 'alter'', 'alterF'', 'adjustMin', +-- 'adjustMax', 'adjustMinWithKey', 'adjustMaxWithKey') are provided in +-- a way restructured to preserve guaruntees of non-empty maps being +-- returned. +-- +-- Some functions (like 'mapEither', 'partition', 'split') +-- have modified return types to account for possible configurations of +-- non-emptiness. +-- +-- This module is intended to be imported qualified, to avoid name clashes with +-- "Prelude" and "Data.IntMap" functions: +-- +-- > import qualified Data.IntMap.NonEmpty.Lazy as NEIM +-- +-- Note that all asmyptotics /O(f(n))/ in this module are actually +-- /O(min(W, f(n)))/, where @W@ is the number of bits in an 'Int' (32 or +-- 64). That is, if @f(n)@ is greater than @W@, all operations are +-- constant-time. +-- +-- Import "Data.IntMap.NonEmpty.Strict" for a variant strict on values. +module Data.IntMap.NonEmpty.Lazy ( + -- * Non-Empty IntMap Type + NEIntMap, + Key, + + -- ** Conversions between empty and non-empty maps + pattern IsNonEmpty, + pattern IsEmpty, + nonEmptyMap, + toMap, + withNonEmpty, + insertMap, + insertMapWith, + insertMapWithKey, + insertMapMin, + insertMapMax, + unsafeFromMap, + + -- * Construction + singleton, + fromSet, + + -- ** From Unordered Lists + fromList, + fromListWith, + fromListWithKey, + + -- ** From Ascending Lists + fromAscList, + fromAscListWith, + fromAscListWithKey, + fromDistinctAscList, + + -- * Insertion + insert, + insertWith, + insertWithKey, + insertLookupWithKey, + + -- * Deletion\/Update + delete, + deleteMaybe, + adjust, + adjustWithKey, + update, + updateWithKey, + updateLookupWithKey, + alter, + alterF, + alter', + alterF', + + -- * Query + + -- ** Lookup + lookup, + (!?), + (!), + findWithDefault, + member, + notMember, + lookupLT, + lookupGT, + lookupLE, + lookupGE, + + -- ** Size + size, + + -- * Combine + + -- ** Union + union, + unionMapLeft, + unionMapRight, + unionWith, + unionMapWithLeft, + unionMapWithRight, + unionWithKey, + unionMapWithKeyLeft, + unionMapWithKeyRight, + unions, + unionsWith, + + -- ** Difference + difference, + (\\), + differenceWith, + differenceWithKey, + + -- ** Intersection + intersection, + intersectionWith, + intersectionWithKey, + -- -- ** Universal combining function + -- , mergeWithKey + + -- * Traversal + + -- ** Map + map, + mapWithKey, + traverseWithKey1, + traverseWithKey, + mapAccum, + mapAccumWithKey, + mapAccumRWithKey, + mapKeys, + mapKeysWith, + mapKeysMonotonic, + + -- * Folds + foldr, + foldl, + foldr1, + foldl1, + foldrWithKey, + foldlWithKey, + foldMapWithKey, + + -- ** Strict folds + foldr', + foldr1', + foldl', + foldl1', + foldrWithKey', + foldlWithKey', + + -- * Conversion + elems, + keys, + assocs, + keysSet, + + -- ** Lists + toList, + + -- ** Ordered lists + toAscList, + toDescList, + + -- * Filter + filter, + filterWithKey, + restrictKeys, + withoutKeys, + partition, + partitionWithKey, + mapMaybe, + mapMaybeWithKey, + mapEither, + mapEitherWithKey, + split, + splitLookup, + splitRoot, + + -- * Submap + isSubmapOf, + isSubmapOfBy, + isProperSubmapOf, + isProperSubmapOfBy, + + -- * Min\/Max + findMin, + findMax, + deleteMin, + deleteMax, + deleteFindMin, + deleteFindMax, + updateMin, + updateMax, + adjustMin, + adjustMax, + updateMinWithKey, + updateMaxWithKey, + adjustMinWithKey, + adjustMaxWithKey, + minView, + maxView, + + -- * Debugging + valid, +) where + +import Control.Applicative +import Data.Bifunctor +import qualified Data.Foldable as F +import Data.Functor.Identity +import qualified Data.IntMap as M +import Data.IntMap.Internal (IntMap (..)) +import Data.IntMap.NonEmpty.Lazy.Internal +import Data.IntSet (IntSet) +import qualified Data.IntSet as S +import Data.IntSet.NonEmpty.Internal (NEIntSet (..)) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE +import Data.Maybe hiding (mapMaybe) +import qualified Data.Maybe as Maybe +import Data.Semigroup.Foldable (Foldable1) +import qualified Data.Semigroup.Foldable as F1 +import Data.These +import Prelude hiding (Foldable (..), filter, lookup, map) + +-- | /O(1)/ match, /O(log n)/ usage of contents. The 'IsNonEmpty' and +-- 'IsEmpty' patterns allow you to treat a 'IntMap' as if it were either +-- a @'IsNonEmpty' n@ (where @n@ is a 'NEIntMap') or an 'IsEmpty'. +-- +-- For example, you can pattern match on a 'IntMap': +-- +-- @ +-- myFunc :: 'IntMap' K X -> Y +-- myFunc ('IsNonEmpty' n) = -- here, the user provided a non-empty map, and @n@ is the 'NEIntMap' +-- myFunc 'IsEmpty' = -- here, the user provided an empty map. +-- @ +-- +-- Matching on @'IsNonEmpty' n@ means that the original 'IntMap' was /not/ +-- empty, and you have a verified-non-empty 'NEIntMap' @n@ to use. +-- +-- Note that patching on this pattern is /O(1)/. However, using the +-- contents requires a /O(log n)/ cost that is deferred until after the +-- pattern is matched on (and is not incurred at all if the contents are +-- never used). +-- +-- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides +-- complete coverage. +-- +-- This is a bidirectional pattern, so you can use 'IsNonEmpty' to convert +-- a 'NEIntMap' back into a 'IntMap', obscuring its non-emptiness (see 'toMap'). +pattern IsNonEmpty :: NEIntMap a -> IntMap a +pattern IsNonEmpty n <- (nonEmptyMap -> Just n) + where + IsNonEmpty n = toMap n + +-- | /O(1)/. The 'IsNonEmpty' and 'IsEmpty' patterns allow you to treat +-- a 'IntMap' as if it were either a @'IsNonEmpty' n@ (where @n@ is +-- a 'NEIntMap') or an 'IsEmpty'. +-- +-- Matching on 'IsEmpty' means that the original 'IntMap' was empty. +-- +-- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides +-- complete coverage. +-- +-- This is a bidirectional pattern, so you can use 'IsEmpty' as an +-- expression, and it will be interpreted as 'Data.IntMap.empty'. +-- +-- See 'IsNonEmpty' for more information. +pattern IsEmpty :: IntMap a +pattern IsEmpty <- (M.null -> True) + where + IsEmpty = M.empty + +{-# COMPLETE IsNonEmpty, IsEmpty #-} + +-- | /O(log n)/. Unsafe version of 'nonEmptyMap'. Coerces a 'IntMap' into an +-- 'NEIntMap', but is undefined (throws a runtime exception when evaluation is +-- attempted) for an empty 'IntMap'. +unsafeFromMap :: + IntMap a -> + NEIntMap a +unsafeFromMap = withNonEmpty e id + where + e = errorWithoutStackTrace "NEIntMap.unsafeFromMap: empty map" +{-# INLINE unsafeFromMap #-} + +-- | /O(log n)/. Convert a 'IntMap' into an 'NEIntMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. If key is already present, +-- will overwrite the original value. +-- +-- See 'insertMapMin' for a version that is constant-time if the new key is +-- /strictly smaller than/ all keys in the original map. +-- +-- > insertMap 4 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) +-- > insertMap 4 "c" Data.IntMap.empty == singleton 4 "c" +insertMap :: Key -> a -> IntMap a -> NEIntMap a +insertMap k v = withNonEmpty (singleton k v) (insert k v) +{-# INLINE insertMap #-} + +-- | /O(log n)/. Convert a 'IntMap' into an 'NEIntMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. Uses a combining function +-- with the new value as the first argument if the key is already present. +-- +-- > insertMapWith (++) 4 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) +-- > insertMapWith (++) 5 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"ca")]) +insertMapWith :: + (a -> a -> a) -> + Key -> + a -> + IntMap a -> + NEIntMap a +insertMapWith f k v = withNonEmpty (singleton k v) (insertWith f k v) +{-# INLINE insertMapWith #-} + +-- | /O(log n)/. Convert a 'IntMap' into an 'NEIntMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. Uses a combining function +-- with the key and new value as the first and second arguments if the key +-- is already present. +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertWithKey f 5 "xxx" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "5:xxx|a")]) +-- > insertWithKey f 7 "xxx" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +-- > insertWithKey f 5 "xxx" Data.IntMap.empty == singleton 5 "xxx" +insertMapWithKey :: + (Key -> a -> a -> a) -> + Key -> + a -> + IntMap a -> + NEIntMap a +insertMapWithKey f k v = withNonEmpty (singleton k v) (insertWithKey f k v) +{-# INLINE insertMapWithKey #-} + +-- | /O(1)/ Convert a 'IntMap' into an 'NEIntMap' by adding a key-value pair +-- where the key is /strictly less than/ all keys in the input map. The +-- keys in the original map must all be /strictly greater than/ the new +-- key. /The precondition is not checked./ +-- +-- > insertMapMin 2 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((2,"c") :| [(3,"b"), (5,"a")]) +-- > valid (insertMapMin 2 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == True +-- > valid (insertMapMin 7 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False +-- > valid (insertMapMin 3 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False +insertMapMin :: + Key -> + a -> + IntMap a -> + NEIntMap a +insertMapMin = NEIntMap +{-# INLINE insertMapMin #-} + +-- | /O(log n)/ Convert a 'IntMap' into an 'NEIntMap' by adding a key-value pair +-- where the key is /strictly greater than/ all keys in the input map. The +-- keys in the original map must all be /strictly less than/ the new +-- key. /The precondition is not checked./ +-- +-- At the current moment, this is identical simply 'insertMap'; however, +-- it is left both for consistency and as a placeholder for a future +-- version where optimizations are implemented to allow for a faster +-- implementation. +-- +-- > insertMap 7 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"a"), (7,"c")]) + +-- these currently are all valid, but shouldn't be +-- > valid (insertMap 7 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == True +-- > valid (insertMap 2 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False +-- > valid (insertMap 5 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False +insertMapMax :: + Key -> + a -> + IntMap a -> + NEIntMap a +insertMapMax k v = withNonEmpty (singleton k v) go + where + go (NEIntMap k0 v0 m0) = NEIntMap k0 v0 . insertMaxMap k v $ m0 +{-# INLINE insertMapMax #-} + +-- | /O(n)/. Build a non-empty map from a non-empty set of keys and +-- a function which for each key computes its value. +-- +-- > fromSet (\k -> replicate k 'a') (Data.Set.NonEmpty.fromList (3 :| [5])) == fromList ((5,"aaaaa") :| [(3,"aaa")]) +fromSet :: + (Key -> a) -> + NEIntSet -> + NEIntMap a +fromSet f (NEIntSet k ks) = NEIntMap k (f k) (M.fromSet f ks) +{-# INLINE fromSet #-} + +-- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs +-- with a combining function. See also 'fromAscListWith'. +-- +-- > fromListWith (++) ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "ab") :| [(5, "aba")]) +fromListWith :: + (a -> a -> a) -> + NonEmpty (Key, a) -> + NEIntMap a +fromListWith f = fromListWithKey (const f) +{-# INLINE fromListWith #-} + +-- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs +-- with a combining function. See also 'fromAscListWithKey'. +-- +-- > let f k a1 a2 = (show k) ++ a1 ++ a2 +-- > fromListWithKey f ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "3ab") :| [(5, "5a5ba")]) +fromListWithKey :: + (Key -> a -> a -> a) -> + NonEmpty (Key, a) -> + NEIntMap a +fromListWithKey f ((k0, v0) :| xs) = F.foldl' go (singleton k0 v0) xs + where + go m (k, v) = insertWithKey f k v m + {-# INLINE go #-} +{-# INLINE fromListWithKey #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time. +-- /The precondition (input list is ascending) is not checked./ +-- +-- > fromAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) +-- > fromAscList ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "b")]) +-- > valid (fromAscList ((3,"b") :| [(5,"a"), (5,"b")])) == True +-- > valid (fromAscList ((5,"a") :| [(3,"b"), (5,"b")])) == False +fromAscList :: + NonEmpty (Key, a) -> + NEIntMap a +fromAscList = fromDistinctAscList . combineEq +{-# INLINE fromAscList #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is ascending) is not checked./ +-- +-- > fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "ba")]) +-- > valid (fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b"))]) == True +-- > valid (fromAscListWith (++) ((5,"a") :| [(3,"b"), (5,"b"))]) == False +fromAscListWith :: + (a -> a -> a) -> + NonEmpty (Key, a) -> + NEIntMap a +fromAscListWith f = fromAscListWithKey (const f) +{-# INLINE fromAscListWith #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is ascending) is not checked./ +-- +-- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 +-- > fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")]) == fromList ((3, "b") :| [(5, "5:b5:ba")]) +-- > valid (fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")])) == True +-- > valid (fromAscListWithKey f ((5,"a") :| [(3,"b"), (5,"b"), (5,"b")])) == False +fromAscListWithKey :: + (Key -> a -> a -> a) -> + NonEmpty (Key, a) -> + NEIntMap a +fromAscListWithKey f = fromDistinctAscList . combineEqWith f +{-# INLINE fromAscListWithKey #-} + +-- | /O(n)/. Build a map from an ascending non-empty list of distinct +-- elements in linear time. /The precondition is not checked./ +-- +-- > fromDistinctAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) +-- > valid (fromDistinctAscList ((3,"b") :| [(5,"a")])) == True +-- > valid (fromDistinctAscList ((3,"b") :| [(5,"a"), (5,"b")])) == False +fromDistinctAscList :: NonEmpty (Key, a) -> NEIntMap a +fromDistinctAscList ((k, v) :| xs) = + insertMapMin k v + . M.fromDistinctAscList + $ xs +{-# INLINE fromDistinctAscList #-} + +-- | /O(log n)/. Insert a new key and value in the map. +-- If the key is already present in the map, the associated value is +-- replaced with the supplied value. 'insert' is equivalent to +-- @'insertWith' 'const'@. +-- +-- See 'insertMap' for a version where the first argument is a 'IntMap'. +-- +-- > insert 5 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'x')]) +-- > insert 7 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'a'), (7, 'x')]) +insert :: + Key -> + a -> + NEIntMap a -> + NEIntMap a +insert k v n@(NEIntMap k0 v0 m) = case compare k k0 of + LT -> NEIntMap k v . toMap $ n + EQ -> NEIntMap k v m + GT -> NEIntMap k0 v0 . M.insert k v $ m +{-# INLINE insert #-} + +-- | /O(log n)/. Insert with a function, combining key, new value and old +-- value. @'insertWithKey' f key value mp@ will insert the pair (key, +-- value) into @mp@ if key does not exist in the map. If the key does +-- exist, the function will insert the pair @(key,f key new_value +-- old_value)@. Note that the key passed to f is the same key passed to +-- 'insertWithKey'. +-- +-- See 'insertMapWithKey' for a version where the first argument is a 'IntMap'. +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:xxx|a")]) +-- > insertWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +insertWithKey :: + (Key -> a -> a -> a) -> + Key -> + a -> + NEIntMap a -> + NEIntMap a +insertWithKey f k v n@(NEIntMap k0 v0 m) = case compare k k0 of + LT -> NEIntMap k v . toMap $ n + EQ -> NEIntMap k (f k v v0) m + GT -> NEIntMap k0 v0 $ M.insertWithKey f k v m +{-# INLINE insertWithKey #-} + +-- | /O(log n)/. Combines insert operation with old value retrieval. The +-- expression (@'insertLookupWithKey' f k x map@) is a pair where the first +-- element is equal to (@'lookup' k map@) and the second element equal to +-- (@'insertWithKey' f k x map@). +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertLookupWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "5:xxx|a")])) +-- > insertLookupWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "xxx")])) +-- +-- This is how to define @insertLookup@ using @insertLookupWithKey@: +-- +-- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t +-- > insertLookup 5 "x" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "x")])) +-- > insertLookup 7 "x" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "x")])) +insertLookupWithKey :: + (Key -> a -> a -> a) -> + Key -> + a -> + NEIntMap a -> + (Maybe a, NEIntMap a) +insertLookupWithKey f k v n@(NEIntMap k0 v0 m) = case compare k k0 of + LT -> (Nothing, NEIntMap k v . toMap $ n) + EQ -> (Just v, NEIntMap k (f k v v0) m) + GT -> NEIntMap k0 v0 <$> M.insertLookupWithKey f k v m +{-# INLINE insertLookupWithKey #-} + +-- | /O(log n)/. Delete a key and its value from the non-empty map. +-- A potentially empty map ('IntMap') is returned, since this might delete the +-- last item in the 'NEIntMap'. When the key is not a member of the map, is +-- equivalent to 'toMap'. +-- +-- > delete 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" +-- > delete 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.Singleton [(3, "b"), (5, "a")] +delete :: Key -> NEIntMap a -> IntMap a +delete k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> toMap n + EQ -> m + GT -> insertMinMap k0 v . M.delete k $ m +{-# INLINE delete #-} + +-- | /O(log n)/. Delete a key and its value from the non-empty map, returning +-- 'Nothing' if the result would be empty. +-- +-- This is more efficient than @'nonEmptyMap' . 'delete' k@ because it avoids +-- converting the known-minimum representation back through 'IntMap' when the +-- deleted key is not the minimum. +-- +-- @since 0.3.6.0 +deleteMaybe :: Key -> NEIntMap a -> Maybe (NEIntMap a) +deleteMaybe k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> Just n + EQ -> nonEmptyMap m + GT -> Just . NEIntMap k0 v . M.delete k $ m +{-# INLINE deleteMaybe #-} + +-- | /O(log n)/. Update a value at a specific key with the result of the +-- provided function. When the key is not a member of the map, the original +-- map is returned. +-- +-- > adjust ("new " ++) 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "new a")]) +-- > adjust ("new " ++) 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) +adjust :: + (a -> a) -> + Key -> + NEIntMap a -> + NEIntMap a +adjust f = adjustWithKey (const f) +{-# INLINE adjust #-} + +-- | /O(log n)/. Adjust a value at a specific key. When the key is not +-- a member of the map, the original map is returned. +-- +-- > let f key x = (show key) ++ ":new " ++ x +-- > adjustWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:new a")]) +-- > adjustWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) +adjustWithKey :: + (Key -> a -> a) -> + Key -> + NEIntMap a -> + NEIntMap a +adjustWithKey f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> n + EQ -> NEIntMap k0 (f k0 v) m + GT -> NEIntMap k0 v . M.adjustWithKey f k $ m +{-# INLINE adjustWithKey #-} + +-- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@ +-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is +-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. +-- +-- Returns a potentially empty map ('IntMap'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEIntMap'. +-- +-- > let f x = if x == "a" then Just "new a" else Nothing +-- > update f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "new a")] +-- > update f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a")] +-- > update f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +update :: + (a -> Maybe a) -> + Key -> + NEIntMap a -> + IntMap a +update f = updateWithKey (const f) +{-# INLINE update #-} + +-- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the +-- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing', +-- the element is deleted. If it is (@'Just' y@), the key @k@ is bound +-- to the new value @y@. +-- +-- Returns a potentially empty map ('IntMap'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEIntMap'. +-- +-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing +-- > updateWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "5:new a")] +-- > updateWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a")] +-- > updateWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +updateWithKey :: + (Key -> a -> Maybe a) -> + Key -> + NEIntMap a -> + IntMap a +updateWithKey f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> toMap n + EQ -> maybe m (flip (insertMinMap k0) m) . f k0 $ v + GT -> insertMinMap k0 v . M.updateWithKey f k $ m +{-# INLINE updateWithKey #-} + +-- | /O(min(n,W))/. Lookup and update. +-- The function returns original value, if it is updated. +-- This is different behavior than @Data.Map.NonEmpty.updateLookupWithKey@. +-- Returns the original key value if the map entry is deleted. +-- +-- Returns a potentially empty map ('IntMap') in the case that we delete +-- the final key of a singleton map. +-- +-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing +-- > updateLookupWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "5:new a", Data.IntMap.fromList ((3, "b") :| [(5, "5:new a")])) +-- > updateLookupWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == (Nothing, Data.IntMap.fromList ((3, "b") :| [(5, "a")])) +-- > updateLookupWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Data.IntMap.singleton 5 "a") +updateLookupWithKey :: + (Key -> a -> Maybe a) -> + Key -> + NEIntMap a -> + (Maybe a, IntMap a) +updateLookupWithKey f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> (Nothing, toMap n) + EQ -> + let u = f k0 v + in (Just v, maybe m (flip (insertMinMap k0) m) u) + GT -> fmap (insertMinMap k0 v) . M.updateLookupWithKey f k $ m +{-# INLINE updateLookupWithKey #-} + +-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at +-- @k@, or absence thereof. 'alter' can be used to insert, delete, or +-- update a value in a 'IntMap'. In short : @Data.IntMap.lookup k ('alter' +-- f k m) = f ('lookup' k m)@. +-- +-- Returns a potentially empty map ('IntMap'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEIntMap'. +-- +-- See 'alterF'' for a version that disallows deletion, and so therefore +-- can return 'NEIntMap'. +-- +-- > let f _ = Nothing +-- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a")] +-- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" +-- > +-- > let f _ = Just "c" +-- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a"), (7, "c")] +-- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "c")] +alter :: + (Maybe a -> Maybe a) -> + Key -> + NEIntMap a -> + IntMap a +alter f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> maybe id (insertMinMap k) (f Nothing) (toMap n) + EQ -> maybe id (insertMinMap k0) (f (Just v)) m + GT -> insertMinMap k0 v . M.alter f k $ m +{-# INLINE alter #-} + +-- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ +-- at @k@, or absence thereof. 'alterF' can be used to inspect, insert, +-- delete, or update a value in a 'IntMap'. In short: @Data.IntMap.lookup +-- k \<$\> 'alterF' f k m = f ('lookup' k m)@. +-- +-- Example: +-- +-- @ +-- interactiveAlter :: Int -> NEIntMap Int String -> IO (IntMap Int String) +-- interactiveAlter k m = alterF f k m where +-- f Nothing = do +-- putStrLn $ show k ++ +-- " was not found in the map. Would you like to add it?" +-- getUserResponse1 :: IO (Maybe String) +-- f (Just old) = do +-- putStrLn $ "The key is currently bound to " ++ show old ++ +-- ". Would you like to change or delete it?" +-- getUserResponse2 :: IO (Maybe String) +-- @ +-- +-- Like @Data.IntMap.alterF@ for 'IntMap', 'alterF' can be considered +-- to be a unifying generalization of 'lookup' and 'delete'; however, as +-- a constrast, it cannot be used to implement 'insert', because it must +-- return a 'IntMap' instead of an 'NEIntMap' (because the function might delete +-- the final item in the 'NEIntMap'). When used with trivial functors like +-- 'Identity' and 'Const', it is often slightly slower than +-- specialized 'lookup' and 'delete'. However, when the functor is +-- non-trivial and key comparison is not particularly cheap, it is the +-- fastest way. +-- +-- See 'alterF'' for a version that disallows deletion, and so therefore +-- can return 'NEIntMap' and be used to implement 'insert' +-- +-- Note on rewrite rules: +-- +-- This module includes GHC rewrite rules to optimize 'alterF' for +-- the 'Const' and 'Identity' functors. In general, these rules +-- improve performance. The sole exception is that when using +-- 'Identity', deleting a key that is already absent takes longer +-- than it would without the rules. If you expect this to occur +-- a very large fraction of the time, you might consider using a +-- private copy of the 'Identity' type. +-- +-- Note: Unlike @Data.IntMap.alterF@ for 'IntMap', 'alterF' is /not/ a flipped +-- version of the 'Control.Lens.At.at' combinator from "Control.Lens.At". +-- However, it match the shape expected from most functions expecting +-- lenses, getters, and setters, so can be thought of as a "psuedo-lens", +-- with virtually the same practical applications as a legitimate lens. +alterF :: + Functor f => + (Maybe a -> f (Maybe a)) -> + Key -> + NEIntMap a -> + f (IntMap a) +alterF f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> flip (maybe id (insertMinMap k)) (toMap n) <$> f Nothing + EQ -> flip (maybe id (insertMinMap k0)) m <$> f (Just v) + GT -> insertMinMap k0 v <$> M.alterF f k m +{-# INLINEABLE [2] alterF #-} + +-- if f ~ Const b, it's a lookup +{-# RULES +"alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)). + alterF f k = + Const . getConst . f . lookup k + #-} + +-- if f ~ Identity, it's an 'alter' +{-# RULES +"alterF/Identity" forall k (f :: Maybe a -> Identity (Maybe a)). + alterF f k = + Identity . alter (runIdentity . f) k + #-} + +-- | /O(log n)/. Variant of 'alter' that disallows deletion. Allows us to +-- guarantee that the result is also a non-empty IntMap. +alter' :: + (Maybe a -> a) -> + Key -> + NEIntMap a -> + NEIntMap a +alter' f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> NEIntMap k (f Nothing) . toMap $ n + EQ -> NEIntMap k0 (f (Just v)) m + GT -> NEIntMap k0 v . M.alter (Just . f) k $ m +{-# INLINE alter' #-} + +-- | /O(log n)/. Variant of 'alterF' that disallows deletion. Allows us to +-- guarantee that the result is also a non-empty IntMap. +-- +-- Like @Data.IntMap.alterF@ for 'IntMap', can be used to generalize and unify +-- 'lookup' and 'insert'. However, because it disallows deletion, it +-- cannot be used to implement 'delete'. +-- +-- See 'alterF' for usage information and caveats. +-- +-- Note: Neither 'alterF' nor 'alterF'' can be considered flipped versions +-- of the 'Control.Lens.At.at' combinator from "Control.Lens.At". However, +-- this can match the shape expected from most functions expecting lenses, +-- getters, and setters, so can be thought of as a "psuedo-lens", with +-- virtually the same practical applications as a legitimate lens. +-- +-- __WARNING__: The rewrite rule for 'Identity' exposes an inconsistency in +-- undefined behavior for "Data.IntMap". @Data.IntMap.alterF@ will actually +-- /maintain/ the original key in the map when used with 'Identity'; +-- however, @Data.IntMap.insertWith@ will /replace/ the orginal key in the +-- map. The rewrite rule for 'alterF'' has chosen to be faithful to +-- @Data.IntMap.insertWith@, and /not/ @Data.IntMap.alterF@, for the sake of +-- a cleaner implementation. +alterF' :: + Functor f => + (Maybe a -> f a) -> + Key -> + NEIntMap a -> + f (NEIntMap a) +alterF' f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> flip (NEIntMap k) (toMap n) <$> f Nothing + EQ -> flip (NEIntMap k0) m <$> f (Just v) + GT -> NEIntMap k0 v <$> M.alterF (fmap Just . f) k m +{-# INLINEABLE [2] alterF' #-} + +-- if f ~ Const b, it's a lookup +{-# RULES +"alterF'/Const" forall k (f :: Maybe a -> Const b a). + alterF' f k = + Const . getConst . f . lookup k + #-} + +-- if f ~ Identity, it's an insertWith +{-# RULES +"alterF'/Identity" forall k (f :: Maybe a -> Identity a). + alterF' f k = + Identity . insertWith (\_ -> runIdentity . f . Just) k (runIdentity (f Nothing)) + #-} + +-- | /O(log n)/. Lookup the value at a key in the map. +-- +-- The function will return the corresponding value as @('Just' value)@, +-- or 'Nothing' if the key isn't in the map. +-- +-- An example of using @lookup@: +-- +-- > import Prelude hiding (lookup) +-- > import Data.Map.NonEmpty +-- > +-- > employeeDept = fromList (("John","Sales") :| [("Bob","IT")]) +-- > deptCountry = fromList (("IT","USA") :| [("Sales","France")]) +-- > countryCurrency = fromList (("USA", "Dollar") :| [("France", "Euro")]) +-- > +-- > employeeCurrency :: String -> Maybe String +-- > employeeCurrency name = do +-- > dept <- lookup name employeeDept +-- > country <- lookup dept deptCountry +-- > lookup country countryCurrency +-- > +-- > main = do +-- > putStrLn $ "John's currency: " ++ (show (employeeCurrency "John")) +-- > putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete")) +-- +-- The output of this program: +-- +-- > John's currency: Just "Euro" +-- > Pete's currency: Nothing +lookup :: + Key -> + NEIntMap a -> + Maybe a +lookup k (NEIntMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Just v + GT -> M.lookup k m +{-# INLINE lookup #-} + +-- | /O(log n)/. Find the value at a key. Returns 'Nothing' when the +-- element can not be found. +-- +-- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 1 == Nothing +-- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 5 == Just 'a' +(!?) :: NEIntMap a -> Key -> Maybe a +(!?) = flip lookup +{-# INLINE (!?) #-} + +-- | /O(log n)/. Find the value at a key. Calls 'error' when the element +-- can not be found. +-- +-- > fromList ((5,'a') :| [(3,'b')]) ! 1 Error: element not in the map +-- > fromList ((5,'a') :| [(3,'b')]) ! 5 == 'a' +(!) :: NEIntMap a -> Key -> a +(!) m k = fromMaybe e $ m !? k + where + e = error "NEIntMap.!: given key is not an element in the map" +{-# INLINE (!) #-} + +infixl 9 !? +infixl 9 ! + +-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns +-- the value at key @k@ or returns default value @def@ +-- when the key is not in the map. +-- +-- > findWithDefault 'x' 1 (fromList ((5,'a') :| [(3,'b')])) == 'x' +-- > findWithDefault 'x' 5 (fromList ((5,'a') :| [(3,'b')])) == 'a' +findWithDefault :: + a -> + Key -> + NEIntMap a -> + a +findWithDefault def k (NEIntMap k0 v m) = case compare k k0 of + LT -> def + EQ -> v + GT -> M.findWithDefault def k m +{-# INLINE findWithDefault #-} + +-- | /O(log n)/. Is the key a member of the map? See also 'notMember'. +-- +-- > member 5 (fromList ((5,'a') :| [(3,'b')])) == True +-- > member 1 (fromList ((5,'a') :| [(3,'b')])) == False +member :: Key -> NEIntMap a -> Bool +member k (NEIntMap k0 _ m) = case compare k k0 of + LT -> False + EQ -> True + GT -> M.member k m +{-# INLINE member #-} + +-- | /O(log n)/. Is the key not a member of the map? See also 'member'. +-- +-- > notMember 5 (fromList ((5,'a') :| [(3,'b')])) == False +-- > notMember 1 (fromList ((5,'a') :| [(3,'b')])) == True +notMember :: Key -> NEIntMap a -> Bool +notMember k (NEIntMap k0 _ m) = case compare k k0 of + LT -> True + EQ -> False + GT -> M.notMember k m +{-# INLINE notMember #-} + +-- | /O(log n)/. Find largest key smaller than the given one and return the +-- corresponding (key, value) pair. +-- +-- > lookupLT 3 (fromList ((3,'a') :| [(5,'b')])) == Nothing +-- > lookupLT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +lookupLT :: Key -> NEIntMap a -> Maybe (Key, a) +lookupLT k (NEIntMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Nothing + GT -> M.lookupLT k m <|> Just (k0, v) +{-# INLINE lookupLT #-} + +-- | /O(log n)/. Find smallest key greater than the given one and return the +-- corresponding (key, value) pair. +-- +-- > lookupGT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +-- > lookupGT 5 (fromList ((3,'a') :| [(5,'b')])) == Nothing +lookupGT :: Key -> NEIntMap a -> Maybe (Key, a) +lookupGT k (NEIntMap k0 v m) = case compare k k0 of + LT -> Just (k0, v) + EQ -> M.lookupMin m + GT -> M.lookupGT k m +{-# INLINE lookupGT #-} + +-- | /O(log n)/. Find largest key smaller or equal to the given one and return +-- the corresponding (key, value) pair. +-- +-- > lookupLE 2 (fromList ((3,'a') :| [(5,'b')])) == Nothing +-- > lookupLE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +-- > lookupLE 5 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +lookupLE :: Key -> NEIntMap a -> Maybe (Key, a) +lookupLE k (NEIntMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Just (k0, v) + GT -> M.lookupLE k m <|> Just (k0, v) +{-# INLINE lookupLE #-} + +-- | /O(log n)/. Find smallest key greater or equal to the given one and return +-- the corresponding (key, value) pair. +-- +-- > lookupGE 3 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +-- > lookupGE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +-- > lookupGE 6 (fromList ((3,'a') :| [(5,'b')])) == Nothing +lookupGE :: Key -> NEIntMap a -> Maybe (Key, a) +lookupGE k (NEIntMap k0 v m) = case compare k k0 of + LT -> Just (k0, v) + EQ -> Just (k0, v) + GT -> M.lookupGE k m +{-# INLINE lookupGE #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union with a combining function. +-- +-- > unionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "aA"), (7, "C")]) +unionWith :: + (a -> a -> a) -> + NEIntMap a -> + NEIntMap a -> + NEIntMap a +unionWith f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + LT -> NEIntMap k1 v1 . M.unionWith f m1 . toMap $ n2 + EQ -> NEIntMap k1 (f v1 v2) . M.unionWith f m1 $ m2 + GT -> NEIntMap k2 v2 . M.unionWith f (toMap n1) $ m2 +{-# INLINE unionWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a possibly-empty +-- 'IntMap' and a non-empty map. +-- +-- @since 0.3.6.0 +unionMapLeft :: IntMap a -> NEIntMap a -> NEIntMap a +unionMapLeft m n = withNonEmpty n (`union` n) m +{-# INLINE unionMapLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a non-empty map and a +-- possibly-empty 'IntMap'. +-- +-- @since 0.3.6.0 +unionMapRight :: NEIntMap a -> IntMap a -> NEIntMap a +unionMapRight n = withNonEmpty n (union n) +{-# INLINE unionMapRight #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'IntMap' and a +-- non-empty map with a combining function. +-- +-- @since 0.3.6.0 +unionMapWithLeft :: (a -> a -> a) -> IntMap a -> NEIntMap a -> NEIntMap a +unionMapWithLeft f m n = withNonEmpty n (\m' -> unionWith f m' n) m +{-# INLINE unionMapWithLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a +-- possibly-empty 'IntMap' with a combining function. +-- +-- @since 0.3.6.0 +unionMapWithRight :: (a -> a -> a) -> NEIntMap a -> IntMap a -> NEIntMap a +unionMapWithRight f n = withNonEmpty n (unionWith f n) +{-# INLINE unionMapWithRight #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- Union with a combining function, given the matching key. +-- +-- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value +-- > unionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "5:a|A"), (7, "C")]) +unionWithKey :: + (Key -> a -> a -> a) -> + NEIntMap a -> + NEIntMap a -> + NEIntMap a +unionWithKey f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + LT -> NEIntMap k1 v1 . M.unionWithKey f m1 . toMap $ n2 + EQ -> NEIntMap k1 (f k1 v1 v2) . M.unionWithKey f m1 $ m2 + GT -> NEIntMap k2 v2 . M.unionWithKey f (toMap n1) $ m2 +{-# INLINE unionWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'IntMap' and a +-- non-empty map with a combining function, given the matching key. +-- +-- @since 0.3.6.0 +unionMapWithKeyLeft :: + (Key -> a -> a -> a) -> + IntMap a -> + NEIntMap a -> + NEIntMap a +unionMapWithKeyLeft f m n = withNonEmpty n (\m' -> unionWithKey f m' n) m +{-# INLINE unionMapWithKeyLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a +-- possibly-empty 'IntMap' with a combining function, given the matching key. +-- +-- @since 0.3.6.0 +unionMapWithKeyRight :: + (Key -> a -> a -> a) -> + NEIntMap a -> + IntMap a -> + NEIntMap a +unionMapWithKeyRight f n = withNonEmpty n (unionWithKey f n) +{-# INLINE unionMapWithKeyRight #-} + +-- | The union of a non-empty list of maps, with a combining operation: +-- (@'unionsWith' f == 'Data.Foldable.foldl1' ('unionWith' f)@). +-- +-- > unionsWith (++) (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) +-- > == fromList ((3, "bB3") :| [(5, "aAA3"), (7, "C")]) +unionsWith :: + Foldable1 f => + (a -> a -> a) -> + f (NEIntMap a) -> + NEIntMap a +unionsWith f (F1.toNonEmpty -> (m :| ms)) = F.foldl' (unionWith f) m ms +{-# INLINE unionsWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Difference of two maps. +-- Return elements of the first map not existing in the second map. +-- +-- Returns a potentially empty map ('IntMap'), in case the first map is +-- a subset of the second map. +-- +-- > difference (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 3 "b" +difference :: + NEIntMap a -> + NEIntMap b -> + IntMap a +difference n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 _ m2) = case compare k1 k2 of + -- k1 is not in n2, so cannot be deleted + LT -> insertMinMap k1 v1 $ m1 `M.difference` toMap n2 + -- k2 deletes k1, and only k1 + EQ -> m1 `M.difference` m2 + -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. + GT -> toMap n1 `M.difference` m2 +{-# INLINE difference #-} + +-- | Same as 'difference'. +(\\) :: + NEIntMap a -> + NEIntMap b -> + IntMap a +(\\) = difference +{-# INLINE (\\) #-} + +-- | /O(n+m)/. Difference with a combining function. +-- When two equal keys are +-- encountered, the combining function is applied to the values of these keys. +-- If it returns 'Nothing', the element is discarded (proper set difference). If +-- it returns (@'Just' y@), the element is updated with a new value @y@. +-- +-- Returns a potentially empty map ('IntMap'), in case the first map is +-- a subset of the second map and the function returns 'Nothing' for every +-- pair. +-- +-- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing +-- > differenceWith f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (7, "C")])) +-- > == Data.IntMap.singleton 3 "b:B" +differenceWith :: + (a -> b -> Maybe a) -> + NEIntMap a -> + NEIntMap b -> + IntMap a +differenceWith f = differenceWithKey (const f) +{-# INLINE differenceWith #-} + +-- | /O(n+m)/. Difference with a combining function. When two equal keys are +-- encountered, the combining function is applied to the key and both values. +-- If it returns 'Nothing', the element is discarded (proper set difference). If +-- it returns (@'Just' y@), the element is updated with a new value @y@. +-- +-- Returns a potentially empty map ('IntMap'), in case the first map is +-- a subset of the second map and the function returns 'Nothing' for every +-- pair. +-- +-- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing +-- > differenceWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (10, "C")])) +-- > == Data.IntMap.singleton 3 "3:b|B" +differenceWithKey :: + (Key -> a -> b -> Maybe a) -> + NEIntMap a -> + NEIntMap b -> + IntMap a +differenceWithKey f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + -- k1 is not in n2, so cannot be deleted + LT -> insertMinMap k1 v1 $ M.differenceWithKey f m1 (toMap n2) + -- k2 deletes k1, and only k1 + EQ -> maybe id (insertMinMap k1) (f k1 v1 v2) (M.differenceWithKey f m1 m2) + -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. + GT -> M.differenceWithKey f (toMap n1) m2 +{-# INLINE differenceWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection of two maps. +-- Return data in the first map for the keys existing in both maps. +-- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). +-- +-- Returns a potentially empty map ('IntMap'), in case the two maps share no +-- keys in common. +-- +-- > intersection (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 5 "a" +intersection :: + NEIntMap a -> + NEIntMap b -> + IntMap a +intersection n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 _ m2) = case compare k1 k2 of + -- k1 is not in n2 + LT -> m1 `M.intersection` toMap n2 + -- k1 and k2 are a part of the result + EQ -> insertMinMap k1 v1 $ m1 `M.intersection` m2 + -- k2 is not in n1 + GT -> toMap n1 `M.intersection` m2 +{-# INLINE intersection #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. +-- +-- Returns a potentially empty map ('IntMap'), in case the two maps share no +-- keys in common. +-- +-- > intersectionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 5 "aA" +intersectionWith :: + (a -> b -> c) -> + NEIntMap a -> + NEIntMap b -> + IntMap c +intersectionWith f = intersectionWithKey (const f) +{-# INLINE intersectionWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. +-- +-- Returns a potentially empty map ('IntMap'), in case the two maps share no +-- keys in common. +-- +-- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar +-- > intersectionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 5 "5:a|A" +intersectionWithKey :: + (Key -> a -> b -> c) -> + NEIntMap a -> + NEIntMap b -> + IntMap c +intersectionWithKey f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + -- k1 is not in n2 + LT -> M.intersectionWithKey f m1 (toMap n2) + -- k1 and k2 are a part of the result + EQ -> insertMinMap k1 (f k1 v1 v2) $ M.intersectionWithKey f m1 m2 + -- k2 is not in n1 + GT -> M.intersectionWithKey f (toMap n1) m2 +{-# INLINE intersectionWithKey #-} + +-- | /O(n)/. IntMap a function over all values in the map. +-- +-- > let f key x = (show key) ++ ":" ++ x +-- > mapWithKey f (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "3:b") :| [(5, "5:a")]) +mapWithKey :: (Key -> a -> b) -> NEIntMap a -> NEIntMap b +mapWithKey f (NEIntMap k v m) = NEIntMap k (f k v) (M.mapWithKey f m) +{-# NOINLINE [1] mapWithKey #-} + +{-# RULES +"mapWithKey/mapWithKey" forall f g xs. + mapWithKey f (mapWithKey g xs) = + mapWithKey (\k a -> f k (g k a)) xs +"mapWithKey/map" forall f g xs. + mapWithKey f (map g xs) = + mapWithKey (\k a -> f k (g a)) xs +"map/mapWithKey" forall f g xs. + map f (mapWithKey g xs) = + mapWithKey (\k a -> f (g k a)) xs + #-} + +-- | /O(n)/. The function 'mapAccum' threads an accumulating argument +-- through the map in ascending order of keys. +-- +-- > let f a b = (a ++ b, b ++ "X") +-- > mapAccum f "Everything: " (fromList ((5,"a") :| [(3,"b")])) == ("Everything: ba", fromList ((3, "bX") :| [(5, "aX")])) +mapAccum :: + (a -> b -> (a, c)) -> + a -> + NEIntMap b -> + (a, NEIntMap c) +mapAccum f = mapAccumWithKey (\x _ -> f x) +{-# INLINE mapAccum #-} + +-- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating +-- argument through the map in ascending order of keys. +-- +-- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X") +-- > mapAccumWithKey f "Everything:" (fromList ((5,"a") :| [(3,"b")])) == ("Everything: 3-b 5-a", fromList ((3, "bX") :| [(5, "aX")])) +mapAccumWithKey :: + (a -> Key -> b -> (a, c)) -> + a -> + NEIntMap b -> + (a, NEIntMap c) +mapAccumWithKey f z0 (NEIntMap k v m) = (z2, NEIntMap k v' m') + where + ~(z1, v') = f z0 k v + ~(z2, m') = M.mapAccumWithKey f z1 m +{-# INLINE mapAccumWithKey #-} + +-- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating +-- argument through the map in descending order of keys. +mapAccumRWithKey :: + (a -> Key -> b -> (a, c)) -> + a -> + NEIntMap b -> + (a, NEIntMap c) +mapAccumRWithKey f z0 (NEIntMap k v m) = (z2, NEIntMap k v' m') + where + ~(z1, m') = M.mapAccumRWithKey f z0 m + ~(z2, v') = f z1 k v +{-# INLINE mapAccumRWithKey #-} + +-- | /O(n*log n)/. +-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. +-- +-- The size of the result may be smaller if @f@ maps two or more distinct +-- keys to the same new key. In this case the value at the greatest of the +-- original keys is retained. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeys (+ 1) (fromList ((5,"a") :| [(3,"b")])) == fromList ((4, "b") :| [(6, "a")]) +-- > mapKeys (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "c" +-- > mapKeys (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "c" +mapKeys :: + (Key -> Key) -> + NEIntMap a -> + NEIntMap a +mapKeys f (NEIntMap k0 v0 m) = + fromListWith const + . ((f k0, v0) :|) + . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] + $ m +{-# INLINEABLE mapKeys #-} + +-- | /O(n*log n)/. +-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. +-- +-- The size of the result may be smaller if @f@ maps two or more distinct +-- keys to the same new key. In this case the associated values will be +-- combined using @c@. The value at the greater of the two original keys +-- is used as the first argument to @c@. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeysWith (++) (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "cdab" +-- > mapKeysWith (++) (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "cdab" +mapKeysWith :: + (a -> a -> a) -> + (Key -> Key) -> + NEIntMap a -> + NEIntMap a +mapKeysWith c f (NEIntMap k0 v0 m) = + fromListWith c + . ((f k0, v0) :|) + . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] + $ m +{-# INLINEABLE mapKeysWith #-} + +-- | /O(n)/. +-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ +-- is strictly monotonic. +-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. +-- /The precondition is not checked./ +-- Semi-formally, we have: +-- +-- > and [x < y ==> f x < f y | x <- ls, y <- ls] +-- > ==> mapKeysMonotonic f s == mapKeys f s +-- > where ls = keys s +-- +-- This means that @f@ maps distinct original keys to distinct resulting keys. +-- This function has better performance than 'mapKeys'. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")])) == fromList ((6, "b") :| [(10, "a")]) +-- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")]))) == True +-- > valid (mapKeysMonotonic (\ _ -> 1) (fromList ((5,"a") :| [(3,"b")]))) == False +mapKeysMonotonic :: + (Key -> Key) -> + NEIntMap a -> + NEIntMap a +mapKeysMonotonic f (NEIntMap k v m) = + NEIntMap (f k) v + . M.mapKeysMonotonic f + $ m +{-# INLINE mapKeysMonotonic #-} + +-- | /O(n)/. Fold the keys and values in the map using the given right-associative +-- binary operator, such that +-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. +-- +-- For example, +-- +-- > keysList map = foldrWithKey (\k x ks -> k:ks) [] map +foldrWithKey :: (Key -> a -> b -> b) -> b -> NEIntMap a -> b +foldrWithKey f z (NEIntMap k v m) = f k v . M.foldrWithKey f z $ m +{-# INLINE foldrWithKey #-} + +-- | /O(n)/. Fold the keys and values in the map using the given left-associative +-- binary operator, such that +-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@. +-- +-- For example, +-- +-- > keysList = reverse . foldlWithKey (\ks k x -> k:ks) [] +foldlWithKey :: (a -> Key -> b -> a) -> a -> NEIntMap b -> a +foldlWithKey f z (NEIntMap k v m) = M.foldlWithKey f (f z k v) m +{-# INLINE foldlWithKey #-} + +-- | /O(n)/. A strict version of 'foldr1'. Each application of the operator +-- is evaluated before using the result in the next application. This +-- function is strict in the starting value. +foldr1' :: (a -> a -> a) -> NEIntMap a -> a +foldr1' f (NEIntMap _ v m) = case M.maxView m of + Nothing -> v + Just (y, m') -> let !z = M.foldr' f y m' in v `f` z +{-# INLINE foldr1' #-} + +-- | /O(n)/. A strict version of 'foldl1'. Each application of the operator +-- is evaluated before using the result in the next application. This +-- function is strict in the starting value. +foldl1' :: (a -> a -> a) -> NEIntMap a -> a +foldl1' f (NEIntMap _ v m) = M.foldl' f v m +{-# INLINE foldl1' #-} + +-- | /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. +foldrWithKey' :: (Key -> a -> b -> b) -> b -> NEIntMap a -> b +foldrWithKey' f z (NEIntMap k v m) = f k v y + where + !y = M.foldrWithKey f z m +{-# INLINE foldrWithKey' #-} + +-- | /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. +foldlWithKey' :: (a -> Key -> b -> a) -> a -> NEIntMap b -> a +foldlWithKey' f z (NEIntMap k v m) = M.foldlWithKey' f x m + where + !x = f z k v +{-# INLINE foldlWithKey' #-} + +-- | /O(n)/. Return all keys of the map in ascending order. +-- +-- > keys (fromList ((5,"a") :| [(3,"b")])) == (3 :| [5]) +keys :: NEIntMap a -> NonEmpty Key +keys (NEIntMap k _ m) = k :| M.keys m +{-# INLINE keys #-} + +-- | /O(n)/. An alias for 'toAscList'. Return all key\/value pairs in the map +-- in ascending key order. +-- +-- > assocs (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +assocs :: NEIntMap a -> NonEmpty (Key, a) +assocs = toList +{-# INLINE assocs #-} + +-- | /O(n)/. The non-empty set of all keys of the map. +-- +-- > keysSet (fromList ((5,"a") :| [(3,"b")])) == Data.Set.NonEmpty.fromList (3 :| [5]) +keysSet :: NEIntMap a -> NEIntSet +keysSet (NEIntMap k _ m) = NEIntSet k (M.keysSet m) +{-# INLINE keysSet #-} + +-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys are +-- in ascending order. +-- +-- > toAscList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +toAscList :: NEIntMap a -> NonEmpty (Key, a) +toAscList = toList +{-# INLINE toAscList #-} + +-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys +-- are in descending order. +-- +-- > toDescList (fromList ((5,"a") :| [(3,"b")])) == ((5,"a") :| [(3,"b")]) +toDescList :: NEIntMap a -> NonEmpty (Key, a) +toDescList (NEIntMap k0 v0 m) = M.foldlWithKey' go ((k0, v0) :| []) m + where + go xs k v = (k, v) NE.<| xs +{-# INLINE toDescList #-} + +-- | /O(n)/. Filter all values that satisfy the predicate. +-- +-- Returns a potentially empty map ('IntMap'), because we could +-- potentailly filter out all items in the original 'NEIntMap'. +-- +-- > filter (> "a") (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" +-- > filter (> "x") (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.empty +-- > filter (< "a") (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.empty +filter :: + (a -> Bool) -> + NEIntMap a -> + IntMap a +filter f (NEIntMap k v m) + | f v = insertMinMap k v . M.filter f $ m + | otherwise = M.filter f m +{-# INLINE filter #-} + +-- | /O(n)/. Filter all keys\/values that satisfy the predicate. +-- +-- Returns a potentially empty map ('IntMap'), because we could +-- potentailly filter out all items in the original 'NEIntMap'. +-- +-- > filterWithKey (\k _ -> k > 4) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +filterWithKey :: + (Key -> a -> Bool) -> + NEIntMap a -> + IntMap a +filterWithKey f (NEIntMap k v m) + | f k v = insertMinMap k v . M.filterWithKey f $ m + | otherwise = M.filterWithKey f m +{-# INLINE filterWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Restrict an 'NEIntMap' to only those keys +-- found in a 'Data.Set.Set'. +-- +-- @ +-- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m +-- m \`restrictKeys\` s = m ``intersection`` 'fromSet' (const ()) s +-- @ +restrictKeys :: + NEIntMap a -> + IntSet -> + IntMap a +restrictKeys n@(NEIntMap k v m) xs = case S.minView xs of + Nothing -> M.empty + Just (y, ys) -> case compare k y of + -- k is not in xs + LT -> m `M.restrictKeys` xs + -- k and y are a part of the result + EQ -> insertMinMap k v $ m `M.restrictKeys` ys + -- y is not in m + GT -> toMap n `M.restrictKeys` ys +{-# INLINE restrictKeys #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Data.Set.Set' from +-- an 'NEIntMap'. +-- +-- @ +-- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m +-- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s +-- @ +withoutKeys :: + NEIntMap a -> + IntSet -> + IntMap a +withoutKeys n@(NEIntMap k v m) xs = case S.minView xs of + Nothing -> toMap n + Just (y, ys) -> case compare k y of + -- k is not in xs, so cannot be deleted + LT -> insertMinMap k v $ m `M.withoutKeys` xs + -- y deletes k, and only k + EQ -> m `M.withoutKeys` ys + -- y is not in n, so cannot delete anything, so we can just difference n and ys + GT -> toMap n `M.withoutKeys` ys +{-# INLINE withoutKeys #-} + +-- | /O(n)/. Partition the map according to a predicate. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate was true for all items. +-- * @'That' n2@ means that the predicate was false for all items. +-- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the +-- predicate) and @n2@ (all of the items that were false for the +-- predicate). +-- +-- See also 'split'. +-- +-- > partition (> "a") (fromList ((5,"a") :| [(3,"b")])) == These (singleton 3 "b") (singleton 5 "a") +-- > partition (< "x") (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) +-- > partition (> "x") (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) +partition :: + (a -> Bool) -> + NEIntMap a -> + These (NEIntMap a) (NEIntMap a) +partition f = partitionWithKey (const f) +{-# INLINE partition #-} + +-- | /O(n)/. Partition the map according to a predicate. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate was true for all items, +-- returning the original map. +-- * @'That' n2@ means that the predicate was false for all items, +-- returning the original map. +-- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the +-- predicate) and @n2@ (all of the items that were false for the +-- predicate). +-- +-- See also 'split'. +-- +-- > partitionWithKey (\ k _ -> k > 3) (fromList ((5,"a") :| [(3,"b")])) == These (singleton 5 "a") (singleton 3 "b") +-- > partitionWithKey (\ k _ -> k < 7) (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) +-- > partitionWithKey (\ k _ -> k > 7) (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) +partitionWithKey :: + (Key -> a -> Bool) -> + NEIntMap a -> + These (NEIntMap a) (NEIntMap a) +partitionWithKey f n@(NEIntMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) + | f k v -> This n + | otherwise -> That n + (Just n1, Nothing) + | f k v -> This n + | otherwise -> These n1 (singleton k v) + (Nothing, Just n2) + | f k v -> These (singleton k v) n2 + | otherwise -> That n + (Just n1, Just n2) + | f k v -> These (insertMapMin k v m1) n2 + | otherwise -> These n1 (insertMapMin k v m2) + where + (m1, m2) = M.partitionWithKey f m0 +{-# INLINEABLE partitionWithKey #-} + +-- | /O(n)/. Map values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('IntMap'), because the function could +-- potentially return 'Nothing' on all items in the 'NEIntMap'. +-- +-- > let f x = if x == "a" then Just "new a" else Nothing +-- > mapMaybe f (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "new a" +mapMaybe :: + (a -> Maybe b) -> + NEIntMap a -> + IntMap b +mapMaybe f = mapMaybeWithKey (const f) +{-# INLINE mapMaybe #-} + +-- | /O(n)/. Map keys\/values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('IntMap'), because the function could +-- potentially return 'Nothing' on all items in the 'NEIntMap'. +-- +-- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing +-- > mapMaybeWithKey f (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "key : 3" +mapMaybeWithKey :: + (Key -> a -> Maybe b) -> + NEIntMap a -> + IntMap b +mapMaybeWithKey f (NEIntMap k v m) = maybe id (insertMinMap k) (f k v) (M.mapMaybeWithKey f m) +{-# INLINE mapMaybeWithKey #-} + +-- | /O(n)/. Map values and separate the 'Left' and 'Right' results. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the results were all 'Left'. +-- * @'That' n2@ means that the results were all 'Right'. +-- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- and @n2@ (the map where the results were 'Right') +-- +-- > let f a = if a < "c" then Left a else Right a +-- > mapEither f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == These (fromList ((3,"b") :| [(5,"a")])) (fromList ((1,"x") :| [(7,"z")])) +-- > +-- > mapEither (\ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == That (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +mapEither :: + (a -> Either b c) -> + NEIntMap a -> + These (NEIntMap b) (NEIntMap c) +mapEither f = mapEitherWithKey (const f) +{-# INLINE mapEither #-} + +-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the results were all 'Left'. +-- * @'That' n2@ means that the results were all 'Right'. +-- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- and @n2@ (the map where the results were 'Right') +-- +-- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) +-- > mapEitherWithKey f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == These (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) +-- > +-- > mapEitherWithKey (\_ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == That (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) +mapEitherWithKey :: + (Key -> a -> Either b c) -> + NEIntMap a -> + These (NEIntMap b) (NEIntMap c) +mapEitherWithKey f (NEIntMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> case f k v of + Left v' -> This (singleton k v') + Right v' -> That (singleton k v') + (Just n1, Nothing) -> case f k v of + Left v' -> This (insertMapMin k v' m1) + Right v' -> These n1 (singleton k v') + (Nothing, Just n2) -> case f k v of + Left v' -> These (singleton k v') n2 + Right v' -> That (insertMapMin k v' m2) + (Just n1, Just n2) -> case f k v of + Left v' -> These (insertMapMin k v' m1) n2 + Right v' -> These n1 (insertMapMin k v' m2) + where + (m1, m2) = M.mapEitherWithKey f m0 +{-# INLINEABLE mapEitherWithKey #-} + +-- | /O(log n)/. The expression (@'split' k map@) is potentially a 'These' +-- containing up to two 'NEIntMap's based on splitting the map into maps +-- containing items before and after the given key @k@. It will never +-- return a map that contains @k@ itself. +-- +-- * 'Nothing' means that @k@ was the only key in the the original map, +-- and so there are no items before or after it. +-- * @'Just' ('This' n1)@ means @k@ was larger than or equal to all items +-- in the map, and @n1@ is the entire original map (minus @k@, if it was +-- present) +-- * @'Just' ('That' n2)@ means @k@ was smaller than or equal to all +-- items in the map, and @n2@ is the entire original map (minus @k@, if +-- it was present) +-- * @'Just' ('These' n1 n2)@ gives @n1@ (the map of all keys from the +-- original map less than @k@) and @n2@ (the map of all keys from the +-- original map greater than @k@) +-- +-- > split 2 (fromList ((5,"a") :| [(3,"b")])) == Just (That (fromList ((3,"b") :| [(5,"a")])) ) +-- > split 3 (fromList ((5,"a") :| [(3,"b")])) == Just (That (singleton 5 "a") ) +-- > split 4 (fromList ((5,"a") :| [(3,"b")])) == Just (These (singleton 3 "b") (singleton 5 "a")) +-- > split 5 (fromList ((5,"a") :| [(3,"b")])) == Just (This (singleton 3 "b") ) +-- > split 6 (fromList ((5,"a") :| [(3,"b")])) == Just (This (fromList ((3,"b") :| [(5,"a")])) ) +-- > split 5 (singleton 5 "a") == Nothing +split :: + Key -> + NEIntMap a -> + Maybe (These (NEIntMap a) (NEIntMap a)) +split k n@(NEIntMap k0 v m0) = case compare k k0 of + LT -> Just $ That n + EQ -> That <$> nonEmptyMap m0 + GT -> Just $ case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k0 v) + (Just _, Nothing) -> This (insertMapMin k0 v m1) + (Nothing, Just n2) -> These (singleton k0 v) n2 + (Just _, Just n2) -> These (insertMapMin k0 v m1) n2 + where + (m1, m2) = M.split k m0 +{-# INLINEABLE split #-} + +-- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just +-- like 'split' but also returns @'lookup' k map@, as the first field in +-- the 'These': +-- +-- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == That (That (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == These "b" (That (singleton 5 "a")) +-- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == That (These (singleton 3 "b") (singleton 5 "a")) +-- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == These "a" (This (singleton 3 "b")) +-- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == That (This (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 5 (singleton 5 "a") == This "a" +splitLookup :: + Key -> + NEIntMap a -> + These a (These (NEIntMap a) (NEIntMap a)) +splitLookup k n@(NEIntMap k0 v0 m0) = case compare k k0 of + LT -> That . That $ n + EQ -> maybe (This v0) (These v0 . That) . nonEmptyMap $ m0 + GT -> maybe That These v $ case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k0 v0) + (Just _, Nothing) -> This (insertMapMin k0 v0 m1) + (Nothing, Just n2) -> These (singleton k0 v0) n2 + (Just _, Just n2) -> These (insertMapMin k0 v0 m1) n2 + where + (m1, v, m2) = M.splitLookup k m0 +{-# INLINEABLE splitLookup #-} + +-- | /O(1)/. Decompose a map into pieces based on the structure of the +-- underlying tree. This function is useful for consuming a map in +-- parallel. +-- +-- No guarantee is made as to the sizes of the pieces; an internal, but +-- deterministic process determines this. However, it is guaranteed that +-- the pieces returned will be in ascending order (all elements in the +-- first submap less than all elements in the second, and so on). +-- +-- Note that the current implementation does not return more than four +-- submaps, but you should not depend on this behaviour because it can +-- change in the future without notice. +splitRoot :: + NEIntMap a -> + NonEmpty (NEIntMap a) +splitRoot (NEIntMap k v m) = + singleton k v + :| Maybe.mapMaybe nonEmptyMap (M.splitRoot m) +{-# INLINE splitRoot #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). +isSubmapOf :: Eq a => NEIntMap a -> NEIntMap a -> Bool +isSubmapOf = isSubmapOfBy (==) +{-# INLINE isSubmapOf #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if +-- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when +-- applied to their respective values. For example, the following +-- expressions are all 'True': +-- +-- > isSubmapOfBy (==) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (<=) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (fromList (('a',1) :| [('b',2)])) +-- +-- But the following are all 'False': +-- +-- > isSubmapOfBy (==) (singleton 'a' 2) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (<) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (singleton 'a' 1) +isSubmapOfBy :: + (a -> b -> Bool) -> + NEIntMap a -> + NEIntMap b -> + Bool +isSubmapOfBy f (NEIntMap k v m0) (toMap -> m1) = + kvSub + && M.isSubmapOfBy f m0 m1 + where + kvSub = case M.lookup k m1 of + Just v0 -> f v v0 + Nothing -> False +{-# INLINE isSubmapOfBy #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap +-- but not equal). Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' +-- (==)@). +isProperSubmapOf :: Eq a => NEIntMap a -> NEIntMap a -> Bool +isProperSubmapOf = isProperSubmapOfBy (==) +{-# INLINE isProperSubmapOf #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap +-- but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns +-- 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, +-- and when @f@ returns 'True' when applied to their respective values. For +-- example, the following expressions are all 'True': +-- +-- > isProperSubmapOfBy (==) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +-- > isProperSubmapOfBy (<=) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +-- +-- But the following are all 'False': +-- +-- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (fromList ((1,1) :| [(2,2)])) +-- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (singleton 1 1)) +-- > isProperSubmapOfBy (<) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +isProperSubmapOfBy :: + (a -> b -> Bool) -> + NEIntMap a -> + NEIntMap b -> + Bool +isProperSubmapOfBy f m1 m2 = + M.size (neimIntMap m1) < M.size (neimIntMap m2) + && isSubmapOfBy f m1 m2 +{-# INLINE isProperSubmapOfBy #-} + +-- | /O(1)/. The minimal key of the map. Note that this is total, making +-- 'Data.IntMap.lookupMin' obsolete. It is constant-time, so has better +-- asymptotics than @Data.IntMap.lookupMin@ and @Data.IntMap.findMin@, as well. +-- +-- > findMin (fromList ((5,"a") :| [(3,"b")])) == (3,"b") +findMin :: NEIntMap a -> (Key, a) +findMin (NEIntMap k v _) = (k, v) +{-# INLINE findMin #-} + +-- | /O(log n)/. The maximal key of the map. Note that this is total, making +-- 'Data.IntMap.lookupMin' obsolete. +-- +-- > findMax (fromList ((5,"a") :| [(3,"b")])) == (5,"a") +findMax :: NEIntMap a -> (Key, a) +findMax (NEIntMap k v m) = fromMaybe (k, v) . M.lookupMax $ m +{-# INLINE findMax #-} + +-- | /O(1)/. Delete the minimal key. Returns a potentially empty map +-- ('IntMap'), because we might end up deleting the final key in a singleton +-- map. It is constant-time, so has better asymptotics than +-- 'Data.IntMap.deleteMin'. +-- +-- > deleteMin (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.IntMap.fromList [(5,"a"), (7,"c")] +-- > deleteMin (singleton 5 "a") == Data.IntMap.empty +deleteMin :: NEIntMap a -> IntMap a +deleteMin (NEIntMap _ _ m) = m +{-# INLINE deleteMin #-} + +-- | /O(log n)/. Delete the maximal key. Returns a potentially empty map +-- ('IntMap'), because we might end up deleting the final key in a singleton +-- map. +-- +-- > deleteMax (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.IntMap.fromList [(3,"b"), (5,"a")] +-- > deleteMax (singleton 5 "a") == Data.IntMap.empty +deleteMax :: NEIntMap a -> IntMap a +deleteMax (NEIntMap k v m) = case M.maxView m of + Nothing -> M.empty + Just (_, m') -> insertMinMap k v m' +{-# INLINE deleteMax #-} + +-- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the +-- minimal key. Returns a potentially empty map ('IntMap'), because we might +-- end up deleting the final key in the map if the function returns +-- 'Nothing'. See 'adjustMin' for a version that can guaruntee that we +-- return a non-empty map. +-- +-- > updateMin (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "Xb"), (5, "a")] +-- > updateMin (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +updateMin :: (a -> Maybe a) -> NEIntMap a -> IntMap a +updateMin f = updateMinWithKey (const f) +{-# INLINE updateMin #-} + +-- | /O(1)/. A version of 'updateMin' that disallows deletion, allowing us +-- to guarantee that the result is also non-empty. +adjustMin :: (a -> a) -> NEIntMap a -> NEIntMap a +adjustMin f = adjustMinWithKey (const f) +{-# INLINE adjustMin #-} + +-- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the +-- minimal key. Returns a potentially empty map ('IntMap'), because we might +-- end up deleting the final key in the map if the function returns +-- 'Nothing'. See 'adjustMinWithKey' for a version that guaruntees +-- a non-empty map. +-- +-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3,"3:b"), (5,"a")] +-- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +updateMinWithKey :: (Key -> a -> Maybe a) -> NEIntMap a -> IntMap a +updateMinWithKey f (NEIntMap k v m) = maybe id (insertMinMap k) (f k v) m +{-# INLINE updateMinWithKey #-} + +-- | /O(1)/. A version of 'adjustMaxWithKey' that disallows deletion, +-- allowing us to guarantee that the result is also non-empty. Note that +-- it also is able to have better asymptotics than 'updateMinWithKey' in +-- general. +adjustMinWithKey :: (Key -> a -> a) -> NEIntMap a -> NEIntMap a +adjustMinWithKey f (NEIntMap k v m) = NEIntMap k (f k v) m +{-# INLINE adjustMinWithKey #-} + +-- | /O(log n)/. Update the value at the maximal key. Returns +-- a potentially empty map ('IntMap'), because we might end up deleting the +-- final key in the map if the function returns 'Nothing'. See 'adjustMax' +-- for a version that can guarantee that we return a non-empty map. +-- +-- > updateMax (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "Xa")] +-- > updateMax (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" +updateMax :: (a -> Maybe a) -> NEIntMap a -> IntMap a +updateMax f = updateMaxWithKey (const f) +{-# INLINE updateMax #-} + +-- | /O(log n)/. A version of 'updateMax' that disallows deletion, allowing +-- us to guarantee that the result is also non-empty. +adjustMax :: (a -> a) -> NEIntMap a -> NEIntMap a +adjustMax f = adjustMaxWithKey (const f) +{-# INLINE adjustMax #-} + +-- | /O(log n)/. Update the value at the maximal key. Returns +-- a potentially empty map ('IntMap'), because we might end up deleting the +-- final key in the map if the function returns 'Nothing'. See +-- 'adjustMaxWithKey' for a version that guaruntees a non-empty map. +-- +-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3,"3:b"), (5,"a")] +-- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +updateMaxWithKey :: (Key -> a -> Maybe a) -> NEIntMap a -> IntMap a +updateMaxWithKey f (NEIntMap k v m) + | M.null m = maybe m (M.singleton k) $ f k v + | otherwise = + insertMinMap k v + . M.updateMaxWithKey f + $ m +{-# INLINE updateMaxWithKey #-} + +-- | /O(log n)/. A version of 'updateMaxWithKey' that disallows deletion, +-- allowing us to guarantee that the result is also non-empty. +adjustMaxWithKey :: (Key -> a -> a) -> NEIntMap a -> NEIntMap a +adjustMaxWithKey f (NEIntMap k0 v m) + | M.null m = NEIntMap k0 (f k0 v) m + | otherwise = + insertMapMin k0 v + . M.updateMaxWithKey (\k -> Just . f k) + $ m +{-# INLINE adjustMaxWithKey #-} + +-- | /O(1)/. Retrieves the value associated with minimal key of the +-- map, and the map stripped of that element. It is constant-time, so has +-- better asymptotics than @Data.IntMap.minView@ for 'IntMap'. +-- +-- Note that unlike @Data.IntMap.minView@ for 'IntMap', this cannot ever fail, +-- so doesn't need to return in a 'Maybe'. However, the result 'IntMap' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > minView (fromList ((5,"a") :| [(3,"b")])) == ("b", Data.IntMap.singleton 5 "a") +minView :: NEIntMap a -> (a, IntMap a) +minView = first snd . deleteFindMin +{-# INLINE minView #-} + +-- | /O(1)/. Delete and find the minimal key-value pair. It is +-- constant-time, so has better asymptotics that @Data.IntMap.minView@ for +-- 'IntMap'. +-- +-- Note that unlike @Data.IntMap.deleteFindMin@ for 'IntMap', this cannot ever +-- fail, and so is a total function. However, the result 'IntMap' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > deleteFindMin (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((3,"b"), Data.IntMap.fromList [(5,"a"), (10,"c")]) +deleteFindMin :: NEIntMap a -> ((Key, a), IntMap a) +deleteFindMin (NEIntMap k v m) = ((k, v), m) +{-# INLINE deleteFindMin #-} + +-- | /O(log n)/. Retrieves the value associated with maximal key of the +-- map, and the map stripped of that element. +-- +-- Note that unlike @Data.IntMap.maxView@ from 'IntMap', this cannot ever fail, +-- so doesn't need to return in a 'Maybe'. However, the result 'IntMap' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > maxView (fromList ((5,"a") :| [(3,"b")])) == ("a", Data.IntMap.singleton 3 "b") +maxView :: NEIntMap a -> (a, IntMap a) +maxView = first snd . deleteFindMax +{-# INLINE maxView #-} + +-- | /O(log n)/. Delete and find the minimal key-value pair. +-- +-- Note that unlike @Data.IntMap.deleteFindMax@ for 'IntMap', this cannot ever +-- fail, and so is a total function. However, the result 'IntMap' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > deleteFindMax (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((10,"c"), Data.IntMap.fromList [(3,"b"), (5,"a")]) +deleteFindMax :: NEIntMap a -> ((Key, a), IntMap a) +deleteFindMax (NEIntMap k v m) = + maybe ((k, v), M.empty) (second (insertMinMap k v)) + . M.maxViewWithKey + $ m +{-# INLINE deleteFindMax #-} + +-- --------------------------- +-- Combining functions +-- --------------------------- +-- +-- Code comes from "Data.Map.Internal" from containers, modified slightly +-- to work with NonEmpty +-- +-- Copyright : (c) Daan Leijen 2002 +-- (c) Andriy Palamarchuk 2008 + +combineEq :: NonEmpty (Key, b) -> NonEmpty (Key, b) +combineEq = \case + x :| [] -> x :| [] + x :| xx@(_ : _) -> go x xx + where + go z [] = z :| [] + go z@(kz, _) (x@(kx, xx) : xs') + | kx == kz = go (kx, xx) xs' + | otherwise = z NE.<| go x xs' + +combineEqWith :: + (Key -> b -> b -> b) -> + NonEmpty (Key, b) -> + NonEmpty (Key, b) +combineEqWith f = \case + x :| [] -> x :| [] + x :| xx@(_ : _) -> go x xx + where + go z [] = z :| [] + go z@(kz, zz) (x@(kx, xx) : xs') + | kx == kz = let yy = f kx xx zz in go (kx, yy) xs' + | otherwise = z NE.<| go x xs' diff --git a/src/Data/IntMap/NonEmpty/Lazy/Internal.hs b/src/Data/IntMap/NonEmpty/Lazy/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/IntMap/NonEmpty/Lazy/Internal.hs @@ -0,0 +1,739 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_HADDOCK not-home #-} + +-- | +-- Module : Data.IntMap.NonEmpty.Lazy.Internal +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- Unsafe internal-use functions used in the implementation of +-- "Data.IntMap.NonEmpty.Lazy". These functions can potentially be used to +-- break the abstraction of 'NEIntMap' and produce unsound maps, so be +-- wary! +module Data.IntMap.NonEmpty.Lazy.Internal ( + -- * Non-Empty IntMap type + NEIntMap (..), + Key, + singleton, + nonEmptyMap, + withNonEmpty, + fromList, + toList, + map, + insertWith, + union, + unions, + elems, + size, + toMap, + + -- * Folds + foldr, + foldr', + foldr1, + foldl, + foldl', + foldl1, + + -- * Traversals + traverseWithKey, + traverseWithKey1, + foldMapWithKey, + + -- * Unsafe IntMap Functions + insertMinMap, + insertMaxMap, + + -- * Debug + valid, +) where + +import Control.Applicative +import Control.Comonad +import Control.DeepSeq +import Control.Monad +import qualified Data.Aeson as A +import Data.Coerce +import Data.Data +import qualified Data.Foldable as F +import Data.Foldable.WithIndex (FoldableWithIndex (..)) +import Data.Function +import Data.Functor.Alt +import Data.Functor.Classes +import Data.Functor.Invariant +import Data.Functor.WithIndex (FunctorWithIndex (..)) +import qualified Data.IntMap as M +import Data.IntMap.Internal (IntMap (..), Key) +import qualified Data.List as L +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe +import Data.Semigroup +import Data.Semigroup.Foldable (Foldable1 (fold1)) +import qualified Data.Semigroup.Foldable as F1 +import Data.Semigroup.Traversable (Traversable1 (..)) +import Data.Traversable.WithIndex (TraversableWithIndex (..)) +import qualified GHC.Exts as Exts +import Text.Read +import Prelude hiding (Foldable (..), map) + +-- | A non-empty (by construction) map from integer keys to values @a@. At +-- least one key-value pair exists in an @'NEIntMap' v@ at all times. +-- +-- Functions that /take/ an 'NEIntMap' can safely operate on it with the +-- assumption that it has at least one key-value pair. +-- +-- Functions that /return/ an 'NEIntMap' provide an assurance that the result +-- has at least one key-value pair. +-- +-- "Data.IntMap.NonEmpty.Lazy" re-exports the API of "Data.IntMap.Lazy", faithfully +-- reproducing asymptotics, typeclass constraints, and semantics. +-- Functions that ensure that input and output maps are both non-empty +-- (like 'Data.IntMap.NonEmpty.Lazy.insert') return 'NEIntMap', but functions that +-- might potentially return an empty map (like 'Data.IntMap.NonEmpty.Lazy.delete') +-- return a 'IntMap' instead. +-- +-- You can directly construct an 'NEIntMap' with the API from +-- "Data.IntMap.NonEmpty.Lazy"; it's more or less the same as constructing a normal +-- 'IntMap', except you don't have access to 'Data.IntMap.empty'. There are also +-- a few ways to construct an 'NEIntMap' from a 'IntMap': +-- +-- 1. The 'nonEmptyMap' smart constructor will convert a @'IntMap' k a@ into +-- a @'Maybe' ('NEIntMap' k a)@, returning 'Nothing' if the original 'IntMap' +-- was empty. +-- 2. You can use the 'Data.IntMap.NonEmpty.insertIntMap' family of functions to +-- insert a value into a 'IntMap' to create a guaranteed 'NEIntMap'. +-- 3. You can use the 'Data.IntMap.NonEmpty.Lazy.IsNonEmpty' and +-- 'Data.IntMap.NonEmpty.Lazy.IsEmpty' patterns to "pattern match" on a 'IntMap' +-- to reveal it as either containing a 'NEIntMap' or an empty map. +-- 4. 'withNonEmpty' offers a continuation-based interface for +-- deconstructing a 'IntMap' and treating it as if it were an +-- 'NEIntMap'. +-- +-- You can convert an 'NEIntMap' into a 'IntMap' with 'toMap' or +-- 'Data.IntMap.NonEmpty.Lazy.IsNonEmpty', essentially "obscuring" the non-empty +-- property from the type. +data NEIntMap a + = NEIntMap + { neimK0 :: !Key + -- ^ invariant: must be smaller than smallest key in map + , neimV0 :: a + , neimIntMap :: !(IntMap a) + } + deriving (Typeable) + +instance Eq a => Eq (NEIntMap a) where + t1 == t2 = + M.size (neimIntMap t1) == M.size (neimIntMap t2) + && toList t1 == toList t2 + +instance Ord a => Ord (NEIntMap a) where + compare = compare `on` toList + (<) = (<) `on` toList + (>) = (>) `on` toList + (<=) = (<=) `on` toList + (>=) = (>=) `on` toList + +-- | @since 0.3.6.0 +instance FunctorWithIndex Int NEIntMap where + imap f (NEIntMap k v m) = NEIntMap k (f k v) (M.mapWithKey f m) + +-- | @since 0.3.6.0 +instance FoldableWithIndex Int NEIntMap where + ifoldMap = foldMapWithKey + +-- | @since 0.3.6.0 +instance TraversableWithIndex Int NEIntMap where + itraverse f (NEIntMap k v m) = + NEIntMap k + <$> f k v + <*> M.traverseWithKey f m + +-- | @since 0.3.6.0 +instance Exts.IsList (NEIntMap a) where + type Item (NEIntMap a) = (Key, a) + + fromList (a : as) = fromList (a :| as) + fromList [] = errorWithoutStackTrace "Data.IntMap.NonEmpty.fromList: empty list" + + toList = F.toList . toList + +instance Eq1 NEIntMap where + liftEq eq m1 m2 = + M.size (neimIntMap m1) == M.size (neimIntMap m2) + && liftEq (liftEq eq) (toList m1) (toList m2) + +instance Ord1 NEIntMap where + liftCompare cmp m n = + liftCompare (liftCompare cmp) (toList m) (toList n) + +instance Show1 NEIntMap where + liftShowsPrec sp sl d m = + showsUnaryWith (liftShowsPrec sp' sl') "fromList" d (toList m) + where + sp' = liftShowsPrec sp sl + sl' = liftShowList sp sl + +instance Read1 NEIntMap where + liftReadsPrec rp rl = + readsData $ + readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList + where + rp' = liftReadsPrec rp rl + rl' = liftReadList rp rl + +instance Read e => Read (NEIntMap e) where + readPrec = parens $ prec 10 $ do + Ident "fromList" <- lexP + xs <- parens . prec 10 $ readPrec + return (fromList xs) + readListPrec = readListPrecDefault + +instance Show a => Show (NEIntMap a) where + showsPrec d m = + showParen (d > 10) $ + showString "fromList (" . shows (toList m) . showString ")" + +instance NFData a => NFData (NEIntMap a) where + rnf (NEIntMap k v a) = rnf k `seq` rnf v `seq` rnf a + +-- Data instance code from Data.IntMap.Internal +-- +-- Copyright : (c) Daan Leijen 2002 +-- (c) Andriy Palamarchuk 2008 +-- (c) wren romano 2016 +#if MIN_VERSION_base(4,16,0) +instance Data a => Data (NEIntMap a) where + gfoldl f z im = z fromList `f` toList im + toConstr _ = fromListConstr + gunfold k z c = case constrIndex c of + 1 -> k (z fromList) + _ -> error "gunfold" + dataTypeOf _ = intMapDataType + dataCast1 = gcast1 +#else +#ifndef __HLINT__ +instance Data a => Data (NEIntMap a) where + gfoldl f z im = z fromList `f` toList im + toConstr _ = fromListConstr + gunfold k z c = case constrIndex c of + 1 -> k (z fromList) + _ -> error "gunfold" + dataTypeOf _ = intMapDataType + dataCast1 f = gcast1 f +#endif +#endif + +fromListConstr :: Constr +fromListConstr = mkConstr intMapDataType "fromList" [] Prefix + +intMapDataType :: DataType +intMapDataType = mkDataType "Data.IntMap.NonEmpty.Internal.NEIntMap" [fromListConstr] + +instance A.ToJSON a => A.ToJSON (NEIntMap a) where + toJSON = A.toJSON . toMap + toEncoding = A.toEncoding . toMap + +instance A.FromJSON a => A.FromJSON (NEIntMap a) where + parseJSON = + withNonEmpty (fail err) pure + <=< A.parseJSON + where + err = "NEIntMap: Non-empty map expected, but empty map found" + +-- | @since 0.3.4.4 +instance Alt NEIntMap where + () = union + +-- | /O(n)/. Fold the values in the map using the given right-associative +-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@. +-- +-- > elemsList map = foldr (:) [] map +-- +-- > let f a len = len + (length a) +-- > foldr f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4 +foldr :: (a -> b -> b) -> b -> NEIntMap a -> b +foldr f z (NEIntMap _ v m) = v `f` M.foldr f z m +{-# INLINE foldr #-} + +-- | /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. +foldr' :: (a -> b -> b) -> b -> NEIntMap a -> b +foldr' f z (NEIntMap _ v m) = v `f` y + where + !y = M.foldr' f z m +{-# INLINE foldr' #-} + +-- | /O(n)/. A version of 'foldr' that uses the value at the maximal key in +-- the map as the starting value. +-- +-- Note that, unlike 'Data.Foldable.foldr1' for 'IntMap', this function is +-- total if the input function is total. +foldr1 :: (a -> a -> a) -> NEIntMap a -> a +foldr1 f (NEIntMap _ v m) = + maybe v (f v . uncurry (M.foldr f)) + . M.maxView + $ m +{-# INLINE foldr1 #-} + +-- | /O(n)/. Fold the values in the map using the given left-associative +-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@. +-- +-- > elemsList = reverse . foldl (flip (:)) [] +-- +-- > let f len a = len + (length a) +-- > foldl f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4 +foldl :: (a -> b -> a) -> a -> NEIntMap b -> a +foldl f z (NEIntMap _ v m) = M.foldl f (f z v) m +{-# INLINE foldl #-} + +-- | /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. +foldl' :: (a -> b -> a) -> a -> NEIntMap b -> a +foldl' f z (NEIntMap _ v m) = M.foldl' f x m + where + !x = f z v +{-# INLINE foldl' #-} + +-- | /O(n)/. A version of 'foldl' that uses the value at the minimal key in +-- the map as the starting value. +-- +-- Note that, unlike 'Data.Foldable.foldl1' for 'IntMap', this function is +-- total if the input function is total. +foldl1 :: (a -> a -> a) -> NEIntMap a -> a +foldl1 f (NEIntMap _ v m) = M.foldl f v m +{-# INLINE foldl1 #-} + +-- | /O(n)/. Fold the keys and values in the map using the given semigroup, +-- such that +-- +-- @'foldMapWithKey' f = 'Data.Semigroup.Foldable.fold1' . 'Data.IntMap.NonEmpty.mapWithKey' f@ +-- +-- __WARNING__: Differs from @Data.IntMap.foldMapWithKey@, which traverses +-- positive items first, then negative items. +-- +-- This can be an asymptotically faster than +-- 'Data.IntMap.NonEmpty.foldrWithKey' or 'Data.IntMap.NonEmpty.foldlWithKey' for +-- some monoids. + +-- TODO: benchmark against maxView method +foldMapWithKey :: + Semigroup m => + (Key -> a -> m) -> + NEIntMap a -> + m +foldMapWithKey f = F1.foldMap1 (uncurry f) . toList +{-# INLINE foldMapWithKey #-} + +-- | /O(n)/. IntMap a function over all values in the map. +-- +-- > map (++ "x") (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "bx") :| [(5, "ax")]) +map :: (a -> b) -> NEIntMap a -> NEIntMap b +map f (NEIntMap k0 v m) = NEIntMap k0 (f v) (M.map f m) +{-# NOINLINE [1] map #-} + +{-# RULES +"map/map" forall f g xs. map f (map g xs) = map (f . g) xs + #-} +{-# RULES +"map/coerce" map coerce = coerce + #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and +-- @t2@. It prefers @t1@ when duplicate keys are encountered, i.e. +-- (@'union' == 'Data.IntMap.NonEmpty.unionWith' 'const'@). +-- +-- > union (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "a"), (7, "C")]) +union :: + NEIntMap a -> + NEIntMap a -> + NEIntMap a +union n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + LT -> NEIntMap k1 v1 . M.union m1 . toMap $ n2 + EQ -> NEIntMap k1 v1 . M.union m1 $ m2 + GT -> NEIntMap k2 v2 . M.union (toMap n1) $ m2 +{-# INLINE union #-} + +-- | The left-biased union of a non-empty list of maps. +-- +-- > unions (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) +-- > == fromList [(3, "b"), (5, "a"), (7, "C")] +-- > unions (fromList ((5, "A3") :| [(3, "B3")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "a") :| [(3, "b")])]) +-- > == fromList ((3, "B3") :| [(5, "A3"), (7, "C")]) +unions :: + Foldable1 f => + f (NEIntMap a) -> + NEIntMap a +unions (F1.toNonEmpty -> (m :| ms)) = F.foldl' union m ms +{-# INLINE unions #-} + +-- | /O(n)/. +-- Return all elements of the map in the ascending order of their keys. +-- +-- > elems (fromList ((5,"a") :| [(3,"b")])) == ("b" :| ["a"]) +elems :: NEIntMap a -> NonEmpty a +elems (NEIntMap _ v m) = v :| M.elems m +{-# INLINE elems #-} + +-- | /O(1)/. The number of elements in the map. Guaranteed to be greater +-- than zero. +-- +-- > size (singleton 1 'a') == 1 +-- > size (fromList ((1,'a') :| [(2,'c'), (3,'b')])) == 3 +size :: NEIntMap a -> Int +size (NEIntMap _ _ m) = 1 + M.size m +{-# INLINE size #-} + +-- | /O(log n)/. +-- Convert a non-empty map back into a normal possibly-empty map, for usage +-- with functions that expect 'IntMap'. +-- +-- Can be thought of as "obscuring" the non-emptiness of the map in its +-- type. See the 'Data.IntMap.NonEmpty.IsNotEmpty' pattern. +-- +-- 'nonEmptyMap' and @'maybe' 'Data.IntMap.empty' 'toMap'@ form an isomorphism: they +-- are perfect structure-preserving inverses of eachother. +-- +-- > toMap (fromList ((3,"a") :| [(5,"b")])) == Data.IntMap.fromList [(3,"a"), (5,"b")] +toMap :: NEIntMap a -> IntMap a +toMap (NEIntMap k v m) = insertMinMap k v m +{-# INLINE toMap #-} + +-- | /O(n)/. +-- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ +-- That is, behaves exactly like a regular 'traverse' except that the traversing +-- function also has access to the key associated with a value. +-- +-- /Use 'traverseWithKey1'/ whenever possible (if your 'Applicative' +-- also has 'Apply' instance). This version is provided only for types +-- that do not have 'Apply' instance, since 'Apply' is not at the moment +-- (and might not ever be) an official superclass of 'Applicative'. +-- +-- __WARNING__: Differs from @Data.IntMap.traverseWithKey@, which traverses +-- positive items first, then negative items. +-- +-- @ +-- 'traverseWithKey' f = 'unwrapApplicative' . 'traverseWithKey1' (\\k -> WrapApplicative . f k) +-- @ +traverseWithKey :: + Applicative t => + (Key -> a -> t b) -> + NEIntMap a -> + t (NEIntMap b) +traverseWithKey f (NEIntMap k v m0) = + NEIntMap k + <$> f k v + <*> M.traverseWithKey f m0 +{-# INLINE traverseWithKey #-} + +-- | /O(n)/. +-- @'traverseWithKey1' f m == 'fromList' <$> 'traverse1' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ +-- +-- That is, behaves exactly like a regular 'traverse1' except that the traversing +-- function also has access to the key associated with a value. +-- +-- __WARNING__: Differs from @Data.IntMap.traverseWithKey@, which traverses +-- positive items first, then negative items. +-- +-- Is more general than 'traverseWithKey', since works with all 'Apply', +-- and not just 'Applicative'. + +-- TODO: benchmark against maxView-based methods +traverseWithKey1 :: + Apply t => + (Key -> a -> t b) -> + NEIntMap a -> + t (NEIntMap b) +traverseWithKey1 f (NEIntMap k0 v m0) = case runMaybeApply m1 of + Left m2 -> NEIntMap k0 <$> f k0 v <.> m2 + Right m2 -> flip (NEIntMap k0) m2 <$> f k0 v + where + m1 = M.traverseWithKey (\k -> MaybeApply . Left . f k) m0 +{-# INLINEABLE traverseWithKey1 #-} + +-- | /O(n)/. Convert the map to a non-empty list of key\/value pairs. +-- +-- > toList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +toList :: NEIntMap a -> NonEmpty (Key, a) +toList (NEIntMap k v m) = (k, v) :| M.toList m +{-# INLINE toList #-} + +-- | /O(log n)/. Smart constructor for an 'NEIntMap' from a 'IntMap'. Returns +-- 'Nothing' if the 'IntMap' was originally actually empty, and @'Just' n@ +-- with an 'NEIntMap', if the 'IntMap' was not empty. +-- +-- 'nonEmptyMap' and @'maybe' 'Data.IntMap.empty' 'toMap'@ form an +-- isomorphism: they are perfect structure-preserving inverses of +-- eachother. +-- +-- See 'Data.IntMap.NonEmpty.IsNonEmpty' for a pattern synonym that lets you +-- "match on" the possiblity of a 'IntMap' being an 'NEIntMap'. +-- +-- > nonEmptyMap (Data.IntMap.fromList [(3,"a"), (5,"b")]) == Just (fromList ((3,"a") :| [(5,"b")])) +nonEmptyMap :: IntMap a -> Maybe (NEIntMap a) +nonEmptyMap = (fmap . uncurry . uncurry) NEIntMap . M.minViewWithKey +{-# INLINE nonEmptyMap #-} + +-- | /O(log n)/. A general continuation-based way to consume a 'IntMap' as if +-- it were an 'NEIntMap'. @'withNonEmpty' def f@ will take a 'IntMap'. If map is +-- empty, it will evaluate to @def@. Otherwise, a non-empty map 'NEIntMap' +-- will be fed to the function @f@ instead. +-- +-- @'nonEmptyMap' == 'withNonEmpty' 'Nothing' 'Just'@ +withNonEmpty :: + -- | value to return if map is empty + r -> + -- | function to apply if map is not empty + (NEIntMap a -> r) -> + IntMap a -> + r +withNonEmpty def f = maybe def f . nonEmptyMap +{-# INLINE withNonEmpty #-} + +-- | /O(n*log n)/. Build a non-empty map from a non-empty list of +-- key\/value pairs. See also 'Data.IntMap.NonEmpty.fromAscList'. If the list +-- contains more than one value for the same key, the last value for the +-- key is retained. +-- +-- > fromList ((5,"a") :| [(3,"b"), (5, "c")]) == fromList ((5,"c") :| [(3,"b")]) +-- > fromList ((5,"c") :| [(3,"b"), (5, "a")]) == fromList ((5,"a") :| [(3,"b")]) + +-- TODO: write manually and optimize to be equivalent to +-- 'fromDistinctAscList' if items are ordered, just like the actual +-- 'M.fromList'. +fromList :: NonEmpty (Key, a) -> NEIntMap a +fromList ((k, v) :| xs) = + withNonEmpty (singleton k v) (insertWith (const id) k v) + . M.fromList + $ xs +{-# INLINE fromList #-} + +-- | /O(1)/. A map with a single element. +-- +-- > singleton 1 'a' == fromList ((1, 'a') :| []) +-- > size (singleton 1 'a') == 1 +singleton :: Key -> a -> NEIntMap a +singleton k v = NEIntMap k v M.empty +{-# INLINE singleton #-} + +-- | /O(log n)/. Insert with a function, combining new value and old value. +-- @'insertWith' f key value mp@ will insert the pair (key, value) into +-- @mp@ if key does not exist in the map. If the key does exist, the +-- function will insert the pair @(key, f new_value old_value)@. +-- +-- See 'Data.IntMap.NonEmpty.insertIntMapWith' for a version where the first +-- argument is a 'IntMap'. +-- +-- > insertWith (++) 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "xxxa")]) +-- > insertWith (++) 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +insertWith :: + (a -> a -> a) -> + Key -> + a -> + NEIntMap a -> + NEIntMap a +insertWith f k v n@(NEIntMap k0 v0 m) = case compare k k0 of + LT -> NEIntMap k v . toMap $ n + EQ -> NEIntMap k (f v v0) m + GT -> NEIntMap k0 v0 $ M.insertWith f k v m +{-# INLINE insertWith #-} + +-- | Left-biased union +instance Semigroup (NEIntMap a) where + (<>) = union + {-# INLINE (<>) #-} + sconcat = unions + {-# INLINE sconcat #-} + +instance Functor NEIntMap where + fmap = map + {-# INLINE fmap #-} + x <$ NEIntMap k _ m = NEIntMap k x (x <$ m) + {-# INLINE (<$) #-} + +-- | @since 0.3.4.4 +instance Invariant NEIntMap where + invmap f _ = fmap f + {-# INLINE invmap #-} + +-- | Traverses elements in order of ascending keys. +-- +-- __WARNING:__ 'F.fold' and 'F.foldMap' are different than for the +-- 'IntMap' instance. They traverse elements in order of ascending keys, +-- while 'IntMap' traverses positive keys first, then negative keys. +-- +-- 'Data.Foldable.foldr1', 'Data.Foldable.foldl1', 'Data.Foldable.minimum', +-- 'Data.Foldable.maximum' are all total. +#if MIN_VERSION_base(4,11,0) +instance F.Foldable NEIntMap where + fold (NEIntMap _ v m) = v <> F.fold (M.elems m) + {-# INLINE fold #-} + foldMap f (NEIntMap _ v m) = f v <> F.foldMap f (M.elems m) + {-# INLINE foldMap #-} + foldr = foldr + {-# INLINE foldr #-} + foldr' = foldr' + {-# INLINE foldr' #-} + foldr1 = foldr1 + {-# INLINE foldr1 #-} + foldl = foldl + {-# INLINE foldl #-} + foldl' = foldl' + {-# INLINE foldl' #-} + foldl1 = foldl1 + {-# INLINE foldl1 #-} + null _ = False + {-# INLINE null #-} + length = size + {-# INLINE length #-} + elem x (NEIntMap _ v m) = F.elem x m + || x == v + {-# INLINE elem #-} + -- TODO: use build + toList = F.toList . elems + {-# INLINE toList #-} +#else +instance F.Foldable NEIntMap where + fold (NEIntMap _ v m) = v `mappend` F.fold (M.elems m) + {-# INLINE fold #-} + foldMap f (NEIntMap _ v m) = f v `mappend` F.foldMap f (M.elems m) + {-# INLINE foldMap #-} + foldr = foldr + {-# INLINE foldr #-} + foldr' = foldr' + {-# INLINE foldr' #-} + foldr1 = foldr1 + {-# INLINE foldr1 #-} + foldl = foldl + {-# INLINE foldl #-} + foldl' = foldl' + {-# INLINE foldl' #-} + foldl1 = foldl1 + {-# INLINE foldl1 #-} + null _ = False + {-# INLINE null #-} + length = size + {-# INLINE length #-} + elem x (NEIntMap _ v m) = F.elem x m + || x == v + {-# INLINE elem #-} + -- TODO: use build + toList = F.toList . elems + {-# INLINE toList #-} +#endif + +-- | Traverses elements in order of ascending keys +-- +-- __WARNING:__ Different than for the 'IntMap' instance. They traverse +-- elements in order of ascending keys, while 'IntMap' traverses positive +-- keys first, then negative keys. +instance Traversable NEIntMap where + traverse f = traverseWithKey (const f) + {-# INLINE traverse #-} + +-- | Traverses elements in order of ascending keys +-- +-- __WARNING:__ 'F1.fold1' and 'F1.foldMap1' are different than 'F.fold' and +-- 'F.foldMap' for the 'IntMap' instance of 'Foldable'. They traverse +-- elements in order of ascending keys, while 'IntMap' traverses positive +-- keys first, then negative keys. +#if MIN_VERSION_base(4,11,0) +instance Foldable1 NEIntMap where + fold1 (NEIntMap _ v m) = maybe v (v <>) + . F.foldMap Just + . M.elems + $ m + {-# INLINE fold1 #-} + foldMap1 f = foldMapWithKey (const f) + {-# INLINE foldMap1 #-} + toNonEmpty = elems + {-# INLINE toNonEmpty #-} +#else +instance Foldable1 NEIntMap where + fold1 (NEIntMap _ v m) = option v (v <>) + . F.foldMap (Option . Just) + . M.elems + $ m + {-# INLINE fold1 #-} + foldMap1 f = foldMapWithKey (const f) + {-# INLINE foldMap1 #-} + toNonEmpty = elems + {-# INLINE toNonEmpty #-} +#endif + +-- | Traverses elements in order of ascending keys +-- +-- __WARNING:__ 'traverse1' and 'sequence1' are different 'traverse' and +-- 'sequence' for the 'IntMap' instance of 'Traversable'. They traverse +-- elements in order of ascending keys, while 'IntMap' traverses positive +-- keys first, then negative keys. +instance Traversable1 NEIntMap where + traverse1 f = traverseWithKey1 (const f) + {-# INLINE traverse1 #-} + +-- | 'extract' gets the value at the minimal key, and 'duplicate' produces +-- a map of maps comprised of all keys from the original map greater than +-- or equal to the current key. +-- +-- @since 0.1.1.0 +instance Comonad NEIntMap where + extract = neimV0 + {-# INLINE extract #-} + + -- We'd like to use 'M.mapAccumWithKey', but it traverses things in the + -- wrong order. + duplicate n0@(NEIntMap k0 _ m0) = + NEIntMap k0 n0 + . M.fromDistinctAscList + . snd + . L.mapAccumL go m0 + . M.toList + $ m0 + where + go m (k, v) = (m', (k, NEIntMap k v m')) + where + !m' = M.deleteMin m + {-# INLINE duplicate #-} + +-- | /O(n)/. Test if the internal map structure is valid. +valid :: NEIntMap a -> Bool +valid (NEIntMap k _ m) = all ((k <) . fst . fst) (M.minViewWithKey m) + +-- | /O(log n)/. Insert new key and value into a map where keys are +-- /strictly greater than/ the new key. That is, the new key must be +-- /strictly less than/ all keys present in the 'IntMap'. /The precondition +-- is not checked./ +-- +-- At the moment this is simply an alias for @Data.IntSet.insert@, but it's +-- left here as a placeholder in case this eventually gets implemented in +-- a more efficient way. + +-- TODO: implementation +insertMinMap :: Key -> a -> IntMap a -> IntMap a +insertMinMap = M.insert +{-# INLINEABLE insertMinMap #-} + +-- | /O(log n)/. Insert new key and value into a map where keys are +-- /strictly less than/ the new key. That is, the new key must be +-- /strictly greater than/ all keys present in the 'IntMap'. /The +-- precondition is not checked./ +-- +-- At the moment this is simply an alias for @Data.IntSet.insert@, but it's +-- left here as a placeholder in case this eventually gets implemented in +-- a more efficient way. + +-- TODO: implementation +insertMaxMap :: Key -> a -> IntMap a -> IntMap a +insertMaxMap = M.insert +{-# INLINEABLE insertMaxMap #-} diff --git a/src/Data/IntMap/NonEmpty/Strict.hs b/src/Data/IntMap/NonEmpty/Strict.hs new file mode 100644 --- /dev/null +++ b/src/Data/IntMap/NonEmpty/Strict.hs @@ -0,0 +1,2072 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module : Data.IntMap.NonEmpty.Strict +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- = Non-Empty Finite Integer-Indexed Maps (strict interface) +-- +-- The @'NEIntMap' v@ type represents a non-empty finite map (sometimes +-- called a dictionary) from integer keys to values of type @v@. +-- An 'NEIntMap' is strict in its keys and values. +-- +-- See documentation for 'NEIntMap' for information on how to convert and +-- manipulate such non-empty maps. +-- +-- This module essentially re-imports the API of "Data.IntMap.Strict" and its +-- 'IntMap' type, along with semantics and asymptotics. In most +-- situations, asymptotics are different only by a constant factor. In +-- some situations, asmyptotics are even better (constant-time instead of +-- log-time). +-- +-- Because 'NEIntMap' is implemented using 'IntMap', all of the caveats of using +-- 'IntMap' apply (such as the limitation of the maximum size of maps). +-- +-- All functions take non-empty maps as inputs. In situations where their +-- results can be guarunteed to also be non-empty, they also return +-- non-empty maps. In situations where their results could potentially be +-- empty, 'IntMap' is returned instead. +-- +-- Some variants of functions (like 'alter'', 'alterF'', 'adjustMin', +-- 'adjustMax', 'adjustMinWithKey', 'adjustMaxWithKey') are provided in +-- a way restructured to preserve guaruntees of non-empty maps being +-- returned. +-- +-- Some functions (like 'mapEither', 'partition', 'split') +-- have modified return types to account for possible configurations of +-- non-emptiness. +-- +-- This module is intended to be imported qualified, to avoid name clashes with +-- "Prelude" and "Data.IntMap" functions: +-- +-- > import qualified Data.IntMap.NonEmpty.Strict as NEIM +-- +-- Note that all asmyptotics /O(f(n))/ in this module are actually +-- /O(min(W, f(n)))/, where @W@ is the number of bits in an 'Int' (32 or +-- 64). That is, if @f(n)@ is greater than @W@, all operations are +-- constant-time. +-- +-- Import "Data.IntMap.NonEmpty.Lazy" for a variant lazy in values. +module Data.IntMap.NonEmpty.Strict ( + -- * Non-Empty IntMap Type + NEIntMap, + Key, + + -- ** Conversions between empty and non-empty maps + pattern IsNonEmpty, + pattern IsEmpty, + nonEmptyMap, + toMap, + withNonEmpty, + insertMap, + insertMapWith, + insertMapWithKey, + insertMapMin, + insertMapMax, + unsafeFromMap, + + -- * Construction + singleton, + fromSet, + + -- ** From Unordered Lists + fromList, + fromListWith, + fromListWithKey, + + -- ** From Ascending Lists + fromAscList, + fromAscListWith, + fromAscListWithKey, + fromDistinctAscList, + + -- * Insertion + insert, + insertWith, + insertWithKey, + insertLookupWithKey, + + -- * Deletion\/Update + delete, + deleteMaybe, + adjust, + adjustWithKey, + update, + updateWithKey, + updateLookupWithKey, + alter, + alterF, + alter', + alterF', + + -- * Query + + -- ** Lookup + lookup, + (!?), + (!), + findWithDefault, + member, + notMember, + lookupLT, + lookupGT, + lookupLE, + lookupGE, + + -- ** Size + size, + + -- * Combine + + -- ** Union + union, + unionMapLeft, + unionMapRight, + unionWith, + unionMapWithLeft, + unionMapWithRight, + unionWithKey, + unionMapWithKeyLeft, + unionMapWithKeyRight, + unions, + unionsWith, + + -- ** Difference + difference, + (\\), + differenceWith, + differenceWithKey, + + -- ** Intersection + intersection, + intersectionWith, + intersectionWithKey, + -- -- ** Universal combining function + -- , mergeWithKey + + -- * Traversal + + -- ** Map + map, + mapWithKey, + traverseWithKey1, + traverseWithKey, + mapAccum, + mapAccumWithKey, + mapAccumRWithKey, + mapKeys, + mapKeysWith, + mapKeysMonotonic, + + -- * Folds + foldr, + foldl, + foldr1, + foldl1, + foldrWithKey, + foldlWithKey, + foldMapWithKey, + + -- ** Strict folds + foldr', + foldr1', + foldl', + foldl1', + foldrWithKey', + foldlWithKey', + + -- * Conversion + elems, + keys, + assocs, + keysSet, + + -- ** Lists + toList, + + -- ** Ordered lists + toAscList, + toDescList, + + -- * Filter + filter, + filterWithKey, + restrictKeys, + withoutKeys, + partition, + partitionWithKey, + mapMaybe, + mapMaybeWithKey, + mapEither, + mapEitherWithKey, + split, + splitLookup, + splitRoot, + + -- * Submap + isSubmapOf, + isSubmapOfBy, + isProperSubmapOf, + isProperSubmapOfBy, + + -- * Min\/Max + findMin, + findMax, + deleteMin, + deleteMax, + deleteFindMin, + deleteFindMax, + updateMin, + updateMax, + adjustMin, + adjustMax, + updateMinWithKey, + updateMaxWithKey, + adjustMinWithKey, + adjustMaxWithKey, + minView, + maxView, + + -- * Debugging + valid, +) where + +import Control.Applicative +import Data.Bifunctor +import qualified Data.Foldable as F +import Data.Functor.Identity +import Data.IntMap.Internal (IntMap (..)) +import Data.IntMap.NonEmpty.Strict.Internal +import qualified Data.IntMap.Strict as M +import Data.IntSet (IntSet) +import qualified Data.IntSet as S +import Data.IntSet.NonEmpty.Internal (NEIntSet (..)) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE +import Data.Maybe hiding (mapMaybe) +import qualified Data.Maybe as Maybe +import Data.Semigroup.Foldable (Foldable1) +import qualified Data.Semigroup.Foldable as F1 +import Data.These +import Prelude hiding (Foldable (..), filter, lookup, map) + +-- | /O(1)/ match, /O(log n)/ usage of contents. The 'IsNonEmpty' and +-- 'IsEmpty' patterns allow you to treat a 'IntMap' as if it were either +-- a @'IsNonEmpty' n@ (where @n@ is a 'NEIntMap') or an 'IsEmpty'. +-- +-- For example, you can pattern match on a 'IntMap': +-- +-- @ +-- myFunc :: 'IntMap' K X -> Y +-- myFunc ('IsNonEmpty' n) = -- here, the user provided a non-empty map, and @n@ is the 'NEIntMap' +-- myFunc 'IsEmpty' = -- here, the user provided an empty map. +-- @ +-- +-- Matching on @'IsNonEmpty' n@ means that the original 'IntMap' was /not/ +-- empty, and you have a verified-non-empty 'NEIntMap' @n@ to use. +-- +-- Note that patching on this pattern is /O(1)/. However, using the +-- contents requires a /O(log n)/ cost that is deferred until after the +-- pattern is matched on (and is not incurred at all if the contents are +-- never used). +-- +-- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides +-- complete coverage. +-- +-- This is a bidirectional pattern, so you can use 'IsNonEmpty' to convert +-- a 'NEIntMap' back into a 'IntMap', obscuring its non-emptiness (see 'toMap'). +pattern IsNonEmpty :: NEIntMap a -> IntMap a +pattern IsNonEmpty n <- (nonEmptyMap -> Just n) + where + IsNonEmpty n = toMap n + +-- | /O(1)/. The 'IsNonEmpty' and 'IsEmpty' patterns allow you to treat +-- a 'IntMap' as if it were either a @'IsNonEmpty' n@ (where @n@ is +-- a 'NEIntMap') or an 'IsEmpty'. +-- +-- Matching on 'IsEmpty' means that the original 'IntMap' was empty. +-- +-- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides +-- complete coverage. +-- +-- This is a bidirectional pattern, so you can use 'IsEmpty' as an +-- expression, and it will be interpreted as 'Data.IntMap.empty'. +-- +-- See 'IsNonEmpty' for more information. +pattern IsEmpty :: IntMap a +pattern IsEmpty <- (M.null -> True) + where + IsEmpty = M.empty + +{-# COMPLETE IsNonEmpty, IsEmpty #-} + +-- | /O(log n)/. Unsafe version of 'nonEmptyMap'. Coerces a 'IntMap' into an +-- 'NEIntMap', but is undefined (throws a runtime exception when evaluation is +-- attempted) for an empty 'IntMap'. +unsafeFromMap :: + IntMap a -> + NEIntMap a +unsafeFromMap = withNonEmpty e id + where + e = errorWithoutStackTrace "NEIntMap.unsafeFromMap: empty map" +{-# INLINE unsafeFromMap #-} + +-- | /O(log n)/. Convert a 'IntMap' into an 'NEIntMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. If key is already present, +-- will overwrite the original value. +-- +-- See 'insertMapMin' for a version that is constant-time if the new key is +-- /strictly smaller than/ all keys in the original map. +-- +-- > insertMap 4 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) +-- > insertMap 4 "c" Data.IntMap.empty == singleton 4 "c" +insertMap :: Key -> a -> IntMap a -> NEIntMap a +insertMap k v = withNonEmpty (singleton k v) (insert k v) +{-# INLINE insertMap #-} + +-- | /O(log n)/. Convert a 'IntMap' into an 'NEIntMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. Uses a combining function +-- with the new value as the first argument if the key is already present. +-- +-- > insertMapWith (++) 4 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) +-- > insertMapWith (++) 5 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"ca")]) +insertMapWith :: + (a -> a -> a) -> + Key -> + a -> + IntMap a -> + NEIntMap a +insertMapWith f k v = withNonEmpty (singleton k v) (insertWith f k v) +{-# INLINE insertMapWith #-} + +-- | /O(log n)/. Convert a 'IntMap' into an 'NEIntMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. Uses a combining function +-- with the key and new value as the first and second arguments if the key +-- is already present. +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertWithKey f 5 "xxx" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "5:xxx|a")]) +-- > insertWithKey f 7 "xxx" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +-- > insertWithKey f 5 "xxx" Data.IntMap.empty == singleton 5 "xxx" +insertMapWithKey :: + (Key -> a -> a -> a) -> + Key -> + a -> + IntMap a -> + NEIntMap a +insertMapWithKey f k v = withNonEmpty (singleton k v) (insertWithKey f k v) +{-# INLINE insertMapWithKey #-} + +-- | /O(1)/ Convert a 'IntMap' into an 'NEIntMap' by adding a key-value pair +-- where the key is /strictly less than/ all keys in the input map. The +-- keys in the original map must all be /strictly greater than/ the new +-- key. /The precondition is not checked./ +-- +-- > insertMapMin 2 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((2,"c") :| [(3,"b"), (5,"a")]) +-- > valid (insertMapMin 2 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == True +-- > valid (insertMapMin 7 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False +-- > valid (insertMapMin 3 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False +insertMapMin :: + Key -> + a -> + IntMap a -> + NEIntMap a +insertMapMin = NEIntMap +{-# INLINE insertMapMin #-} + +-- | /O(log n)/ Convert a 'IntMap' into an 'NEIntMap' by adding a key-value pair +-- where the key is /strictly greater than/ all keys in the input map. The +-- keys in the original map must all be /strictly less than/ the new +-- key. /The precondition is not checked./ +-- +-- At the current moment, this is identical simply 'insertMap'; however, +-- it is left both for consistency and as a placeholder for a future +-- version where optimizations are implemented to allow for a faster +-- implementation. +-- +-- > insertMap 7 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"a"), (7,"c")]) + +-- these currently are all valid, but shouldn't be +-- > valid (insertMap 7 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == True +-- > valid (insertMap 2 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False +-- > valid (insertMap 5 "c" (Data.IntMap.fromList [(5,"a"), (3,"b")])) == False +insertMapMax :: + Key -> + a -> + IntMap a -> + NEIntMap a +insertMapMax k v = withNonEmpty (singleton k v) go + where + go (NEIntMap k0 v0 m0) = NEIntMap k0 v0 . insertMaxMap k v $ m0 +{-# INLINE insertMapMax #-} + +-- | /O(n)/. Build a non-empty map from a non-empty set of keys and +-- a function which for each key computes its value. +-- +-- > fromSet (\k -> replicate k 'a') (Data.Set.NonEmpty.fromList (3 :| [5])) == fromList ((5,"aaaaa") :| [(3,"aaa")]) +fromSet :: + (Key -> a) -> + NEIntSet -> + NEIntMap a +fromSet f (NEIntSet k ks) = NEIntMap k (f k) (M.fromSet f ks) +{-# INLINE fromSet #-} + +-- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs +-- with a combining function. See also 'fromAscListWith'. +-- +-- > fromListWith (++) ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "ab") :| [(5, "aba")]) +fromListWith :: + (a -> a -> a) -> + NonEmpty (Key, a) -> + NEIntMap a +fromListWith f = fromListWithKey (const f) +{-# INLINE fromListWith #-} + +-- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs +-- with a combining function. See also 'fromAscListWithKey'. +-- +-- > let f k a1 a2 = (show k) ++ a1 ++ a2 +-- > fromListWithKey f ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "3ab") :| [(5, "5a5ba")]) +fromListWithKey :: + (Key -> a -> a -> a) -> + NonEmpty (Key, a) -> + NEIntMap a +fromListWithKey f ((k0, v0) :| xs) = F.foldl' go (singleton k0 v0) xs + where + go m (k, v) = insertWithKey f k v m + {-# INLINE go #-} +{-# INLINE fromListWithKey #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time. +-- /The precondition (input list is ascending) is not checked./ +-- +-- > fromAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) +-- > fromAscList ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "b")]) +-- > valid (fromAscList ((3,"b") :| [(5,"a"), (5,"b")])) == True +-- > valid (fromAscList ((5,"a") :| [(3,"b"), (5,"b")])) == False +fromAscList :: + NonEmpty (Key, a) -> + NEIntMap a +fromAscList = fromDistinctAscList . combineEq +{-# INLINE fromAscList #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is ascending) is not checked./ +-- +-- > fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "ba")]) +-- > valid (fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b"))]) == True +-- > valid (fromAscListWith (++) ((5,"a") :| [(3,"b"), (5,"b"))]) == False +fromAscListWith :: + (a -> a -> a) -> + NonEmpty (Key, a) -> + NEIntMap a +fromAscListWith f = fromAscListWithKey (const f) +{-# INLINE fromAscListWith #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is ascending) is not checked./ +-- +-- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 +-- > fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")]) == fromList ((3, "b") :| [(5, "5:b5:ba")]) +-- > valid (fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")])) == True +-- > valid (fromAscListWithKey f ((5,"a") :| [(3,"b"), (5,"b"), (5,"b")])) == False +fromAscListWithKey :: + (Key -> a -> a -> a) -> + NonEmpty (Key, a) -> + NEIntMap a +fromAscListWithKey f = fromDistinctAscList . combineEqWith f +{-# INLINE fromAscListWithKey #-} + +-- | /O(n)/. Build a map from an ascending non-empty list of distinct +-- elements in linear time. /The precondition is not checked./ +-- +-- > fromDistinctAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) +-- > valid (fromDistinctAscList ((3,"b") :| [(5,"a")])) == True +-- > valid (fromDistinctAscList ((3,"b") :| [(5,"a"), (5,"b")])) == False +fromDistinctAscList :: NonEmpty (Key, a) -> NEIntMap a +fromDistinctAscList ((k, v) :| xs) = + insertMapMin k v + . M.fromDistinctAscList + $ xs +{-# INLINE fromDistinctAscList #-} + +-- | /O(log n)/. Insert a new key and value in the map. +-- If the key is already present in the map, the associated value is +-- replaced with the supplied value. 'insert' is equivalent to +-- @'insertWith' 'const'@. +-- +-- See 'insertMap' for a version where the first argument is a 'IntMap'. +-- +-- > insert 5 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'x')]) +-- > insert 7 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'a'), (7, 'x')]) +insert :: + Key -> + a -> + NEIntMap a -> + NEIntMap a +insert k v n@(NEIntMap k0 v0 m) = case compare k k0 of + LT -> NEIntMap k v . toMap $ n + EQ -> NEIntMap k v m + GT -> NEIntMap k0 v0 . M.insert k v $ m +{-# INLINE insert #-} + +-- | /O(log n)/. Insert with a function, combining key, new value and old +-- value. @'insertWithKey' f key value mp@ will insert the pair (key, +-- value) into @mp@ if key does not exist in the map. If the key does +-- exist, the function will insert the pair @(key,f key new_value +-- old_value)@. Note that the key passed to f is the same key passed to +-- 'insertWithKey'. +-- +-- See 'insertMapWithKey' for a version where the first argument is a 'IntMap'. +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:xxx|a")]) +-- > insertWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +insertWithKey :: + (Key -> a -> a -> a) -> + Key -> + a -> + NEIntMap a -> + NEIntMap a +insertWithKey f k v n@(NEIntMap k0 v0 m) = case compare k k0 of + LT -> NEIntMap k v . toMap $ n + EQ -> NEIntMap k (f k v v0) m + GT -> NEIntMap k0 v0 $ M.insertWithKey f k v m +{-# INLINE insertWithKey #-} + +-- | /O(log n)/. Combines insert operation with old value retrieval. The +-- expression (@'insertLookupWithKey' f k x map@) is a pair where the first +-- element is equal to (@'lookup' k map@) and the second element equal to +-- (@'insertWithKey' f k x map@). +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertLookupWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "5:xxx|a")])) +-- > insertLookupWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "xxx")])) +-- +-- This is how to define @insertLookup@ using @insertLookupWithKey@: +-- +-- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t +-- > insertLookup 5 "x" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "x")])) +-- > insertLookup 7 "x" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "x")])) +insertLookupWithKey :: + (Key -> a -> a -> a) -> + Key -> + a -> + NEIntMap a -> + (Maybe a, NEIntMap a) +insertLookupWithKey f k v n@(NEIntMap k0 v0 m) = case compare k k0 of + LT -> (Nothing, NEIntMap k v . toMap $ n) + EQ -> (Just v, NEIntMap k (f k v v0) m) + GT -> NEIntMap k0 v0 <$> M.insertLookupWithKey f k v m +{-# INLINE insertLookupWithKey #-} + +-- | /O(log n)/. Delete a key and its value from the non-empty map. +-- A potentially empty map ('IntMap') is returned, since this might delete the +-- last item in the 'NEIntMap'. When the key is not a member of the map, is +-- equivalent to 'toMap'. +-- +-- > delete 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" +-- > delete 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.Singleton [(3, "b"), (5, "a")] +delete :: Key -> NEIntMap a -> IntMap a +delete k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> toMap n + EQ -> m + GT -> insertMinMap k0 v . M.delete k $ m +{-# INLINE delete #-} + +-- | /O(log n)/. Delete a key and its value from the non-empty map, returning +-- 'Nothing' if the result would be empty. +-- +-- This is more efficient than @'nonEmptyMap' . 'delete' k@ because it avoids +-- converting the known-minimum representation back through 'IntMap' when the +-- deleted key is not the minimum. +-- +-- @since 0.3.6.0 +deleteMaybe :: Key -> NEIntMap a -> Maybe (NEIntMap a) +deleteMaybe k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> Just n + EQ -> nonEmptyMap m + GT -> Just . NEIntMap k0 v . M.delete k $ m +{-# INLINE deleteMaybe #-} + +-- | /O(log n)/. Update a value at a specific key with the result of the +-- provided function. When the key is not a member of the map, the original +-- map is returned. +-- +-- > adjust ("new " ++) 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "new a")]) +-- > adjust ("new " ++) 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) +adjust :: + (a -> a) -> + Key -> + NEIntMap a -> + NEIntMap a +adjust f = adjustWithKey (const f) +{-# INLINE adjust #-} + +-- | /O(log n)/. Adjust a value at a specific key. When the key is not +-- a member of the map, the original map is returned. +-- +-- > let f key x = (show key) ++ ":new " ++ x +-- > adjustWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:new a")]) +-- > adjustWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) +adjustWithKey :: + (Key -> a -> a) -> + Key -> + NEIntMap a -> + NEIntMap a +adjustWithKey f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> n + EQ -> NEIntMap k0 (f k0 v) m + GT -> NEIntMap k0 v . M.adjustWithKey f k $ m +{-# INLINE adjustWithKey #-} + +-- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@ +-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is +-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. +-- +-- Returns a potentially empty map ('IntMap'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEIntMap'. +-- +-- > let f x = if x == "a" then Just "new a" else Nothing +-- > update f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "new a")] +-- > update f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a")] +-- > update f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +update :: + (a -> Maybe a) -> + Key -> + NEIntMap a -> + IntMap a +update f = updateWithKey (const f) +{-# INLINE update #-} + +-- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the +-- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing', +-- the element is deleted. If it is (@'Just' y@), the key @k@ is bound +-- to the new value @y@. +-- +-- Returns a potentially empty map ('IntMap'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEIntMap'. +-- +-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing +-- > updateWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "5:new a")] +-- > updateWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a")] +-- > updateWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +updateWithKey :: + (Key -> a -> Maybe a) -> + Key -> + NEIntMap a -> + IntMap a +updateWithKey f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> toMap n + EQ -> maybe m (flip (insertMinMap k0) m) . f k0 $ v + GT -> insertMinMap k0 v . M.updateWithKey f k $ m +{-# INLINE updateWithKey #-} + +-- | /O(min(n,W))/. Lookup and update. +-- The function returns original value, if it is updated. +-- This is different behavior than @Data.Map.NonEmpty.updateLookupWithKey@. +-- Returns the original key value if the map entry is deleted. +-- +-- Returns a potentially empty map ('IntMap') in the case that we delete +-- the final key of a singleton map. +-- +-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing +-- > updateLookupWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "5:new a", Data.IntMap.fromList ((3, "b") :| [(5, "5:new a")])) +-- > updateLookupWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == (Nothing, Data.IntMap.fromList ((3, "b") :| [(5, "a")])) +-- > updateLookupWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Data.IntMap.singleton 5 "a") +updateLookupWithKey :: + (Key -> a -> Maybe a) -> + Key -> + NEIntMap a -> + (Maybe a, IntMap a) +updateLookupWithKey f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> (Nothing, toMap n) + EQ -> + let u = f k0 v + in (Just v, maybe m (flip (insertMinMap k0) m) u) + GT -> fmap (insertMinMap k0 v) . M.updateLookupWithKey f k $ m +{-# INLINE updateLookupWithKey #-} + +-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at +-- @k@, or absence thereof. 'alter' can be used to insert, delete, or +-- update a value in a 'IntMap'. In short : @Data.IntMap.lookup k ('alter' +-- f k m) = f ('lookup' k m)@. +-- +-- Returns a potentially empty map ('IntMap'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEIntMap'. +-- +-- See 'alterF'' for a version that disallows deletion, and so therefore +-- can return 'NEIntMap'. +-- +-- > let f _ = Nothing +-- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a")] +-- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" +-- > +-- > let f _ = Just "c" +-- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "a"), (7, "c")] +-- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "c")] +alter :: + (Maybe a -> Maybe a) -> + Key -> + NEIntMap a -> + IntMap a +alter f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> maybe id (insertMinMap k) (f Nothing) (toMap n) + EQ -> maybe id (insertMinMap k0) (f (Just v)) m + GT -> insertMinMap k0 v . M.alter f k $ m +{-# INLINE alter #-} + +-- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ +-- at @k@, or absence thereof. 'alterF' can be used to inspect, insert, +-- delete, or update a value in a 'IntMap'. In short: @Data.IntMap.lookup +-- k \<$\> 'alterF' f k m = f ('lookup' k m)@. +-- +-- Example: +-- +-- @ +-- interactiveAlter :: Int -> NEIntMap Int String -> IO (IntMap Int String) +-- interactiveAlter k m = alterF f k m where +-- f Nothing = do +-- putStrLn $ show k ++ +-- " was not found in the map. Would you like to add it?" +-- getUserResponse1 :: IO (Maybe String) +-- f (Just old) = do +-- putStrLn $ "The key is currently bound to " ++ show old ++ +-- ". Would you like to change or delete it?" +-- getUserResponse2 :: IO (Maybe String) +-- @ +-- +-- Like @Data.IntMap.alterF@ for 'IntMap', 'alterF' can be considered +-- to be a unifying generalization of 'lookup' and 'delete'; however, as +-- a constrast, it cannot be used to implement 'insert', because it must +-- return a 'IntMap' instead of an 'NEIntMap' (because the function might delete +-- the final item in the 'NEIntMap'). When used with trivial functors like +-- 'Identity' and 'Const', it is often slightly slower than +-- specialized 'lookup' and 'delete'. However, when the functor is +-- non-trivial and key comparison is not particularly cheap, it is the +-- fastest way. +-- +-- See 'alterF'' for a version that disallows deletion, and so therefore +-- can return 'NEIntMap' and be used to implement 'insert' +-- +-- Note on rewrite rules: +-- +-- This module includes GHC rewrite rules to optimize 'alterF' for +-- the 'Const' and 'Identity' functors. In general, these rules +-- improve performance. The sole exception is that when using +-- 'Identity', deleting a key that is already absent takes longer +-- than it would without the rules. If you expect this to occur +-- a very large fraction of the time, you might consider using a +-- private copy of the 'Identity' type. +-- +-- Note: Unlike @Data.IntMap.alterF@ for 'IntMap', 'alterF' is /not/ a flipped +-- version of the 'Control.Lens.At.at' combinator from "Control.Lens.At". +-- However, it match the shape expected from most functions expecting +-- lenses, getters, and setters, so can be thought of as a "psuedo-lens", +-- with virtually the same practical applications as a legitimate lens. +alterF :: + Functor f => + (Maybe a -> f (Maybe a)) -> + Key -> + NEIntMap a -> + f (IntMap a) +alterF f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> flip (maybe id (insertMinMap k)) (toMap n) <$> f Nothing + EQ -> flip (maybe id (insertMinMap k0)) m <$> f (Just v) + GT -> insertMinMap k0 v <$> M.alterF f k m +{-# INLINEABLE [2] alterF #-} + +-- if f ~ Const b, it's a lookup +{-# RULES +"alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)). + alterF f k = + Const . getConst . f . lookup k + #-} + +-- if f ~ Identity, it's an 'alter' +{-# RULES +"alterF/Identity" forall k (f :: Maybe a -> Identity (Maybe a)). + alterF f k = + Identity . alter (runIdentity . f) k + #-} + +-- | /O(log n)/. Variant of 'alter' that disallows deletion. Allows us to +-- guarantee that the result is also a non-empty IntMap. +alter' :: + (Maybe a -> a) -> + Key -> + NEIntMap a -> + NEIntMap a +alter' f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> NEIntMap k (f Nothing) . toMap $ n + EQ -> NEIntMap k0 (f (Just v)) m + GT -> NEIntMap k0 v . M.alter (Just . f) k $ m +{-# INLINE alter' #-} + +-- | /O(log n)/. Variant of 'alterF' that disallows deletion. Allows us to +-- guarantee that the result is also a non-empty IntMap. +-- +-- Like @Data.IntMap.alterF@ for 'IntMap', can be used to generalize and unify +-- 'lookup' and 'insert'. However, because it disallows deletion, it +-- cannot be used to implement 'delete'. +-- +-- See 'alterF' for usage information and caveats. +-- +-- Note: Neither 'alterF' nor 'alterF'' can be considered flipped versions +-- of the 'Control.Lens.At.at' combinator from "Control.Lens.At". However, +-- this can match the shape expected from most functions expecting lenses, +-- getters, and setters, so can be thought of as a "psuedo-lens", with +-- virtually the same practical applications as a legitimate lens. +-- +-- __WARNING__: The rewrite rule for 'Identity' exposes an inconsistency in +-- undefined behavior for "Data.IntMap". @Data.IntMap.alterF@ will actually +-- /maintain/ the original key in the map when used with 'Identity'; +-- however, @Data.IntMap.insertWith@ will /replace/ the orginal key in the +-- map. The rewrite rule for 'alterF'' has chosen to be faithful to +-- @Data.IntMap.insertWith@, and /not/ @Data.IntMap.alterF@, for the sake of +-- a cleaner implementation. +alterF' :: + Functor f => + (Maybe a -> f a) -> + Key -> + NEIntMap a -> + f (NEIntMap a) +alterF' f k n@(NEIntMap k0 v m) = case compare k k0 of + LT -> flip (NEIntMap k) (toMap n) <$> f Nothing + EQ -> flip (NEIntMap k0) m <$> f (Just v) + GT -> NEIntMap k0 v <$> M.alterF (fmap Just . f) k m +{-# INLINEABLE [2] alterF' #-} + +-- if f ~ Const b, it's a lookup +{-# RULES +"alterF'/Const" forall k (f :: Maybe a -> Const b a). + alterF' f k = + Const . getConst . f . lookup k + #-} + +-- if f ~ Identity, it's an insertWith +{-# RULES +"alterF'/Identity" forall k (f :: Maybe a -> Identity a). + alterF' f k = + Identity . insertWith (\_ -> runIdentity . f . Just) k (runIdentity (f Nothing)) + #-} + +-- | /O(log n)/. Lookup the value at a key in the map. +-- +-- The function will return the corresponding value as @('Just' value)@, +-- or 'Nothing' if the key isn't in the map. +-- +-- An example of using @lookup@: +-- +-- > import Prelude hiding (lookup) +-- > import Data.Map.NonEmpty +-- > +-- > employeeDept = fromList (("John","Sales") :| [("Bob","IT")]) +-- > deptCountry = fromList (("IT","USA") :| [("Sales","France")]) +-- > countryCurrency = fromList (("USA", "Dollar") :| [("France", "Euro")]) +-- > +-- > employeeCurrency :: String -> Maybe String +-- > employeeCurrency name = do +-- > dept <- lookup name employeeDept +-- > country <- lookup dept deptCountry +-- > lookup country countryCurrency +-- > +-- > main = do +-- > putStrLn $ "John's currency: " ++ (show (employeeCurrency "John")) +-- > putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete")) +-- +-- The output of this program: +-- +-- > John's currency: Just "Euro" +-- > Pete's currency: Nothing +lookup :: + Key -> + NEIntMap a -> + Maybe a +lookup k (NEIntMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Just v + GT -> M.lookup k m +{-# INLINE lookup #-} + +-- | /O(log n)/. Find the value at a key. Returns 'Nothing' when the +-- element can not be found. +-- +-- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 1 == Nothing +-- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 5 == Just 'a' +(!?) :: NEIntMap a -> Key -> Maybe a +(!?) = flip lookup +{-# INLINE (!?) #-} + +-- | /O(log n)/. Find the value at a key. Calls 'error' when the element +-- can not be found. +-- +-- > fromList ((5,'a') :| [(3,'b')]) ! 1 Error: element not in the map +-- > fromList ((5,'a') :| [(3,'b')]) ! 5 == 'a' +(!) :: NEIntMap a -> Key -> a +(!) m k = fromMaybe e $ m !? k + where + e = error "NEIntMap.!: given key is not an element in the map" +{-# INLINE (!) #-} + +infixl 9 !? +infixl 9 ! + +-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns +-- the value at key @k@ or returns default value @def@ +-- when the key is not in the map. +-- +-- > findWithDefault 'x' 1 (fromList ((5,'a') :| [(3,'b')])) == 'x' +-- > findWithDefault 'x' 5 (fromList ((5,'a') :| [(3,'b')])) == 'a' +findWithDefault :: + a -> + Key -> + NEIntMap a -> + a +findWithDefault def k (NEIntMap k0 v m) = case compare k k0 of + LT -> def + EQ -> v + GT -> M.findWithDefault def k m +{-# INLINE findWithDefault #-} + +-- | /O(log n)/. Is the key a member of the map? See also 'notMember'. +-- +-- > member 5 (fromList ((5,'a') :| [(3,'b')])) == True +-- > member 1 (fromList ((5,'a') :| [(3,'b')])) == False +member :: Key -> NEIntMap a -> Bool +member k (NEIntMap k0 _ m) = case compare k k0 of + LT -> False + EQ -> True + GT -> M.member k m +{-# INLINE member #-} + +-- | /O(log n)/. Is the key not a member of the map? See also 'member'. +-- +-- > notMember 5 (fromList ((5,'a') :| [(3,'b')])) == False +-- > notMember 1 (fromList ((5,'a') :| [(3,'b')])) == True +notMember :: Key -> NEIntMap a -> Bool +notMember k (NEIntMap k0 _ m) = case compare k k0 of + LT -> True + EQ -> False + GT -> M.notMember k m +{-# INLINE notMember #-} + +-- | /O(log n)/. Find largest key smaller than the given one and return the +-- corresponding (key, value) pair. +-- +-- > lookupLT 3 (fromList ((3,'a') :| [(5,'b')])) == Nothing +-- > lookupLT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +lookupLT :: Key -> NEIntMap a -> Maybe (Key, a) +lookupLT k (NEIntMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Nothing + GT -> M.lookupLT k m <|> Just (k0, v) +{-# INLINE lookupLT #-} + +-- | /O(log n)/. Find smallest key greater than the given one and return the +-- corresponding (key, value) pair. +-- +-- > lookupGT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +-- > lookupGT 5 (fromList ((3,'a') :| [(5,'b')])) == Nothing +lookupGT :: Key -> NEIntMap a -> Maybe (Key, a) +lookupGT k (NEIntMap k0 v m) = case compare k k0 of + LT -> Just (k0, v) + EQ -> M.lookupMin m + GT -> M.lookupGT k m +{-# INLINE lookupGT #-} + +-- | /O(log n)/. Find largest key smaller or equal to the given one and return +-- the corresponding (key, value) pair. +-- +-- > lookupLE 2 (fromList ((3,'a') :| [(5,'b')])) == Nothing +-- > lookupLE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +-- > lookupLE 5 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +lookupLE :: Key -> NEIntMap a -> Maybe (Key, a) +lookupLE k (NEIntMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Just (k0, v) + GT -> M.lookupLE k m <|> Just (k0, v) +{-# INLINE lookupLE #-} + +-- | /O(log n)/. Find smallest key greater or equal to the given one and return +-- the corresponding (key, value) pair. +-- +-- > lookupGE 3 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +-- > lookupGE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +-- > lookupGE 6 (fromList ((3,'a') :| [(5,'b')])) == Nothing +lookupGE :: Key -> NEIntMap a -> Maybe (Key, a) +lookupGE k (NEIntMap k0 v m) = case compare k k0 of + LT -> Just (k0, v) + EQ -> Just (k0, v) + GT -> M.lookupGE k m +{-# INLINE lookupGE #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union with a combining function. +-- +-- > unionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "aA"), (7, "C")]) +unionWith :: + (a -> a -> a) -> + NEIntMap a -> + NEIntMap a -> + NEIntMap a +unionWith f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + LT -> NEIntMap k1 v1 . M.unionWith f m1 . toMap $ n2 + EQ -> NEIntMap k1 (f v1 v2) . M.unionWith f m1 $ m2 + GT -> NEIntMap k2 v2 . M.unionWith f (toMap n1) $ m2 +{-# INLINE unionWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a possibly-empty +-- 'IntMap' and a non-empty map. +-- +-- @since 0.3.6.0 +unionMapLeft :: IntMap a -> NEIntMap a -> NEIntMap a +unionMapLeft m n = withNonEmpty n (`union` n) m +{-# INLINE unionMapLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a non-empty map and a +-- possibly-empty 'IntMap'. +-- +-- @since 0.3.6.0 +unionMapRight :: NEIntMap a -> IntMap a -> NEIntMap a +unionMapRight n = withNonEmpty n (union n) +{-# INLINE unionMapRight #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'IntMap' and a +-- non-empty map with a combining function. +-- +-- @since 0.3.6.0 +unionMapWithLeft :: (a -> a -> a) -> IntMap a -> NEIntMap a -> NEIntMap a +unionMapWithLeft f m n = withNonEmpty n (\m' -> unionWith f m' n) m +{-# INLINE unionMapWithLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a +-- possibly-empty 'IntMap' with a combining function. +-- +-- @since 0.3.6.0 +unionMapWithRight :: (a -> a -> a) -> NEIntMap a -> IntMap a -> NEIntMap a +unionMapWithRight f n = withNonEmpty n (unionWith f n) +{-# INLINE unionMapWithRight #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- Union with a combining function, given the matching key. +-- +-- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value +-- > unionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "5:a|A"), (7, "C")]) +unionWithKey :: + (Key -> a -> a -> a) -> + NEIntMap a -> + NEIntMap a -> + NEIntMap a +unionWithKey f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + LT -> NEIntMap k1 v1 . M.unionWithKey f m1 . toMap $ n2 + EQ -> NEIntMap k1 (f k1 v1 v2) . M.unionWithKey f m1 $ m2 + GT -> NEIntMap k2 v2 . M.unionWithKey f (toMap n1) $ m2 +{-# INLINE unionWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'IntMap' and a +-- non-empty map with a combining function, given the matching key. +-- +-- @since 0.3.6.0 +unionMapWithKeyLeft :: + (Key -> a -> a -> a) -> + IntMap a -> + NEIntMap a -> + NEIntMap a +unionMapWithKeyLeft f m n = withNonEmpty n (\m' -> unionWithKey f m' n) m +{-# INLINE unionMapWithKeyLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a +-- possibly-empty 'IntMap' with a combining function, given the matching key. +-- +-- @since 0.3.6.0 +unionMapWithKeyRight :: + (Key -> a -> a -> a) -> + NEIntMap a -> + IntMap a -> + NEIntMap a +unionMapWithKeyRight f n = withNonEmpty n (unionWithKey f n) +{-# INLINE unionMapWithKeyRight #-} + +-- | The union of a non-empty list of maps, with a combining operation: +-- (@'unionsWith' f == 'Data.Foldable.foldl1' ('unionWith' f)@). +-- +-- > unionsWith (++) (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) +-- > == fromList ((3, "bB3") :| [(5, "aAA3"), (7, "C")]) +unionsWith :: + Foldable1 f => + (a -> a -> a) -> + f (NEIntMap a) -> + NEIntMap a +unionsWith f (F1.toNonEmpty -> (m :| ms)) = F.foldl' (unionWith f) m ms +{-# INLINE unionsWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Difference of two maps. +-- Return elements of the first map not existing in the second map. +-- +-- Returns a potentially empty map ('IntMap'), in case the first map is +-- a subset of the second map. +-- +-- > difference (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 3 "b" +difference :: + NEIntMap a -> + NEIntMap b -> + IntMap a +difference n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 _ m2) = case compare k1 k2 of + -- k1 is not in n2, so cannot be deleted + LT -> insertMinMap k1 v1 $ m1 `M.difference` toMap n2 + -- k2 deletes k1, and only k1 + EQ -> m1 `M.difference` m2 + -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. + GT -> toMap n1 `M.difference` m2 +{-# INLINE difference #-} + +-- | Same as 'difference'. +(\\) :: + NEIntMap a -> + NEIntMap b -> + IntMap a +(\\) = difference +{-# INLINE (\\) #-} + +-- | /O(n+m)/. Difference with a combining function. +-- When two equal keys are +-- encountered, the combining function is applied to the values of these keys. +-- If it returns 'Nothing', the element is discarded (proper set difference). If +-- it returns (@'Just' y@), the element is updated with a new value @y@. +-- +-- Returns a potentially empty map ('IntMap'), in case the first map is +-- a subset of the second map and the function returns 'Nothing' for every +-- pair. +-- +-- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing +-- > differenceWith f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (7, "C")])) +-- > == Data.IntMap.singleton 3 "b:B" +differenceWith :: + (a -> b -> Maybe a) -> + NEIntMap a -> + NEIntMap b -> + IntMap a +differenceWith f = differenceWithKey (const f) +{-# INLINE differenceWith #-} + +-- | /O(n+m)/. Difference with a combining function. When two equal keys are +-- encountered, the combining function is applied to the key and both values. +-- If it returns 'Nothing', the element is discarded (proper set difference). If +-- it returns (@'Just' y@), the element is updated with a new value @y@. +-- +-- Returns a potentially empty map ('IntMap'), in case the first map is +-- a subset of the second map and the function returns 'Nothing' for every +-- pair. +-- +-- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing +-- > differenceWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (10, "C")])) +-- > == Data.IntMap.singleton 3 "3:b|B" +differenceWithKey :: + (Key -> a -> b -> Maybe a) -> + NEIntMap a -> + NEIntMap b -> + IntMap a +differenceWithKey f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + -- k1 is not in n2, so cannot be deleted + LT -> insertMinMap k1 v1 $ M.differenceWithKey f m1 (toMap n2) + -- k2 deletes k1, and only k1 + EQ -> maybe id (insertMinMap k1) (f k1 v1 v2) (M.differenceWithKey f m1 m2) + -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. + GT -> M.differenceWithKey f (toMap n1) m2 +{-# INLINE differenceWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection of two maps. +-- Return data in the first map for the keys existing in both maps. +-- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). +-- +-- Returns a potentially empty map ('IntMap'), in case the two maps share no +-- keys in common. +-- +-- > intersection (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 5 "a" +intersection :: + NEIntMap a -> + NEIntMap b -> + IntMap a +intersection n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 _ m2) = case compare k1 k2 of + -- k1 is not in n2 + LT -> m1 `M.intersection` toMap n2 + -- k1 and k2 are a part of the result + EQ -> insertMinMap k1 v1 $ m1 `M.intersection` m2 + -- k2 is not in n1 + GT -> toMap n1 `M.intersection` m2 +{-# INLINE intersection #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. +-- +-- Returns a potentially empty map ('IntMap'), in case the two maps share no +-- keys in common. +-- +-- > intersectionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 5 "aA" +intersectionWith :: + (a -> b -> c) -> + NEIntMap a -> + NEIntMap b -> + IntMap c +intersectionWith f = intersectionWithKey (const f) +{-# INLINE intersectionWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. +-- +-- Returns a potentially empty map ('IntMap'), in case the two maps share no +-- keys in common. +-- +-- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar +-- > intersectionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.IntMap.singleton 5 "5:a|A" +intersectionWithKey :: + (Key -> a -> b -> c) -> + NEIntMap a -> + NEIntMap b -> + IntMap c +intersectionWithKey f n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + -- k1 is not in n2 + LT -> M.intersectionWithKey f m1 (toMap n2) + -- k1 and k2 are a part of the result + EQ -> insertMinMap k1 (f k1 v1 v2) $ M.intersectionWithKey f m1 m2 + -- k2 is not in n1 + GT -> M.intersectionWithKey f (toMap n1) m2 +{-# INLINE intersectionWithKey #-} + +-- | /O(n)/. IntMap a function over all values in the map. +-- +-- > let f key x = (show key) ++ ":" ++ x +-- > mapWithKey f (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "3:b") :| [(5, "5:a")]) +mapWithKey :: (Key -> a -> b) -> NEIntMap a -> NEIntMap b +mapWithKey f (NEIntMap k v m) = NEIntMap k (f k v) (M.mapWithKey f m) +{-# NOINLINE [1] mapWithKey #-} + +{-# RULES +"mapWithKey/mapWithKey" forall f g xs. + mapWithKey f (mapWithKey g xs) = + mapWithKey (\k a -> f k (g k a)) xs +"mapWithKey/map" forall f g xs. + mapWithKey f (map g xs) = + mapWithKey (\k a -> f k (g a)) xs +"map/mapWithKey" forall f g xs. + map f (mapWithKey g xs) = + mapWithKey (\k a -> f (g k a)) xs + #-} + +-- | /O(n)/. The function 'mapAccum' threads an accumulating argument +-- through the map in ascending order of keys. +-- +-- > let f a b = (a ++ b, b ++ "X") +-- > mapAccum f "Everything: " (fromList ((5,"a") :| [(3,"b")])) == ("Everything: ba", fromList ((3, "bX") :| [(5, "aX")])) +mapAccum :: + (a -> b -> (a, c)) -> + a -> + NEIntMap b -> + (a, NEIntMap c) +mapAccum f = mapAccumWithKey (\x _ -> f x) +{-# INLINE mapAccum #-} + +-- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating +-- argument through the map in ascending order of keys. +-- +-- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X") +-- > mapAccumWithKey f "Everything:" (fromList ((5,"a") :| [(3,"b")])) == ("Everything: 3-b 5-a", fromList ((3, "bX") :| [(5, "aX")])) +mapAccumWithKey :: + (a -> Key -> b -> (a, c)) -> + a -> + NEIntMap b -> + (a, NEIntMap c) +mapAccumWithKey f z0 (NEIntMap k v m) = (z2, NEIntMap k v' m') + where + ~(z1, v') = f z0 k v + ~(z2, m') = M.mapAccumWithKey f z1 m +{-# INLINE mapAccumWithKey #-} + +-- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating +-- argument through the map in descending order of keys. +mapAccumRWithKey :: + (a -> Key -> b -> (a, c)) -> + a -> + NEIntMap b -> + (a, NEIntMap c) +mapAccumRWithKey f z0 (NEIntMap k v m) = (z2, NEIntMap k v' m') + where + ~(z1, m') = M.mapAccumRWithKey f z0 m + ~(z2, v') = f z1 k v +{-# INLINE mapAccumRWithKey #-} + +-- | /O(n*log n)/. +-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. +-- +-- The size of the result may be smaller if @f@ maps two or more distinct +-- keys to the same new key. In this case the value at the greatest of the +-- original keys is retained. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeys (+ 1) (fromList ((5,"a") :| [(3,"b")])) == fromList ((4, "b") :| [(6, "a")]) +-- > mapKeys (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "c" +-- > mapKeys (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "c" +mapKeys :: + (Key -> Key) -> + NEIntMap a -> + NEIntMap a +mapKeys f (NEIntMap k0 v0 m) = + fromListWith const + . ((f k0, v0) :|) + . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] + $ m +{-# INLINEABLE mapKeys #-} + +-- | /O(n*log n)/. +-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. +-- +-- The size of the result may be smaller if @f@ maps two or more distinct +-- keys to the same new key. In this case the associated values will be +-- combined using @c@. The value at the greater of the two original keys +-- is used as the first argument to @c@. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeysWith (++) (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "cdab" +-- > mapKeysWith (++) (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "cdab" +mapKeysWith :: + (a -> a -> a) -> + (Key -> Key) -> + NEIntMap a -> + NEIntMap a +mapKeysWith c f (NEIntMap k0 v0 m) = + fromListWith c + . ((f k0, v0) :|) + . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] + $ m +{-# INLINEABLE mapKeysWith #-} + +-- | /O(n)/. +-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ +-- is strictly monotonic. +-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. +-- /The precondition is not checked./ +-- Semi-formally, we have: +-- +-- > and [x < y ==> f x < f y | x <- ls, y <- ls] +-- > ==> mapKeysMonotonic f s == mapKeys f s +-- > where ls = keys s +-- +-- This means that @f@ maps distinct original keys to distinct resulting keys. +-- This function has better performance than 'mapKeys'. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")])) == fromList ((6, "b") :| [(10, "a")]) +-- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")]))) == True +-- > valid (mapKeysMonotonic (\ _ -> 1) (fromList ((5,"a") :| [(3,"b")]))) == False +mapKeysMonotonic :: + (Key -> Key) -> + NEIntMap a -> + NEIntMap a +mapKeysMonotonic f (NEIntMap k v m) = + NEIntMap (f k) v + . M.mapKeysMonotonic f + $ m +{-# INLINE mapKeysMonotonic #-} + +-- | /O(n)/. Fold the keys and values in the map using the given right-associative +-- binary operator, such that +-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. +-- +-- For example, +-- +-- > keysList map = foldrWithKey (\k x ks -> k:ks) [] map +foldrWithKey :: (Key -> a -> b -> b) -> b -> NEIntMap a -> b +foldrWithKey f z (NEIntMap k v m) = f k v . M.foldrWithKey f z $ m +{-# INLINE foldrWithKey #-} + +-- | /O(n)/. Fold the keys and values in the map using the given left-associative +-- binary operator, such that +-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@. +-- +-- For example, +-- +-- > keysList = reverse . foldlWithKey (\ks k x -> k:ks) [] +foldlWithKey :: (a -> Key -> b -> a) -> a -> NEIntMap b -> a +foldlWithKey f z (NEIntMap k v m) = M.foldlWithKey f (f z k v) m +{-# INLINE foldlWithKey #-} + +-- | /O(n)/. A strict version of 'foldr1'. Each application of the operator +-- is evaluated before using the result in the next application. This +-- function is strict in the starting value. +foldr1' :: (a -> a -> a) -> NEIntMap a -> a +foldr1' f (NEIntMap _ v m) = case M.maxView m of + Nothing -> v + Just (y, m') -> let !z = M.foldr' f y m' in v `f` z +{-# INLINE foldr1' #-} + +-- | /O(n)/. A strict version of 'foldl1'. Each application of the operator +-- is evaluated before using the result in the next application. This +-- function is strict in the starting value. +foldl1' :: (a -> a -> a) -> NEIntMap a -> a +foldl1' f (NEIntMap _ v m) = M.foldl' f v m +{-# INLINE foldl1' #-} + +-- | /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. +foldrWithKey' :: (Key -> a -> b -> b) -> b -> NEIntMap a -> b +foldrWithKey' f z (NEIntMap k v m) = f k v y + where + !y = M.foldrWithKey f z m +{-# INLINE foldrWithKey' #-} + +-- | /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. +foldlWithKey' :: (a -> Key -> b -> a) -> a -> NEIntMap b -> a +foldlWithKey' f z (NEIntMap k v m) = M.foldlWithKey' f x m + where + !x = f z k v +{-# INLINE foldlWithKey' #-} + +-- | /O(n)/. Return all keys of the map in ascending order. +-- +-- > keys (fromList ((5,"a") :| [(3,"b")])) == (3 :| [5]) +keys :: NEIntMap a -> NonEmpty Key +keys (NEIntMap k _ m) = k :| M.keys m +{-# INLINE keys #-} + +-- | /O(n)/. An alias for 'toAscList'. Return all key\/value pairs in the map +-- in ascending key order. +-- +-- > assocs (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +assocs :: NEIntMap a -> NonEmpty (Key, a) +assocs = toList +{-# INLINE assocs #-} + +-- | /O(n)/. The non-empty set of all keys of the map. +-- +-- > keysSet (fromList ((5,"a") :| [(3,"b")])) == Data.Set.NonEmpty.fromList (3 :| [5]) +keysSet :: NEIntMap a -> NEIntSet +keysSet (NEIntMap k _ m) = NEIntSet k (M.keysSet m) +{-# INLINE keysSet #-} + +-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys are +-- in ascending order. +-- +-- > toAscList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +toAscList :: NEIntMap a -> NonEmpty (Key, a) +toAscList = toList +{-# INLINE toAscList #-} + +-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys +-- are in descending order. +-- +-- > toDescList (fromList ((5,"a") :| [(3,"b")])) == ((5,"a") :| [(3,"b")]) +toDescList :: NEIntMap a -> NonEmpty (Key, a) +toDescList (NEIntMap k0 v0 m) = M.foldlWithKey' go ((k0, v0) :| []) m + where + go xs k v = (k, v) NE.<| xs +{-# INLINE toDescList #-} + +-- | /O(n)/. Filter all values that satisfy the predicate. +-- +-- Returns a potentially empty map ('IntMap'), because we could +-- potentailly filter out all items in the original 'NEIntMap'. +-- +-- > filter (> "a") (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" +-- > filter (> "x") (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.empty +-- > filter (< "a") (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.empty +filter :: + (a -> Bool) -> + NEIntMap a -> + IntMap a +filter f (NEIntMap k v m) + | f v = insertMinMap k v . M.filter f $ m + | otherwise = M.filter f m +{-# INLINE filter #-} + +-- | /O(n)/. Filter all keys\/values that satisfy the predicate. +-- +-- Returns a potentially empty map ('IntMap'), because we could +-- potentailly filter out all items in the original 'NEIntMap'. +-- +-- > filterWithKey (\k _ -> k > 4) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +filterWithKey :: + (Key -> a -> Bool) -> + NEIntMap a -> + IntMap a +filterWithKey f (NEIntMap k v m) + | f k v = insertMinMap k v . M.filterWithKey f $ m + | otherwise = M.filterWithKey f m +{-# INLINE filterWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Restrict an 'NEIntMap' to only those keys +-- found in a 'Data.Set.Set'. +-- +-- @ +-- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m +-- m \`restrictKeys\` s = m ``intersection`` 'fromSet' (const ()) s +-- @ +restrictKeys :: + NEIntMap a -> + IntSet -> + IntMap a +restrictKeys n@(NEIntMap k v m) xs = case S.minView xs of + Nothing -> M.empty + Just (y, ys) -> case compare k y of + -- k is not in xs + LT -> m `M.restrictKeys` xs + -- k and y are a part of the result + EQ -> insertMinMap k v $ m `M.restrictKeys` ys + -- y is not in m + GT -> toMap n `M.restrictKeys` ys +{-# INLINE restrictKeys #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Data.Set.Set' from +-- an 'NEIntMap'. +-- +-- @ +-- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m +-- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s +-- @ +withoutKeys :: + NEIntMap a -> + IntSet -> + IntMap a +withoutKeys n@(NEIntMap k v m) xs = case S.minView xs of + Nothing -> toMap n + Just (y, ys) -> case compare k y of + -- k is not in xs, so cannot be deleted + LT -> insertMinMap k v $ m `M.withoutKeys` xs + -- y deletes k, and only k + EQ -> m `M.withoutKeys` ys + -- y is not in n, so cannot delete anything, so we can just difference n and ys + GT -> toMap n `M.withoutKeys` ys +{-# INLINE withoutKeys #-} + +-- | /O(n)/. Partition the map according to a predicate. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate was true for all items. +-- * @'That' n2@ means that the predicate was false for all items. +-- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the +-- predicate) and @n2@ (all of the items that were false for the +-- predicate). +-- +-- See also 'split'. +-- +-- > partition (> "a") (fromList ((5,"a") :| [(3,"b")])) == These (singleton 3 "b") (singleton 5 "a") +-- > partition (< "x") (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) +-- > partition (> "x") (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) +partition :: + (a -> Bool) -> + NEIntMap a -> + These (NEIntMap a) (NEIntMap a) +partition f = partitionWithKey (const f) +{-# INLINE partition #-} + +-- | /O(n)/. Partition the map according to a predicate. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate was true for all items, +-- returning the original map. +-- * @'That' n2@ means that the predicate was false for all items, +-- returning the original map. +-- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the +-- predicate) and @n2@ (all of the items that were false for the +-- predicate). +-- +-- See also 'split'. +-- +-- > partitionWithKey (\ k _ -> k > 3) (fromList ((5,"a") :| [(3,"b")])) == These (singleton 5 "a") (singleton 3 "b") +-- > partitionWithKey (\ k _ -> k < 7) (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) +-- > partitionWithKey (\ k _ -> k > 7) (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) +partitionWithKey :: + (Key -> a -> Bool) -> + NEIntMap a -> + These (NEIntMap a) (NEIntMap a) +partitionWithKey f n@(NEIntMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) + | f k v -> This n + | otherwise -> That n + (Just n1, Nothing) + | f k v -> This n + | otherwise -> These n1 (singleton k v) + (Nothing, Just n2) + | f k v -> These (singleton k v) n2 + | otherwise -> That n + (Just n1, Just n2) + | f k v -> These (insertMapMin k v m1) n2 + | otherwise -> These n1 (insertMapMin k v m2) + where + (m1, m2) = M.partitionWithKey f m0 +{-# INLINEABLE partitionWithKey #-} + +-- | /O(n)/. Map values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('IntMap'), because the function could +-- potentially return 'Nothing' on all items in the 'NEIntMap'. +-- +-- > let f x = if x == "a" then Just "new a" else Nothing +-- > mapMaybe f (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "new a" +mapMaybe :: + (a -> Maybe b) -> + NEIntMap a -> + IntMap b +mapMaybe f = mapMaybeWithKey (const f) +{-# INLINE mapMaybe #-} + +-- | /O(n)/. Map keys\/values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('IntMap'), because the function could +-- potentially return 'Nothing' on all items in the 'NEIntMap'. +-- +-- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing +-- > mapMaybeWithKey f (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "key : 3" +mapMaybeWithKey :: + (Key -> a -> Maybe b) -> + NEIntMap a -> + IntMap b +mapMaybeWithKey f (NEIntMap k v m) = maybe id (insertMinMap k) (f k v) (M.mapMaybeWithKey f m) +{-# INLINE mapMaybeWithKey #-} + +-- | /O(n)/. Map values and separate the 'Left' and 'Right' results. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the results were all 'Left'. +-- * @'That' n2@ means that the results were all 'Right'. +-- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- and @n2@ (the map where the results were 'Right') +-- +-- > let f a = if a < "c" then Left a else Right a +-- > mapEither f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == These (fromList ((3,"b") :| [(5,"a")])) (fromList ((1,"x") :| [(7,"z")])) +-- > +-- > mapEither (\ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == That (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +mapEither :: + (a -> Either b c) -> + NEIntMap a -> + These (NEIntMap b) (NEIntMap c) +mapEither f = mapEitherWithKey (const f) +{-# INLINE mapEither #-} + +-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the results were all 'Left'. +-- * @'That' n2@ means that the results were all 'Right'. +-- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- and @n2@ (the map where the results were 'Right') +-- +-- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) +-- > mapEitherWithKey f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == These (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) +-- > +-- > mapEitherWithKey (\_ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == That (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) +mapEitherWithKey :: + (Key -> a -> Either b c) -> + NEIntMap a -> + These (NEIntMap b) (NEIntMap c) +mapEitherWithKey f (NEIntMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> case f k v of + Left v' -> This (singleton k v') + Right v' -> That (singleton k v') + (Just n1, Nothing) -> case f k v of + Left v' -> This (insertMapMin k v' m1) + Right v' -> These n1 (singleton k v') + (Nothing, Just n2) -> case f k v of + Left v' -> These (singleton k v') n2 + Right v' -> That (insertMapMin k v' m2) + (Just n1, Just n2) -> case f k v of + Left v' -> These (insertMapMin k v' m1) n2 + Right v' -> These n1 (insertMapMin k v' m2) + where + (m1, m2) = M.mapEitherWithKey f m0 +{-# INLINEABLE mapEitherWithKey #-} + +-- | /O(log n)/. The expression (@'split' k map@) is potentially a 'These' +-- containing up to two 'NEIntMap's based on splitting the map into maps +-- containing items before and after the given key @k@. It will never +-- return a map that contains @k@ itself. +-- +-- * 'Nothing' means that @k@ was the only key in the the original map, +-- and so there are no items before or after it. +-- * @'Just' ('This' n1)@ means @k@ was larger than or equal to all items +-- in the map, and @n1@ is the entire original map (minus @k@, if it was +-- present) +-- * @'Just' ('That' n2)@ means @k@ was smaller than or equal to all +-- items in the map, and @n2@ is the entire original map (minus @k@, if +-- it was present) +-- * @'Just' ('These' n1 n2)@ gives @n1@ (the map of all keys from the +-- original map less than @k@) and @n2@ (the map of all keys from the +-- original map greater than @k@) +-- +-- > split 2 (fromList ((5,"a") :| [(3,"b")])) == Just (That (fromList ((3,"b") :| [(5,"a")])) ) +-- > split 3 (fromList ((5,"a") :| [(3,"b")])) == Just (That (singleton 5 "a") ) +-- > split 4 (fromList ((5,"a") :| [(3,"b")])) == Just (These (singleton 3 "b") (singleton 5 "a")) +-- > split 5 (fromList ((5,"a") :| [(3,"b")])) == Just (This (singleton 3 "b") ) +-- > split 6 (fromList ((5,"a") :| [(3,"b")])) == Just (This (fromList ((3,"b") :| [(5,"a")])) ) +-- > split 5 (singleton 5 "a") == Nothing +split :: + Key -> + NEIntMap a -> + Maybe (These (NEIntMap a) (NEIntMap a)) +split k n@(NEIntMap k0 v m0) = case compare k k0 of + LT -> Just $ That n + EQ -> That <$> nonEmptyMap m0 + GT -> Just $ case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k0 v) + (Just _, Nothing) -> This (insertMapMin k0 v m1) + (Nothing, Just n2) -> These (singleton k0 v) n2 + (Just _, Just n2) -> These (insertMapMin k0 v m1) n2 + where + (m1, m2) = M.split k m0 +{-# INLINEABLE split #-} + +-- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just +-- like 'split' but also returns @'lookup' k map@, as the first field in +-- the 'These': +-- +-- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == That (That (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == These "b" (That (singleton 5 "a")) +-- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == That (These (singleton 3 "b") (singleton 5 "a")) +-- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == These "a" (This (singleton 3 "b")) +-- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == That (This (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 5 (singleton 5 "a") == This "a" +splitLookup :: + Key -> + NEIntMap a -> + These a (These (NEIntMap a) (NEIntMap a)) +splitLookup k n@(NEIntMap k0 v0 m0) = case compare k k0 of + LT -> That . That $ n + EQ -> maybe (This v0) (These v0 . That) . nonEmptyMap $ m0 + GT -> maybe That These v $ case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k0 v0) + (Just _, Nothing) -> This (insertMapMin k0 v0 m1) + (Nothing, Just n2) -> These (singleton k0 v0) n2 + (Just _, Just n2) -> These (insertMapMin k0 v0 m1) n2 + where + (m1, v, m2) = M.splitLookup k m0 +{-# INLINEABLE splitLookup #-} + +-- | /O(1)/. Decompose a map into pieces based on the structure of the +-- underlying tree. This function is useful for consuming a map in +-- parallel. +-- +-- No guarantee is made as to the sizes of the pieces; an internal, but +-- deterministic process determines this. However, it is guaranteed that +-- the pieces returned will be in ascending order (all elements in the +-- first submap less than all elements in the second, and so on). +-- +-- Note that the current implementation does not return more than four +-- submaps, but you should not depend on this behaviour because it can +-- change in the future without notice. +splitRoot :: + NEIntMap a -> + NonEmpty (NEIntMap a) +splitRoot (NEIntMap k v m) = + singleton k v + :| Maybe.mapMaybe nonEmptyMap (M.splitRoot m) +{-# INLINE splitRoot #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). +isSubmapOf :: Eq a => NEIntMap a -> NEIntMap a -> Bool +isSubmapOf = isSubmapOfBy (==) +{-# INLINE isSubmapOf #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if +-- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when +-- applied to their respective values. For example, the following +-- expressions are all 'True': +-- +-- > isSubmapOfBy (==) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (<=) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (fromList (('a',1) :| [('b',2)])) +-- +-- But the following are all 'False': +-- +-- > isSubmapOfBy (==) (singleton 'a' 2) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (<) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (singleton 'a' 1) +isSubmapOfBy :: + (a -> b -> Bool) -> + NEIntMap a -> + NEIntMap b -> + Bool +isSubmapOfBy f (NEIntMap k v m0) (toMap -> m1) = + kvSub + && M.isSubmapOfBy f m0 m1 + where + kvSub = case M.lookup k m1 of + Just v0 -> f v v0 + Nothing -> False +{-# INLINE isSubmapOfBy #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap +-- but not equal). Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' +-- (==)@). +isProperSubmapOf :: Eq a => NEIntMap a -> NEIntMap a -> Bool +isProperSubmapOf = isProperSubmapOfBy (==) +{-# INLINE isProperSubmapOf #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap +-- but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns +-- 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, +-- and when @f@ returns 'True' when applied to their respective values. For +-- example, the following expressions are all 'True': +-- +-- > isProperSubmapOfBy (==) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +-- > isProperSubmapOfBy (<=) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +-- +-- But the following are all 'False': +-- +-- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (fromList ((1,1) :| [(2,2)])) +-- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (singleton 1 1)) +-- > isProperSubmapOfBy (<) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +isProperSubmapOfBy :: + (a -> b -> Bool) -> + NEIntMap a -> + NEIntMap b -> + Bool +isProperSubmapOfBy f m1 m2 = + M.size (neimIntMap m1) < M.size (neimIntMap m2) + && isSubmapOfBy f m1 m2 +{-# INLINE isProperSubmapOfBy #-} + +-- | /O(1)/. The minimal key of the map. Note that this is total, making +-- 'Data.IntMap.lookupMin' obsolete. It is constant-time, so has better +-- asymptotics than @Data.IntMap.lookupMin@ and @Data.IntMap.findMin@, as well. +-- +-- > findMin (fromList ((5,"a") :| [(3,"b")])) == (3,"b") +findMin :: NEIntMap a -> (Key, a) +findMin (NEIntMap k v _) = (k, v) +{-# INLINE findMin #-} + +-- | /O(log n)/. The maximal key of the map. Note that this is total, making +-- 'Data.IntMap.lookupMin' obsolete. +-- +-- > findMax (fromList ((5,"a") :| [(3,"b")])) == (5,"a") +findMax :: NEIntMap a -> (Key, a) +findMax (NEIntMap k v m) = fromMaybe (k, v) . M.lookupMax $ m +{-# INLINE findMax #-} + +-- | /O(1)/. Delete the minimal key. Returns a potentially empty map +-- ('IntMap'), because we might end up deleting the final key in a singleton +-- map. It is constant-time, so has better asymptotics than +-- 'Data.IntMap.deleteMin'. +-- +-- > deleteMin (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.IntMap.fromList [(5,"a"), (7,"c")] +-- > deleteMin (singleton 5 "a") == Data.IntMap.empty +deleteMin :: NEIntMap a -> IntMap a +deleteMin (NEIntMap _ _ m) = m +{-# INLINE deleteMin #-} + +-- | /O(log n)/. Delete the maximal key. Returns a potentially empty map +-- ('IntMap'), because we might end up deleting the final key in a singleton +-- map. +-- +-- > deleteMax (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.IntMap.fromList [(3,"b"), (5,"a")] +-- > deleteMax (singleton 5 "a") == Data.IntMap.empty +deleteMax :: NEIntMap a -> IntMap a +deleteMax (NEIntMap k v m) = case M.maxView m of + Nothing -> M.empty + Just (_, m') -> insertMinMap k v m' +{-# INLINE deleteMax #-} + +-- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the +-- minimal key. Returns a potentially empty map ('IntMap'), because we might +-- end up deleting the final key in the map if the function returns +-- 'Nothing'. See 'adjustMin' for a version that can guaruntee that we +-- return a non-empty map. +-- +-- > updateMin (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "Xb"), (5, "a")] +-- > updateMin (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +updateMin :: (a -> Maybe a) -> NEIntMap a -> IntMap a +updateMin f = updateMinWithKey (const f) +{-# INLINE updateMin #-} + +-- | /O(1)/. A version of 'updateMin' that disallows deletion, allowing us +-- to guarantee that the result is also non-empty. +adjustMin :: (a -> a) -> NEIntMap a -> NEIntMap a +adjustMin f = adjustMinWithKey (const f) +{-# INLINE adjustMin #-} + +-- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the +-- minimal key. Returns a potentially empty map ('IntMap'), because we might +-- end up deleting the final key in the map if the function returns +-- 'Nothing'. See 'adjustMinWithKey' for a version that guaruntees +-- a non-empty map. +-- +-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3,"3:b"), (5,"a")] +-- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +updateMinWithKey :: (Key -> a -> Maybe a) -> NEIntMap a -> IntMap a +updateMinWithKey f (NEIntMap k v m) = maybe id (insertMinMap k) (f k v) m +{-# INLINE updateMinWithKey #-} + +-- | /O(1)/. A version of 'adjustMaxWithKey' that disallows deletion, +-- allowing us to guarantee that the result is also non-empty. Note that +-- it also is able to have better asymptotics than 'updateMinWithKey' in +-- general. +adjustMinWithKey :: (Key -> a -> a) -> NEIntMap a -> NEIntMap a +adjustMinWithKey f (NEIntMap k v m) = NEIntMap k (f k v) m +{-# INLINE adjustMinWithKey #-} + +-- | /O(log n)/. Update the value at the maximal key. Returns +-- a potentially empty map ('IntMap'), because we might end up deleting the +-- final key in the map if the function returns 'Nothing'. See 'adjustMax' +-- for a version that can guarantee that we return a non-empty map. +-- +-- > updateMax (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3, "b"), (5, "Xa")] +-- > updateMax (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 3 "b" +updateMax :: (a -> Maybe a) -> NEIntMap a -> IntMap a +updateMax f = updateMaxWithKey (const f) +{-# INLINE updateMax #-} + +-- | /O(log n)/. A version of 'updateMax' that disallows deletion, allowing +-- us to guarantee that the result is also non-empty. +adjustMax :: (a -> a) -> NEIntMap a -> NEIntMap a +adjustMax f = adjustMaxWithKey (const f) +{-# INLINE adjustMax #-} + +-- | /O(log n)/. Update the value at the maximal key. Returns +-- a potentially empty map ('IntMap'), because we might end up deleting the +-- final key in the map if the function returns 'Nothing'. See +-- 'adjustMaxWithKey' for a version that guaruntees a non-empty map. +-- +-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.fromList [(3,"3:b"), (5,"a")] +-- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.IntMap.singleton 5 "a" +updateMaxWithKey :: (Key -> a -> Maybe a) -> NEIntMap a -> IntMap a +updateMaxWithKey f (NEIntMap k v m) + | M.null m = maybe m (M.singleton k) $ f k v + | otherwise = + insertMinMap k v + . M.updateMaxWithKey f + $ m +{-# INLINE updateMaxWithKey #-} + +-- | /O(log n)/. A version of 'updateMaxWithKey' that disallows deletion, +-- allowing us to guarantee that the result is also non-empty. +adjustMaxWithKey :: (Key -> a -> a) -> NEIntMap a -> NEIntMap a +adjustMaxWithKey f (NEIntMap k0 v m) + | M.null m = NEIntMap k0 (f k0 v) m + | otherwise = + insertMapMin k0 v + . M.updateMaxWithKey (\k -> Just . f k) + $ m +{-# INLINE adjustMaxWithKey #-} + +-- | /O(1)/. Retrieves the value associated with minimal key of the +-- map, and the map stripped of that element. It is constant-time, so has +-- better asymptotics than @Data.IntMap.minView@ for 'IntMap'. +-- +-- Note that unlike @Data.IntMap.minView@ for 'IntMap', this cannot ever fail, +-- so doesn't need to return in a 'Maybe'. However, the result 'IntMap' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > minView (fromList ((5,"a") :| [(3,"b")])) == ("b", Data.IntMap.singleton 5 "a") +minView :: NEIntMap a -> (a, IntMap a) +minView = first snd . deleteFindMin +{-# INLINE minView #-} + +-- | /O(1)/. Delete and find the minimal key-value pair. It is +-- constant-time, so has better asymptotics that @Data.IntMap.minView@ for +-- 'IntMap'. +-- +-- Note that unlike @Data.IntMap.deleteFindMin@ for 'IntMap', this cannot ever +-- fail, and so is a total function. However, the result 'IntMap' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > deleteFindMin (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((3,"b"), Data.IntMap.fromList [(5,"a"), (10,"c")]) +deleteFindMin :: NEIntMap a -> ((Key, a), IntMap a) +deleteFindMin (NEIntMap k v m) = ((k, v), m) +{-# INLINE deleteFindMin #-} + +-- | /O(log n)/. Retrieves the value associated with maximal key of the +-- map, and the map stripped of that element. +-- +-- Note that unlike @Data.IntMap.maxView@ from 'IntMap', this cannot ever fail, +-- so doesn't need to return in a 'Maybe'. However, the result 'IntMap' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > maxView (fromList ((5,"a") :| [(3,"b")])) == ("a", Data.IntMap.singleton 3 "b") +maxView :: NEIntMap a -> (a, IntMap a) +maxView = first snd . deleteFindMax +{-# INLINE maxView #-} + +-- | /O(log n)/. Delete and find the minimal key-value pair. +-- +-- Note that unlike @Data.IntMap.deleteFindMax@ for 'IntMap', this cannot ever +-- fail, and so is a total function. However, the result 'IntMap' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > deleteFindMax (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((10,"c"), Data.IntMap.fromList [(3,"b"), (5,"a")]) +deleteFindMax :: NEIntMap a -> ((Key, a), IntMap a) +deleteFindMax (NEIntMap k v m) = + maybe ((k, v), M.empty) (second (insertMinMap k v)) + . M.maxViewWithKey + $ m +{-# INLINE deleteFindMax #-} + +-- --------------------------- +-- Combining functions +-- --------------------------- +-- +-- Code comes from "Data.Map.Internal" from containers, modified slightly +-- to work with NonEmpty +-- +-- Copyright : (c) Daan Leijen 2002 +-- (c) Andriy Palamarchuk 2008 + +combineEq :: NonEmpty (Key, b) -> NonEmpty (Key, b) +combineEq = \case + x :| [] -> x :| [] + x :| xx@(_ : _) -> go x xx + where + go z [] = z :| [] + go z@(kz, _) (x@(kx, xx) : xs') + | kx == kz = go (kx, xx) xs' + | otherwise = z NE.<| go x xs' + +combineEqWith :: + (Key -> b -> b -> b) -> + NonEmpty (Key, b) -> + NonEmpty (Key, b) +combineEqWith f = \case + x :| [] -> x :| [] + x :| xx@(_ : _) -> go x xx + where + go z [] = z :| [] + go z@(kz, zz) (x@(kx, xx) : xs') + | kx == kz = let yy = f kx xx zz in go (kx, yy) xs' + | otherwise = z NE.<| go x xs' diff --git a/src/Data/IntMap/NonEmpty/Strict/Internal.hs b/src/Data/IntMap/NonEmpty/Strict/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/IntMap/NonEmpty/Strict/Internal.hs @@ -0,0 +1,186 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_HADDOCK not-home #-} + +-- | +-- Module : Data.IntMap.NonEmpty.Strict.Internal +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- Strict internal-use functions used in the implementation of +-- "Data.IntMap.NonEmpty.Strict". These share the same 'NEIntMap' type as +-- the lazy modules; only construction is strict in the value. +module Data.IntMap.NonEmpty.Strict.Internal ( + -- * Non-Empty IntMap type + NEIntMap, + pattern NEIntMap, + neimIntMap, + Key, + singleton, + nonEmptyMap, + withNonEmpty, + fromList, + toList, + map, + insertWith, + union, + unions, + elems, + size, + toMap, + + -- * Folds + foldr, + foldr', + foldr1, + foldl, + foldl', + foldl1, + + -- * Traversals + traverseWithKey, + traverseWithKey1, + foldMapWithKey, + + -- * Unsafe IntMap Functions + insertMinMap, + insertMaxMap, + + -- * Debug + valid, +) where + +import Control.Applicative +import qualified Data.Foldable as F +import Data.Functor.Apply (Apply, MaybeApply (..), (<.>)) +import Data.IntMap.Internal (IntMap, Key) +import qualified Data.IntMap.NonEmpty.Lazy.Internal as L +import qualified Data.IntMap.Strict as M +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Semigroup.Foldable (Foldable1) +import qualified Data.Semigroup.Foldable as F1 +import Prelude hiding (Foldable (..), foldl, foldl1, foldr, foldr1, map) + +type NEIntMap = L.NEIntMap + +pattern NEIntMap :: Key -> a -> IntMap a -> NEIntMap a +pattern NEIntMap k v m <- L.NEIntMap k v m + where + NEIntMap k !v m = L.NEIntMap k v m + +{-# COMPLETE NEIntMap #-} + +neimIntMap :: NEIntMap a -> IntMap a +neimIntMap (NEIntMap _ _ m) = m +{-# INLINE neimIntMap #-} + +singleton :: Key -> a -> NEIntMap a +singleton k !v = L.NEIntMap k v M.empty +{-# INLINE singleton #-} + +nonEmptyMap :: IntMap a -> Maybe (NEIntMap a) +nonEmptyMap = L.nonEmptyMap +{-# INLINE nonEmptyMap #-} + +withNonEmpty :: b -> (NEIntMap a -> b) -> IntMap a -> b +withNonEmpty = L.withNonEmpty +{-# INLINE withNonEmpty #-} + +fromList :: NonEmpty (Key, a) -> NEIntMap a +fromList ((k, v) :| xs) = F.foldl' (\m (k', v') -> insertWith const k' v' m) (singleton k v) xs +{-# INLINE fromList #-} + +toList :: NEIntMap a -> NonEmpty (Key, a) +toList = L.toList +{-# INLINE toList #-} + +map :: (a -> b) -> NEIntMap a -> NEIntMap b +map f (NEIntMap k v m) = NEIntMap k (f v) (M.map f m) +{-# INLINE map #-} + +insertWith :: (a -> a -> a) -> Key -> a -> NEIntMap a -> NEIntMap a +insertWith f k !v n@(NEIntMap k0 v0 m) = case compare k k0 of + LT -> NEIntMap k v (toMap n) + EQ -> NEIntMap k0 (f v v0) m + GT -> NEIntMap k0 v0 (M.insertWith f k v m) +{-# INLINE insertWith #-} + +union :: NEIntMap a -> NEIntMap a -> NEIntMap a +union n1@(NEIntMap k1 v1 m1) n2@(NEIntMap k2 v2 m2) = case compare k1 k2 of + LT -> NEIntMap k1 v1 . M.union m1 . toMap $ n2 + EQ -> NEIntMap k1 v1 . M.union m1 $ m2 + GT -> NEIntMap k2 v2 . M.union (toMap n1) $ m2 +{-# INLINE union #-} + +unions :: Foldable1 f => f (NEIntMap a) -> NEIntMap a +unions ns = case F1.toNonEmpty ns of + m :| ms -> F.foldl' union m ms +{-# INLINE unions #-} + +elems :: NEIntMap a -> NonEmpty a +elems = fmap snd . toList +{-# INLINE elems #-} + +size :: NEIntMap a -> Int +size = L.size +{-# INLINE size #-} + +toMap :: NEIntMap a -> IntMap a +toMap (NEIntMap k v m) = insertMinMap k v m +{-# INLINE toMap #-} + +foldr :: (a -> b -> b) -> b -> NEIntMap a -> b +foldr = L.foldr +{-# INLINE foldr #-} + +foldr' :: (a -> b -> b) -> b -> NEIntMap a -> b +foldr' = L.foldr' +{-# INLINE foldr' #-} + +foldr1 :: (a -> a -> a) -> NEIntMap a -> a +foldr1 = L.foldr1 +{-# INLINE foldr1 #-} + +foldl :: (b -> a -> b) -> b -> NEIntMap a -> b +foldl = L.foldl +{-# INLINE foldl #-} + +foldl' :: (b -> a -> b) -> b -> NEIntMap a -> b +foldl' = L.foldl' +{-# INLINE foldl' #-} + +foldl1 :: (a -> a -> a) -> NEIntMap a -> a +foldl1 = L.foldl1 +{-# INLINE foldl1 #-} + +traverseWithKey :: Applicative f => (Key -> a -> f b) -> NEIntMap a -> f (NEIntMap b) +traverseWithKey f (NEIntMap k v m) = NEIntMap k <$> f k v <*> M.traverseWithKey f m +{-# INLINE traverseWithKey #-} + +traverseWithKey1 :: Apply f => (Key -> a -> f b) -> NEIntMap a -> f (NEIntMap b) +traverseWithKey1 f (NEIntMap k0 v m0) = case runMaybeApply m1 of + Left m2 -> NEIntMap k0 <$> f k0 v <.> m2 + Right m2 -> flip (NEIntMap k0) m2 <$> f k0 v + where + m1 = M.traverseWithKey (\k -> MaybeApply . Left . f k) m0 +{-# INLINE traverseWithKey1 #-} + +foldMapWithKey :: Monoid m => (Key -> a -> m) -> NEIntMap a -> m +foldMapWithKey = L.foldMapWithKey +{-# INLINE foldMapWithKey #-} + +valid :: NEIntMap a -> Bool +valid (NEIntMap k _ m) = + all ((k <) . fst . fst) (M.minViewWithKey m) + +insertMinMap :: Key -> a -> IntMap a -> IntMap a +insertMinMap k !v = M.insert k v +{-# INLINE insertMinMap #-} + +insertMaxMap :: Key -> a -> IntMap a -> IntMap a +insertMaxMap k !v = M.insert k v +{-# INLINE insertMaxMap #-} diff --git a/src/Data/Map/NonEmpty.hs b/src/Data/Map/NonEmpty.hs --- a/src/Data/Map/NonEmpty.hs +++ b/src/Data/Map/NonEmpty.hs @@ -1,2495 +1,18 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE EmptyCase #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ViewPatterns #-} - --- | --- Module : Data.Map.NonEmpty --- Copyright : (c) Justin Le 2018 --- License : BSD3 --- --- Maintainer : justin@jle.im --- Stability : experimental --- Portability : non-portable --- --- = Non-Empty Finite Maps (lazy interface) --- --- The @'NEMap' k v@ type represents a non-empty finite map (sometimes --- called a dictionary) from keys of type @k@ to values of type @v@. --- An 'NEMap' is strict in its keys but lazy in its values. --- --- See documentation for 'NEMap' for information on how to convert and --- manipulate such non-empty maps. --- --- This module essentially re-imports the API of "Data.Map.Lazy" and its --- 'Map' type, along with semantics and asymptotics. In most situations, --- asymptotics are different only by a constant factor. In some --- situations, asmyptotics are even better (constant-time instead of --- log-time). All typeclass constraints are identical to their "Data.Map" --- counterparts. --- --- Because 'NEMap' is implemented using 'Map', all of the caveats of using --- 'Map' apply (such as the limitation of the maximum size of maps). --- --- All functions take non-empty maps as inputs. In situations where their --- results can be guarunteed to also be non-empty, they also return --- non-empty maps. In situations where their results could potentially be --- empty, 'Map' is returned instead. --- --- Some variants of functions (like 'alter'', 'alterF'', 'adjustAt', --- 'adjustMin', 'adjustMax', 'adjustMinWithKey', 'adjustMaxWithKey') are --- provided in a way restructured to preserve guaruntees of non-empty maps --- being returned. --- --- Some functions (like 'mapEither', 'partition', 'spanAntitone', 'split') --- have modified return types to account for possible configurations of --- non-emptiness. --- --- This module is intended to be imported qualified, to avoid name clashes with --- "Prelude" and "Data.Map" functions: --- --- > import qualified Data.Map.NonEmpty as NEM --- --- At the moment, this package does not provide a variant strict on values --- for these functions, like /containers/ does. This is a planned future --- implementation (PR's are appreciated). For now, you can simulate --- a strict interface by manually forcing values before returning results. -module Data.Map.NonEmpty ( - -- * Non-Empty Map type - NEMap, - - -- ** Conversions between empty and non-empty maps - pattern IsNonEmpty, - pattern IsEmpty, - nonEmptyMap, - toMap, - withNonEmpty, - insertMap, - insertMapWith, - insertMapWithKey, - insertMapMin, - insertMapMax, - unsafeFromMap, - - -- * Construction - singleton, - fromSet, - - -- ** From Unordered Lists - fromList, - fromListWith, - fromListWithKey, - - -- ** From Ascending Lists - fromAscList, - fromAscListWith, - fromAscListWithKey, - fromDistinctAscList, - - -- ** From Descending Lists - fromDescList, - fromDescListWith, - fromDescListWithKey, - fromDistinctDescList, - - -- * Insertion - insert, - insertWith, - insertWithKey, - insertLookupWithKey, - - -- * Deletion\/Update - delete, - deleteMaybe, - adjust, - adjustWithKey, - update, - updateWithKey, - updateLookupWithKey, - alter, - alterF, - alter', - alterF', - - -- * Query - - -- ** Lookup - lookup, - (!?), - (!), - findWithDefault, - member, - notMember, - lookupLT, - lookupGT, - lookupLE, - lookupGE, - absurdNEMap, - - -- ** Size - size, - - -- * Combine - - -- ** Union - union, - unionMapLeft, - unionMapRight, - unionWith, - unionMapWithLeft, - unionMapWithRight, - unionWithKey, - unionMapWithKeyLeft, - unionMapWithKeyRight, - unions, - unionsWith, - - -- ** Difference - difference, - (\\), - differenceWith, - differenceWithKey, - - -- ** Intersection - intersection, - intersectionWith, - intersectionWithKey, - -- -- ** Unsafe general combining function - -- , mergeWithKey - - -- * Traversal - - -- ** Map - map, - mapWithKey, - traverseWithKey1, - traverseWithKey, - traverseMaybeWithKey1, - traverseMaybeWithKey, - mapAccum, - mapAccumWithKey, - mapAccumRWithKey, - mapKeys, - mapKeysWith, - mapKeysMonotonic, - - -- * Folds - foldr, - foldl, - foldr1, - foldl1, - foldrWithKey, - foldlWithKey, - foldMapWithKey, - - -- ** Strict folds - foldr', - foldr1', - foldl', - foldl1', - foldrWithKey', - foldlWithKey', - - -- * Conversion - elems, - keys, - assocs, - keysSet, - - -- ** Lists - toList, - - -- ** Ordered lists - toAscList, - toDescList, - - -- * Filter - filter, - filterWithKey, - restrictKeys, - withoutKeys, - partition, - partitionWithKey, - takeWhileAntitone, - dropWhileAntitone, - spanAntitone, - mapMaybe, - mapMaybeWithKey, - mapEither, - mapEitherWithKey, - split, - splitLookup, - splitRoot, - - -- * Submap - isSubmapOf, - isSubmapOfBy, - isProperSubmapOf, - isProperSubmapOfBy, - - -- * Indexed - lookupIndex, - findIndex, - elemAt, - updateAt, - adjustAt, - deleteAt, - take, - drop, - splitAt, - - -- * Min\/Max - findMin, - findMax, - deleteMin, - deleteMax, - deleteFindMin, - deleteFindMax, - updateMin, - updateMax, - adjustMin, - adjustMax, - updateMinWithKey, - updateMaxWithKey, - adjustMinWithKey, - adjustMaxWithKey, - minView, - maxView, - - -- * Debugging - valid, -) where - -import Control.Applicative -import Data.Bifunctor -import qualified Data.Foldable as F -import Data.Function -import Data.Functor.Apply -import Data.Functor.Identity -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NE -import Data.Map (Map) -import qualified Data.Map as M -import Data.Map.NonEmpty.Internal -import Data.Maybe hiding (mapMaybe) -import qualified Data.Maybe as Maybe -import Data.Semigroup.Foldable (Foldable1) -import qualified Data.Semigroup.Foldable as F1 -import Data.Set (Set) -import qualified Data.Set as S -import Data.Set.NonEmpty.Internal (NESet (..)) -import Data.These -import Data.Void -import Prelude hiding (Foldable (..), drop, filter, lookup, map, splitAt, take) - --- | /O(1)/ match, /O(log n)/ usage of contents. The 'IsNonEmpty' and --- 'IsEmpty' patterns allow you to treat a 'Map' as if it were either --- a @'IsNonEmpty' n@ (where @n@ is a 'NEMap') or an 'IsEmpty'. --- --- For example, you can pattern match on a 'Map': --- --- @ --- myFunc :: 'Map' K X -> Y --- myFunc ('IsNonEmpty' n) = -- here, the user provided a non-empty map, and @n@ is the 'NEMap' --- myFunc 'IsEmpty' = -- here, the user provided an empty map. --- @ --- --- Matching on @'IsNonEmpty' n@ means that the original 'Map' was /not/ --- empty, and you have a verified-non-empty 'NEMap' @n@ to use. --- --- Note that patching on this pattern is /O(1)/. However, using the --- contents requires a /O(log n)/ cost that is deferred until after the --- pattern is matched on (and is not incurred at all if the contents are --- never used). --- --- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides --- complete coverage. --- --- This is a bidirectional pattern, so you can use 'IsNonEmpty' to convert --- a 'NEMap' back into a 'Map', obscuring its non-emptiness (see 'toMap'). -pattern IsNonEmpty :: NEMap k a -> Map k a -pattern IsNonEmpty n <- (nonEmptyMap -> Just n) - where - IsNonEmpty n = toMap n - --- | /O(1)/. The 'IsNonEmpty' and 'IsEmpty' patterns allow you to treat --- a 'Map' as if it were either a @'IsNonEmpty' n@ (where @n@ is --- a 'NEMap') or an 'IsEmpty'. --- --- Matching on 'IsEmpty' means that the original 'Map' was empty. --- --- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides --- complete coverage. --- --- This is a bidirectional pattern, so you can use 'IsEmpty' as an --- expression, and it will be interpreted as 'Data.Map.empty'. --- --- See 'IsNonEmpty' for more information. -pattern IsEmpty :: Map k a -pattern IsEmpty <- (M.null -> True) - where - IsEmpty = M.empty - -{-# COMPLETE IsNonEmpty, IsEmpty #-} - --- | /O(log n)/. Unsafe version of 'nonEmptyMap'. Coerces a 'Map' into an --- 'NEMap', but is undefined (throws a runtime exception when evaluation is --- attempted) for an empty 'Map'. -unsafeFromMap :: - Map k a -> - NEMap k a -unsafeFromMap = withNonEmpty e id - where - e = errorWithoutStackTrace "NEMap.unsafeFromMap: empty map" -{-# INLINE unsafeFromMap #-} - --- | /O(n)/. Build a non-empty map from a non-empty set of keys and --- a function which for each key computes its value. --- --- > fromSet (\k -> replicate k 'a') (Data.Set.NonEmpty.fromList (3 :| [5])) == fromList ((5,"aaaaa") :| [(3,"aaa")]) -fromSet :: - (k -> a) -> - NESet k -> - NEMap k a -fromSet f (NESet k ks) = NEMap k (f k) (M.fromSet f ks) -{-# INLINE fromSet #-} - --- | /O(log n)/. Lookup the value at a key in the map. --- --- The function will return the corresponding value as @('Just' value)@, --- or 'Nothing' if the key isn't in the map. --- --- An example of using @lookup@: --- --- > import Prelude hiding (lookup) --- > import Data.Map.NonEmpty --- > --- > employeeDept = fromList (("John","Sales") :| [("Bob","IT")]) --- > deptCountry = fromList (("IT","USA") :| [("Sales","France")]) --- > countryCurrency = fromList (("USA", "Dollar") :| [("France", "Euro")]) --- > --- > employeeCurrency :: String -> Maybe String --- > employeeCurrency name = do --- > dept <- lookup name employeeDept --- > country <- lookup dept deptCountry --- > lookup country countryCurrency --- > --- > main = do --- > putStrLn $ "John's currency: " ++ (show (employeeCurrency "John")) --- > putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete")) --- --- The output of this program: --- --- > John's currency: Just "Euro" --- > Pete's currency: Nothing -lookup :: - Ord k => - k -> - NEMap k a -> - Maybe a -lookup k (NEMap k0 v m) = case compare k k0 of - LT -> Nothing - EQ -> Just v - GT -> M.lookup k m -{-# INLINE lookup #-} - --- | /O(log n)/. Find the value at a key. Returns 'Nothing' when the --- element can not be found. --- --- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 1 == Nothing --- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 5 == Just 'a' -(!?) :: Ord k => NEMap k a -> k -> Maybe a -(!?) = flip lookup -{-# INLINE (!?) #-} - --- | /O(log n)/. Find the value at a key. Calls 'error' when the element --- can not be found. --- --- > fromList ((5,'a') :| [(3,'b')]) ! 1 Error: element not in the map --- > fromList ((5,'a') :| [(3,'b')]) ! 5 == 'a' -(!) :: Ord k => NEMap k a -> k -> a -(!) m k = fromMaybe e $ m !? k - where - e = error "NEMap.!: given key is not an element in the map" -{-# INLINE (!) #-} - -infixl 9 !? -infixl 9 ! - --- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns --- the value at key @k@ or returns default value @def@ --- when the key is not in the map. --- --- > findWithDefault 'x' 1 (fromList ((5,'a') :| [(3,'b')])) == 'x' --- > findWithDefault 'x' 5 (fromList ((5,'a') :| [(3,'b')])) == 'a' -findWithDefault :: - Ord k => - a -> - k -> - NEMap k a -> - a -findWithDefault def k (NEMap k0 v m) = case compare k k0 of - LT -> def - EQ -> v - GT -> M.findWithDefault def k m -{-# INLINE findWithDefault #-} - --- | /O(log n)/. Is the key a member of the map? See also 'notMember'. --- --- > member 5 (fromList ((5,'a') :| [(3,'b')])) == True --- > member 1 (fromList ((5,'a') :| [(3,'b')])) == False -member :: Ord k => k -> NEMap k a -> Bool -member k (NEMap k0 _ m) = case compare k k0 of - LT -> False - EQ -> True - GT -> M.member k m -{-# INLINE member #-} - --- | /O(log n)/. Is the key not a member of the map? See also 'member'. --- --- > notMember 5 (fromList ((5,'a') :| [(3,'b')])) == False --- > notMember 1 (fromList ((5,'a') :| [(3,'b')])) == True -notMember :: Ord k => k -> NEMap k a -> Bool -notMember k (NEMap k0 _ m) = case compare k k0 of - LT -> True - EQ -> False - GT -> M.notMember k m -{-# INLINE notMember #-} - --- | /O(log n)/. Find largest key smaller than the given one and return the --- corresponding (key, value) pair. --- --- > lookupLT 3 (fromList ((3,'a') :| [(5,'b')])) == Nothing --- > lookupLT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') -lookupLT :: Ord k => k -> NEMap k a -> Maybe (k, a) -lookupLT k (NEMap k0 v m) = case compare k k0 of - LT -> Nothing - EQ -> Nothing - GT -> M.lookupLT k m <|> Just (k0, v) -{-# INLINE lookupLT #-} - --- | /O(log n)/. Find smallest key greater than the given one and return the --- corresponding (key, value) pair. --- --- > lookupGT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') --- > lookupGT 5 (fromList ((3,'a') :| [(5,'b')])) == Nothing -lookupGT :: Ord k => k -> NEMap k a -> Maybe (k, a) -lookupGT k (NEMap k0 v m) = case compare k k0 of - LT -> Just (k0, v) - EQ -> M.lookupMin m - GT -> M.lookupGT k m -{-# INLINE lookupGT #-} - --- | /O(log n)/. Find largest key smaller or equal to the given one and return --- the corresponding (key, value) pair. --- --- > lookupLE 2 (fromList ((3,'a') :| [(5,'b')])) == Nothing --- > lookupLE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') --- > lookupLE 5 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') -lookupLE :: Ord k => k -> NEMap k a -> Maybe (k, a) -lookupLE k (NEMap k0 v m) = case compare k k0 of - LT -> Nothing - EQ -> Just (k0, v) - GT -> M.lookupLE k m <|> Just (k0, v) -{-# INLINE lookupLE #-} - --- | /O(log n)/. Find smallest key greater or equal to the given one and return --- the corresponding (key, value) pair. --- --- > lookupGE 3 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') --- > lookupGE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') --- > lookupGE 6 (fromList ((3,'a') :| [(5,'b')])) == Nothing -lookupGE :: Ord k => k -> NEMap k a -> Maybe (k, a) -lookupGE k (NEMap k0 v m) = case compare k k0 of - LT -> Just (k0, v) - EQ -> Just (k0, v) - GT -> M.lookupGE k m -{-# INLINE lookupGE #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union with a combining function. --- --- > unionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "aA"), (7, "C")]) -unionWith :: - Ord k => - (a -> a -> a) -> - NEMap k a -> - NEMap k a -> - NEMap k a -unionWith f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of - LT -> NEMap k1 v1 . M.unionWith f m1 . toMap $ n2 - EQ -> NEMap k1 (f v1 v2) . M.unionWith f m1 $ m2 - GT -> NEMap k2 v2 . M.unionWith f (toMap n1) $ m2 -{-# INLINE unionWith #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a possibly-empty --- 'Map' and a non-empty map. --- --- @since 0.3.6.0 -unionMapLeft :: Ord k => Map k a -> NEMap k a -> NEMap k a -unionMapLeft m n = withNonEmpty n (`union` n) m -{-# INLINE unionMapLeft #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a non-empty map and a --- possibly-empty 'Map'. --- --- @since 0.3.6.0 -unionMapRight :: Ord k => NEMap k a -> Map k a -> NEMap k a -unionMapRight n = withNonEmpty n (union n) -{-# INLINE unionMapRight #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'Map' and a --- non-empty map with a combining function. --- --- @since 0.3.6.0 -unionMapWithLeft :: Ord k => (a -> a -> a) -> Map k a -> NEMap k a -> NEMap k a -unionMapWithLeft f m n = withNonEmpty n (\m' -> unionWith f m' n) m -{-# INLINE unionMapWithLeft #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a --- possibly-empty 'Map' with a combining function. --- --- @since 0.3.6.0 -unionMapWithRight :: Ord k => (a -> a -> a) -> NEMap k a -> Map k a -> NEMap k a -unionMapWithRight f n = withNonEmpty n (unionWith f n) -{-# INLINE unionMapWithRight #-} - --- | /O(m*log(n\/m + 1)), m <= n/. --- Union with a combining function, given the matching key. --- --- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value --- > unionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "5:a|A"), (7, "C")]) -unionWithKey :: - Ord k => - (k -> a -> a -> a) -> - NEMap k a -> - NEMap k a -> - NEMap k a -unionWithKey f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of - LT -> NEMap k1 v1 . M.unionWithKey f m1 . toMap $ n2 - EQ -> NEMap k1 (f k1 v1 v2) . M.unionWithKey f m1 $ m2 - GT -> NEMap k2 v2 . M.unionWithKey f (toMap n1) $ m2 -{-# INLINE unionWithKey #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'Map' and a --- non-empty map with a combining function, given the matching key. --- --- @since 0.3.6.0 -unionMapWithKeyLeft :: - Ord k => - (k -> a -> a -> a) -> - Map k a -> - NEMap k a -> - NEMap k a -unionMapWithKeyLeft f m n = withNonEmpty n (\m' -> unionWithKey f m' n) m -{-# INLINE unionMapWithKeyLeft #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a --- possibly-empty 'Map' with a combining function, given the matching key. --- --- @since 0.3.6.0 -unionMapWithKeyRight :: - Ord k => - (k -> a -> a -> a) -> - NEMap k a -> - Map k a -> - NEMap k a -unionMapWithKeyRight f n = withNonEmpty n (unionWithKey f n) -{-# INLINE unionMapWithKeyRight #-} - --- | The union of a non-empty list of maps, with a combining operation: --- (@'unionsWith' f == 'Data.Foldable.foldl1' ('unionWith' f)@). --- --- > unionsWith (++) (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) --- > == fromList ((3, "bB3") :| [(5, "aAA3"), (7, "C")]) -unionsWith :: - (Foldable1 f, Ord k) => - (a -> a -> a) -> - f (NEMap k a) -> - NEMap k a -unionsWith f (F1.toNonEmpty -> (m :| ms)) = F.foldl' (unionWith f) m ms -{-# INLINE unionsWith #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Difference of two maps. --- Return elements of the first map not existing in the second map. --- --- Returns a potentially empty map ('Map'), in case the first map is --- a subset of the second map. --- --- > difference (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 3 "b" -difference :: - Ord k => - NEMap k a -> - NEMap k b -> - Map k a -difference n1@(NEMap k1 v1 m1) n2@(NEMap k2 _ m2) = case compare k1 k2 of - -- k1 is not in n2, so cannot be deleted - LT -> insertMinMap k1 v1 $ m1 `M.difference` toMap n2 - -- k2 deletes k1, and only k1 - EQ -> m1 `M.difference` m2 - -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. - GT -> toMap n1 `M.difference` m2 -{-# INLINE difference #-} - --- | Same as 'difference'. -(\\) :: - Ord k => - NEMap k a -> - NEMap k b -> - Map k a -(\\) = difference -{-# INLINE (\\) #-} - --- | /O(n+m)/. Difference with a combining function. --- When two equal keys are --- encountered, the combining function is applied to the values of these keys. --- If it returns 'Nothing', the element is discarded (proper set difference). If --- it returns (@'Just' y@), the element is updated with a new value @y@. --- --- Returns a potentially empty map ('Map'), in case the first map is --- a subset of the second map and the function returns 'Nothing' for every --- pair. --- --- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing --- > differenceWith f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (7, "C")])) --- > == Data.Map.singleton 3 "b:B" -differenceWith :: - Ord k => - (a -> b -> Maybe a) -> - NEMap k a -> - NEMap k b -> - Map k a -differenceWith f = differenceWithKey (const f) -{-# INLINE differenceWith #-} - --- | /O(n+m)/. Difference with a combining function. When two equal keys are --- encountered, the combining function is applied to the key and both values. --- If it returns 'Nothing', the element is discarded (proper set difference). If --- it returns (@'Just' y@), the element is updated with a new value @y@. --- --- Returns a potentially empty map ('Map'), in case the first map is --- a subset of the second map and the function returns 'Nothing' for every --- pair. --- --- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing --- > differenceWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (10, "C")])) --- > == Data.Map.singleton 3 "3:b|B" -differenceWithKey :: - Ord k => - (k -> a -> b -> Maybe a) -> - NEMap k a -> - NEMap k b -> - Map k a -differenceWithKey f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of - -- k1 is not in n2, so cannot be deleted - LT -> insertMinMap k1 v1 $ M.differenceWithKey f m1 (toMap n2) - -- k2 deletes k1, and only k1 - EQ -> maybe id (insertMinMap k1) (f k1 v1 v2) (M.differenceWithKey f m1 m2) - -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. - GT -> M.differenceWithKey f (toMap n1) m2 -{-# INLINE differenceWithKey #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Intersection of two maps. --- Return data in the first map for the keys existing in both maps. --- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). --- --- Returns a potentially empty map ('Map'), in case the two maps share no --- keys in common. --- --- > intersection (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 5 "a" -intersection :: - Ord k => - NEMap k a -> - NEMap k b -> - Map k a -intersection n1@(NEMap k1 v1 m1) n2@(NEMap k2 _ m2) = case compare k1 k2 of - -- k1 is not in n2 - LT -> m1 `M.intersection` toMap n2 - -- k1 and k2 are a part of the result - EQ -> insertMinMap k1 v1 $ m1 `M.intersection` m2 - -- k2 is not in n1 - GT -> toMap n1 `M.intersection` m2 -{-# INLINE intersection #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. --- --- Returns a potentially empty map ('Map'), in case the two maps share no --- keys in common. --- --- > intersectionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 5 "aA" -intersectionWith :: - Ord k => - (a -> b -> c) -> - NEMap k a -> - NEMap k b -> - Map k c -intersectionWith f = intersectionWithKey (const f) -{-# INLINE intersectionWith #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. --- --- Returns a potentially empty map ('Map'), in case the two maps share no --- keys in common. --- --- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar --- > intersectionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 5 "5:a|A" -intersectionWithKey :: - Ord k => - (k -> a -> b -> c) -> - NEMap k a -> - NEMap k b -> - Map k c -intersectionWithKey f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of - -- k1 is not in n2 - LT -> M.intersectionWithKey f m1 (toMap n2) - -- k1 and k2 are a part of the result - EQ -> insertMinMap k1 (f k1 v1 v2) $ M.intersectionWithKey f m1 m2 - -- k2 is not in n1 - GT -> M.intersectionWithKey f (toMap n1) m2 -{-# INLINE intersectionWithKey #-} - --- | /O(n)/. A strict version of 'foldr1'. Each application of the operator --- is evaluated before using the result in the next application. This --- function is strict in the starting value. -foldr1' :: (a -> a -> a) -> NEMap k a -> a -foldr1' f (NEMap _ v m) = case M.maxView m of - Nothing -> v - Just (y, m') -> let !z = M.foldr' f y m' in v `f` z -{-# INLINE foldr1' #-} - --- | /O(n)/. A strict version of 'foldl1'. Each application of the operator --- is evaluated before using the result in the next application. This --- function is strict in the starting value. -foldl1' :: (a -> a -> a) -> NEMap k a -> a -foldl1' f (NEMap _ v m) = M.foldl' f v m -{-# INLINE foldl1' #-} - --- | /O(n)/. Fold the keys and values in the map using the given right-associative --- binary operator, such that --- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. --- --- For example, --- --- > keysList map = foldrWithKey (\k x ks -> k:ks) [] map -foldrWithKey :: (k -> a -> b -> b) -> b -> NEMap k a -> b -foldrWithKey f z (NEMap k v m) = f k v . M.foldrWithKey f z $ m -{-# INLINE foldrWithKey #-} - --- | /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. -foldrWithKey' :: (k -> a -> b -> b) -> b -> NEMap k a -> b -foldrWithKey' f z (NEMap k v m) = f k v y - where - !y = M.foldrWithKey f z m -{-# INLINE foldrWithKey' #-} - --- | /O(n)/. Fold the keys and values in the map using the given left-associative --- binary operator, such that --- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@. --- --- For example, --- --- > keysList = reverse . foldlWithKey (\ks k x -> k:ks) [] -foldlWithKey :: (a -> k -> b -> a) -> a -> NEMap k b -> a -foldlWithKey f z (NEMap k v m) = M.foldlWithKey f (f z k v) m -{-# INLINE foldlWithKey #-} - --- | /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. -foldlWithKey' :: (a -> k -> b -> a) -> a -> NEMap k b -> a -foldlWithKey' f z (NEMap k v m) = M.foldlWithKey' f x m - where - !x = f z k v -{-# INLINE foldlWithKey' #-} - --- | /O(n)/. Return all keys of the map in ascending order. --- --- > keys (fromList ((5,"a") :| [(3,"b")])) == (3 :| [5]) -keys :: NEMap k a -> NonEmpty k -keys (NEMap k _ m) = k :| M.keys m -{-# INLINE keys #-} - --- | /O(n)/. An alias for 'toAscList'. Return all key\/value pairs in the map --- in ascending key order. --- --- > assocs (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) -assocs :: NEMap k a -> NonEmpty (k, a) -assocs = toList -{-# INLINE assocs #-} - --- | /O(n)/. The non-empty set of all keys of the map. --- --- > keysSet (fromList ((5,"a") :| [(3,"b")])) == Data.Set.NonEmpty.fromList (3 :| [5]) -keysSet :: NEMap k a -> NESet k -keysSet (NEMap k _ m) = NESet k (M.keysSet m) -{-# INLINE keysSet #-} - --- | /O(n)/. Map a function over all values in the map. --- --- > let f key x = (show key) ++ ":" ++ x --- > mapWithKey f (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "3:b") :| [(5, "5:a")]) -mapWithKey :: (k -> a -> b) -> NEMap k a -> NEMap k b -mapWithKey f (NEMap k v m) = NEMap k (f k v) (M.mapWithKey f m) -{-# NOINLINE [1] mapWithKey #-} - -{-# RULES -"mapWithKey/mapWithKey" forall f g xs. - mapWithKey f (mapWithKey g xs) = - mapWithKey (\k a -> f k (g k a)) xs -"mapWithKey/map" forall f g xs. - mapWithKey f (map g xs) = - mapWithKey (\k a -> f k (g a)) xs -"map/mapWithKey" forall f g xs. - map f (mapWithKey g xs) = - mapWithKey (\k a -> f (g k a)) xs - #-} - --- | /O(n)/. Convert the map to a list of key\/value pairs where the keys are --- in ascending order. --- --- > toAscList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) -toAscList :: NEMap k a -> NonEmpty (k, a) -toAscList = toList -{-# INLINE toAscList #-} - --- | /O(n)/. Convert the map to a list of key\/value pairs where the keys --- are in descending order. --- --- > toDescList (fromList ((5,"a") :| [(3,"b")])) == ((5,"a") :| [(3,"b")]) -toDescList :: NEMap k a -> NonEmpty (k, a) -toDescList (NEMap k0 v0 m) = M.foldlWithKey' go ((k0, v0) :| []) m - where - go xs k v = (k, v) NE.<| xs -{-# INLINE toDescList #-} - --- | /O(log n)/. Convert a 'Map' into an 'NEMap' by adding a key-value --- pair. Because of this, we know that the map must have at least one --- element, and so therefore cannot be empty. If key is already present, --- will overwrite the original value. --- --- See 'insertMapMin' for a version that is constant-time if the new key is --- /strictly smaller than/ all keys in the original map. --- --- > insertMap 4 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) --- > insertMap 4 "c" Data.Map.empty == singleton 4 "c" -insertMap :: Ord k => k -> a -> Map k a -> NEMap k a -insertMap k v = withNonEmpty (singleton k v) (insert k v) -{-# INLINE insertMap #-} - --- | /O(log n)/. Convert a 'Map' into an 'NEMap' by adding a key-value --- pair. Because of this, we know that the map must have at least one --- element, and so therefore cannot be empty. Uses a combining function --- with the new value as the first argument if the key is already present. --- --- > insertMapWith (++) 4 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) --- > insertMapWith (++) 5 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"ca")]) -insertMapWith :: - Ord k => - (a -> a -> a) -> - k -> - a -> - Map k a -> - NEMap k a -insertMapWith f k v = withNonEmpty (singleton k v) (insertWith f k v) -{-# INLINE insertMapWith #-} - --- | /O(log n)/. Convert a 'Map' into an 'NEMap' by adding a key-value --- pair. Because of this, we know that the map must have at least one --- element, and so therefore cannot be empty. Uses a combining function --- with the key and new value as the first and second arguments if the key --- is already present. --- --- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value --- > insertWithKey f 5 "xxx" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "5:xxx|a")]) --- > insertWithKey f 7 "xxx" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) --- > insertWithKey f 5 "xxx" Data.Map.empty == singleton 5 "xxx" -insertMapWithKey :: - Ord k => - (k -> a -> a -> a) -> - k -> - a -> - Map k a -> - NEMap k a -insertMapWithKey f k v = withNonEmpty (singleton k v) (insertWithKey f k v) -{-# INLINE insertMapWithKey #-} - --- | /O(1)/ Convert a 'Map' into an 'NEMap' by adding a key-value pair --- where the key is /strictly less than/ all keys in the input map. The --- keys in the original map must all be /strictly greater than/ the new --- key. /The precondition is not checked./ --- --- > insertMapMin 2 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((2,"c") :| [(3,"b"), (5,"a")]) --- > valid (insertMapMin 2 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == True --- > valid (insertMapMin 7 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False --- > valid (insertMapMin 3 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False -insertMapMin :: - k -> - a -> - Map k a -> - NEMap k a -insertMapMin = NEMap -{-# INLINE insertMapMin #-} - --- | /O(log n)/ Convert a 'Map' into an 'NEMap' by adding a key-value pair --- where the key is /strictly greater than/ all keys in the input map. The --- keys in the original map must all be /strictly less than/ the new --- key. /The precondition is not checked./ --- --- While this has the same asymptotics as 'insertMap', it saves a constant --- factor for key comparison (so may be helpful if comparison is expensive) --- and also does not require an 'Ord' instance for the key type. --- --- > insertMap 7 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"a"), (7,"c")]) --- > valid (insertMap 7 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == True --- > valid (insertMap 2 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False --- > valid (insertMap 5 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False -insertMapMax :: - k -> - a -> - Map k a -> - NEMap k a -insertMapMax k v = withNonEmpty (singleton k v) go - where - go (NEMap k0 v0 m0) = NEMap k0 v0 . insertMaxMap k v $ m0 -{-# INLINE insertMapMax #-} - --- | /O(log n)/. Insert a new key and value in the map. --- If the key is already present in the map, the associated value is --- replaced with the supplied value. 'insert' is equivalent to --- @'insertWith' 'const'@. --- --- See 'insertMap' for a version where the first argument is a 'Map'. --- --- > insert 5 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'x')]) --- > insert 7 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'a'), (7, 'x')]) -insert :: - Ord k => - k -> - a -> - NEMap k a -> - NEMap k a -insert k v n@(NEMap k0 v0 m) = case compare k k0 of - LT -> NEMap k v . toMap $ n - EQ -> NEMap k v m - GT -> NEMap k0 v0 . M.insert k v $ m -{-# INLINE insert #-} - --- | /O(log n)/. Insert with a function, combining key, new value and old --- value. @'insertWithKey' f key value mp@ will insert the pair (key, --- value) into @mp@ if key does not exist in the map. If the key does --- exist, the function will insert the pair @(key,f key new_value --- old_value)@. Note that the key passed to f is the same key passed to --- 'insertWithKey'. --- --- See 'insertMapWithKey' for a version where the first argument is a 'Map'. --- --- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value --- > insertWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:xxx|a")]) --- > insertWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) -insertWithKey :: - Ord k => - (k -> a -> a -> a) -> - k -> - a -> - NEMap k a -> - NEMap k a -insertWithKey f k v n@(NEMap k0 v0 m) = case compare k k0 of - LT -> NEMap k v . toMap $ n - EQ -> NEMap k (f k v v0) m - GT -> NEMap k0 v0 $ M.insertWithKey f k v m -{-# INLINE insertWithKey #-} - --- | /O(log n)/. Combines insert operation with old value retrieval. The --- expression (@'insertLookupWithKey' f k x map@) is a pair where the first --- element is equal to (@'lookup' k map@) and the second element equal to --- (@'insertWithKey' f k x map@). --- --- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value --- > insertLookupWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "5:xxx|a")])) --- > insertLookupWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "xxx")])) --- --- This is how to define @insertLookup@ using @insertLookupWithKey@: --- --- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t --- > insertLookup 5 "x" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "x")])) --- > insertLookup 7 "x" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "x")])) -insertLookupWithKey :: - Ord k => - (k -> a -> a -> a) -> - k -> - a -> - NEMap k a -> - (Maybe a, NEMap k a) -insertLookupWithKey f k v n@(NEMap k0 v0 m) = case compare k k0 of - LT -> (Nothing, NEMap k v . toMap $ n) - EQ -> (Just v, NEMap k (f k v v0) m) - GT -> NEMap k0 v0 <$> M.insertLookupWithKey f k v m -{-# INLINE insertLookupWithKey #-} - --- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs --- with a combining function. See also 'fromAscListWith'. --- --- > fromListWith (++) ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "ab") :| [(5, "aba")]) -fromListWith :: - Ord k => - (a -> a -> a) -> - NonEmpty (k, a) -> - NEMap k a -fromListWith f = fromListWithKey (const f) -{-# INLINE fromListWith #-} - --- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs --- with a combining function. See also 'fromAscListWithKey'. --- --- > let f k a1 a2 = (show k) ++ a1 ++ a2 --- > fromListWithKey f ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "3ab") :| [(5, "5a5ba")]) -fromListWithKey :: - Ord k => - (k -> a -> a -> a) -> - NonEmpty (k, a) -> - NEMap k a -fromListWithKey f ((k0, v0) :| xs) = F.foldl' go (singleton k0 v0) xs - where - go m (k, v) = insertWithKey f k v m - {-# INLINE go #-} -{-# INLINE fromListWithKey #-} - --- | /O(n)/. Build a map from an ascending non-empty list in linear time. --- /The precondition (input list is ascending) is not checked./ --- --- > fromAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) --- > fromAscList ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "b")]) --- > valid (fromAscList ((3,"b") :| [(5,"a"), (5,"b")])) == True --- > valid (fromAscList ((5,"a") :| [(3,"b"), (5,"b")])) == False -fromAscList :: - Eq k => - NonEmpty (k, a) -> - NEMap k a -fromAscList = fromDistinctAscList . combineEq -{-# INLINE fromAscList #-} - --- | /O(n)/. Build a map from an ascending non-empty list in linear time --- with a combining function for equal keys. /The precondition (input list --- is ascending) is not checked./ --- --- > fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "ba")]) --- > valid (fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b"))]) == True --- > valid (fromAscListWith (++) ((5,"a") :| [(3,"b"), (5,"b"))]) == False -fromAscListWith :: - Eq k => - (a -> a -> a) -> - NonEmpty (k, a) -> - NEMap k a -fromAscListWith f = fromAscListWithKey (const f) -{-# INLINE fromAscListWith #-} - --- | /O(n)/. Build a map from an ascending non-empty list in linear time --- with a combining function for equal keys. /The precondition (input list --- is ascending) is not checked./ --- --- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 --- > fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")]) == fromList ((3, "b") :| [(5, "5:b5:ba")]) --- > valid (fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")])) == True --- > valid (fromAscListWithKey f ((5,"a") :| [(3,"b"), (5,"b"), (5,"b")])) == False -fromAscListWithKey :: - Eq k => - (k -> a -> a -> a) -> - NonEmpty (k, a) -> - NEMap k a -fromAscListWithKey f = fromDistinctAscList . combineEqWith f -{-# INLINE fromAscListWithKey #-} - --- | /O(n)/. Build a map from an ascending non-empty list of distinct --- elements in linear time. /The precondition is not checked./ --- --- > fromDistinctAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) --- > valid (fromDistinctAscList ((3,"b") :| [(5,"a")])) == True --- > valid (fromDistinctAscList ((3,"b") :| [(5,"a"), (5,"b")])) == False -fromDistinctAscList :: NonEmpty (k, a) -> NEMap k a -fromDistinctAscList ((k, v) :| xs) = - insertMapMin k v - . M.fromDistinctAscList - $ xs -{-# INLINE fromDistinctAscList #-} - --- | /O(n)/. Build a map from a descending non-empty list in linear time. --- /The precondition (input list is descending) is not checked./ --- --- > fromDescList ((5,"a") :| [(3,"b")]) == fromList ((3, "b") :| [(5, "a")]) --- > fromDescList ((5,"a") :| [(5,"b"), (3,"b")]) == fromList ((3, "b") :| [(5, "b")]) --- > valid (fromDescList ((5,"a") :| [(5,"b"), (3,"b")])) == True --- > valid (fromDescList ((5,"a") :| [(3,"b"), (5,"b")])) == False -fromDescList :: - Eq k => - NonEmpty (k, a) -> - NEMap k a -fromDescList = fromDistinctDescList . combineEq -{-# INLINE fromDescList #-} - --- | /O(n)/. Build a map from a descending non-empty list in linear time --- with a combining function for equal keys. /The precondition (input list --- is descending) is not checked./ --- --- > fromDescListWith (++) ((5,"a") :| [(5,"b"), (3,"b")]) == fromList ((3, "b") :| [(5, "ba")]) --- > valid (fromDescListWith (++) ((5,"a") :| [(5,"b"), (3,"b")])) == True --- > valid (fromDescListWith (++) ((5,"a") :| [(3,"b"), (5,"b")])) == False -fromDescListWith :: - Eq k => - (a -> a -> a) -> - NonEmpty (k, a) -> - NEMap k a -fromDescListWith f = fromDescListWithKey (const f) -{-# INLINE fromDescListWith #-} - --- | /O(n)/. Build a map from a descending non-empty list in linear time --- with a combining function for equal keys. /The precondition (input list --- is descending) is not checked./ --- --- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 --- > fromDescListWithKey f ((5,"a") :| [(5,"b"), (5,"b"), (3,"b")]) == fromList ((3, "b") :| [(5, "5:b5:ba")]) --- > valid (fromDescListWithKey f ((5,"a") :| [(5,"b"), (5,"b"), (3,"b")])) == True --- > valid (fromDescListWithKey f ((5,"a") :| [(3,"b"), (5,"b"), (5,"b")])) == False -fromDescListWithKey :: - Eq k => - (k -> a -> a -> a) -> - NonEmpty (k, a) -> - NEMap k a -fromDescListWithKey f = fromDistinctDescList . combineEqWith f -{-# INLINE fromDescListWithKey #-} - --- | /O(n)/. Build a map from a descending list of distinct elements in linear time. --- /The precondition is not checked./ --- --- > fromDistinctDescList ((5,"a") :| [(3,"b")]) == fromList ((3, "b") :| [(5, "a")]) --- > valid (fromDistinctDescList ((5,"a") :| [(3,"b")])) == True --- > valid (fromDistinctDescList ((5,"a") :| [(5,"b"), (3,"b")])) == False --- --- @since 0.5.8 -fromDistinctDescList :: NonEmpty (k, a) -> NEMap k a -fromDistinctDescList ((k, v) :| xs) = - insertMapMax k v - . M.fromDistinctDescList - $ xs -{-# INLINE fromDistinctDescList #-} - --- | /O(log n)/. Delete a key and its value from the non-empty map. --- A potentially empty map ('Map') is returned, since this might delete the --- last item in the 'NEMap'. When the key is not a member of the map, is --- equivalent to 'toMap'. --- --- > delete 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" --- > delete 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.Singleton [(3, "b"), (5, "a")] -delete :: Ord k => k -> NEMap k a -> Map k a -delete k n@(NEMap k0 v m) = case compare k k0 of - LT -> toMap n - EQ -> m - GT -> insertMinMap k0 v . M.delete k $ m -{-# INLINE delete #-} - --- | /O(log n)/. Delete a key and its value from the non-empty map, returning --- 'Nothing' if the result would be empty. --- --- This is more efficient than @'nonEmptyMap' . 'delete' k@ because it avoids --- converting the known-minimum representation back through 'Map' when the --- deleted key is not the minimum. --- --- @since 0.3.6.0 -deleteMaybe :: Ord k => k -> NEMap k a -> Maybe (NEMap k a) -deleteMaybe k n@(NEMap k0 v m) = case compare k k0 of - LT -> Just n - EQ -> nonEmptyMap m - GT -> Just . NEMap k0 v . M.delete k $ m -{-# INLINE deleteMaybe #-} - --- | /O(log n)/. Update a value at a specific key with the result of the --- provided function. When the key is not a member of the map, the original --- map is returned. --- --- > adjust ("new " ++) 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "new a")]) --- > adjust ("new " ++) 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) -adjust :: - Ord k => - (a -> a) -> - k -> - NEMap k a -> - NEMap k a -adjust f = adjustWithKey (const f) -{-# INLINE adjust #-} - --- | /O(log n)/. Adjust a value at a specific key. When the key is not --- a member of the map, the original map is returned. --- --- > let f key x = (show key) ++ ":new " ++ x --- > adjustWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:new a")]) --- > adjustWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) -adjustWithKey :: - Ord k => - (k -> a -> a) -> - k -> - NEMap k a -> - NEMap k a -adjustWithKey f k n@(NEMap k0 v m) = case compare k k0 of - LT -> n - EQ -> NEMap k0 (f k0 v) m - GT -> NEMap k0 v . M.adjustWithKey f k $ m -{-# INLINE adjustWithKey #-} - --- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@ --- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is --- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. --- --- Returns a potentially empty map ('Map'), because we can't know ahead of --- time if the function returns 'Nothing' and deletes the final item in the --- 'NEMap'. --- --- > let f x = if x == "a" then Just "new a" else Nothing --- > update f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "new a")] --- > update f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a")] --- > update f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" -update :: - Ord k => - (a -> Maybe a) -> - k -> - NEMap k a -> - Map k a -update f = updateWithKey (const f) -{-# INLINE update #-} - --- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the --- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing', --- the element is deleted. If it is (@'Just' y@), the key @k@ is bound --- to the new value @y@. --- --- Returns a potentially empty map ('Map'), because we can't know ahead of --- time if the function returns 'Nothing' and deletes the final item in the --- 'NEMap'. --- --- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing --- > updateWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "5:new a")] --- > updateWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a")] --- > updateWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" -updateWithKey :: - Ord k => - (k -> a -> Maybe a) -> - k -> - NEMap k a -> - Map k a -updateWithKey f k n@(NEMap k0 v m) = case compare k k0 of - LT -> toMap n - EQ -> maybe m (flip (insertMinMap k0) m) . f k0 $ v - GT -> insertMinMap k0 v . M.updateWithKey f k $ m -{-# INLINE updateWithKey #-} - --- | /O(log n)/. Lookup and update. See also 'updateWithKey'. --- The function returns changed value, if it is updated. --- Returns the original key value if the map entry is deleted. --- --- Returns a potentially empty map ('Map') in the case that we delete the --- final key of a singleton map. --- --- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing --- > updateLookupWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "5:new a", Data.Map.fromList ((3, "b") :| [(5, "5:new a")])) --- > updateLookupWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == (Nothing, Data.Map.fromList ((3, "b") :| [(5, "a")])) --- > updateLookupWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Data.Map.singleton 5 "a") -updateLookupWithKey :: - Ord k => - (k -> a -> Maybe a) -> - k -> - NEMap k a -> - (Maybe a, Map k a) -updateLookupWithKey f k n@(NEMap k0 v m) = case compare k k0 of - LT -> (Nothing, toMap n) - EQ -> - let u = f k0 v - in (u <|> Just v, maybe m (flip (insertMinMap k0) m) u) - GT -> fmap (insertMinMap k0 v) . M.updateLookupWithKey f k $ m -{-# INLINE updateLookupWithKey #-} - --- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at --- @k@, or absence thereof. 'alter' can be used to insert, delete, or --- update a value in a 'Map'. In short : @Data.Map.lookup k ('alter' --- f k m) = f ('lookup' k m)@. --- --- Returns a potentially empty map ('Map'), because we can't know ahead of --- time if the function returns 'Nothing' and deletes the final item in the --- 'NEMap'. --- --- See 'alterF'' for a version that disallows deletion, and so therefore --- can return 'NEMap'. --- --- > let f _ = Nothing --- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a")] --- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" --- > --- > let f _ = Just "c" --- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a"), (7, "c")] --- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "c")] -alter :: - Ord k => - (Maybe a -> Maybe a) -> - k -> - NEMap k a -> - Map k a -alter f k n@(NEMap k0 v m) = case compare k k0 of - LT -> maybe id (insertMinMap k) (f Nothing) (toMap n) - EQ -> maybe id (insertMinMap k0) (f (Just v)) m - GT -> insertMinMap k0 v . M.alter f k $ m -{-# INLINE alter #-} - --- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ --- at @k@, or absence thereof. 'alterF' can be used to inspect, insert, --- delete, or update a value in a 'Map'. In short: @Data.Map.lookup --- k \<$\> 'alterF' f k m = f ('lookup' k m)@. --- --- Example: --- --- @ --- interactiveAlter :: Int -> NEMap Int String -> IO (Map Int String) --- interactiveAlter k m = alterF f k m where --- f Nothing = do --- putStrLn $ show k ++ --- " was not found in the map. Would you like to add it?" --- getUserResponse1 :: IO (Maybe String) --- f (Just old) = do --- putStrLn $ "The key is currently bound to " ++ show old ++ --- ". Would you like to change or delete it?" --- getUserResponse2 :: IO (Maybe String) --- @ --- --- Like @Data.Map.alterF@ for 'Map', 'alterF' can be considered --- to be a unifying generalization of 'lookup' and 'delete'; however, as --- a constrast, it cannot be used to implement 'insert', because it must --- return a 'Map' instead of an 'NEMap' (because the function might delete --- the final item in the 'NEMap'). When used with trivial functors like --- 'Identity' and 'Const', it is often slightly slower than --- specialized 'lookup' and 'delete'. However, when the functor is --- non-trivial and key comparison is not particularly cheap, it is the --- fastest way. --- --- See 'alterF'' for a version that disallows deletion, and so therefore --- can return 'NEMap' and be used to implement 'insert' --- --- Note on rewrite rules: --- --- This module includes GHC rewrite rules to optimize 'alterF' for --- the 'Const' and 'Identity' functors. In general, these rules --- improve performance. The sole exception is that when using --- 'Identity', deleting a key that is already absent takes longer --- than it would without the rules. If you expect this to occur --- a very large fraction of the time, you might consider using a --- private copy of the 'Identity' type. --- --- Note: Unlike @Data.Map.alterF@ for 'Map', 'alterF' is /not/ a flipped --- version of the 'Control.Lens.At.at' combinator from "Control.Lens.At". --- However, it match the shape expected from most functions expecting --- lenses, getters, and setters, so can be thought of as a "psuedo-lens", --- with virtually the same practical applications as a legitimate lens. -alterF :: - (Ord k, Functor f) => - (Maybe a -> f (Maybe a)) -> - k -> - NEMap k a -> - f (Map k a) -alterF f k n@(NEMap k0 v m) = case compare k k0 of - LT -> flip (maybe id (insertMinMap k)) (toMap n) <$> f Nothing - EQ -> flip (maybe id (insertMinMap k0)) m <$> f (Just v) - GT -> insertMinMap k0 v <$> M.alterF f k m -{-# INLINEABLE [2] alterF #-} - --- if f ~ Const b, it's a lookup -{-# RULES -"alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)). - alterF f k = - Const . getConst . f . lookup k - #-} - --- if f ~ Identity, it's an 'alter' -{-# RULES -"alterF/Identity" forall k (f :: Maybe a -> Identity (Maybe a)). - alterF f k = - Identity . alter (runIdentity . f) k - #-} - --- | /O(log n)/. Variant of 'alter' that disallows deletion. Allows us to --- guarantee that the result is also a non-empty Map. -alter' :: - Ord k => - (Maybe a -> a) -> - k -> - NEMap k a -> - NEMap k a -alter' f k n@(NEMap k0 v m) = case compare k k0 of - LT -> NEMap k (f Nothing) . toMap $ n - EQ -> NEMap k0 (f (Just v)) m - GT -> NEMap k0 v . M.alter (Just . f) k $ m -{-# INLINE alter' #-} - --- | /O(log n)/. Variant of 'alterF' that disallows deletion. Allows us to --- guarantee that the result is also a non-empty Map. --- --- Like @Data.Map.alterF@ for 'Map', can be used to generalize and unify --- 'lookup' and 'insert'. However, because it disallows deletion, it --- cannot be used to implement 'delete'. --- --- See 'alterF' for usage information and caveats. --- --- Note: Neither 'alterF' nor 'alterF'' can be considered flipped versions --- of the 'Control.Lens.At.at' combinator from "Control.Lens.At". However, --- this can match the shape expected from most functions expecting lenses, --- getters, and setters, so can be thought of as a "psuedo-lens", with --- virtually the same practical applications as a legitimate lens. --- --- __WARNING__: The rewrite rule for 'Identity' exposes an inconsistency in --- undefined behavior for "Data.Map". @Data.Map.alterF@ will actually --- /maintain/ the original key in the map when used with 'Identity'; --- however, @Data.Map.insertWith@ will /replace/ the orginal key in the --- map. The rewrite rule for 'alterF'' has chosen to be faithful to --- @Data.Map.insertWith@, and /not/ @Data.Map.alterF@, for the sake of --- a cleaner implementation. -alterF' :: - (Ord k, Functor f) => - (Maybe a -> f a) -> - k -> - NEMap k a -> - f (NEMap k a) -alterF' f k n@(NEMap k0 v m) = case compare k k0 of - LT -> flip (NEMap k) (toMap n) <$> f Nothing - EQ -> flip (NEMap k0) m <$> f (Just v) - GT -> NEMap k0 v <$> M.alterF (fmap Just . f) k m -{-# INLINEABLE [2] alterF' #-} - --- if f ~ Const b, it's a lookup -{-# RULES -"alterF'/Const" forall k (f :: Maybe a -> Const b a). - alterF' f k = - Const . getConst . f . lookup k - #-} - --- if f ~ Identity, it's an insertWith -{-# RULES -"alterF'/Identity" forall k (f :: Maybe a -> Identity a). - alterF' f k = - Identity . insertWith (\_ -> runIdentity . f . Just) k (runIdentity (f Nothing)) - #-} - --- | /O(n)/. Traverse keys\/values and collect the 'Just' results. --- --- Returns a potentially empty map ('Map'), our function might return --- 'Nothing' on every item in the 'NEMap'. --- --- /Use 'traverseMaybeWithKey1'/ whenever possible (if your 'Applicative' --- also has 'Apply' instance). This version is provided only for types --- that do not have 'Apply' instance, since 'Apply' is not at the moment --- (and might not ever be) an official superclass of 'Applicative'. -traverseMaybeWithKey :: - Applicative t => - (k -> a -> t (Maybe b)) -> - NEMap k a -> - t (Map k b) -traverseMaybeWithKey f (NEMap k0 v m0) = - combine <$> f k0 v <*> M.traverseMaybeWithKey f m0 - where - combine Nothing = id - combine (Just v') = insertMinMap k0 v' -{-# INLINE traverseMaybeWithKey #-} - --- | /O(n)/. Traverse keys\/values and collect the 'Just' results. --- --- Returns a potentially empty map ('Map'), our function might return --- 'Nothing' on every item in the 'NEMap'. --- --- Is more general than 'traverseWithKey', since works with all 'Apply', --- and not just 'Applicative'. - --- TODO: benchmark against M.maxView version -traverseMaybeWithKey1 :: - Apply t => - (k -> a -> t (Maybe b)) -> - NEMap k a -> - t (Map k b) -traverseMaybeWithKey1 f (NEMap k0 v m0) = case runMaybeApply m1 of - Left m2 -> combine <$> f k0 v <.> m2 - Right m2 -> (`combine` m2) <$> f k0 v - where - m1 = M.traverseMaybeWithKey (\k -> MaybeApply . Left . f k) m0 - combine Nothing = id - combine (Just v') = insertMinMap k0 v' -{-# INLINE traverseMaybeWithKey1 #-} - --- | /O(n)/. The function 'mapAccum' threads an accumulating argument --- through the map in ascending order of keys. --- --- > let f a b = (a ++ b, b ++ "X") --- > mapAccum f "Everything: " (fromList ((5,"a") :| [(3,"b")])) == ("Everything: ba", fromList ((3, "bX") :| [(5, "aX")])) -mapAccum :: - (a -> b -> (a, c)) -> - a -> - NEMap k b -> - (a, NEMap k c) -mapAccum f = mapAccumWithKey (\x _ -> f x) -{-# INLINE mapAccum #-} - --- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating --- argument through the map in ascending order of keys. --- --- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X") --- > mapAccumWithKey f "Everything:" (fromList ((5,"a") :| [(3,"b")])) == ("Everything: 3-b 5-a", fromList ((3, "bX") :| [(5, "aX")])) -mapAccumWithKey :: - (a -> k -> b -> (a, c)) -> - a -> - NEMap k b -> - (a, NEMap k c) -mapAccumWithKey f z0 (NEMap k v m) = (z2, NEMap k v' m') - where - ~(z1, v') = f z0 k v - ~(z2, m') = M.mapAccumWithKey f z1 m -{-# INLINE mapAccumWithKey #-} - --- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating --- argument through the map in descending order of keys. -mapAccumRWithKey :: - (a -> k -> b -> (a, c)) -> - a -> - NEMap k b -> - (a, NEMap k c) -mapAccumRWithKey f z0 (NEMap k v m) = (z2, NEMap k v' m') - where - ~(z1, m') = M.mapAccumRWithKey f z0 m - ~(z2, v') = f z1 k v -{-# INLINE mapAccumRWithKey #-} - --- TODO: what other situations can we take advantage of lazy tuple pattern --- matching? - --- | /O(n*log n)/. --- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. --- --- The size of the result may be smaller if @f@ maps two or more distinct --- keys to the same new key. In this case the value at the greatest of the --- original keys is retained. --- --- While the size of the result map may be smaller than the input map, the --- output map is still guaranteed to be non-empty if the input map is --- non-empty. --- --- > mapKeys (+ 1) (fromList ((5,"a") :| [(3,"b")])) == fromList ((4, "b") :| [(6, "a")]) --- > mapKeys (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "c" --- > mapKeys (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "c" -mapKeys :: - Ord k2 => - (k1 -> k2) -> - NEMap k1 a -> - NEMap k2 a -mapKeys f (NEMap k0 v0 m) = - fromListWith const - . ((f k0, v0) :|) - . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] - $ m -{-# INLINEABLE mapKeys #-} - --- | /O(n*log n)/. --- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. --- --- The size of the result may be smaller if @f@ maps two or more distinct --- keys to the same new key. In this case the associated values will be --- combined using @c@. The value at the greater of the two original keys --- is used as the first argument to @c@. --- --- While the size of the result map may be smaller than the input map, the --- output map is still guaranteed to be non-empty if the input map is --- non-empty. --- --- > mapKeysWith (++) (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "cdab" --- > mapKeysWith (++) (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "cdab" -mapKeysWith :: - Ord k2 => - (a -> a -> a) -> - (k1 -> k2) -> - NEMap k1 a -> - NEMap k2 a -mapKeysWith c f (NEMap k0 v0 m) = - fromListWith c - . ((f k0, v0) :|) - . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] - $ m -{-# INLINEABLE mapKeysWith #-} - --- | /O(n)/. --- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ --- is strictly monotonic. --- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. --- /The precondition is not checked./ --- Semi-formally, we have: --- --- > and [x < y ==> f x < f y | x <- ls, y <- ls] --- > ==> mapKeysMonotonic f s == mapKeys f s --- > where ls = keys s --- --- This means that @f@ maps distinct original keys to distinct resulting keys. --- This function has better performance than 'mapKeys'. --- --- While the size of the result map may be smaller than the input map, the --- output map is still guaranteed to be non-empty if the input map is --- non-empty. --- --- > mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")])) == fromList ((6, "b") :| [(10, "a")]) --- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")]))) == True --- > valid (mapKeysMonotonic (\ _ -> 1) (fromList ((5,"a") :| [(3,"b")]))) == False -mapKeysMonotonic :: - (k1 -> k2) -> - NEMap k1 a -> - NEMap k2 a -mapKeysMonotonic f (NEMap k v m) = - NEMap (f k) v - . M.mapKeysMonotonic f - $ m -{-# INLINE mapKeysMonotonic #-} - --- | /O(n)/. Filter all values that satisfy the predicate. --- --- Returns a potentially empty map ('Map'), because we could --- potentailly filter out all items in the original 'NEMap'. --- --- > filter (> "a") (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" --- > filter (> "x") (fromList ((5,"a") :| [(3,"b")])) == Data.Map.empty --- > filter (< "a") (fromList ((5,"a") :| [(3,"b")])) == Data.Map.empty -filter :: - (a -> Bool) -> - NEMap k a -> - Map k a -filter f (NEMap k v m) - | f v = insertMinMap k v . M.filter f $ m - | otherwise = M.filter f m -{-# INLINE filter #-} - --- | /O(n)/. Filter all keys\/values that satisfy the predicate. --- --- Returns a potentially empty map ('Map'), because we could --- potentailly filter out all items in the original 'NEMap'. --- --- > filterWithKey (\k _ -> k > 4) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" -filterWithKey :: - (k -> a -> Bool) -> - NEMap k a -> - Map k a -filterWithKey f (NEMap k v m) - | f k v = insertMinMap k v . M.filterWithKey f $ m - | otherwise = M.filterWithKey f m -{-# INLINE filterWithKey #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Restrict an 'NEMap' to only those keys --- found in a 'Data.Set.Set'. --- --- @ --- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m --- m \`restrictKeys\` s = m ``intersection`` 'fromSet' (const ()) s --- @ -restrictKeys :: - Ord k => - NEMap k a -> - Set k -> - Map k a -restrictKeys n@(NEMap k v m) xs = case S.minView xs of - Nothing -> M.empty - Just (y, ys) -> case compare k y of - -- k is not in xs - LT -> m `M.restrictKeys` xs - -- k and y are a part of the result - EQ -> insertMinMap k v $ m `M.restrictKeys` ys - -- y is not in m - GT -> toMap n `M.restrictKeys` ys -{-# INLINE restrictKeys #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Data.Set.Set' from --- an 'NEMap'. --- --- @ --- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m --- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s --- @ -withoutKeys :: - Ord k => - NEMap k a -> - Set k -> - Map k a -withoutKeys n@(NEMap k v m) xs = case S.minView xs of - Nothing -> toMap n - Just (y, ys) -> case compare k y of - -- k is not in xs, so cannot be deleted - LT -> insertMinMap k v $ m `M.withoutKeys` xs - -- y deletes k, and only k - EQ -> m `M.withoutKeys` ys - -- y is not in n, so cannot delete anything, so we can just difference n and ys - GT -> toMap n `M.withoutKeys` ys -{-# INLINE withoutKeys #-} - --- | /O(n)/. Partition the map according to a predicate. --- --- Returns a 'These' with potentially two non-empty maps: --- --- * @'This' n1@ means that the predicate was true for all items. --- * @'That' n2@ means that the predicate was false for all items. --- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the --- predicate) and @n2@ (all of the items that were false for the --- predicate). --- --- See also 'split'. --- --- > partition (> "a") (fromList ((5,"a") :| [(3,"b")])) == These (singleton 3 "b") (singleton 5 "a") --- > partition (< "x") (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) --- > partition (> "x") (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) -partition :: - (a -> Bool) -> - NEMap k a -> - These (NEMap k a) (NEMap k a) -partition f = partitionWithKey (const f) -{-# INLINE partition #-} - --- | /O(n)/. Partition the map according to a predicate. --- --- Returns a 'These' with potentially two non-empty maps: --- --- * @'This' n1@ means that the predicate was true for all items, --- returning the original map. --- * @'That' n2@ means that the predicate was false for all items, --- returning the original map. --- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the --- predicate) and @n2@ (all of the items that were false for the --- predicate). --- --- See also 'split'. --- --- > partitionWithKey (\ k _ -> k > 3) (fromList ((5,"a") :| [(3,"b")])) == These (singleton 5 "a") (singleton 3 "b") --- > partitionWithKey (\ k _ -> k < 7) (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) --- > partitionWithKey (\ k _ -> k > 7) (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) -partitionWithKey :: - (k -> a -> Bool) -> - NEMap k a -> - These (NEMap k a) (NEMap k a) -partitionWithKey f n@(NEMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) - | f k v -> This n - | otherwise -> That n - (Just n1, Nothing) - | f k v -> This n - | otherwise -> These n1 (singleton k v) - (Nothing, Just n2) - | f k v -> These (singleton k v) n2 - | otherwise -> That n - (Just n1, Just n2) - | f k v -> These (insertMapMin k v m1) n2 - | otherwise -> These n1 (insertMapMin k v m2) - where - (m1, m2) = M.partitionWithKey f m0 -{-# INLINEABLE partitionWithKey #-} - --- | /O(log n)/. Take while a predicate on the keys holds. --- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, --- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'. --- --- Returns a potentially empty map ('Map'), because the predicate might --- fail on the first input. --- --- @ --- takeWhileAntitone p = Data.Map.fromDistinctAscList . Data.List.takeWhile (p . fst) . Data.Foldable.toList --- takeWhileAntitone p = 'filterWithKey' (\k _ -> p k) --- @ -takeWhileAntitone :: - (k -> Bool) -> - NEMap k a -> - Map k a -takeWhileAntitone f (NEMap k v m) - | f k = insertMinMap k v . M.takeWhileAntitone f $ m - | otherwise = M.empty -{-# INLINE takeWhileAntitone #-} - --- | /O(log n)/. Drop while a predicate on the keys holds. --- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, --- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'. --- --- @ --- dropWhileAntitone p = Data.Map.fromDistinctAscList . Data.List.dropWhile (p . fst) . Data.Foldable.toList --- dropWhileAntitone p = 'filterWithKey' (\k -> not (p k)) --- @ -dropWhileAntitone :: - (k -> Bool) -> - NEMap k a -> - Map k a -dropWhileAntitone f n@(NEMap k _ m) - | f k = M.dropWhileAntitone f m - | otherwise = toMap n -{-# INLINE dropWhileAntitone #-} - --- | /O(log n)/. Divide a map at the point where a predicate on the keys stops holding. --- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, --- @j \< k ==\> p j \>= p k@. --- --- Returns a 'These' with potentially two non-empty maps: --- --- * @'This' n1@ means that the predicate never failed for any item, --- returning the original map. --- * @'That' n2@ means that the predicate failed for the first item, --- returning the original map. --- * @'These' n1 n2@ gives @n1@ (the map up to the point where the --- predicate on the keys stops holding) and @n2@ (the map starting from --- the point where the predicate stops holding) --- --- @ --- spanAntitone p xs = partitionWithKey (\k _ -> p k) xs --- @ --- --- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map --- at some /unspecified/ point where the predicate switches from holding to not --- holding (where the predicate is seen to hold before the first key and to fail --- after the last key). -spanAntitone :: - (k -> Bool) -> - NEMap k a -> - These (NEMap k a) (NEMap k a) -spanAntitone f n@(NEMap k v m0) - | f k = case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> This n - (Just _, Nothing) -> This n - (Nothing, Just n2) -> These (singleton k v) n2 - (Just _, Just n2) -> These (insertMapMin k v m1) n2 - | otherwise = That n - where - (m1, m2) = M.spanAntitone f m0 -{-# INLINEABLE spanAntitone #-} - --- | /O(n)/. Map values and collect the 'Just' results. --- --- Returns a potentially empty map ('Map'), because the function could --- potentially return 'Nothing' on all items in the 'NEMap'. --- --- > let f x = if x == "a" then Just "new a" else Nothing --- > mapMaybe f (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "new a" -mapMaybe :: - (a -> Maybe b) -> - NEMap k a -> - Map k b -mapMaybe f = mapMaybeWithKey (const f) -{-# INLINE mapMaybe #-} - --- | /O(n)/. Map keys\/values and collect the 'Just' results. --- --- Returns a potentially empty map ('Map'), because the function could --- potentially return 'Nothing' on all items in the 'NEMap'. --- --- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing --- > mapMaybeWithKey f (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "key : 3" -mapMaybeWithKey :: - (k -> a -> Maybe b) -> - NEMap k a -> - Map k b -mapMaybeWithKey f (NEMap k v m) = maybe id (insertMinMap k) (f k v) (M.mapMaybeWithKey f m) -{-# INLINE mapMaybeWithKey #-} - --- | /O(n)/. Map values and separate the 'Left' and 'Right' results. --- --- Returns a 'These' with potentially two non-empty maps: --- --- * @'This' n1@ means that the results were all 'Left'. --- * @'That' n2@ means that the results were all 'Right'. --- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') --- and @n2@ (the map where the results were 'Right') --- --- > let f a = if a < "c" then Left a else Right a --- > mapEither f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == These (fromList ((3,"b") :| [(5,"a")])) (fromList ((1,"x") :| [(7,"z")])) --- > --- > mapEither (\ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == That (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) -mapEither :: - (a -> Either b c) -> - NEMap k a -> - These (NEMap k b) (NEMap k c) -mapEither f = mapEitherWithKey (const f) -{-# INLINE mapEither #-} - --- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results. --- --- Returns a 'These' with potentially two non-empty maps: --- --- * @'This' n1@ means that the results were all 'Left'. --- * @'That' n2@ means that the results were all 'Right'. --- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') --- and @n2@ (the map where the results were 'Right') --- --- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) --- > mapEitherWithKey f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == These (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) --- > --- > mapEitherWithKey (\_ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == That (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) -mapEitherWithKey :: - (k -> a -> Either b c) -> - NEMap k a -> - These (NEMap k b) (NEMap k c) -mapEitherWithKey f (NEMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> case f k v of - Left v' -> This (singleton k v') - Right v' -> That (singleton k v') - (Just n1, Nothing) -> case f k v of - Left v' -> This (insertMapMin k v' m1) - Right v' -> These n1 (singleton k v') - (Nothing, Just n2) -> case f k v of - Left v' -> These (singleton k v') n2 - Right v' -> That (insertMapMin k v' m2) - (Just n1, Just n2) -> case f k v of - Left v' -> These (insertMapMin k v' m1) n2 - Right v' -> These n1 (insertMapMin k v' m2) - where - (m1, m2) = M.mapEitherWithKey f m0 -{-# INLINEABLE mapEitherWithKey #-} - --- | /O(log n)/. The expression (@'split' k map@) is potentially a 'These' --- containing up to two 'NEMap's based on splitting the map into maps --- containing items before and after the given key @k@. It will never --- return a map that contains @k@ itself. --- --- * 'Nothing' means that @k@ was the only key in the the original map, --- and so there are no items before or after it. --- * @'Just' ('This' n1)@ means @k@ was larger than or equal to all items --- in the map, and @n1@ is the entire original map (minus @k@, if it was --- present) --- * @'Just' ('That' n2)@ means @k@ was smaller than or equal to all --- items in the map, and @n2@ is the entire original map (minus @k@, if --- it was present) --- * @'Just' ('These' n1 n2)@ gives @n1@ (the map of all keys from the --- original map less than @k@) and @n2@ (the map of all keys from the --- original map greater than @k@) --- --- > split 2 (fromList ((5,"a") :| [(3,"b")])) == Just (That (fromList ((3,"b") :| [(5,"a")])) ) --- > split 3 (fromList ((5,"a") :| [(3,"b")])) == Just (That (singleton 5 "a") ) --- > split 4 (fromList ((5,"a") :| [(3,"b")])) == Just (These (singleton 3 "b") (singleton 5 "a")) --- > split 5 (fromList ((5,"a") :| [(3,"b")])) == Just (This (singleton 3 "b") ) --- > split 6 (fromList ((5,"a") :| [(3,"b")])) == Just (This (fromList ((3,"b") :| [(5,"a")])) ) --- > split 5 (singleton 5 "a") == Nothing -split :: - Ord k => - k -> - NEMap k a -> - Maybe (These (NEMap k a) (NEMap k a)) -split k n@(NEMap k0 v m0) = case compare k k0 of - LT -> Just $ That n - EQ -> That <$> nonEmptyMap m0 - GT -> Just $ case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> This (singleton k0 v) - (Just _, Nothing) -> This (insertMapMin k0 v m1) - (Nothing, Just n2) -> These (singleton k0 v) n2 - (Just _, Just n2) -> These (insertMapMin k0 v m1) n2 - where - (m1, m2) = M.split k m0 -{-# INLINEABLE split #-} - --- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just --- like 'split' but also returns @'lookup' k map@, as the first field in --- the 'These': --- --- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == That (That (fromList ((3,"b") :| [(5,"a")]))) --- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == These "b" (That (singleton 5 "a")) --- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == That (These (singleton 3 "b") (singleton 5 "a")) --- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == These "a" (This (singleton 3 "b")) --- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == That (This (fromList ((3,"b") :| [(5,"a")]))) --- > splitLookup 5 (singleton 5 "a") == This "a" -splitLookup :: - Ord k => - k -> - NEMap k a -> - These a (These (NEMap k a) (NEMap k a)) -splitLookup k n@(NEMap k0 v0 m0) = case compare k k0 of - LT -> That . That $ n - EQ -> maybe (This v0) (These v0 . That) . nonEmptyMap $ m0 - GT -> maybe That These v $ case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> This (singleton k0 v0) - (Just _, Nothing) -> This (insertMapMin k0 v0 m1) - (Nothing, Just n2) -> These (singleton k0 v0) n2 - (Just _, Just n2) -> These (insertMapMin k0 v0 m1) n2 - where - (m1, v, m2) = M.splitLookup k m0 -{-# INLINEABLE splitLookup #-} - --- | /O(1)/. Decompose a map into pieces based on the structure of the --- underlying tree. This function is useful for consuming a map in --- parallel. --- --- No guarantee is made as to the sizes of the pieces; an internal, but --- deterministic process determines this. However, it is guaranteed that --- the pieces returned will be in ascending order (all elements in the --- first submap less than all elements in the second, and so on). --- --- Note that the current implementation does not return more than four --- submaps, but you should not depend on this behaviour because it can --- change in the future without notice. -splitRoot :: - NEMap k a -> - NonEmpty (NEMap k a) -splitRoot (NEMap k v m) = - singleton k v - :| Maybe.mapMaybe nonEmptyMap (M.splitRoot m) -{-# INLINE splitRoot #-} - --- | /O(m*log(n\/m + 1)), m <= n/. --- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). -isSubmapOf :: (Ord k, Eq a) => NEMap k a -> NEMap k a -> Bool -isSubmapOf = isSubmapOfBy (==) -{-# INLINE isSubmapOf #-} - --- | /O(m*log(n\/m + 1)), m <= n/. --- The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if --- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when --- applied to their respective values. For example, the following --- expressions are all 'True': --- --- > isSubmapOfBy (==) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) --- > isSubmapOfBy (<=) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) --- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (fromList (('a',1) :| [('b',2)])) --- --- But the following are all 'False': --- --- > isSubmapOfBy (==) (singleton 'a' 2) (fromList (('a',1) :| [('b',2)])) --- > isSubmapOfBy (<) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) --- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (singleton 'a' 1) -isSubmapOfBy :: - Ord k => - (a -> b -> Bool) -> - NEMap k a -> - NEMap k b -> - Bool -isSubmapOfBy f (NEMap k v m0) (toMap -> m1) = - kvSub - && M.isSubmapOfBy f m0 m1 - where - kvSub = case M.lookup k m1 of - Just v0 -> f v v0 - Nothing -> False -{-# INLINE isSubmapOfBy #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap --- but not equal). Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' --- (==)@). -isProperSubmapOf :: (Ord k, Eq a) => NEMap k a -> NEMap k a -> Bool -isProperSubmapOf = isProperSubmapOfBy (==) -{-# INLINE isProperSubmapOf #-} - --- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap --- but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns --- 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, --- and when @f@ returns 'True' when applied to their respective values. For --- example, the following expressions are all 'True': --- --- > isProperSubmapOfBy (==) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) --- > isProperSubmapOfBy (<=) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) --- --- But the following are all 'False': --- --- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (fromList ((1,1) :| [(2,2)])) --- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (singleton 1 1)) --- > isProperSubmapOfBy (<) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) -isProperSubmapOfBy :: - Ord k => - (a -> b -> Bool) -> - NEMap k a -> - NEMap k b -> - Bool -isProperSubmapOfBy f m1 m2 = - M.size (nemMap m1) < M.size (nemMap m2) - && isSubmapOfBy f m1 m2 -{-# INLINE isProperSubmapOfBy #-} - --- | /O(log n)/. Lookup the /index/ of a key, which is its zero-based index --- in the sequence sorted by keys. The index is a number from /0/ up to, --- but not including, the 'size' of the map. --- --- > isJust (lookupIndex 2 (fromList ((5,"a") :| [(3,"b")]))) == False --- > fromJust (lookupIndex 3 (fromList ((5,"a") :| [(3,"b")]))) == 0 --- > fromJust (lookupIndex 5 (fromList ((5,"a") :| [(3,"b")]))) == 1 --- > isJust (lookupIndex 6 (fromList ((5,"a") :| [(3,"b")]))) == False -lookupIndex :: - Ord k => - k -> - NEMap k a -> - Maybe Int -lookupIndex k (NEMap k0 _ m) = case compare k k0 of - LT -> Nothing - EQ -> Just 0 - GT -> (+ 1) <$> M.lookupIndex k m -{-# INLINE lookupIndex #-} - --- | /O(log n)/. Return the /index/ of a key, which is its zero-based index --- in the sequence sorted by keys. The index is a number from /0/ up to, --- but not including, the 'size' of the map. Calls 'error' when the key is --- not a 'member' of the map. --- --- > findIndex 2 (fromList ((5,"a") :| [(3,"b")])) Error: element is not in the map --- > findIndex 3 (fromList ((5,"a") :| [(3,"b")])) == 0 --- > findIndex 5 (fromList ((5,"a") :| [(3,"b")])) == 1 --- > findIndex 6 (fromList ((5,"a") :| [(3,"b")])) Error: element is not in the map -findIndex :: - Ord k => - k -> - NEMap k a -> - Int -findIndex k = fromMaybe e . lookupIndex k - where - e = error "NEMap.findIndex: element is not in the map" -{-# INLINE findIndex #-} - --- | /O(log n)/. Retrieve an element by its /index/, i.e. by its zero-based --- index in the sequence sorted by keys. If the /index/ is out of range --- (less than zero, greater or equal to 'size' of the map), 'error' is --- called. --- --- > elemAt 0 (fromList ((5,"a") :| [(3,"b")])) == (3,"b") --- > elemAt 1 (fromList ((5,"a") :| [(3,"b")])) == (5, "a") --- > elemAt 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range -elemAt :: - Int -> - NEMap k a -> - (k, a) -elemAt 0 (NEMap k v _) = (k, v) -elemAt i (NEMap _ _ m) = M.elemAt (i - 1) m -{-# INLINEABLE elemAt #-} - --- | /O(log n)/. Update the element at /index/, i.e. by its zero-based index in --- the sequence sorted by keys. If the /index/ is out of range (less than zero, --- greater or equal to 'size' of the map), 'error' is called. --- --- Returns a possibly empty map ('Map'), because the function might end up --- deleting the last key in the map. See 'adjustAt' for a version that --- disallows deletion, guaranteeing that the result is also a non-empty --- Map. --- --- > updateAt (\ _ _ -> Just "x") 0 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "x"), (5, "a")] --- > updateAt (\ _ _ -> Just "x") 1 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "x")] --- > updateAt (\ _ _ -> Just "x") 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range --- > updateAt (\ _ _ -> Just "x") (-1) (fromList ((5,"a") :| [(3,"b")])) Error: index out of range --- > updateAt (\_ _ -> Nothing) 0 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" --- > updateAt (\_ _ -> Nothing) 1 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" --- > updateAt (\_ _ -> Nothing) 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range --- > updateAt (\_ _ -> Nothing) (-1) (fromList ((5,"a") :| [(3,"b")])) Error: index out of range -updateAt :: - (k -> a -> Maybe a) -> - Int -> - NEMap k a -> - Map k a -updateAt f 0 (NEMap k v m) = maybe m (flip (insertMinMap k) m) $ f k v -updateAt f i (NEMap k v m) = insertMinMap k v . M.updateAt f (i - 1) $ m -{-# INLINEABLE updateAt #-} - --- | /O(log n)/. Variant of 'updateAt' that disallows deletion. Allows us --- to guarantee that the result is also a non-empty Map. -adjustAt :: - (k -> a -> a) -> - Int -> - NEMap k a -> - NEMap k a -adjustAt f 0 (NEMap k0 v m) = NEMap k0 (f k0 v) m -adjustAt f i (NEMap k0 v m) = - NEMap k0 v - . M.updateAt (\k -> Just . f k) (i - 1) - $ m -{-# INLINEABLE adjustAt #-} - --- | /O(log n)/. Delete the element at /index/, i.e. by its zero-based --- index in the sequence sorted by keys. If the /index/ is out of range --- (less than zero, greater or equal to 'size' of the map), 'error' is --- called. --- --- Returns a potentially empty map ('Map') because of the possibility of --- deleting the last item in a map. --- --- > deleteAt 0 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" --- > deleteAt 1 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" --- > deleteAt 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range --- > deleteAt (-1) (fromList ((5,"a") :| [(3,"b")])) Error: index out of range -deleteAt :: - Int -> - NEMap k a -> - Map k a -deleteAt 0 (NEMap _ _ m) = m -deleteAt i (NEMap k v m) = insertMinMap k v . M.deleteAt (i - 1) $ m -{-# INLINEABLE deleteAt #-} - --- | Take a given number of entries in key order, beginning with the --- smallest keys. --- --- Returns a possibly empty map ('Map'), which can only happen if we call --- @take 0@. --- --- @ --- take n = Data.Map.fromDistinctAscList . Data.List.NonEmpty.take n . 'toList' --- @ -take :: - Int -> - NEMap k a -> - Map k a -take 0 NEMap{} = M.empty -take i (NEMap k v m) = insertMinMap k v . M.take (i - 1) $ m -{-# INLINEABLE take #-} - --- | Drop a given number of entries in key order, beginning --- with the smallest keys. --- --- Returns a possibly empty map ('Map'), in case we drop all of the --- elements (which can happen if we drop a number greater than or equal to --- the number of items in the map) --- --- @ --- drop n = Data.Map.fromDistinctAscList . Data.List.NonEmpty.drop' n . 'toList' --- @ -drop :: - Int -> - NEMap k a -> - Map k a -drop 0 n = toMap n -drop i (NEMap _ _ m) = M.drop (i - 1) m -{-# INLINEABLE drop #-} - --- | /O(log n)/. Split a map at a particular index @i@. --- --- * @'This' n1@ means that there are less than @i@ items in the map, and --- @n1@ is the original map. --- * @'That' n2@ means @i@ was 0; we dropped 0 items, so @n2@ is the --- original map. --- * @'These' n1 n2@ gives @n1@ (taking @i@ items from the original map) --- and @n2@ (dropping @i@ items from the original map)) -splitAt :: - Int -> - NEMap k a -> - These (NEMap k a) (NEMap k a) -splitAt 0 n = That n -splitAt i n@(NEMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> This (singleton k v) - (Just _, Nothing) -> This n - (Nothing, Just n2) -> These (singleton k v) n2 - (Just _, Just n2) -> These (insertMapMin k v m1) n2 - where - (m1, m2) = M.splitAt (i - 1) m0 -{-# INLINEABLE splitAt #-} - --- | /O(1)/. The minimal key of the map. Note that this is total, making --- 'Data.Map.lookupMin' obsolete. It is constant-time, so has better --- asymptotics than @Data.Map.lookupMin@ and @Data.Map.findMin@, as well. --- --- > findMin (fromList ((5,"a") :| [(3,"b")])) == (3,"b") -findMin :: NEMap k a -> (k, a) -findMin (NEMap k v _) = (k, v) -{-# INLINE findMin #-} - --- | /O(log n)/. The maximal key of the map. Note that this is total, making --- 'Data.Map.lookupMin' obsolete. --- --- > findMax (fromList ((5,"a") :| [(3,"b")])) == (5,"a") -findMax :: NEMap k a -> (k, a) -findMax (NEMap k v m) = fromMaybe (k, v) . M.lookupMax $ m -{-# INLINE findMax #-} - --- | /O(1)/. Delete the minimal key. Returns a potentially empty map --- ('Map'), because we might end up deleting the final key in a singleton --- map. It is constant-time, so has better asymptotics than --- 'Data.Map.deleteMin'. --- --- > deleteMin (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.Map.fromList [(5,"a"), (7,"c")] --- > deleteMin (singleton 5 "a") == Data.Map.empty -deleteMin :: NEMap k a -> Map k a -deleteMin (NEMap _ _ m) = m -{-# INLINE deleteMin #-} - --- | /O(log n)/. Delete the maximal key. Returns a potentially empty map --- ('Map'), because we might end up deleting the final key in a singleton --- map. --- --- > deleteMax (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.Map.fromList [(3,"b"), (5,"a")] --- > deleteMax (singleton 5 "a") == Data.Map.empty -deleteMax :: NEMap k a -> Map k a -deleteMax (NEMap k v m) = case M.maxView m of - Nothing -> M.empty - Just (_, m') -> insertMinMap k v m' -{-# INLINE deleteMax #-} - --- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the --- minimal key. Returns a potentially empty map ('Map'), because we might --- end up deleting the final key in the map if the function returns --- 'Nothing'. See 'adjustMin' for a version that can guaruntee that we --- return a non-empty map. --- --- > updateMin (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "Xb"), (5, "a")] --- > updateMin (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" -updateMin :: (a -> Maybe a) -> NEMap k a -> Map k a -updateMin f = updateMinWithKey (const f) -{-# INLINE updateMin #-} - --- | /O(1)/. A version of 'updateMin' that disallows deletion, allowing us --- to guarantee that the result is also non-empty. -adjustMin :: (a -> a) -> NEMap k a -> NEMap k a -adjustMin f = adjustMinWithKey (const f) -{-# INLINE adjustMin #-} - --- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the --- minimal key. Returns a potentially empty map ('Map'), because we might --- end up deleting the final key in the map if the function returns --- 'Nothing'. See 'adjustMinWithKey' for a version that guaruntees --- a non-empty map. --- --- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3,"3:b"), (5,"a")] --- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" -updateMinWithKey :: (k -> a -> Maybe a) -> NEMap k a -> Map k a -updateMinWithKey f (NEMap k v m) = maybe id (insertMinMap k) (f k v) m -{-# INLINE updateMinWithKey #-} - --- | /O(1)/. A version of 'adjustMaxWithKey' that disallows deletion, --- allowing us to guarantee that the result is also non-empty. Note that --- it also is able to have better asymptotics than 'updateMinWithKey' in --- general. -adjustMinWithKey :: (k -> a -> a) -> NEMap k a -> NEMap k a -adjustMinWithKey f (NEMap k v m) = NEMap k (f k v) m -{-# INLINE adjustMinWithKey #-} - --- | /O(log n)/. Update the value at the maximal key. Returns --- a potentially empty map ('Map'), because we might end up deleting the --- final key in the map if the function returns 'Nothing'. See 'adjustMax' --- for a version that can guarantee that we return a non-empty map. --- --- > updateMax (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "Xa")] --- > updateMax (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" -updateMax :: (a -> Maybe a) -> NEMap k a -> Map k a -updateMax f = updateMaxWithKey (const f) -{-# INLINE updateMax #-} - --- | /O(log n)/. A version of 'updateMax' that disallows deletion, allowing --- us to guarantee that the result is also non-empty. -adjustMax :: (a -> a) -> NEMap k a -> NEMap k a -adjustMax f = adjustMaxWithKey (const f) -{-# INLINE adjustMax #-} - --- | /O(log n)/. Update the value at the maximal key. Returns --- a potentially empty map ('Map'), because we might end up deleting the --- final key in the map if the function returns 'Nothing'. See --- 'adjustMaxWithKey' for a version that guaruntees a non-empty map. --- --- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3,"3:b"), (5,"a")] --- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" -updateMaxWithKey :: (k -> a -> Maybe a) -> NEMap k a -> Map k a -updateMaxWithKey f (NEMap k v m) - | M.null m = maybe m (M.singleton k) $ f k v - | otherwise = - insertMinMap k v - . M.updateMaxWithKey f - $ m -{-# INLINE updateMaxWithKey #-} - --- | /O(log n)/. A version of 'updateMaxWithKey' that disallows deletion, --- allowing us to guarantee that the result is also non-empty. -adjustMaxWithKey :: (k -> a -> a) -> NEMap k a -> NEMap k a -adjustMaxWithKey f (NEMap k0 v m) - | M.null m = NEMap k0 (f k0 v) m - | otherwise = - insertMapMin k0 v - . M.updateMaxWithKey (\k -> Just . f k) - $ m -{-# INLINE adjustMaxWithKey #-} - --- | /O(1)/. Retrieves the value associated with minimal key of the --- map, and the map stripped of that element. It is constant-time, so has --- better asymptotics than @Data.Map.minView@ for 'Map'. --- --- Note that unlike @Data.Map.minView@ for 'Map', this cannot ever fail, --- so doesn't need to return in a 'Maybe'. However, the result 'Map' is --- potentially empty, since the original map might have contained just --- a single item. --- --- > minView (fromList ((5,"a") :| [(3,"b")])) == ("b", Data.Map.singleton 5 "a") -minView :: NEMap k a -> (a, Map k a) -minView = first snd . deleteFindMin -{-# INLINE minView #-} - --- | /O(1)/. Delete and find the minimal key-value pair. It is --- constant-time, so has better asymptotics that @Data.Map.minView@ for --- 'Map'. --- --- Note that unlike @Data.Map.deleteFindMin@ for 'Map', this cannot ever --- fail, and so is a total function. However, the result 'Map' is --- potentially empty, since the original map might have contained just --- a single item. --- --- > deleteFindMin (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((3,"b"), Data.Map.fromList [(5,"a"), (10,"c")]) -deleteFindMin :: NEMap k a -> ((k, a), Map k a) -deleteFindMin (NEMap k v m) = ((k, v), m) -{-# INLINE deleteFindMin #-} - --- | /O(log n)/. Retrieves the value associated with maximal key of the --- map, and the map stripped of that element. --- --- Note that unlike @Data.Map.maxView@ from 'Map', this cannot ever fail, --- so doesn't need to return in a 'Maybe'. However, the result 'Map' is --- potentially empty, since the original map might have contained just --- a single item. --- --- > maxView (fromList ((5,"a") :| [(3,"b")])) == ("a", Data.Map.singleton 3 "b") -maxView :: NEMap k a -> (a, Map k a) -maxView = first snd . deleteFindMax -{-# INLINE maxView #-} - --- | /O(log n)/. Delete and find the minimal key-value pair. --- --- Note that unlike @Data.Map.deleteFindMax@ for 'Map', this cannot ever --- fail, and so is a total function. However, the result 'Map' is --- potentially empty, since the original map might have contained just --- a single item. --- --- > deleteFindMax (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((10,"c"), Data.Map.fromList [(3,"b"), (5,"a")]) -deleteFindMax :: NEMap k a -> ((k, a), Map k a) -deleteFindMax (NEMap k v m) = - maybe ((k, v), M.empty) (second (insertMinMap k v)) - . M.maxViewWithKey - $ m -{-# INLINE deleteFindMax #-} - --- | Special property of non-empty maps: The type of non-empty maps over --- uninhabited keys is itself uninhabited. --- --- This property also exists for /values/ inside a non-empty container --- (like for 'NESet', 'NESeq', and 'NEIntMap'); this can be witnessed using --- the function @'absurd' . 'fold1'@. --- --- @since 0.3.1.0 -absurdNEMap :: NEMap Void a -> b -absurdNEMap = \case {} - --- --------------------------- --- Combining functions --- --------------------------- --- --- Code comes from "Data.Map.Internal" from containers, modified slightly --- to work with NonEmpty --- --- Copyright : (c) Daan Leijen 2002 --- (c) Andriy Palamarchuk 2008 - -combineEq :: Eq a => NonEmpty (a, b) -> NonEmpty (a, b) -combineEq = \case - x :| [] -> x :| [] - x :| xx@(_ : _) -> go x xx - where - go z [] = z :| [] - go z@(kz, _) (x@(kx, xx) : xs') - | kx == kz = go (kx, xx) xs' - | otherwise = z NE.<| go x xs' - -combineEqWith :: - Eq a => - (a -> b -> b -> b) -> - NonEmpty (a, b) -> - NonEmpty (a, b) -combineEqWith f = \case - x :| [] -> x :| [] - x :| xx@(_ : _) -> go x xx - where - go z [] = z :| [] - go z@(kz, zz) (x@(kx, xx) : xs') - | kx == kz = let yy = f kx xx zz in go (kx, yy) xs' - | otherwise = z NE.<| go x xs' +-- | +-- Module : Data.Map.NonEmpty +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- = Non-Empty Finite Maps +-- +-- This module re-exports "Data.Map.NonEmpty.Lazy". Import +-- "Data.Map.NonEmpty.Strict" for the strict value interface. +module Data.Map.NonEmpty ( + module Data.Map.NonEmpty.Lazy, +) where + +import Data.Map.NonEmpty.Lazy diff --git a/src/Data/Map/NonEmpty/Internal.hs b/src/Data/Map/NonEmpty/Internal.hs --- a/src/Data/Map/NonEmpty/Internal.hs +++ b/src/Data/Map/NonEmpty/Internal.hs @@ -1,11 +1,3 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_HADDOCK not-home #-} -- | @@ -17,710 +9,10 @@ -- Stability : experimental -- Portability : non-portable -- --- Unsafe internal-use functions used in the implementation of --- "Data.Map.NonEmpty". These functions can potentially be used to break --- the abstraction of 'NEMap' and produce unsound maps, so be wary! +-- Internal compatibility module for the lazy non-empty map implementation. +-- Import "Data.Map.NonEmpty.Strict.Internal" for the strict value variant. module Data.Map.NonEmpty.Internal ( - -- * Non-Empty Map type - NEMap (..), - singleton, - nonEmptyMap, - withNonEmpty, - fromList, - toList, - map, - insertWith, - union, - unions, - elems, - size, - toMap, - - -- * Folds - foldr, - foldr', - foldr1, - foldl, - foldl', - foldl1, - - -- * Traversals - traverseWithKey, - traverseWithKey1, - foldMapWithKey, - - -- * Unsafe Map Functions - insertMinMap, - insertMaxMap, - - -- * Debug - valid, + module Data.Map.NonEmpty.Lazy.Internal, ) where -import Control.Applicative -import Control.Comonad -import Control.DeepSeq -import Control.Monad -import qualified Data.Aeson as A -import Data.Coerce -import Data.Data -import qualified Data.Foldable as F -import Data.Foldable.WithIndex (FoldableWithIndex (..)) -import Data.Function -import Data.Functor.Alt -import Data.Functor.Classes -import Data.Functor.Invariant -import Data.Functor.WithIndex (FunctorWithIndex (..)) -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.Map as M -import Data.Map.Internal (Map (..)) -import qualified Data.Map.Internal as M -import Data.Maybe -import Data.Semigroup -import Data.Semigroup.Foldable (Foldable1 (fold1)) -import qualified Data.Semigroup.Foldable as F1 -import Data.Semigroup.Traversable (Traversable1 (..)) -import Data.Traversable.WithIndex (TraversableWithIndex (..)) -import qualified GHC.Exts as Exts -import Text.Read -import Prelude hiding (Foldable (..), map) - --- | A non-empty (by construction) map from keys @k@ to values @a@. At --- least one key-value pair exists in an @'NEMap' k v@ at all times. --- --- Functions that /take/ an 'NEMap' can safely operate on it with the --- assumption that it has at least one key-value pair. --- --- Functions that /return/ an 'NEMap' provide an assurance that the result --- has at least one key-value pair. --- --- "Data.Map.NonEmpty" re-exports the API of "Data.Map", faithfully --- reproducing asymptotics, typeclass constraints, and semantics. --- Functions that ensure that input and output maps are both non-empty --- (like 'Data.Map.NonEmpty.insert') return 'NEMap', but functions that --- might potentially return an empty map (like 'Data.Map.NonEmpty.delete') --- return a 'Map' instead. --- --- You can directly construct an 'NEMap' with the API from --- "Data.Map.NonEmpty"; it's more or less the same as constructing a normal --- 'Map', except you don't have access to 'Data.Map.empty'. There are also --- a few ways to construct an 'NEMap' from a 'Map': --- --- 1. The 'nonEmptyMap' smart constructor will convert a @'Map' k a@ into --- a @'Maybe' ('NEMap' k a)@, returning 'Nothing' if the original 'Map' --- was empty. --- 2. You can use the 'Data.Map.NonEmpty.insertMap' family of functions to --- insert a value into a 'Map' to create a guaranteed 'NEMap'. --- 3. You can use the 'Data.Map.NonEmpty.IsNonEmpty' and --- 'Data.Map.NonEmpty.IsEmpty' patterns to "pattern match" on a 'Map' --- to reveal it as either containing a 'NEMap' or an empty map. --- 4. 'withNonEmpty' offers a continuation-based interface for --- deconstructing a 'Map' and treating it as if it were an 'NEMap'. --- --- You can convert an 'NEMap' into a 'Map' with 'toMap' or --- 'Data.Map.NonEmpty.IsNonEmpty', essentially "obscuring" the non-empty --- property from the type. -data NEMap k a - = NEMap - { nemK0 :: !k - -- ^ invariant: must be smaller than smallest key in map - , nemV0 :: a - , nemMap :: !(Map k a) - } - deriving (Typeable) - -instance (Eq k, Eq a) => Eq (NEMap k a) where - t1 == t2 = - M.size (nemMap t1) == M.size (nemMap t2) - && toList t1 == toList t2 - -instance (Ord k, Ord a) => Ord (NEMap k a) where - compare = compare `on` toList - (<) = (<) `on` toList - (>) = (>) `on` toList - (<=) = (<=) `on` toList - (>=) = (>=) `on` toList - -instance Eq2 NEMap where - liftEq2 eqk eqv m n = - size m == size n && liftEq (liftEq2 eqk eqv) (toList m) (toList n) - -instance Eq k => Eq1 (NEMap k) where - liftEq = liftEq2 (==) - -instance Ord2 NEMap where - liftCompare2 cmpk cmpv m n = - liftCompare (liftCompare2 cmpk cmpv) (toList m) (toList n) - -instance Ord k => Ord1 (NEMap k) where - liftCompare = liftCompare2 compare - -instance Show2 NEMap where - liftShowsPrec2 spk slk spv slv d m = - showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m) - where - sp = liftShowsPrec2 spk slk spv slv - sl = liftShowList2 spk slk spv slv - -instance Show k => Show1 (NEMap k) where - liftShowsPrec = liftShowsPrec2 showsPrec showList - -instance (Ord k, Read k) => Read1 (NEMap k) where - liftReadsPrec rp rl = - readsData $ - readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList - where - rp' = liftReadsPrec rp rl - rl' = liftReadList rp rl - -instance (Ord k, Read k, Read e) => Read (NEMap k e) where - readPrec = parens $ prec 10 $ do - Ident "fromList" <- lexP - xs <- parens . prec 10 $ readPrec - return (fromList xs) - readListPrec = readListPrecDefault - -instance (Show k, Show a) => Show (NEMap k a) where - showsPrec d m = - showParen (d > 10) $ - showString "fromList (" . shows (toList m) . showString ")" - -instance (NFData k, NFData a) => NFData (NEMap k a) where - rnf (NEMap k v a) = rnf k `seq` rnf v `seq` rnf a - --- | @since 0.3.6.0 -instance FunctorWithIndex k (NEMap k) where - imap f (NEMap k v m) = NEMap k (f k v) (M.mapWithKey f m) - --- | @since 0.3.6.0 -instance FoldableWithIndex k (NEMap k) where - ifoldMap = foldMapWithKey - --- | @since 0.3.6.0 -instance TraversableWithIndex k (NEMap k) where - itraverse f (NEMap k v m) = NEMap k <$> f k v <*> M.traverseWithKey f m - --- | @since 0.3.6.0 -instance Ord k => Exts.IsList (NEMap k a) where - type Item (NEMap k a) = (k, a) - - fromList (a : as) = fromList (a :| as) - fromList [] = errorWithoutStackTrace "Data.Map.NonEmpty.fromList: empty list" - - toList = F.toList . toList - --- Data instance code from Data.Map.Internal --- --- Copyright : (c) Daan Leijen 2002 --- (c) Andriy Palamarchuk 2008 -#if MIN_VERSION_base(4,16,0) -instance (Data k, Data a, Ord k) => Data (NEMap k a) where - gfoldl f z m = z fromList `f` toList m - toConstr _ = fromListConstr - gunfold k z c = case constrIndex c of - 1 -> k (z fromList) - _ -> error "gunfold" - dataTypeOf _ = mapDataType - dataCast2 = gcast2 -#else -#ifndef __HLINT__ -instance (Data k, Data a, Ord k) => Data (NEMap k a) where - gfoldl f z m = z fromList `f` toList m - toConstr _ = fromListConstr - gunfold k z c = case constrIndex c of - 1 -> k (z fromList) - _ -> error "gunfold" - dataTypeOf _ = mapDataType - dataCast2 f = gcast2 f -#endif -#endif - -fromListConstr :: Constr -fromListConstr = mkConstr mapDataType "fromList" [] Prefix - -mapDataType :: DataType -mapDataType = mkDataType "Data.Map.NonEmpty.NonEmpty.Internal.NEMap" [fromListConstr] - -instance (A.ToJSONKey k, A.ToJSON a) => A.ToJSON (NEMap k a) where - toJSON = A.toJSON . toMap - toEncoding = A.toEncoding . toMap - -instance (A.FromJSONKey k, Ord k, A.FromJSON a) => A.FromJSON (NEMap k a) where - parseJSON = - withNonEmpty (fail err) pure - <=< A.parseJSON - where - err = "NEMap: Non-empty map expected, but empty map found" - --- | @since 0.3.4.4 -instance Ord k => Alt (NEMap k) where - () = union - {-# INLINE () #-} - --- | /O(n)/. Fold the values in the map using the given right-associative --- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@. --- --- > elemsList map = foldr (:) [] map --- --- > let f a len = len + (length a) --- > foldr f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4 -foldr :: (a -> b -> b) -> b -> NEMap k a -> b -foldr f z (NEMap _ v m) = v `f` M.foldr f z m -{-# INLINE foldr #-} - --- | /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. -foldr' :: (a -> b -> b) -> b -> NEMap k a -> b -foldr' f z (NEMap _ v m) = v `f` y - where - !y = M.foldr' f z m -{-# INLINE foldr' #-} - --- | /O(n)/. A version of 'foldr' that uses the value at the maximal key in --- the map as the starting value. --- --- Note that, unlike 'Data.Foldable.foldr1' for 'Map', this function is --- total if the input function is total. -foldr1 :: (a -> a -> a) -> NEMap k a -> a -foldr1 f (NEMap _ v m) = - maybe v (f v . uncurry (M.foldr f)) - . M.maxView - $ m -{-# INLINE foldr1 #-} - --- | /O(n)/. Fold the values in the map using the given left-associative --- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@. --- --- > elemsList = reverse . foldl (flip (:)) [] --- --- > let f len a = len + (length a) --- > foldl f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4 -foldl :: (a -> b -> a) -> a -> NEMap k b -> a -foldl f z (NEMap _ v m) = M.foldl f (f z v) m -{-# INLINE foldl #-} - --- | /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. -foldl' :: (a -> b -> a) -> a -> NEMap k b -> a -foldl' f z (NEMap _ v m) = M.foldl' f x m - where - !x = f z v -{-# INLINE foldl' #-} - --- | /O(n)/. A version of 'foldl' that uses the value at the minimal key in --- the map as the starting value. --- --- Note that, unlike 'Data.Foldable.foldl1' for 'Map', this function is --- total if the input function is total. -foldl1 :: (a -> a -> a) -> NEMap k a -> a -foldl1 f (NEMap _ v m) = M.foldl f v m -{-# INLINE foldl1 #-} - --- | /O(n)/. Fold the keys and values in the map using the given semigroup, --- such that --- --- @'foldMapWithKey' f = 'Data.Semigroup.Foldable.fold1' . 'Data.Map.NonEmpty.mapWithKey' f@ --- --- This can be an asymptotically faster than --- 'Data.Map.NonEmpty.foldrWithKey' or 'Data.Map.NonEmpty.foldlWithKey' for --- some monoids. - --- TODO: benchmark against maxView method -foldMapWithKey :: - Semigroup m => - (k -> a -> m) -> - NEMap k a -> - m -#if MIN_VERSION_base(4,11,0) -foldMapWithKey f (NEMap k0 v m) = maybe (f k0 v) (f k0 v <>) - . M.foldMapWithKey (\k -> Just . f k) - $ m -#else -foldMapWithKey f (NEMap k0 v m) = option (f k0 v) (f k0 v <>) - . M.foldMapWithKey (\k -> Option . Just . f k) - $ m -#endif -{-# INLINE foldMapWithKey #-} - --- | /O(n)/. Map a function over all values in the map. --- --- > map (++ "x") (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "bx") :| [(5, "ax")]) -map :: (a -> b) -> NEMap k a -> NEMap k b -map f (NEMap k0 v m) = NEMap k0 (f v) (M.map f m) -{-# NOINLINE [1] map #-} - -{-# RULES -"map/map" forall f g xs. map f (map g xs) = map (f . g) xs - #-} -{-# RULES -"map/coerce" map coerce = coerce - #-} - --- | /O(m*log(n\/m + 1)), m <= n/. --- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and --- @t2@. It prefers @t1@ when duplicate keys are encountered, i.e. --- (@'union' == 'Data.Map.NonEmpty.unionWith' 'const'@). --- --- > union (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "a"), (7, "C")]) -union :: - Ord k => - NEMap k a -> - NEMap k a -> - NEMap k a -union n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of - LT -> NEMap k1 v1 . M.union m1 . toMap $ n2 - EQ -> NEMap k1 v1 . M.union m1 $ m2 - GT -> NEMap k2 v2 . M.union (toMap n1) $ m2 -{-# INLINE union #-} - --- | The left-biased union of a non-empty list of maps. --- --- > unions (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) --- > == fromList [(3, "b"), (5, "a"), (7, "C")] --- > unions (fromList ((5, "A3") :| [(3, "B3")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "a") :| [(3, "b")])]) --- > == fromList ((3, "B3") :| [(5, "A3"), (7, "C")]) -unions :: - (Foldable1 f, Ord k) => - f (NEMap k a) -> - NEMap k a -unions (F1.toNonEmpty -> (m :| ms)) = F.foldl' union m ms -{-# INLINE unions #-} - --- | /O(n)/. --- Return all elements of the map in the ascending order of their keys. --- --- > elems (fromList ((5,"a") :| [(3,"b")])) == ("b" :| ["a"]) -elems :: NEMap k a -> NonEmpty a -elems (NEMap _ v m) = v :| M.elems m -{-# INLINE elems #-} - --- | /O(1)/. The number of elements in the map. Guaranteed to be greater --- than zero. --- --- > size (singleton 1 'a') == 1 --- > size (fromList ((1,'a') :| [(2,'c'), (3,'b')])) == 3 -size :: NEMap k a -> Int -size (NEMap _ _ m) = 1 + M.size m -{-# INLINE size #-} - --- | /O(log n)/. --- Convert a non-empty map back into a normal possibly-empty map, for usage --- with functions that expect 'Map'. --- --- Can be thought of as "obscuring" the non-emptiness of the map in its --- type. See the 'Data.Map.NonEmpty.IsNotEmpty' pattern. --- --- 'nonEmptyMap' and @'maybe' 'Data.Map.empty' 'toMap'@ form an isomorphism: they --- are perfect structure-preserving inverses of eachother. --- --- > toMap (fromList ((3,"a") :| [(5,"b")])) == Data.Map.fromList [(3,"a"), (5,"b")] -toMap :: NEMap k a -> Map k a -toMap (NEMap k v m) = insertMinMap k v m -{-# INLINE toMap #-} - --- | /O(n)/. --- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ --- That is, behaves exactly like a regular 'traverse' except that the traversing --- function also has access to the key associated with a value. --- --- /Use 'traverseWithKey1'/ whenever possible (if your 'Applicative' --- also has 'Apply' instance). This version is provided only for types --- that do not have 'Apply' instance, since 'Apply' is not at the moment --- (and might not ever be) an official superclass of 'Applicative'. --- --- @ --- 'traverseWithKey' f = 'unwrapApplicative' . 'traverseWithKey1' (\\k -> WrapApplicative . f k) --- @ -traverseWithKey :: - Applicative t => - (k -> a -> t b) -> - NEMap k a -> - t (NEMap k b) -traverseWithKey f (NEMap k v m0) = NEMap k <$> f k v <*> M.traverseWithKey f m0 -{-# INLINE traverseWithKey #-} - --- | /O(n)/. --- @'traverseWithKey1' f m == 'fromList' <$> 'traverse1' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ --- --- That is, behaves exactly like a regular 'traverse1' except that the traversing --- function also has access to the key associated with a value. --- --- Is more general than 'traverseWithKey', since works with all 'Apply', --- and not just 'Applicative'. - --- TODO: benchmark against maxView-based methods -traverseWithKey1 :: - Apply t => - (k -> a -> t b) -> - NEMap k a -> - t (NEMap k b) -traverseWithKey1 f (NEMap k0 v m0) = case runMaybeApply m1 of - Left m2 -> NEMap k0 <$> f k0 v <.> m2 - Right m2 -> flip (NEMap k0) m2 <$> f k0 v - where - m1 = M.traverseWithKey (\k -> MaybeApply . Left . f k) m0 -{-# INLINEABLE traverseWithKey1 #-} - --- | /O(n)/. Convert the map to a non-empty list of key\/value pairs. --- --- > toList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) -toList :: NEMap k a -> NonEmpty (k, a) -toList (NEMap k v m) = (k, v) :| M.toList m -{-# INLINE toList #-} - --- | /O(log n)/. Smart constructor for an 'NEMap' from a 'Map'. Returns --- 'Nothing' if the 'Map' was originally actually empty, and @'Just' n@ --- with an 'NEMap', if the 'Map' was not empty. --- --- 'nonEmptyMap' and @'maybe' 'Data.Map.empty' 'toMap'@ form an --- isomorphism: they are perfect structure-preserving inverses of --- eachother. --- --- See 'Data.Map.NonEmpty.IsNonEmpty' for a pattern synonym that lets you --- "match on" the possiblity of a 'Map' being an 'NEMap'. --- --- > nonEmptyMap (Data.Map.fromList [(3,"a"), (5,"b")]) == Just (fromList ((3,"a") :| [(5,"b")])) -nonEmptyMap :: Map k a -> Maybe (NEMap k a) -nonEmptyMap = (fmap . uncurry . uncurry) NEMap . M.minViewWithKey -{-# INLINE nonEmptyMap #-} - --- | /O(log n)/. A general continuation-based way to consume a 'Map' as if --- it were an 'NEMap'. @'withNonEmpty' def f@ will take a 'Map'. If map is --- empty, it will evaluate to @def@. Otherwise, a non-empty map 'NEMap' --- will be fed to the function @f@ instead. --- --- @'nonEmptyMap' == 'withNonEmpty' 'Nothing' 'Just'@ -withNonEmpty :: - -- | value to return if map is empty - r -> - -- | function to apply if map is not empty - (NEMap k a -> r) -> - Map k a -> - r -withNonEmpty def f = maybe def f . nonEmptyMap -{-# INLINE withNonEmpty #-} - --- | /O(n*log n)/. Build a non-empty map from a non-empty list of --- key\/value pairs. See also 'Data.Map.NonEmpty.fromAscList'. If the list --- contains more than one value for the same key, the last value for the --- key is retained. --- --- > fromList ((5,"a") :| [(3,"b"), (5, "c")]) == fromList ((5,"c") :| [(3,"b")]) --- > fromList ((5,"c") :| [(3,"b"), (5, "a")]) == fromList ((5,"a") :| [(3,"b")]) - --- TODO: write manually and optimize to be equivalent to --- 'fromDistinctAscList' if items are ordered, just like the actual --- 'M.fromList'. -fromList :: Ord k => NonEmpty (k, a) -> NEMap k a -fromList ((k, v) :| xs) = - withNonEmpty (singleton k v) (insertWith (const id) k v) - . M.fromList - $ xs -{-# INLINE fromList #-} - --- | /O(1)/. A map with a single element. --- --- > singleton 1 'a' == fromList ((1, 'a') :| []) --- > size (singleton 1 'a') == 1 -singleton :: k -> a -> NEMap k a -singleton k v = NEMap k v M.empty -{-# INLINE singleton #-} - --- | /O(log n)/. Insert with a function, combining new value and old value. --- @'insertWith' f key value mp@ will insert the pair (key, value) into --- @mp@ if key does not exist in the map. If the key does exist, the --- function will insert the pair @(key, f new_value old_value)@. --- --- See 'Data.Map.NonEmpty.insertMapWith' for a version where the first --- argument is a 'Map'. --- --- > insertWith (++) 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "xxxa")]) --- > insertWith (++) 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) -insertWith :: - Ord k => - (a -> a -> a) -> - k -> - a -> - NEMap k a -> - NEMap k a -insertWith f k v n@(NEMap k0 v0 m) = case compare k k0 of - LT -> NEMap k v . toMap $ n - EQ -> NEMap k (f v v0) m - GT -> NEMap k0 v0 $ M.insertWith f k v m -{-# INLINE insertWith #-} - --- | Left-biased union -instance Ord k => Semigroup (NEMap k a) where - (<>) = union - {-# INLINE (<>) #-} - sconcat = unions - {-# INLINE sconcat #-} - -instance Functor (NEMap k) where - fmap = map - {-# INLINE fmap #-} - x <$ NEMap k _ m = NEMap k x (x <$ m) - {-# INLINE (<$) #-} - --- | @since 0.3.4.4 -instance Invariant (NEMap k) where - invmap f _ = fmap f - {-# INLINE invmap #-} - --- | Traverses elements in order of ascending keys --- --- 'Data.Foldable.foldr1', 'Data.Foldable.foldl1', 'Data.Foldable.minimum', --- 'Data.Foldable.maximum' are all total. -#if MIN_VERSION_base(4,11,0) -instance F.Foldable (NEMap k) where - fold (NEMap _ v m) = v <> F.fold m - {-# INLINE fold #-} - foldMap f (NEMap _ v m) = f v <> F.foldMap f m - {-# INLINE foldMap #-} - foldr = foldr - {-# INLINE foldr #-} - foldr' = foldr' - {-# INLINE foldr' #-} - foldr1 = foldr1 - {-# INLINE foldr1 #-} - foldl = foldl - {-# INLINE foldl #-} - foldl' = foldl' - {-# INLINE foldl' #-} - foldl1 = foldl1 - {-# INLINE foldl1 #-} - null _ = False - {-# INLINE null #-} - length = size - {-# INLINE length #-} - elem x (NEMap _ v m) = F.elem x m - || x == v - {-# INLINE elem #-} - -- TODO: use build - toList = F.toList . elems - {-# INLINE toList #-} -#else -instance F.Foldable (NEMap k) where - fold (NEMap _ v m) = v `mappend` F.fold m - {-# INLINE fold #-} - foldMap f (NEMap _ v m) = f v `mappend` F.foldMap f m - {-# INLINE foldMap #-} - foldr = foldr - {-# INLINE foldr #-} - foldr' = foldr' - {-# INLINE foldr' #-} - foldr1 = foldr1 - {-# INLINE foldr1 #-} - foldl = foldl - {-# INLINE foldl #-} - foldl' = foldl' - {-# INLINE foldl' #-} - foldl1 = foldl1 - {-# INLINE foldl1 #-} - null _ = False - {-# INLINE null #-} - length = size - {-# INLINE length #-} - elem x (NEMap _ v m) = F.elem x m - || x == v - {-# INLINE elem #-} - -- TODO: use build - toList = F.toList . elems - {-# INLINE toList #-} -#endif - --- | Traverses elements in order of ascending keys -instance Traversable (NEMap k) where - traverse f (NEMap k v m) = NEMap k <$> f v <*> traverse f m - {-# INLINE traverse #-} - sequenceA (NEMap k v m) = NEMap k <$> v <*> sequenceA m - {-# INLINE sequenceA #-} - --- | Traverses elements in order of ascending keys -#if MIN_VERSION_base(4,11,0) -instance Foldable1 (NEMap k) where - fold1 (NEMap _ v m) = maybe v (v <>) - . F.foldMap Just - $ m - {-# INLINE fold1 #-} - foldMap1 f = foldMapWithKey (const f) - {-# INLINE foldMap1 #-} - toNonEmpty = elems - {-# INLINE toNonEmpty #-} -#else -instance Foldable1 (NEMap k) where - fold1 (NEMap _ v m) = option v (v <>) - . F.foldMap (Option . Just) - $ m - {-# INLINE fold1 #-} - foldMap1 f = foldMapWithKey (const f) - {-# INLINE foldMap1 #-} - toNonEmpty = elems - {-# INLINE toNonEmpty #-} -#endif - --- | Traverses elements in order of ascending keys -instance Traversable1 (NEMap k) where - traverse1 f = traverseWithKey1 (const f) - {-# INLINE traverse1 #-} - sequence1 (NEMap k v m0) = case runMaybeApply m1 of - Left m2 -> NEMap k <$> v <.> m2 - Right m2 -> flip (NEMap k) m2 <$> v - where - m1 = traverse (MaybeApply . Left) m0 - {-# INLINEABLE sequence1 #-} - --- | 'extract' gets the value at the minimal key, and 'duplicate' produces --- a map of maps comprised of all keys from the original map greater than --- or equal to the current key. --- --- @since 0.1.1.0 -instance Comonad (NEMap k) where - extract = nemV0 - {-# INLINE extract #-} - duplicate n0@(NEMap k0 _ m0) = - NEMap k0 n0 - . snd - . M.mapAccumWithKey go m0 - $ m0 - where - go m k v = (m', NEMap k v m') - where - !m' = M.deleteMin m - {-# INLINE duplicate #-} - --- | /O(n)/. Test if the internal map structure is valid. -valid :: Ord k => NEMap k a -> Bool -valid (NEMap k _ m) = - M.valid m - && all ((k <) . fst . fst) (M.minViewWithKey m) - --- | /O(log n)/. Insert new key and value into a map where keys are --- /strictly greater than/ the new key. That is, the new key must be --- /strictly less than/ all keys present in the 'Map'. /The precondition --- is not checked./ --- --- While this has the same asymptotics as @Data.Map.insert@, it saves --- a constant factor for key comparison (so may be helpful if comparison is --- expensive) and also does not require an 'Ord' instance for the key type. -insertMinMap :: k -> a -> Map k a -> Map k a -insertMinMap kx x = \case - Tip -> M.singleton kx x - Bin _ ky y l r -> M.balanceL ky y (insertMinMap kx x l) r -{-# INLINEABLE insertMinMap #-} - --- | /O(log n)/. Insert new key and value into a map where keys are --- /strictly less than/ the new key. That is, the new key must be --- /strictly greater than/ all keys present in the 'Map'. /The --- precondition is not checked./ --- --- While this has the same asymptotics as @Data.Map.insert@, it saves --- a constant factor for key comparison (so may be helpful if comparison is --- expensive) and also does not require an 'Ord' instance for the key type. -insertMaxMap :: k -> a -> Map k a -> Map k a -insertMaxMap kx x = \case - Tip -> M.singleton kx x - Bin _ ky y l r -> M.balanceR ky y l (insertMaxMap kx x r) -{-# INLINEABLE insertMaxMap #-} +import Data.Map.NonEmpty.Lazy.Internal diff --git a/src/Data/Map/NonEmpty/Lazy.hs b/src/Data/Map/NonEmpty/Lazy.hs new file mode 100644 --- /dev/null +++ b/src/Data/Map/NonEmpty/Lazy.hs @@ -0,0 +1,2492 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module : Data.Map.NonEmpty.Lazy +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- = Non-Empty Finite Maps (lazy interface) +-- +-- The @'NEMap' k v@ type represents a non-empty finite map (sometimes +-- called a dictionary) from keys of type @k@ to values of type @v@. +-- An 'NEMap' is strict in its keys but lazy in its values. +-- +-- See documentation for 'NEMap' for information on how to convert and +-- manipulate such non-empty maps. +-- +-- This module essentially re-imports the API of "Data.Map.Lazy" and its +-- 'Map' type, along with semantics and asymptotics. In most situations, +-- asymptotics are different only by a constant factor. In some +-- situations, asmyptotics are even better (constant-time instead of +-- log-time). All typeclass constraints are identical to their "Data.Map" +-- counterparts. +-- +-- Because 'NEMap' is implemented using 'Map', all of the caveats of using +-- 'Map' apply (such as the limitation of the maximum size of maps). +-- +-- All functions take non-empty maps as inputs. In situations where their +-- results can be guarunteed to also be non-empty, they also return +-- non-empty maps. In situations where their results could potentially be +-- empty, 'Map' is returned instead. +-- +-- Some variants of functions (like 'alter'', 'alterF'', 'adjustAt', +-- 'adjustMin', 'adjustMax', 'adjustMinWithKey', 'adjustMaxWithKey') are +-- provided in a way restructured to preserve guaruntees of non-empty maps +-- being returned. +-- +-- Some functions (like 'mapEither', 'partition', 'spanAntitone', 'split') +-- have modified return types to account for possible configurations of +-- non-emptiness. +-- +-- This module is intended to be imported qualified, to avoid name clashes with +-- "Prelude" and "Data.Map" functions: +-- +-- > import qualified Data.Map.NonEmpty.Lazy as NEM +-- +-- Import "Data.Map.NonEmpty.Strict" for a variant strict on values. +module Data.Map.NonEmpty.Lazy ( + -- * Non-Empty Map type + NEMap, + + -- ** Conversions between empty and non-empty maps + pattern IsNonEmpty, + pattern IsEmpty, + nonEmptyMap, + toMap, + withNonEmpty, + insertMap, + insertMapWith, + insertMapWithKey, + insertMapMin, + insertMapMax, + unsafeFromMap, + + -- * Construction + singleton, + fromSet, + + -- ** From Unordered Lists + fromList, + fromListWith, + fromListWithKey, + + -- ** From Ascending Lists + fromAscList, + fromAscListWith, + fromAscListWithKey, + fromDistinctAscList, + + -- ** From Descending Lists + fromDescList, + fromDescListWith, + fromDescListWithKey, + fromDistinctDescList, + + -- * Insertion + insert, + insertWith, + insertWithKey, + insertLookupWithKey, + + -- * Deletion\/Update + delete, + deleteMaybe, + adjust, + adjustWithKey, + update, + updateWithKey, + updateLookupWithKey, + alter, + alterF, + alter', + alterF', + + -- * Query + + -- ** Lookup + lookup, + (!?), + (!), + findWithDefault, + member, + notMember, + lookupLT, + lookupGT, + lookupLE, + lookupGE, + absurdNEMap, + + -- ** Size + size, + + -- * Combine + + -- ** Union + union, + unionMapLeft, + unionMapRight, + unionWith, + unionMapWithLeft, + unionMapWithRight, + unionWithKey, + unionMapWithKeyLeft, + unionMapWithKeyRight, + unions, + unionsWith, + + -- ** Difference + difference, + (\\), + differenceWith, + differenceWithKey, + + -- ** Intersection + intersection, + intersectionWith, + intersectionWithKey, + -- -- ** Unsafe general combining function + -- , mergeWithKey + + -- * Traversal + + -- ** Map + map, + mapWithKey, + traverseWithKey1, + traverseWithKey, + traverseMaybeWithKey1, + traverseMaybeWithKey, + mapAccum, + mapAccumWithKey, + mapAccumRWithKey, + mapKeys, + mapKeysWith, + mapKeysMonotonic, + + -- * Folds + foldr, + foldl, + foldr1, + foldl1, + foldrWithKey, + foldlWithKey, + foldMapWithKey, + + -- ** Strict folds + foldr', + foldr1', + foldl', + foldl1', + foldrWithKey', + foldlWithKey', + + -- * Conversion + elems, + keys, + assocs, + keysSet, + + -- ** Lists + toList, + + -- ** Ordered lists + toAscList, + toDescList, + + -- * Filter + filter, + filterWithKey, + restrictKeys, + withoutKeys, + partition, + partitionWithKey, + takeWhileAntitone, + dropWhileAntitone, + spanAntitone, + mapMaybe, + mapMaybeWithKey, + mapEither, + mapEitherWithKey, + split, + splitLookup, + splitRoot, + + -- * Submap + isSubmapOf, + isSubmapOfBy, + isProperSubmapOf, + isProperSubmapOfBy, + + -- * Indexed + lookupIndex, + findIndex, + elemAt, + updateAt, + adjustAt, + deleteAt, + take, + drop, + splitAt, + + -- * Min\/Max + findMin, + findMax, + deleteMin, + deleteMax, + deleteFindMin, + deleteFindMax, + updateMin, + updateMax, + adjustMin, + adjustMax, + updateMinWithKey, + updateMaxWithKey, + adjustMinWithKey, + adjustMaxWithKey, + minView, + maxView, + + -- * Debugging + valid, +) where + +import Control.Applicative +import Data.Bifunctor +import qualified Data.Foldable as F +import Data.Function +import Data.Functor.Apply +import Data.Functor.Identity +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE +import Data.Map (Map) +import qualified Data.Map as M +import Data.Map.NonEmpty.Lazy.Internal +import Data.Maybe hiding (mapMaybe) +import qualified Data.Maybe as Maybe +import Data.Semigroup.Foldable (Foldable1) +import qualified Data.Semigroup.Foldable as F1 +import Data.Set (Set) +import qualified Data.Set as S +import Data.Set.NonEmpty.Internal (NESet (..)) +import Data.These +import Data.Void +import Prelude hiding (Foldable (..), drop, filter, lookup, map, splitAt, take) + +-- | /O(1)/ match, /O(log n)/ usage of contents. The 'IsNonEmpty' and +-- 'IsEmpty' patterns allow you to treat a 'Map' as if it were either +-- a @'IsNonEmpty' n@ (where @n@ is a 'NEMap') or an 'IsEmpty'. +-- +-- For example, you can pattern match on a 'Map': +-- +-- @ +-- myFunc :: 'Map' K X -> Y +-- myFunc ('IsNonEmpty' n) = -- here, the user provided a non-empty map, and @n@ is the 'NEMap' +-- myFunc 'IsEmpty' = -- here, the user provided an empty map. +-- @ +-- +-- Matching on @'IsNonEmpty' n@ means that the original 'Map' was /not/ +-- empty, and you have a verified-non-empty 'NEMap' @n@ to use. +-- +-- Note that patching on this pattern is /O(1)/. However, using the +-- contents requires a /O(log n)/ cost that is deferred until after the +-- pattern is matched on (and is not incurred at all if the contents are +-- never used). +-- +-- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides +-- complete coverage. +-- +-- This is a bidirectional pattern, so you can use 'IsNonEmpty' to convert +-- a 'NEMap' back into a 'Map', obscuring its non-emptiness (see 'toMap'). +pattern IsNonEmpty :: NEMap k a -> Map k a +pattern IsNonEmpty n <- (nonEmptyMap -> Just n) + where + IsNonEmpty n = toMap n + +-- | /O(1)/. The 'IsNonEmpty' and 'IsEmpty' patterns allow you to treat +-- a 'Map' as if it were either a @'IsNonEmpty' n@ (where @n@ is +-- a 'NEMap') or an 'IsEmpty'. +-- +-- Matching on 'IsEmpty' means that the original 'Map' was empty. +-- +-- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides +-- complete coverage. +-- +-- This is a bidirectional pattern, so you can use 'IsEmpty' as an +-- expression, and it will be interpreted as 'Data.Map.empty'. +-- +-- See 'IsNonEmpty' for more information. +pattern IsEmpty :: Map k a +pattern IsEmpty <- (M.null -> True) + where + IsEmpty = M.empty + +{-# COMPLETE IsNonEmpty, IsEmpty #-} + +-- | /O(log n)/. Unsafe version of 'nonEmptyMap'. Coerces a 'Map' into an +-- 'NEMap', but is undefined (throws a runtime exception when evaluation is +-- attempted) for an empty 'Map'. +unsafeFromMap :: + Map k a -> + NEMap k a +unsafeFromMap = withNonEmpty e id + where + e = errorWithoutStackTrace "NEMap.unsafeFromMap: empty map" +{-# INLINE unsafeFromMap #-} + +-- | /O(n)/. Build a non-empty map from a non-empty set of keys and +-- a function which for each key computes its value. +-- +-- > fromSet (\k -> replicate k 'a') (Data.Set.NonEmpty.fromList (3 :| [5])) == fromList ((5,"aaaaa") :| [(3,"aaa")]) +fromSet :: + (k -> a) -> + NESet k -> + NEMap k a +fromSet f (NESet k ks) = NEMap k (f k) (M.fromSet f ks) +{-# INLINE fromSet #-} + +-- | /O(log n)/. Lookup the value at a key in the map. +-- +-- The function will return the corresponding value as @('Just' value)@, +-- or 'Nothing' if the key isn't in the map. +-- +-- An example of using @lookup@: +-- +-- > import Prelude hiding (lookup) +-- > import Data.Map.NonEmpty +-- > +-- > employeeDept = fromList (("John","Sales") :| [("Bob","IT")]) +-- > deptCountry = fromList (("IT","USA") :| [("Sales","France")]) +-- > countryCurrency = fromList (("USA", "Dollar") :| [("France", "Euro")]) +-- > +-- > employeeCurrency :: String -> Maybe String +-- > employeeCurrency name = do +-- > dept <- lookup name employeeDept +-- > country <- lookup dept deptCountry +-- > lookup country countryCurrency +-- > +-- > main = do +-- > putStrLn $ "John's currency: " ++ (show (employeeCurrency "John")) +-- > putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete")) +-- +-- The output of this program: +-- +-- > John's currency: Just "Euro" +-- > Pete's currency: Nothing +lookup :: + Ord k => + k -> + NEMap k a -> + Maybe a +lookup k (NEMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Just v + GT -> M.lookup k m +{-# INLINE lookup #-} + +-- | /O(log n)/. Find the value at a key. Returns 'Nothing' when the +-- element can not be found. +-- +-- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 1 == Nothing +-- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 5 == Just 'a' +(!?) :: Ord k => NEMap k a -> k -> Maybe a +(!?) = flip lookup +{-# INLINE (!?) #-} + +-- | /O(log n)/. Find the value at a key. Calls 'error' when the element +-- can not be found. +-- +-- > fromList ((5,'a') :| [(3,'b')]) ! 1 Error: element not in the map +-- > fromList ((5,'a') :| [(3,'b')]) ! 5 == 'a' +(!) :: Ord k => NEMap k a -> k -> a +(!) m k = fromMaybe e $ m !? k + where + e = error "NEMap.!: given key is not an element in the map" +{-# INLINE (!) #-} + +infixl 9 !? +infixl 9 ! + +-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns +-- the value at key @k@ or returns default value @def@ +-- when the key is not in the map. +-- +-- > findWithDefault 'x' 1 (fromList ((5,'a') :| [(3,'b')])) == 'x' +-- > findWithDefault 'x' 5 (fromList ((5,'a') :| [(3,'b')])) == 'a' +findWithDefault :: + Ord k => + a -> + k -> + NEMap k a -> + a +findWithDefault def k (NEMap k0 v m) = case compare k k0 of + LT -> def + EQ -> v + GT -> M.findWithDefault def k m +{-# INLINE findWithDefault #-} + +-- | /O(log n)/. Is the key a member of the map? See also 'notMember'. +-- +-- > member 5 (fromList ((5,'a') :| [(3,'b')])) == True +-- > member 1 (fromList ((5,'a') :| [(3,'b')])) == False +member :: Ord k => k -> NEMap k a -> Bool +member k (NEMap k0 _ m) = case compare k k0 of + LT -> False + EQ -> True + GT -> M.member k m +{-# INLINE member #-} + +-- | /O(log n)/. Is the key not a member of the map? See also 'member'. +-- +-- > notMember 5 (fromList ((5,'a') :| [(3,'b')])) == False +-- > notMember 1 (fromList ((5,'a') :| [(3,'b')])) == True +notMember :: Ord k => k -> NEMap k a -> Bool +notMember k (NEMap k0 _ m) = case compare k k0 of + LT -> True + EQ -> False + GT -> M.notMember k m +{-# INLINE notMember #-} + +-- | /O(log n)/. Find largest key smaller than the given one and return the +-- corresponding (key, value) pair. +-- +-- > lookupLT 3 (fromList ((3,'a') :| [(5,'b')])) == Nothing +-- > lookupLT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +lookupLT :: Ord k => k -> NEMap k a -> Maybe (k, a) +lookupLT k (NEMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Nothing + GT -> M.lookupLT k m <|> Just (k0, v) +{-# INLINE lookupLT #-} + +-- | /O(log n)/. Find smallest key greater than the given one and return the +-- corresponding (key, value) pair. +-- +-- > lookupGT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +-- > lookupGT 5 (fromList ((3,'a') :| [(5,'b')])) == Nothing +lookupGT :: Ord k => k -> NEMap k a -> Maybe (k, a) +lookupGT k (NEMap k0 v m) = case compare k k0 of + LT -> Just (k0, v) + EQ -> M.lookupMin m + GT -> M.lookupGT k m +{-# INLINE lookupGT #-} + +-- | /O(log n)/. Find largest key smaller or equal to the given one and return +-- the corresponding (key, value) pair. +-- +-- > lookupLE 2 (fromList ((3,'a') :| [(5,'b')])) == Nothing +-- > lookupLE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +-- > lookupLE 5 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +lookupLE :: Ord k => k -> NEMap k a -> Maybe (k, a) +lookupLE k (NEMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Just (k0, v) + GT -> M.lookupLE k m <|> Just (k0, v) +{-# INLINE lookupLE #-} + +-- | /O(log n)/. Find smallest key greater or equal to the given one and return +-- the corresponding (key, value) pair. +-- +-- > lookupGE 3 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +-- > lookupGE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +-- > lookupGE 6 (fromList ((3,'a') :| [(5,'b')])) == Nothing +lookupGE :: Ord k => k -> NEMap k a -> Maybe (k, a) +lookupGE k (NEMap k0 v m) = case compare k k0 of + LT -> Just (k0, v) + EQ -> Just (k0, v) + GT -> M.lookupGE k m +{-# INLINE lookupGE #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union with a combining function. +-- +-- > unionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "aA"), (7, "C")]) +unionWith :: + Ord k => + (a -> a -> a) -> + NEMap k a -> + NEMap k a -> + NEMap k a +unionWith f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + LT -> NEMap k1 v1 . M.unionWith f m1 . toMap $ n2 + EQ -> NEMap k1 (f v1 v2) . M.unionWith f m1 $ m2 + GT -> NEMap k2 v2 . M.unionWith f (toMap n1) $ m2 +{-# INLINE unionWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a possibly-empty +-- 'Map' and a non-empty map. +-- +-- @since 0.3.6.0 +unionMapLeft :: Ord k => Map k a -> NEMap k a -> NEMap k a +unionMapLeft m n = withNonEmpty n (`union` n) m +{-# INLINE unionMapLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a non-empty map and a +-- possibly-empty 'Map'. +-- +-- @since 0.3.6.0 +unionMapRight :: Ord k => NEMap k a -> Map k a -> NEMap k a +unionMapRight n = withNonEmpty n (union n) +{-# INLINE unionMapRight #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'Map' and a +-- non-empty map with a combining function. +-- +-- @since 0.3.6.0 +unionMapWithLeft :: Ord k => (a -> a -> a) -> Map k a -> NEMap k a -> NEMap k a +unionMapWithLeft f m n = withNonEmpty n (\m' -> unionWith f m' n) m +{-# INLINE unionMapWithLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a +-- possibly-empty 'Map' with a combining function. +-- +-- @since 0.3.6.0 +unionMapWithRight :: Ord k => (a -> a -> a) -> NEMap k a -> Map k a -> NEMap k a +unionMapWithRight f n = withNonEmpty n (unionWith f n) +{-# INLINE unionMapWithRight #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- Union with a combining function, given the matching key. +-- +-- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value +-- > unionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "5:a|A"), (7, "C")]) +unionWithKey :: + Ord k => + (k -> a -> a -> a) -> + NEMap k a -> + NEMap k a -> + NEMap k a +unionWithKey f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + LT -> NEMap k1 v1 . M.unionWithKey f m1 . toMap $ n2 + EQ -> NEMap k1 (f k1 v1 v2) . M.unionWithKey f m1 $ m2 + GT -> NEMap k2 v2 . M.unionWithKey f (toMap n1) $ m2 +{-# INLINE unionWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'Map' and a +-- non-empty map with a combining function, given the matching key. +-- +-- @since 0.3.6.0 +unionMapWithKeyLeft :: + Ord k => + (k -> a -> a -> a) -> + Map k a -> + NEMap k a -> + NEMap k a +unionMapWithKeyLeft f m n = withNonEmpty n (\m' -> unionWithKey f m' n) m +{-# INLINE unionMapWithKeyLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a +-- possibly-empty 'Map' with a combining function, given the matching key. +-- +-- @since 0.3.6.0 +unionMapWithKeyRight :: + Ord k => + (k -> a -> a -> a) -> + NEMap k a -> + Map k a -> + NEMap k a +unionMapWithKeyRight f n = withNonEmpty n (unionWithKey f n) +{-# INLINE unionMapWithKeyRight #-} + +-- | The union of a non-empty list of maps, with a combining operation: +-- (@'unionsWith' f == 'Data.Foldable.foldl1' ('unionWith' f)@). +-- +-- > unionsWith (++) (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) +-- > == fromList ((3, "bB3") :| [(5, "aAA3"), (7, "C")]) +unionsWith :: + (Foldable1 f, Ord k) => + (a -> a -> a) -> + f (NEMap k a) -> + NEMap k a +unionsWith f (F1.toNonEmpty -> (m :| ms)) = F.foldl' (unionWith f) m ms +{-# INLINE unionsWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Difference of two maps. +-- Return elements of the first map not existing in the second map. +-- +-- Returns a potentially empty map ('Map'), in case the first map is +-- a subset of the second map. +-- +-- > difference (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 3 "b" +difference :: + Ord k => + NEMap k a -> + NEMap k b -> + Map k a +difference n1@(NEMap k1 v1 m1) n2@(NEMap k2 _ m2) = case compare k1 k2 of + -- k1 is not in n2, so cannot be deleted + LT -> insertMinMap k1 v1 $ m1 `M.difference` toMap n2 + -- k2 deletes k1, and only k1 + EQ -> m1 `M.difference` m2 + -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. + GT -> toMap n1 `M.difference` m2 +{-# INLINE difference #-} + +-- | Same as 'difference'. +(\\) :: + Ord k => + NEMap k a -> + NEMap k b -> + Map k a +(\\) = difference +{-# INLINE (\\) #-} + +-- | /O(n+m)/. Difference with a combining function. +-- When two equal keys are +-- encountered, the combining function is applied to the values of these keys. +-- If it returns 'Nothing', the element is discarded (proper set difference). If +-- it returns (@'Just' y@), the element is updated with a new value @y@. +-- +-- Returns a potentially empty map ('Map'), in case the first map is +-- a subset of the second map and the function returns 'Nothing' for every +-- pair. +-- +-- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing +-- > differenceWith f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (7, "C")])) +-- > == Data.Map.singleton 3 "b:B" +differenceWith :: + Ord k => + (a -> b -> Maybe a) -> + NEMap k a -> + NEMap k b -> + Map k a +differenceWith f = differenceWithKey (const f) +{-# INLINE differenceWith #-} + +-- | /O(n+m)/. Difference with a combining function. When two equal keys are +-- encountered, the combining function is applied to the key and both values. +-- If it returns 'Nothing', the element is discarded (proper set difference). If +-- it returns (@'Just' y@), the element is updated with a new value @y@. +-- +-- Returns a potentially empty map ('Map'), in case the first map is +-- a subset of the second map and the function returns 'Nothing' for every +-- pair. +-- +-- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing +-- > differenceWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (10, "C")])) +-- > == Data.Map.singleton 3 "3:b|B" +differenceWithKey :: + Ord k => + (k -> a -> b -> Maybe a) -> + NEMap k a -> + NEMap k b -> + Map k a +differenceWithKey f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + -- k1 is not in n2, so cannot be deleted + LT -> insertMinMap k1 v1 $ M.differenceWithKey f m1 (toMap n2) + -- k2 deletes k1, and only k1 + EQ -> maybe id (insertMinMap k1) (f k1 v1 v2) (M.differenceWithKey f m1 m2) + -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. + GT -> M.differenceWithKey f (toMap n1) m2 +{-# INLINE differenceWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection of two maps. +-- Return data in the first map for the keys existing in both maps. +-- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). +-- +-- Returns a potentially empty map ('Map'), in case the two maps share no +-- keys in common. +-- +-- > intersection (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 5 "a" +intersection :: + Ord k => + NEMap k a -> + NEMap k b -> + Map k a +intersection n1@(NEMap k1 v1 m1) n2@(NEMap k2 _ m2) = case compare k1 k2 of + -- k1 is not in n2 + LT -> m1 `M.intersection` toMap n2 + -- k1 and k2 are a part of the result + EQ -> insertMinMap k1 v1 $ m1 `M.intersection` m2 + -- k2 is not in n1 + GT -> toMap n1 `M.intersection` m2 +{-# INLINE intersection #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. +-- +-- Returns a potentially empty map ('Map'), in case the two maps share no +-- keys in common. +-- +-- > intersectionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 5 "aA" +intersectionWith :: + Ord k => + (a -> b -> c) -> + NEMap k a -> + NEMap k b -> + Map k c +intersectionWith f = intersectionWithKey (const f) +{-# INLINE intersectionWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. +-- +-- Returns a potentially empty map ('Map'), in case the two maps share no +-- keys in common. +-- +-- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar +-- > intersectionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 5 "5:a|A" +intersectionWithKey :: + Ord k => + (k -> a -> b -> c) -> + NEMap k a -> + NEMap k b -> + Map k c +intersectionWithKey f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + -- k1 is not in n2 + LT -> M.intersectionWithKey f m1 (toMap n2) + -- k1 and k2 are a part of the result + EQ -> insertMinMap k1 (f k1 v1 v2) $ M.intersectionWithKey f m1 m2 + -- k2 is not in n1 + GT -> M.intersectionWithKey f (toMap n1) m2 +{-# INLINE intersectionWithKey #-} + +-- | /O(n)/. A strict version of 'foldr1'. Each application of the operator +-- is evaluated before using the result in the next application. This +-- function is strict in the starting value. +foldr1' :: (a -> a -> a) -> NEMap k a -> a +foldr1' f (NEMap _ v m) = case M.maxView m of + Nothing -> v + Just (y, m') -> let !z = M.foldr' f y m' in v `f` z +{-# INLINE foldr1' #-} + +-- | /O(n)/. A strict version of 'foldl1'. Each application of the operator +-- is evaluated before using the result in the next application. This +-- function is strict in the starting value. +foldl1' :: (a -> a -> a) -> NEMap k a -> a +foldl1' f (NEMap _ v m) = M.foldl' f v m +{-# INLINE foldl1' #-} + +-- | /O(n)/. Fold the keys and values in the map using the given right-associative +-- binary operator, such that +-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. +-- +-- For example, +-- +-- > keysList map = foldrWithKey (\k x ks -> k:ks) [] map +foldrWithKey :: (k -> a -> b -> b) -> b -> NEMap k a -> b +foldrWithKey f z (NEMap k v m) = f k v . M.foldrWithKey f z $ m +{-# INLINE foldrWithKey #-} + +-- | /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. +foldrWithKey' :: (k -> a -> b -> b) -> b -> NEMap k a -> b +foldrWithKey' f z (NEMap k v m) = f k v y + where + !y = M.foldrWithKey f z m +{-# INLINE foldrWithKey' #-} + +-- | /O(n)/. Fold the keys and values in the map using the given left-associative +-- binary operator, such that +-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@. +-- +-- For example, +-- +-- > keysList = reverse . foldlWithKey (\ks k x -> k:ks) [] +foldlWithKey :: (a -> k -> b -> a) -> a -> NEMap k b -> a +foldlWithKey f z (NEMap k v m) = M.foldlWithKey f (f z k v) m +{-# INLINE foldlWithKey #-} + +-- | /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. +foldlWithKey' :: (a -> k -> b -> a) -> a -> NEMap k b -> a +foldlWithKey' f z (NEMap k v m) = M.foldlWithKey' f x m + where + !x = f z k v +{-# INLINE foldlWithKey' #-} + +-- | /O(n)/. Return all keys of the map in ascending order. +-- +-- > keys (fromList ((5,"a") :| [(3,"b")])) == (3 :| [5]) +keys :: NEMap k a -> NonEmpty k +keys (NEMap k _ m) = k :| M.keys m +{-# INLINE keys #-} + +-- | /O(n)/. An alias for 'toAscList'. Return all key\/value pairs in the map +-- in ascending key order. +-- +-- > assocs (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +assocs :: NEMap k a -> NonEmpty (k, a) +assocs = toList +{-# INLINE assocs #-} + +-- | /O(n)/. The non-empty set of all keys of the map. +-- +-- > keysSet (fromList ((5,"a") :| [(3,"b")])) == Data.Set.NonEmpty.fromList (3 :| [5]) +keysSet :: NEMap k a -> NESet k +keysSet (NEMap k _ m) = NESet k (M.keysSet m) +{-# INLINE keysSet #-} + +-- | /O(n)/. Map a function over all values in the map. +-- +-- > let f key x = (show key) ++ ":" ++ x +-- > mapWithKey f (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "3:b") :| [(5, "5:a")]) +mapWithKey :: (k -> a -> b) -> NEMap k a -> NEMap k b +mapWithKey f (NEMap k v m) = NEMap k (f k v) (M.mapWithKey f m) +{-# NOINLINE [1] mapWithKey #-} + +{-# RULES +"mapWithKey/mapWithKey" forall f g xs. + mapWithKey f (mapWithKey g xs) = + mapWithKey (\k a -> f k (g k a)) xs +"mapWithKey/map" forall f g xs. + mapWithKey f (map g xs) = + mapWithKey (\k a -> f k (g a)) xs +"map/mapWithKey" forall f g xs. + map f (mapWithKey g xs) = + mapWithKey (\k a -> f (g k a)) xs + #-} + +-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys are +-- in ascending order. +-- +-- > toAscList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +toAscList :: NEMap k a -> NonEmpty (k, a) +toAscList = toList +{-# INLINE toAscList #-} + +-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys +-- are in descending order. +-- +-- > toDescList (fromList ((5,"a") :| [(3,"b")])) == ((5,"a") :| [(3,"b")]) +toDescList :: NEMap k a -> NonEmpty (k, a) +toDescList (NEMap k0 v0 m) = M.foldlWithKey' go ((k0, v0) :| []) m + where + go xs k v = (k, v) NE.<| xs +{-# INLINE toDescList #-} + +-- | /O(log n)/. Convert a 'Map' into an 'NEMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. If key is already present, +-- will overwrite the original value. +-- +-- See 'insertMapMin' for a version that is constant-time if the new key is +-- /strictly smaller than/ all keys in the original map. +-- +-- > insertMap 4 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) +-- > insertMap 4 "c" Data.Map.empty == singleton 4 "c" +insertMap :: Ord k => k -> a -> Map k a -> NEMap k a +insertMap k v = withNonEmpty (singleton k v) (insert k v) +{-# INLINE insertMap #-} + +-- | /O(log n)/. Convert a 'Map' into an 'NEMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. Uses a combining function +-- with the new value as the first argument if the key is already present. +-- +-- > insertMapWith (++) 4 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) +-- > insertMapWith (++) 5 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"ca")]) +insertMapWith :: + Ord k => + (a -> a -> a) -> + k -> + a -> + Map k a -> + NEMap k a +insertMapWith f k v = withNonEmpty (singleton k v) (insertWith f k v) +{-# INLINE insertMapWith #-} + +-- | /O(log n)/. Convert a 'Map' into an 'NEMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. Uses a combining function +-- with the key and new value as the first and second arguments if the key +-- is already present. +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertWithKey f 5 "xxx" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "5:xxx|a")]) +-- > insertWithKey f 7 "xxx" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +-- > insertWithKey f 5 "xxx" Data.Map.empty == singleton 5 "xxx" +insertMapWithKey :: + Ord k => + (k -> a -> a -> a) -> + k -> + a -> + Map k a -> + NEMap k a +insertMapWithKey f k v = withNonEmpty (singleton k v) (insertWithKey f k v) +{-# INLINE insertMapWithKey #-} + +-- | /O(1)/ Convert a 'Map' into an 'NEMap' by adding a key-value pair +-- where the key is /strictly less than/ all keys in the input map. The +-- keys in the original map must all be /strictly greater than/ the new +-- key. /The precondition is not checked./ +-- +-- > insertMapMin 2 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((2,"c") :| [(3,"b"), (5,"a")]) +-- > valid (insertMapMin 2 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == True +-- > valid (insertMapMin 7 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False +-- > valid (insertMapMin 3 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False +insertMapMin :: + k -> + a -> + Map k a -> + NEMap k a +insertMapMin = NEMap +{-# INLINE insertMapMin #-} + +-- | /O(log n)/ Convert a 'Map' into an 'NEMap' by adding a key-value pair +-- where the key is /strictly greater than/ all keys in the input map. The +-- keys in the original map must all be /strictly less than/ the new +-- key. /The precondition is not checked./ +-- +-- While this has the same asymptotics as 'insertMap', it saves a constant +-- factor for key comparison (so may be helpful if comparison is expensive) +-- and also does not require an 'Ord' instance for the key type. +-- +-- > insertMap 7 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"a"), (7,"c")]) +-- > valid (insertMap 7 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == True +-- > valid (insertMap 2 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False +-- > valid (insertMap 5 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False +insertMapMax :: + k -> + a -> + Map k a -> + NEMap k a +insertMapMax k v = withNonEmpty (singleton k v) go + where + go (NEMap k0 v0 m0) = NEMap k0 v0 . insertMaxMap k v $ m0 +{-# INLINE insertMapMax #-} + +-- | /O(log n)/. Insert a new key and value in the map. +-- If the key is already present in the map, the associated value is +-- replaced with the supplied value. 'insert' is equivalent to +-- @'insertWith' 'const'@. +-- +-- See 'insertMap' for a version where the first argument is a 'Map'. +-- +-- > insert 5 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'x')]) +-- > insert 7 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'a'), (7, 'x')]) +insert :: + Ord k => + k -> + a -> + NEMap k a -> + NEMap k a +insert k v n@(NEMap k0 v0 m) = case compare k k0 of + LT -> NEMap k v . toMap $ n + EQ -> NEMap k v m + GT -> NEMap k0 v0 . M.insert k v $ m +{-# INLINE insert #-} + +-- | /O(log n)/. Insert with a function, combining key, new value and old +-- value. @'insertWithKey' f key value mp@ will insert the pair (key, +-- value) into @mp@ if key does not exist in the map. If the key does +-- exist, the function will insert the pair @(key,f key new_value +-- old_value)@. Note that the key passed to f is the same key passed to +-- 'insertWithKey'. +-- +-- See 'insertMapWithKey' for a version where the first argument is a 'Map'. +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:xxx|a")]) +-- > insertWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +insertWithKey :: + Ord k => + (k -> a -> a -> a) -> + k -> + a -> + NEMap k a -> + NEMap k a +insertWithKey f k v n@(NEMap k0 v0 m) = case compare k k0 of + LT -> NEMap k v . toMap $ n + EQ -> NEMap k (f k v v0) m + GT -> NEMap k0 v0 $ M.insertWithKey f k v m +{-# INLINE insertWithKey #-} + +-- | /O(log n)/. Combines insert operation with old value retrieval. The +-- expression (@'insertLookupWithKey' f k x map@) is a pair where the first +-- element is equal to (@'lookup' k map@) and the second element equal to +-- (@'insertWithKey' f k x map@). +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertLookupWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "5:xxx|a")])) +-- > insertLookupWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "xxx")])) +-- +-- This is how to define @insertLookup@ using @insertLookupWithKey@: +-- +-- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t +-- > insertLookup 5 "x" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "x")])) +-- > insertLookup 7 "x" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "x")])) +insertLookupWithKey :: + Ord k => + (k -> a -> a -> a) -> + k -> + a -> + NEMap k a -> + (Maybe a, NEMap k a) +insertLookupWithKey f k v n@(NEMap k0 v0 m) = case compare k k0 of + LT -> (Nothing, NEMap k v . toMap $ n) + EQ -> (Just v, NEMap k (f k v v0) m) + GT -> NEMap k0 v0 <$> M.insertLookupWithKey f k v m +{-# INLINE insertLookupWithKey #-} + +-- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs +-- with a combining function. See also 'fromAscListWith'. +-- +-- > fromListWith (++) ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "ab") :| [(5, "aba")]) +fromListWith :: + Ord k => + (a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromListWith f = fromListWithKey (const f) +{-# INLINE fromListWith #-} + +-- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs +-- with a combining function. See also 'fromAscListWithKey'. +-- +-- > let f k a1 a2 = (show k) ++ a1 ++ a2 +-- > fromListWithKey f ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "3ab") :| [(5, "5a5ba")]) +fromListWithKey :: + Ord k => + (k -> a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromListWithKey f ((k0, v0) :| xs) = F.foldl' go (singleton k0 v0) xs + where + go m (k, v) = insertWithKey f k v m + {-# INLINE go #-} +{-# INLINE fromListWithKey #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time. +-- /The precondition (input list is ascending) is not checked./ +-- +-- > fromAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) +-- > fromAscList ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "b")]) +-- > valid (fromAscList ((3,"b") :| [(5,"a"), (5,"b")])) == True +-- > valid (fromAscList ((5,"a") :| [(3,"b"), (5,"b")])) == False +fromAscList :: + Eq k => + NonEmpty (k, a) -> + NEMap k a +fromAscList = fromDistinctAscList . combineEq +{-# INLINE fromAscList #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is ascending) is not checked./ +-- +-- > fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "ba")]) +-- > valid (fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b"))]) == True +-- > valid (fromAscListWith (++) ((5,"a") :| [(3,"b"), (5,"b"))]) == False +fromAscListWith :: + Eq k => + (a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromAscListWith f = fromAscListWithKey (const f) +{-# INLINE fromAscListWith #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is ascending) is not checked./ +-- +-- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 +-- > fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")]) == fromList ((3, "b") :| [(5, "5:b5:ba")]) +-- > valid (fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")])) == True +-- > valid (fromAscListWithKey f ((5,"a") :| [(3,"b"), (5,"b"), (5,"b")])) == False +fromAscListWithKey :: + Eq k => + (k -> a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromAscListWithKey f = fromDistinctAscList . combineEqWith f +{-# INLINE fromAscListWithKey #-} + +-- | /O(n)/. Build a map from an ascending non-empty list of distinct +-- elements in linear time. /The precondition is not checked./ +-- +-- > fromDistinctAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) +-- > valid (fromDistinctAscList ((3,"b") :| [(5,"a")])) == True +-- > valid (fromDistinctAscList ((3,"b") :| [(5,"a"), (5,"b")])) == False +fromDistinctAscList :: NonEmpty (k, a) -> NEMap k a +fromDistinctAscList ((k, v) :| xs) = + insertMapMin k v + . M.fromDistinctAscList + $ xs +{-# INLINE fromDistinctAscList #-} + +-- | /O(n)/. Build a map from a descending non-empty list in linear time. +-- /The precondition (input list is descending) is not checked./ +-- +-- > fromDescList ((5,"a") :| [(3,"b")]) == fromList ((3, "b") :| [(5, "a")]) +-- > fromDescList ((5,"a") :| [(5,"b"), (3,"b")]) == fromList ((3, "b") :| [(5, "b")]) +-- > valid (fromDescList ((5,"a") :| [(5,"b"), (3,"b")])) == True +-- > valid (fromDescList ((5,"a") :| [(3,"b"), (5,"b")])) == False +fromDescList :: + Eq k => + NonEmpty (k, a) -> + NEMap k a +fromDescList = fromDistinctDescList . combineEq +{-# INLINE fromDescList #-} + +-- | /O(n)/. Build a map from a descending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is descending) is not checked./ +-- +-- > fromDescListWith (++) ((5,"a") :| [(5,"b"), (3,"b")]) == fromList ((3, "b") :| [(5, "ba")]) +-- > valid (fromDescListWith (++) ((5,"a") :| [(5,"b"), (3,"b")])) == True +-- > valid (fromDescListWith (++) ((5,"a") :| [(3,"b"), (5,"b")])) == False +fromDescListWith :: + Eq k => + (a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromDescListWith f = fromDescListWithKey (const f) +{-# INLINE fromDescListWith #-} + +-- | /O(n)/. Build a map from a descending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is descending) is not checked./ +-- +-- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 +-- > fromDescListWithKey f ((5,"a") :| [(5,"b"), (5,"b"), (3,"b")]) == fromList ((3, "b") :| [(5, "5:b5:ba")]) +-- > valid (fromDescListWithKey f ((5,"a") :| [(5,"b"), (5,"b"), (3,"b")])) == True +-- > valid (fromDescListWithKey f ((5,"a") :| [(3,"b"), (5,"b"), (5,"b")])) == False +fromDescListWithKey :: + Eq k => + (k -> a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromDescListWithKey f = fromDistinctDescList . combineEqWith f +{-# INLINE fromDescListWithKey #-} + +-- | /O(n)/. Build a map from a descending list of distinct elements in linear time. +-- /The precondition is not checked./ +-- +-- > fromDistinctDescList ((5,"a") :| [(3,"b")]) == fromList ((3, "b") :| [(5, "a")]) +-- > valid (fromDistinctDescList ((5,"a") :| [(3,"b")])) == True +-- > valid (fromDistinctDescList ((5,"a") :| [(5,"b"), (3,"b")])) == False +-- +-- @since 0.5.8 +fromDistinctDescList :: NonEmpty (k, a) -> NEMap k a +fromDistinctDescList ((k, v) :| xs) = + insertMapMax k v + . M.fromDistinctDescList + $ xs +{-# INLINE fromDistinctDescList #-} + +-- | /O(log n)/. Delete a key and its value from the non-empty map. +-- A potentially empty map ('Map') is returned, since this might delete the +-- last item in the 'NEMap'. When the key is not a member of the map, is +-- equivalent to 'toMap'. +-- +-- > delete 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > delete 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.Singleton [(3, "b"), (5, "a")] +delete :: Ord k => k -> NEMap k a -> Map k a +delete k n@(NEMap k0 v m) = case compare k k0 of + LT -> toMap n + EQ -> m + GT -> insertMinMap k0 v . M.delete k $ m +{-# INLINE delete #-} + +-- | /O(log n)/. Delete a key and its value from the non-empty map, returning +-- 'Nothing' if the result would be empty. +-- +-- This is more efficient than @'nonEmptyMap' . 'delete' k@ because it avoids +-- converting the known-minimum representation back through 'Map' when the +-- deleted key is not the minimum. +-- +-- @since 0.3.6.0 +deleteMaybe :: Ord k => k -> NEMap k a -> Maybe (NEMap k a) +deleteMaybe k n@(NEMap k0 v m) = case compare k k0 of + LT -> Just n + EQ -> nonEmptyMap m + GT -> Just . NEMap k0 v . M.delete k $ m +{-# INLINE deleteMaybe #-} + +-- | /O(log n)/. Update a value at a specific key with the result of the +-- provided function. When the key is not a member of the map, the original +-- map is returned. +-- +-- > adjust ("new " ++) 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "new a")]) +-- > adjust ("new " ++) 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) +adjust :: + Ord k => + (a -> a) -> + k -> + NEMap k a -> + NEMap k a +adjust f = adjustWithKey (const f) +{-# INLINE adjust #-} + +-- | /O(log n)/. Adjust a value at a specific key. When the key is not +-- a member of the map, the original map is returned. +-- +-- > let f key x = (show key) ++ ":new " ++ x +-- > adjustWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:new a")]) +-- > adjustWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) +adjustWithKey :: + Ord k => + (k -> a -> a) -> + k -> + NEMap k a -> + NEMap k a +adjustWithKey f k n@(NEMap k0 v m) = case compare k k0 of + LT -> n + EQ -> NEMap k0 (f k0 v) m + GT -> NEMap k0 v . M.adjustWithKey f k $ m +{-# INLINE adjustWithKey #-} + +-- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@ +-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is +-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. +-- +-- Returns a potentially empty map ('Map'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEMap'. +-- +-- > let f x = if x == "a" then Just "new a" else Nothing +-- > update f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "new a")] +-- > update f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a")] +-- > update f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +update :: + Ord k => + (a -> Maybe a) -> + k -> + NEMap k a -> + Map k a +update f = updateWithKey (const f) +{-# INLINE update #-} + +-- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the +-- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing', +-- the element is deleted. If it is (@'Just' y@), the key @k@ is bound +-- to the new value @y@. +-- +-- Returns a potentially empty map ('Map'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEMap'. +-- +-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing +-- > updateWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "5:new a")] +-- > updateWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a")] +-- > updateWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +updateWithKey :: + Ord k => + (k -> a -> Maybe a) -> + k -> + NEMap k a -> + Map k a +updateWithKey f k n@(NEMap k0 v m) = case compare k k0 of + LT -> toMap n + EQ -> maybe m (flip (insertMinMap k0) m) . f k0 $ v + GT -> insertMinMap k0 v . M.updateWithKey f k $ m +{-# INLINE updateWithKey #-} + +-- | /O(log n)/. Lookup and update. See also 'updateWithKey'. +-- The function returns changed value, if it is updated. +-- Returns the original key value if the map entry is deleted. +-- +-- Returns a potentially empty map ('Map') in the case that we delete the +-- final key of a singleton map. +-- +-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing +-- > updateLookupWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "5:new a", Data.Map.fromList ((3, "b") :| [(5, "5:new a")])) +-- > updateLookupWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == (Nothing, Data.Map.fromList ((3, "b") :| [(5, "a")])) +-- > updateLookupWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Data.Map.singleton 5 "a") +updateLookupWithKey :: + Ord k => + (k -> a -> Maybe a) -> + k -> + NEMap k a -> + (Maybe a, Map k a) +updateLookupWithKey f k n@(NEMap k0 v m) = case compare k k0 of + LT -> (Nothing, toMap n) + EQ -> + let u = f k0 v + in (u <|> Just v, maybe m (flip (insertMinMap k0) m) u) + GT -> fmap (insertMinMap k0 v) . M.updateLookupWithKey f k $ m +{-# INLINE updateLookupWithKey #-} + +-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at +-- @k@, or absence thereof. 'alter' can be used to insert, delete, or +-- update a value in a 'Map'. In short : @Data.Map.lookup k ('alter' +-- f k m) = f ('lookup' k m)@. +-- +-- Returns a potentially empty map ('Map'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEMap'. +-- +-- See 'alterF'' for a version that disallows deletion, and so therefore +-- can return 'NEMap'. +-- +-- > let f _ = Nothing +-- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a")] +-- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > +-- > let f _ = Just "c" +-- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a"), (7, "c")] +-- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "c")] +alter :: + Ord k => + (Maybe a -> Maybe a) -> + k -> + NEMap k a -> + Map k a +alter f k n@(NEMap k0 v m) = case compare k k0 of + LT -> maybe id (insertMinMap k) (f Nothing) (toMap n) + EQ -> maybe id (insertMinMap k0) (f (Just v)) m + GT -> insertMinMap k0 v . M.alter f k $ m +{-# INLINE alter #-} + +-- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ +-- at @k@, or absence thereof. 'alterF' can be used to inspect, insert, +-- delete, or update a value in a 'Map'. In short: @Data.Map.lookup +-- k \<$\> 'alterF' f k m = f ('lookup' k m)@. +-- +-- Example: +-- +-- @ +-- interactiveAlter :: Int -> NEMap Int String -> IO (Map Int String) +-- interactiveAlter k m = alterF f k m where +-- f Nothing = do +-- putStrLn $ show k ++ +-- " was not found in the map. Would you like to add it?" +-- getUserResponse1 :: IO (Maybe String) +-- f (Just old) = do +-- putStrLn $ "The key is currently bound to " ++ show old ++ +-- ". Would you like to change or delete it?" +-- getUserResponse2 :: IO (Maybe String) +-- @ +-- +-- Like @Data.Map.alterF@ for 'Map', 'alterF' can be considered +-- to be a unifying generalization of 'lookup' and 'delete'; however, as +-- a constrast, it cannot be used to implement 'insert', because it must +-- return a 'Map' instead of an 'NEMap' (because the function might delete +-- the final item in the 'NEMap'). When used with trivial functors like +-- 'Identity' and 'Const', it is often slightly slower than +-- specialized 'lookup' and 'delete'. However, when the functor is +-- non-trivial and key comparison is not particularly cheap, it is the +-- fastest way. +-- +-- See 'alterF'' for a version that disallows deletion, and so therefore +-- can return 'NEMap' and be used to implement 'insert' +-- +-- Note on rewrite rules: +-- +-- This module includes GHC rewrite rules to optimize 'alterF' for +-- the 'Const' and 'Identity' functors. In general, these rules +-- improve performance. The sole exception is that when using +-- 'Identity', deleting a key that is already absent takes longer +-- than it would without the rules. If you expect this to occur +-- a very large fraction of the time, you might consider using a +-- private copy of the 'Identity' type. +-- +-- Note: Unlike @Data.Map.alterF@ for 'Map', 'alterF' is /not/ a flipped +-- version of the 'Control.Lens.At.at' combinator from "Control.Lens.At". +-- However, it match the shape expected from most functions expecting +-- lenses, getters, and setters, so can be thought of as a "psuedo-lens", +-- with virtually the same practical applications as a legitimate lens. +alterF :: + (Ord k, Functor f) => + (Maybe a -> f (Maybe a)) -> + k -> + NEMap k a -> + f (Map k a) +alterF f k n@(NEMap k0 v m) = case compare k k0 of + LT -> flip (maybe id (insertMinMap k)) (toMap n) <$> f Nothing + EQ -> flip (maybe id (insertMinMap k0)) m <$> f (Just v) + GT -> insertMinMap k0 v <$> M.alterF f k m +{-# INLINEABLE [2] alterF #-} + +-- if f ~ Const b, it's a lookup +{-# RULES +"alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)). + alterF f k = + Const . getConst . f . lookup k + #-} + +-- if f ~ Identity, it's an 'alter' +{-# RULES +"alterF/Identity" forall k (f :: Maybe a -> Identity (Maybe a)). + alterF f k = + Identity . alter (runIdentity . f) k + #-} + +-- | /O(log n)/. Variant of 'alter' that disallows deletion. Allows us to +-- guarantee that the result is also a non-empty Map. +alter' :: + Ord k => + (Maybe a -> a) -> + k -> + NEMap k a -> + NEMap k a +alter' f k n@(NEMap k0 v m) = case compare k k0 of + LT -> NEMap k (f Nothing) . toMap $ n + EQ -> NEMap k0 (f (Just v)) m + GT -> NEMap k0 v . M.alter (Just . f) k $ m +{-# INLINE alter' #-} + +-- | /O(log n)/. Variant of 'alterF' that disallows deletion. Allows us to +-- guarantee that the result is also a non-empty Map. +-- +-- Like @Data.Map.alterF@ for 'Map', can be used to generalize and unify +-- 'lookup' and 'insert'. However, because it disallows deletion, it +-- cannot be used to implement 'delete'. +-- +-- See 'alterF' for usage information and caveats. +-- +-- Note: Neither 'alterF' nor 'alterF'' can be considered flipped versions +-- of the 'Control.Lens.At.at' combinator from "Control.Lens.At". However, +-- this can match the shape expected from most functions expecting lenses, +-- getters, and setters, so can be thought of as a "psuedo-lens", with +-- virtually the same practical applications as a legitimate lens. +-- +-- __WARNING__: The rewrite rule for 'Identity' exposes an inconsistency in +-- undefined behavior for "Data.Map". @Data.Map.alterF@ will actually +-- /maintain/ the original key in the map when used with 'Identity'; +-- however, @Data.Map.insertWith@ will /replace/ the orginal key in the +-- map. The rewrite rule for 'alterF'' has chosen to be faithful to +-- @Data.Map.insertWith@, and /not/ @Data.Map.alterF@, for the sake of +-- a cleaner implementation. +alterF' :: + (Ord k, Functor f) => + (Maybe a -> f a) -> + k -> + NEMap k a -> + f (NEMap k a) +alterF' f k n@(NEMap k0 v m) = case compare k k0 of + LT -> flip (NEMap k) (toMap n) <$> f Nothing + EQ -> flip (NEMap k0) m <$> f (Just v) + GT -> NEMap k0 v <$> M.alterF (fmap Just . f) k m +{-# INLINEABLE [2] alterF' #-} + +-- if f ~ Const b, it's a lookup +{-# RULES +"alterF'/Const" forall k (f :: Maybe a -> Const b a). + alterF' f k = + Const . getConst . f . lookup k + #-} + +-- if f ~ Identity, it's an insertWith +{-# RULES +"alterF'/Identity" forall k (f :: Maybe a -> Identity a). + alterF' f k = + Identity . insertWith (\_ -> runIdentity . f . Just) k (runIdentity (f Nothing)) + #-} + +-- | /O(n)/. Traverse keys\/values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('Map'), our function might return +-- 'Nothing' on every item in the 'NEMap'. +-- +-- /Use 'traverseMaybeWithKey1'/ whenever possible (if your 'Applicative' +-- also has 'Apply' instance). This version is provided only for types +-- that do not have 'Apply' instance, since 'Apply' is not at the moment +-- (and might not ever be) an official superclass of 'Applicative'. +traverseMaybeWithKey :: + Applicative t => + (k -> a -> t (Maybe b)) -> + NEMap k a -> + t (Map k b) +traverseMaybeWithKey f (NEMap k0 v m0) = + combine <$> f k0 v <*> M.traverseMaybeWithKey f m0 + where + combine Nothing = id + combine (Just v') = insertMinMap k0 v' +{-# INLINE traverseMaybeWithKey #-} + +-- | /O(n)/. Traverse keys\/values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('Map'), our function might return +-- 'Nothing' on every item in the 'NEMap'. +-- +-- Is more general than 'traverseWithKey', since works with all 'Apply', +-- and not just 'Applicative'. + +-- TODO: benchmark against M.maxView version +traverseMaybeWithKey1 :: + Apply t => + (k -> a -> t (Maybe b)) -> + NEMap k a -> + t (Map k b) +traverseMaybeWithKey1 f (NEMap k0 v m0) = case runMaybeApply m1 of + Left m2 -> combine <$> f k0 v <.> m2 + Right m2 -> (`combine` m2) <$> f k0 v + where + m1 = M.traverseMaybeWithKey (\k -> MaybeApply . Left . f k) m0 + combine Nothing = id + combine (Just v') = insertMinMap k0 v' +{-# INLINE traverseMaybeWithKey1 #-} + +-- | /O(n)/. The function 'mapAccum' threads an accumulating argument +-- through the map in ascending order of keys. +-- +-- > let f a b = (a ++ b, b ++ "X") +-- > mapAccum f "Everything: " (fromList ((5,"a") :| [(3,"b")])) == ("Everything: ba", fromList ((3, "bX") :| [(5, "aX")])) +mapAccum :: + (a -> b -> (a, c)) -> + a -> + NEMap k b -> + (a, NEMap k c) +mapAccum f = mapAccumWithKey (\x _ -> f x) +{-# INLINE mapAccum #-} + +-- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating +-- argument through the map in ascending order of keys. +-- +-- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X") +-- > mapAccumWithKey f "Everything:" (fromList ((5,"a") :| [(3,"b")])) == ("Everything: 3-b 5-a", fromList ((3, "bX") :| [(5, "aX")])) +mapAccumWithKey :: + (a -> k -> b -> (a, c)) -> + a -> + NEMap k b -> + (a, NEMap k c) +mapAccumWithKey f z0 (NEMap k v m) = (z2, NEMap k v' m') + where + ~(z1, v') = f z0 k v + ~(z2, m') = M.mapAccumWithKey f z1 m +{-# INLINE mapAccumWithKey #-} + +-- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating +-- argument through the map in descending order of keys. +mapAccumRWithKey :: + (a -> k -> b -> (a, c)) -> + a -> + NEMap k b -> + (a, NEMap k c) +mapAccumRWithKey f z0 (NEMap k v m) = (z2, NEMap k v' m') + where + ~(z1, m') = M.mapAccumRWithKey f z0 m + ~(z2, v') = f z1 k v +{-# INLINE mapAccumRWithKey #-} + +-- TODO: what other situations can we take advantage of lazy tuple pattern +-- matching? + +-- | /O(n*log n)/. +-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. +-- +-- The size of the result may be smaller if @f@ maps two or more distinct +-- keys to the same new key. In this case the value at the greatest of the +-- original keys is retained. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeys (+ 1) (fromList ((5,"a") :| [(3,"b")])) == fromList ((4, "b") :| [(6, "a")]) +-- > mapKeys (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "c" +-- > mapKeys (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "c" +mapKeys :: + Ord k2 => + (k1 -> k2) -> + NEMap k1 a -> + NEMap k2 a +mapKeys f (NEMap k0 v0 m) = + fromListWith const + . ((f k0, v0) :|) + . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] + $ m +{-# INLINEABLE mapKeys #-} + +-- | /O(n*log n)/. +-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. +-- +-- The size of the result may be smaller if @f@ maps two or more distinct +-- keys to the same new key. In this case the associated values will be +-- combined using @c@. The value at the greater of the two original keys +-- is used as the first argument to @c@. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeysWith (++) (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "cdab" +-- > mapKeysWith (++) (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "cdab" +mapKeysWith :: + Ord k2 => + (a -> a -> a) -> + (k1 -> k2) -> + NEMap k1 a -> + NEMap k2 a +mapKeysWith c f (NEMap k0 v0 m) = + fromListWith c + . ((f k0, v0) :|) + . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] + $ m +{-# INLINEABLE mapKeysWith #-} + +-- | /O(n)/. +-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ +-- is strictly monotonic. +-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. +-- /The precondition is not checked./ +-- Semi-formally, we have: +-- +-- > and [x < y ==> f x < f y | x <- ls, y <- ls] +-- > ==> mapKeysMonotonic f s == mapKeys f s +-- > where ls = keys s +-- +-- This means that @f@ maps distinct original keys to distinct resulting keys. +-- This function has better performance than 'mapKeys'. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")])) == fromList ((6, "b") :| [(10, "a")]) +-- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")]))) == True +-- > valid (mapKeysMonotonic (\ _ -> 1) (fromList ((5,"a") :| [(3,"b")]))) == False +mapKeysMonotonic :: + (k1 -> k2) -> + NEMap k1 a -> + NEMap k2 a +mapKeysMonotonic f (NEMap k v m) = + NEMap (f k) v + . M.mapKeysMonotonic f + $ m +{-# INLINE mapKeysMonotonic #-} + +-- | /O(n)/. Filter all values that satisfy the predicate. +-- +-- Returns a potentially empty map ('Map'), because we could +-- potentailly filter out all items in the original 'NEMap'. +-- +-- > filter (> "a") (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > filter (> "x") (fromList ((5,"a") :| [(3,"b")])) == Data.Map.empty +-- > filter (< "a") (fromList ((5,"a") :| [(3,"b")])) == Data.Map.empty +filter :: + (a -> Bool) -> + NEMap k a -> + Map k a +filter f (NEMap k v m) + | f v = insertMinMap k v . M.filter f $ m + | otherwise = M.filter f m +{-# INLINE filter #-} + +-- | /O(n)/. Filter all keys\/values that satisfy the predicate. +-- +-- Returns a potentially empty map ('Map'), because we could +-- potentailly filter out all items in the original 'NEMap'. +-- +-- > filterWithKey (\k _ -> k > 4) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +filterWithKey :: + (k -> a -> Bool) -> + NEMap k a -> + Map k a +filterWithKey f (NEMap k v m) + | f k v = insertMinMap k v . M.filterWithKey f $ m + | otherwise = M.filterWithKey f m +{-# INLINE filterWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Restrict an 'NEMap' to only those keys +-- found in a 'Data.Set.Set'. +-- +-- @ +-- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m +-- m \`restrictKeys\` s = m ``intersection`` 'fromSet' (const ()) s +-- @ +restrictKeys :: + Ord k => + NEMap k a -> + Set k -> + Map k a +restrictKeys n@(NEMap k v m) xs = case S.minView xs of + Nothing -> M.empty + Just (y, ys) -> case compare k y of + -- k is not in xs + LT -> m `M.restrictKeys` xs + -- k and y are a part of the result + EQ -> insertMinMap k v $ m `M.restrictKeys` ys + -- y is not in m + GT -> toMap n `M.restrictKeys` ys +{-# INLINE restrictKeys #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Data.Set.Set' from +-- an 'NEMap'. +-- +-- @ +-- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m +-- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s +-- @ +withoutKeys :: + Ord k => + NEMap k a -> + Set k -> + Map k a +withoutKeys n@(NEMap k v m) xs = case S.minView xs of + Nothing -> toMap n + Just (y, ys) -> case compare k y of + -- k is not in xs, so cannot be deleted + LT -> insertMinMap k v $ m `M.withoutKeys` xs + -- y deletes k, and only k + EQ -> m `M.withoutKeys` ys + -- y is not in n, so cannot delete anything, so we can just difference n and ys + GT -> toMap n `M.withoutKeys` ys +{-# INLINE withoutKeys #-} + +-- | /O(n)/. Partition the map according to a predicate. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate was true for all items. +-- * @'That' n2@ means that the predicate was false for all items. +-- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the +-- predicate) and @n2@ (all of the items that were false for the +-- predicate). +-- +-- See also 'split'. +-- +-- > partition (> "a") (fromList ((5,"a") :| [(3,"b")])) == These (singleton 3 "b") (singleton 5 "a") +-- > partition (< "x") (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) +-- > partition (> "x") (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) +partition :: + (a -> Bool) -> + NEMap k a -> + These (NEMap k a) (NEMap k a) +partition f = partitionWithKey (const f) +{-# INLINE partition #-} + +-- | /O(n)/. Partition the map according to a predicate. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate was true for all items, +-- returning the original map. +-- * @'That' n2@ means that the predicate was false for all items, +-- returning the original map. +-- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the +-- predicate) and @n2@ (all of the items that were false for the +-- predicate). +-- +-- See also 'split'. +-- +-- > partitionWithKey (\ k _ -> k > 3) (fromList ((5,"a") :| [(3,"b")])) == These (singleton 5 "a") (singleton 3 "b") +-- > partitionWithKey (\ k _ -> k < 7) (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) +-- > partitionWithKey (\ k _ -> k > 7) (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) +partitionWithKey :: + (k -> a -> Bool) -> + NEMap k a -> + These (NEMap k a) (NEMap k a) +partitionWithKey f n@(NEMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) + | f k v -> This n + | otherwise -> That n + (Just n1, Nothing) + | f k v -> This n + | otherwise -> These n1 (singleton k v) + (Nothing, Just n2) + | f k v -> These (singleton k v) n2 + | otherwise -> That n + (Just n1, Just n2) + | f k v -> These (insertMapMin k v m1) n2 + | otherwise -> These n1 (insertMapMin k v m2) + where + (m1, m2) = M.partitionWithKey f m0 +{-# INLINEABLE partitionWithKey #-} + +-- | /O(log n)/. Take while a predicate on the keys holds. +-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, +-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'. +-- +-- Returns a potentially empty map ('Map'), because the predicate might +-- fail on the first input. +-- +-- @ +-- takeWhileAntitone p = Data.Map.fromDistinctAscList . Data.List.takeWhile (p . fst) . Data.Foldable.toList +-- takeWhileAntitone p = 'filterWithKey' (\k _ -> p k) +-- @ +takeWhileAntitone :: + (k -> Bool) -> + NEMap k a -> + Map k a +takeWhileAntitone f (NEMap k v m) + | f k = insertMinMap k v . M.takeWhileAntitone f $ m + | otherwise = M.empty +{-# INLINE takeWhileAntitone #-} + +-- | /O(log n)/. Drop while a predicate on the keys holds. +-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, +-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'. +-- +-- @ +-- dropWhileAntitone p = Data.Map.fromDistinctAscList . Data.List.dropWhile (p . fst) . Data.Foldable.toList +-- dropWhileAntitone p = 'filterWithKey' (\k -> not (p k)) +-- @ +dropWhileAntitone :: + (k -> Bool) -> + NEMap k a -> + Map k a +dropWhileAntitone f n@(NEMap k _ m) + | f k = M.dropWhileAntitone f m + | otherwise = toMap n +{-# INLINE dropWhileAntitone #-} + +-- | /O(log n)/. Divide a map at the point where a predicate on the keys stops holding. +-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, +-- @j \< k ==\> p j \>= p k@. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate never failed for any item, +-- returning the original map. +-- * @'That' n2@ means that the predicate failed for the first item, +-- returning the original map. +-- * @'These' n1 n2@ gives @n1@ (the map up to the point where the +-- predicate on the keys stops holding) and @n2@ (the map starting from +-- the point where the predicate stops holding) +-- +-- @ +-- spanAntitone p xs = partitionWithKey (\k _ -> p k) xs +-- @ +-- +-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map +-- at some /unspecified/ point where the predicate switches from holding to not +-- holding (where the predicate is seen to hold before the first key and to fail +-- after the last key). +spanAntitone :: + (k -> Bool) -> + NEMap k a -> + These (NEMap k a) (NEMap k a) +spanAntitone f n@(NEMap k v m0) + | f k = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This n + (Just _, Nothing) -> This n + (Nothing, Just n2) -> These (singleton k v) n2 + (Just _, Just n2) -> These (insertMapMin k v m1) n2 + | otherwise = That n + where + (m1, m2) = M.spanAntitone f m0 +{-# INLINEABLE spanAntitone #-} + +-- | /O(n)/. Map values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('Map'), because the function could +-- potentially return 'Nothing' on all items in the 'NEMap'. +-- +-- > let f x = if x == "a" then Just "new a" else Nothing +-- > mapMaybe f (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "new a" +mapMaybe :: + (a -> Maybe b) -> + NEMap k a -> + Map k b +mapMaybe f = mapMaybeWithKey (const f) +{-# INLINE mapMaybe #-} + +-- | /O(n)/. Map keys\/values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('Map'), because the function could +-- potentially return 'Nothing' on all items in the 'NEMap'. +-- +-- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing +-- > mapMaybeWithKey f (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "key : 3" +mapMaybeWithKey :: + (k -> a -> Maybe b) -> + NEMap k a -> + Map k b +mapMaybeWithKey f (NEMap k v m) = maybe id (insertMinMap k) (f k v) (M.mapMaybeWithKey f m) +{-# INLINE mapMaybeWithKey #-} + +-- | /O(n)/. Map values and separate the 'Left' and 'Right' results. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the results were all 'Left'. +-- * @'That' n2@ means that the results were all 'Right'. +-- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- and @n2@ (the map where the results were 'Right') +-- +-- > let f a = if a < "c" then Left a else Right a +-- > mapEither f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == These (fromList ((3,"b") :| [(5,"a")])) (fromList ((1,"x") :| [(7,"z")])) +-- > +-- > mapEither (\ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == That (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +mapEither :: + (a -> Either b c) -> + NEMap k a -> + These (NEMap k b) (NEMap k c) +mapEither f = mapEitherWithKey (const f) +{-# INLINE mapEither #-} + +-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the results were all 'Left'. +-- * @'That' n2@ means that the results were all 'Right'. +-- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- and @n2@ (the map where the results were 'Right') +-- +-- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) +-- > mapEitherWithKey f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == These (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) +-- > +-- > mapEitherWithKey (\_ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == That (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) +mapEitherWithKey :: + (k -> a -> Either b c) -> + NEMap k a -> + These (NEMap k b) (NEMap k c) +mapEitherWithKey f (NEMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> case f k v of + Left v' -> This (singleton k v') + Right v' -> That (singleton k v') + (Just n1, Nothing) -> case f k v of + Left v' -> This (insertMapMin k v' m1) + Right v' -> These n1 (singleton k v') + (Nothing, Just n2) -> case f k v of + Left v' -> These (singleton k v') n2 + Right v' -> That (insertMapMin k v' m2) + (Just n1, Just n2) -> case f k v of + Left v' -> These (insertMapMin k v' m1) n2 + Right v' -> These n1 (insertMapMin k v' m2) + where + (m1, m2) = M.mapEitherWithKey f m0 +{-# INLINEABLE mapEitherWithKey #-} + +-- | /O(log n)/. The expression (@'split' k map@) is potentially a 'These' +-- containing up to two 'NEMap's based on splitting the map into maps +-- containing items before and after the given key @k@. It will never +-- return a map that contains @k@ itself. +-- +-- * 'Nothing' means that @k@ was the only key in the the original map, +-- and so there are no items before or after it. +-- * @'Just' ('This' n1)@ means @k@ was larger than or equal to all items +-- in the map, and @n1@ is the entire original map (minus @k@, if it was +-- present) +-- * @'Just' ('That' n2)@ means @k@ was smaller than or equal to all +-- items in the map, and @n2@ is the entire original map (minus @k@, if +-- it was present) +-- * @'Just' ('These' n1 n2)@ gives @n1@ (the map of all keys from the +-- original map less than @k@) and @n2@ (the map of all keys from the +-- original map greater than @k@) +-- +-- > split 2 (fromList ((5,"a") :| [(3,"b")])) == Just (That (fromList ((3,"b") :| [(5,"a")])) ) +-- > split 3 (fromList ((5,"a") :| [(3,"b")])) == Just (That (singleton 5 "a") ) +-- > split 4 (fromList ((5,"a") :| [(3,"b")])) == Just (These (singleton 3 "b") (singleton 5 "a")) +-- > split 5 (fromList ((5,"a") :| [(3,"b")])) == Just (This (singleton 3 "b") ) +-- > split 6 (fromList ((5,"a") :| [(3,"b")])) == Just (This (fromList ((3,"b") :| [(5,"a")])) ) +-- > split 5 (singleton 5 "a") == Nothing +split :: + Ord k => + k -> + NEMap k a -> + Maybe (These (NEMap k a) (NEMap k a)) +split k n@(NEMap k0 v m0) = case compare k k0 of + LT -> Just $ That n + EQ -> That <$> nonEmptyMap m0 + GT -> Just $ case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k0 v) + (Just _, Nothing) -> This (insertMapMin k0 v m1) + (Nothing, Just n2) -> These (singleton k0 v) n2 + (Just _, Just n2) -> These (insertMapMin k0 v m1) n2 + where + (m1, m2) = M.split k m0 +{-# INLINEABLE split #-} + +-- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just +-- like 'split' but also returns @'lookup' k map@, as the first field in +-- the 'These': +-- +-- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == That (That (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == These "b" (That (singleton 5 "a")) +-- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == That (These (singleton 3 "b") (singleton 5 "a")) +-- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == These "a" (This (singleton 3 "b")) +-- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == That (This (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 5 (singleton 5 "a") == This "a" +splitLookup :: + Ord k => + k -> + NEMap k a -> + These a (These (NEMap k a) (NEMap k a)) +splitLookup k n@(NEMap k0 v0 m0) = case compare k k0 of + LT -> That . That $ n + EQ -> maybe (This v0) (These v0 . That) . nonEmptyMap $ m0 + GT -> maybe That These v $ case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k0 v0) + (Just _, Nothing) -> This (insertMapMin k0 v0 m1) + (Nothing, Just n2) -> These (singleton k0 v0) n2 + (Just _, Just n2) -> These (insertMapMin k0 v0 m1) n2 + where + (m1, v, m2) = M.splitLookup k m0 +{-# INLINEABLE splitLookup #-} + +-- | /O(1)/. Decompose a map into pieces based on the structure of the +-- underlying tree. This function is useful for consuming a map in +-- parallel. +-- +-- No guarantee is made as to the sizes of the pieces; an internal, but +-- deterministic process determines this. However, it is guaranteed that +-- the pieces returned will be in ascending order (all elements in the +-- first submap less than all elements in the second, and so on). +-- +-- Note that the current implementation does not return more than four +-- submaps, but you should not depend on this behaviour because it can +-- change in the future without notice. +splitRoot :: + NEMap k a -> + NonEmpty (NEMap k a) +splitRoot (NEMap k v m) = + singleton k v + :| Maybe.mapMaybe nonEmptyMap (M.splitRoot m) +{-# INLINE splitRoot #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). +isSubmapOf :: (Ord k, Eq a) => NEMap k a -> NEMap k a -> Bool +isSubmapOf = isSubmapOfBy (==) +{-# INLINE isSubmapOf #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if +-- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when +-- applied to their respective values. For example, the following +-- expressions are all 'True': +-- +-- > isSubmapOfBy (==) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (<=) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (fromList (('a',1) :| [('b',2)])) +-- +-- But the following are all 'False': +-- +-- > isSubmapOfBy (==) (singleton 'a' 2) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (<) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (singleton 'a' 1) +isSubmapOfBy :: + Ord k => + (a -> b -> Bool) -> + NEMap k a -> + NEMap k b -> + Bool +isSubmapOfBy f (NEMap k v m0) (toMap -> m1) = + kvSub + && M.isSubmapOfBy f m0 m1 + where + kvSub = case M.lookup k m1 of + Just v0 -> f v v0 + Nothing -> False +{-# INLINE isSubmapOfBy #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap +-- but not equal). Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' +-- (==)@). +isProperSubmapOf :: (Ord k, Eq a) => NEMap k a -> NEMap k a -> Bool +isProperSubmapOf = isProperSubmapOfBy (==) +{-# INLINE isProperSubmapOf #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap +-- but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns +-- 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, +-- and when @f@ returns 'True' when applied to their respective values. For +-- example, the following expressions are all 'True': +-- +-- > isProperSubmapOfBy (==) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +-- > isProperSubmapOfBy (<=) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +-- +-- But the following are all 'False': +-- +-- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (fromList ((1,1) :| [(2,2)])) +-- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (singleton 1 1)) +-- > isProperSubmapOfBy (<) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +isProperSubmapOfBy :: + Ord k => + (a -> b -> Bool) -> + NEMap k a -> + NEMap k b -> + Bool +isProperSubmapOfBy f m1 m2 = + M.size (nemMap m1) < M.size (nemMap m2) + && isSubmapOfBy f m1 m2 +{-# INLINE isProperSubmapOfBy #-} + +-- | /O(log n)/. Lookup the /index/ of a key, which is its zero-based index +-- in the sequence sorted by keys. The index is a number from /0/ up to, +-- but not including, the 'size' of the map. +-- +-- > isJust (lookupIndex 2 (fromList ((5,"a") :| [(3,"b")]))) == False +-- > fromJust (lookupIndex 3 (fromList ((5,"a") :| [(3,"b")]))) == 0 +-- > fromJust (lookupIndex 5 (fromList ((5,"a") :| [(3,"b")]))) == 1 +-- > isJust (lookupIndex 6 (fromList ((5,"a") :| [(3,"b")]))) == False +lookupIndex :: + Ord k => + k -> + NEMap k a -> + Maybe Int +lookupIndex k (NEMap k0 _ m) = case compare k k0 of + LT -> Nothing + EQ -> Just 0 + GT -> (+ 1) <$> M.lookupIndex k m +{-# INLINE lookupIndex #-} + +-- | /O(log n)/. Return the /index/ of a key, which is its zero-based index +-- in the sequence sorted by keys. The index is a number from /0/ up to, +-- but not including, the 'size' of the map. Calls 'error' when the key is +-- not a 'member' of the map. +-- +-- > findIndex 2 (fromList ((5,"a") :| [(3,"b")])) Error: element is not in the map +-- > findIndex 3 (fromList ((5,"a") :| [(3,"b")])) == 0 +-- > findIndex 5 (fromList ((5,"a") :| [(3,"b")])) == 1 +-- > findIndex 6 (fromList ((5,"a") :| [(3,"b")])) Error: element is not in the map +findIndex :: + Ord k => + k -> + NEMap k a -> + Int +findIndex k = fromMaybe e . lookupIndex k + where + e = error "NEMap.findIndex: element is not in the map" +{-# INLINE findIndex #-} + +-- | /O(log n)/. Retrieve an element by its /index/, i.e. by its zero-based +-- index in the sequence sorted by keys. If the /index/ is out of range +-- (less than zero, greater or equal to 'size' of the map), 'error' is +-- called. +-- +-- > elemAt 0 (fromList ((5,"a") :| [(3,"b")])) == (3,"b") +-- > elemAt 1 (fromList ((5,"a") :| [(3,"b")])) == (5, "a") +-- > elemAt 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +elemAt :: + Int -> + NEMap k a -> + (k, a) +elemAt 0 (NEMap k v _) = (k, v) +elemAt i (NEMap _ _ m) = M.elemAt (i - 1) m +{-# INLINEABLE elemAt #-} + +-- | /O(log n)/. Update the element at /index/, i.e. by its zero-based index in +-- the sequence sorted by keys. If the /index/ is out of range (less than zero, +-- greater or equal to 'size' of the map), 'error' is called. +-- +-- Returns a possibly empty map ('Map'), because the function might end up +-- deleting the last key in the map. See 'adjustAt' for a version that +-- disallows deletion, guaranteeing that the result is also a non-empty +-- Map. +-- +-- > updateAt (\ _ _ -> Just "x") 0 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "x"), (5, "a")] +-- > updateAt (\ _ _ -> Just "x") 1 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "x")] +-- > updateAt (\ _ _ -> Just "x") 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +-- > updateAt (\ _ _ -> Just "x") (-1) (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +-- > updateAt (\_ _ -> Nothing) 0 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +-- > updateAt (\_ _ -> Nothing) 1 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > updateAt (\_ _ -> Nothing) 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +-- > updateAt (\_ _ -> Nothing) (-1) (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +updateAt :: + (k -> a -> Maybe a) -> + Int -> + NEMap k a -> + Map k a +updateAt f 0 (NEMap k v m) = maybe m (flip (insertMinMap k) m) $ f k v +updateAt f i (NEMap k v m) = insertMinMap k v . M.updateAt f (i - 1) $ m +{-# INLINEABLE updateAt #-} + +-- | /O(log n)/. Variant of 'updateAt' that disallows deletion. Allows us +-- to guarantee that the result is also a non-empty Map. +adjustAt :: + (k -> a -> a) -> + Int -> + NEMap k a -> + NEMap k a +adjustAt f 0 (NEMap k0 v m) = NEMap k0 (f k0 v) m +adjustAt f i (NEMap k0 v m) = + NEMap k0 v + . M.updateAt (\k -> Just . f k) (i - 1) + $ m +{-# INLINEABLE adjustAt #-} + +-- | /O(log n)/. Delete the element at /index/, i.e. by its zero-based +-- index in the sequence sorted by keys. If the /index/ is out of range +-- (less than zero, greater or equal to 'size' of the map), 'error' is +-- called. +-- +-- Returns a potentially empty map ('Map') because of the possibility of +-- deleting the last item in a map. +-- +-- > deleteAt 0 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +-- > deleteAt 1 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > deleteAt 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +-- > deleteAt (-1) (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +deleteAt :: + Int -> + NEMap k a -> + Map k a +deleteAt 0 (NEMap _ _ m) = m +deleteAt i (NEMap k v m) = insertMinMap k v . M.deleteAt (i - 1) $ m +{-# INLINEABLE deleteAt #-} + +-- | Take a given number of entries in key order, beginning with the +-- smallest keys. +-- +-- Returns a possibly empty map ('Map'), which can only happen if we call +-- @take 0@. +-- +-- @ +-- take n = Data.Map.fromDistinctAscList . Data.List.NonEmpty.take n . 'toList' +-- @ +take :: + Int -> + NEMap k a -> + Map k a +take 0 NEMap{} = M.empty +take i (NEMap k v m) = insertMinMap k v . M.take (i - 1) $ m +{-# INLINEABLE take #-} + +-- | Drop a given number of entries in key order, beginning +-- with the smallest keys. +-- +-- Returns a possibly empty map ('Map'), in case we drop all of the +-- elements (which can happen if we drop a number greater than or equal to +-- the number of items in the map) +-- +-- @ +-- drop n = Data.Map.fromDistinctAscList . Data.List.NonEmpty.drop' n . 'toList' +-- @ +drop :: + Int -> + NEMap k a -> + Map k a +drop 0 n = toMap n +drop i (NEMap _ _ m) = M.drop (i - 1) m +{-# INLINEABLE drop #-} + +-- | /O(log n)/. Split a map at a particular index @i@. +-- +-- * @'This' n1@ means that there are less than @i@ items in the map, and +-- @n1@ is the original map. +-- * @'That' n2@ means @i@ was 0; we dropped 0 items, so @n2@ is the +-- original map. +-- * @'These' n1 n2@ gives @n1@ (taking @i@ items from the original map) +-- and @n2@ (dropping @i@ items from the original map)) +splitAt :: + Int -> + NEMap k a -> + These (NEMap k a) (NEMap k a) +splitAt 0 n = That n +splitAt i n@(NEMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k v) + (Just _, Nothing) -> This n + (Nothing, Just n2) -> These (singleton k v) n2 + (Just _, Just n2) -> These (insertMapMin k v m1) n2 + where + (m1, m2) = M.splitAt (i - 1) m0 +{-# INLINEABLE splitAt #-} + +-- | /O(1)/. The minimal key of the map. Note that this is total, making +-- 'Data.Map.lookupMin' obsolete. It is constant-time, so has better +-- asymptotics than @Data.Map.lookupMin@ and @Data.Map.findMin@, as well. +-- +-- > findMin (fromList ((5,"a") :| [(3,"b")])) == (3,"b") +findMin :: NEMap k a -> (k, a) +findMin (NEMap k v _) = (k, v) +{-# INLINE findMin #-} + +-- | /O(log n)/. The maximal key of the map. Note that this is total, making +-- 'Data.Map.lookupMin' obsolete. +-- +-- > findMax (fromList ((5,"a") :| [(3,"b")])) == (5,"a") +findMax :: NEMap k a -> (k, a) +findMax (NEMap k v m) = fromMaybe (k, v) . M.lookupMax $ m +{-# INLINE findMax #-} + +-- | /O(1)/. Delete the minimal key. Returns a potentially empty map +-- ('Map'), because we might end up deleting the final key in a singleton +-- map. It is constant-time, so has better asymptotics than +-- 'Data.Map.deleteMin'. +-- +-- > deleteMin (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.Map.fromList [(5,"a"), (7,"c")] +-- > deleteMin (singleton 5 "a") == Data.Map.empty +deleteMin :: NEMap k a -> Map k a +deleteMin (NEMap _ _ m) = m +{-# INLINE deleteMin #-} + +-- | /O(log n)/. Delete the maximal key. Returns a potentially empty map +-- ('Map'), because we might end up deleting the final key in a singleton +-- map. +-- +-- > deleteMax (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.Map.fromList [(3,"b"), (5,"a")] +-- > deleteMax (singleton 5 "a") == Data.Map.empty +deleteMax :: NEMap k a -> Map k a +deleteMax (NEMap k v m) = case M.maxView m of + Nothing -> M.empty + Just (_, m') -> insertMinMap k v m' +{-# INLINE deleteMax #-} + +-- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the +-- minimal key. Returns a potentially empty map ('Map'), because we might +-- end up deleting the final key in the map if the function returns +-- 'Nothing'. See 'adjustMin' for a version that can guaruntee that we +-- return a non-empty map. +-- +-- > updateMin (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "Xb"), (5, "a")] +-- > updateMin (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +updateMin :: (a -> Maybe a) -> NEMap k a -> Map k a +updateMin f = updateMinWithKey (const f) +{-# INLINE updateMin #-} + +-- | /O(1)/. A version of 'updateMin' that disallows deletion, allowing us +-- to guarantee that the result is also non-empty. +adjustMin :: (a -> a) -> NEMap k a -> NEMap k a +adjustMin f = adjustMinWithKey (const f) +{-# INLINE adjustMin #-} + +-- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the +-- minimal key. Returns a potentially empty map ('Map'), because we might +-- end up deleting the final key in the map if the function returns +-- 'Nothing'. See 'adjustMinWithKey' for a version that guaruntees +-- a non-empty map. +-- +-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3,"3:b"), (5,"a")] +-- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +updateMinWithKey :: (k -> a -> Maybe a) -> NEMap k a -> Map k a +updateMinWithKey f (NEMap k v m) = maybe id (insertMinMap k) (f k v) m +{-# INLINE updateMinWithKey #-} + +-- | /O(1)/. A version of 'adjustMaxWithKey' that disallows deletion, +-- allowing us to guarantee that the result is also non-empty. Note that +-- it also is able to have better asymptotics than 'updateMinWithKey' in +-- general. +adjustMinWithKey :: (k -> a -> a) -> NEMap k a -> NEMap k a +adjustMinWithKey f (NEMap k v m) = NEMap k (f k v) m +{-# INLINE adjustMinWithKey #-} + +-- | /O(log n)/. Update the value at the maximal key. Returns +-- a potentially empty map ('Map'), because we might end up deleting the +-- final key in the map if the function returns 'Nothing'. See 'adjustMax' +-- for a version that can guarantee that we return a non-empty map. +-- +-- > updateMax (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "Xa")] +-- > updateMax (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +updateMax :: (a -> Maybe a) -> NEMap k a -> Map k a +updateMax f = updateMaxWithKey (const f) +{-# INLINE updateMax #-} + +-- | /O(log n)/. A version of 'updateMax' that disallows deletion, allowing +-- us to guarantee that the result is also non-empty. +adjustMax :: (a -> a) -> NEMap k a -> NEMap k a +adjustMax f = adjustMaxWithKey (const f) +{-# INLINE adjustMax #-} + +-- | /O(log n)/. Update the value at the maximal key. Returns +-- a potentially empty map ('Map'), because we might end up deleting the +-- final key in the map if the function returns 'Nothing'. See +-- 'adjustMaxWithKey' for a version that guaruntees a non-empty map. +-- +-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3,"3:b"), (5,"a")] +-- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +updateMaxWithKey :: (k -> a -> Maybe a) -> NEMap k a -> Map k a +updateMaxWithKey f (NEMap k v m) + | M.null m = maybe m (M.singleton k) $ f k v + | otherwise = + insertMinMap k v + . M.updateMaxWithKey f + $ m +{-# INLINE updateMaxWithKey #-} + +-- | /O(log n)/. A version of 'updateMaxWithKey' that disallows deletion, +-- allowing us to guarantee that the result is also non-empty. +adjustMaxWithKey :: (k -> a -> a) -> NEMap k a -> NEMap k a +adjustMaxWithKey f (NEMap k0 v m) + | M.null m = NEMap k0 (f k0 v) m + | otherwise = + insertMapMin k0 v + . M.updateMaxWithKey (\k -> Just . f k) + $ m +{-# INLINE adjustMaxWithKey #-} + +-- | /O(1)/. Retrieves the value associated with minimal key of the +-- map, and the map stripped of that element. It is constant-time, so has +-- better asymptotics than @Data.Map.minView@ for 'Map'. +-- +-- Note that unlike @Data.Map.minView@ for 'Map', this cannot ever fail, +-- so doesn't need to return in a 'Maybe'. However, the result 'Map' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > minView (fromList ((5,"a") :| [(3,"b")])) == ("b", Data.Map.singleton 5 "a") +minView :: NEMap k a -> (a, Map k a) +minView = first snd . deleteFindMin +{-# INLINE minView #-} + +-- | /O(1)/. Delete and find the minimal key-value pair. It is +-- constant-time, so has better asymptotics that @Data.Map.minView@ for +-- 'Map'. +-- +-- Note that unlike @Data.Map.deleteFindMin@ for 'Map', this cannot ever +-- fail, and so is a total function. However, the result 'Map' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > deleteFindMin (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((3,"b"), Data.Map.fromList [(5,"a"), (10,"c")]) +deleteFindMin :: NEMap k a -> ((k, a), Map k a) +deleteFindMin (NEMap k v m) = ((k, v), m) +{-# INLINE deleteFindMin #-} + +-- | /O(log n)/. Retrieves the value associated with maximal key of the +-- map, and the map stripped of that element. +-- +-- Note that unlike @Data.Map.maxView@ from 'Map', this cannot ever fail, +-- so doesn't need to return in a 'Maybe'. However, the result 'Map' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > maxView (fromList ((5,"a") :| [(3,"b")])) == ("a", Data.Map.singleton 3 "b") +maxView :: NEMap k a -> (a, Map k a) +maxView = first snd . deleteFindMax +{-# INLINE maxView #-} + +-- | /O(log n)/. Delete and find the minimal key-value pair. +-- +-- Note that unlike @Data.Map.deleteFindMax@ for 'Map', this cannot ever +-- fail, and so is a total function. However, the result 'Map' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > deleteFindMax (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((10,"c"), Data.Map.fromList [(3,"b"), (5,"a")]) +deleteFindMax :: NEMap k a -> ((k, a), Map k a) +deleteFindMax (NEMap k v m) = + maybe ((k, v), M.empty) (second (insertMinMap k v)) + . M.maxViewWithKey + $ m +{-# INLINE deleteFindMax #-} + +-- | Special property of non-empty maps: The type of non-empty maps over +-- uninhabited keys is itself uninhabited. +-- +-- This property also exists for /values/ inside a non-empty container +-- (like for 'NESet', 'NESeq', and 'NEIntMap'); this can be witnessed using +-- the function @'absurd' . 'fold1'@. +-- +-- @since 0.3.1.0 +absurdNEMap :: NEMap Void a -> b +absurdNEMap = \case {} + +-- --------------------------- +-- Combining functions +-- --------------------------- +-- +-- Code comes from "Data.Map.Internal" from containers, modified slightly +-- to work with NonEmpty +-- +-- Copyright : (c) Daan Leijen 2002 +-- (c) Andriy Palamarchuk 2008 + +combineEq :: Eq a => NonEmpty (a, b) -> NonEmpty (a, b) +combineEq = \case + x :| [] -> x :| [] + x :| xx@(_ : _) -> go x xx + where + go z [] = z :| [] + go z@(kz, _) (x@(kx, xx) : xs') + | kx == kz = go (kx, xx) xs' + | otherwise = z NE.<| go x xs' + +combineEqWith :: + Eq a => + (a -> b -> b -> b) -> + NonEmpty (a, b) -> + NonEmpty (a, b) +combineEqWith f = \case + x :| [] -> x :| [] + x :| xx@(_ : _) -> go x xx + where + go z [] = z :| [] + go z@(kz, zz) (x@(kx, xx) : xs') + | kx == kz = let yy = f kx xx zz in go (kx, yy) xs' + | otherwise = z NE.<| go x xs' diff --git a/src/Data/Map/NonEmpty/Lazy/Internal.hs b/src/Data/Map/NonEmpty/Lazy/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Map/NonEmpty/Lazy/Internal.hs @@ -0,0 +1,726 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_HADDOCK not-home #-} + +-- | +-- Module : Data.Map.NonEmpty.Lazy.Internal +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- Unsafe internal-use functions used in the implementation of +-- "Data.Map.NonEmpty.Lazy". These functions can potentially be used to break +-- the abstraction of 'NEMap' and produce unsound maps, so be wary! +module Data.Map.NonEmpty.Lazy.Internal ( + -- * Non-Empty Map type + NEMap (..), + singleton, + nonEmptyMap, + withNonEmpty, + fromList, + toList, + map, + insertWith, + union, + unions, + elems, + size, + toMap, + + -- * Folds + foldr, + foldr', + foldr1, + foldl, + foldl', + foldl1, + + -- * Traversals + traverseWithKey, + traverseWithKey1, + foldMapWithKey, + + -- * Unsafe Map Functions + insertMinMap, + insertMaxMap, + + -- * Debug + valid, +) where + +import Control.Applicative +import Control.Comonad +import Control.DeepSeq +import Control.Monad +import qualified Data.Aeson as A +import Data.Coerce +import Data.Data +import qualified Data.Foldable as F +import Data.Foldable.WithIndex (FoldableWithIndex (..)) +import Data.Function +import Data.Functor.Alt +import Data.Functor.Classes +import Data.Functor.Invariant +import Data.Functor.WithIndex (FunctorWithIndex (..)) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.Map as M +import Data.Map.Internal (Map (..)) +import qualified Data.Map.Internal as M +import Data.Maybe +import Data.Semigroup +import Data.Semigroup.Foldable (Foldable1 (fold1)) +import qualified Data.Semigroup.Foldable as F1 +import Data.Semigroup.Traversable (Traversable1 (..)) +import Data.Traversable.WithIndex (TraversableWithIndex (..)) +import qualified GHC.Exts as Exts +import Text.Read +import Prelude hiding (Foldable (..), map) + +-- | A non-empty (by construction) map from keys @k@ to values @a@. At +-- least one key-value pair exists in an @'NEMap' k v@ at all times. +-- +-- Functions that /take/ an 'NEMap' can safely operate on it with the +-- assumption that it has at least one key-value pair. +-- +-- Functions that /return/ an 'NEMap' provide an assurance that the result +-- has at least one key-value pair. +-- +-- "Data.Map.NonEmpty.Lazy" re-exports the API of "Data.Map.Lazy", faithfully +-- reproducing asymptotics, typeclass constraints, and semantics. +-- Functions that ensure that input and output maps are both non-empty +-- (like 'Data.Map.NonEmpty.Lazy.insert') return 'NEMap', but functions that +-- might potentially return an empty map (like 'Data.Map.NonEmpty.Lazy.delete') +-- return a 'Map' instead. +-- +-- You can directly construct an 'NEMap' with the API from +-- "Data.Map.NonEmpty.Lazy"; it's more or less the same as constructing a normal +-- 'Map', except you don't have access to 'Data.Map.empty'. There are also +-- a few ways to construct an 'NEMap' from a 'Map': +-- +-- 1. The 'nonEmptyMap' smart constructor will convert a @'Map' k a@ into +-- a @'Maybe' ('NEMap' k a)@, returning 'Nothing' if the original 'Map' +-- was empty. +-- 2. You can use the 'Data.Map.NonEmpty.insertMap' family of functions to +-- insert a value into a 'Map' to create a guaranteed 'NEMap'. +-- 3. You can use the 'Data.Map.NonEmpty.Lazy.IsNonEmpty' and +-- 'Data.Map.NonEmpty.Lazy.IsEmpty' patterns to "pattern match" on a 'Map' +-- to reveal it as either containing a 'NEMap' or an empty map. +-- 4. 'withNonEmpty' offers a continuation-based interface for +-- deconstructing a 'Map' and treating it as if it were an 'NEMap'. +-- +-- You can convert an 'NEMap' into a 'Map' with 'toMap' or +-- 'Data.Map.NonEmpty.Lazy.IsNonEmpty', essentially "obscuring" the non-empty +-- property from the type. +data NEMap k a + = NEMap + { nemK0 :: !k + -- ^ invariant: must be smaller than smallest key in map + , nemV0 :: a + , nemMap :: !(Map k a) + } + deriving (Typeable) + +instance (Eq k, Eq a) => Eq (NEMap k a) where + t1 == t2 = + M.size (nemMap t1) == M.size (nemMap t2) + && toList t1 == toList t2 + +instance (Ord k, Ord a) => Ord (NEMap k a) where + compare = compare `on` toList + (<) = (<) `on` toList + (>) = (>) `on` toList + (<=) = (<=) `on` toList + (>=) = (>=) `on` toList + +instance Eq2 NEMap where + liftEq2 eqk eqv m n = + size m == size n && liftEq (liftEq2 eqk eqv) (toList m) (toList n) + +instance Eq k => Eq1 (NEMap k) where + liftEq = liftEq2 (==) + +instance Ord2 NEMap where + liftCompare2 cmpk cmpv m n = + liftCompare (liftCompare2 cmpk cmpv) (toList m) (toList n) + +instance Ord k => Ord1 (NEMap k) where + liftCompare = liftCompare2 compare + +instance Show2 NEMap where + liftShowsPrec2 spk slk spv slv d m = + showsUnaryWith (liftShowsPrec sp sl) "fromList" d (toList m) + where + sp = liftShowsPrec2 spk slk spv slv + sl = liftShowList2 spk slk spv slv + +instance Show k => Show1 (NEMap k) where + liftShowsPrec = liftShowsPrec2 showsPrec showList + +instance (Ord k, Read k) => Read1 (NEMap k) where + liftReadsPrec rp rl = + readsData $ + readsUnaryWith (liftReadsPrec rp' rl') "fromList" fromList + where + rp' = liftReadsPrec rp rl + rl' = liftReadList rp rl + +instance (Ord k, Read k, Read e) => Read (NEMap k e) where + readPrec = parens $ prec 10 $ do + Ident "fromList" <- lexP + xs <- parens . prec 10 $ readPrec + return (fromList xs) + readListPrec = readListPrecDefault + +instance (Show k, Show a) => Show (NEMap k a) where + showsPrec d m = + showParen (d > 10) $ + showString "fromList (" . shows (toList m) . showString ")" + +instance (NFData k, NFData a) => NFData (NEMap k a) where + rnf (NEMap k v a) = rnf k `seq` rnf v `seq` rnf a + +-- | @since 0.3.6.0 +instance FunctorWithIndex k (NEMap k) where + imap f (NEMap k v m) = NEMap k (f k v) (M.mapWithKey f m) + +-- | @since 0.3.6.0 +instance FoldableWithIndex k (NEMap k) where + ifoldMap = foldMapWithKey + +-- | @since 0.3.6.0 +instance TraversableWithIndex k (NEMap k) where + itraverse f (NEMap k v m) = NEMap k <$> f k v <*> M.traverseWithKey f m + +-- | @since 0.3.6.0 +instance Ord k => Exts.IsList (NEMap k a) where + type Item (NEMap k a) = (k, a) + + fromList (a : as) = fromList (a :| as) + fromList [] = errorWithoutStackTrace "Data.Map.NonEmpty.fromList: empty list" + + toList = F.toList . toList + +-- Data instance code from Data.Map.Internal +-- +-- Copyright : (c) Daan Leijen 2002 +-- (c) Andriy Palamarchuk 2008 +#if MIN_VERSION_base(4,16,0) +instance (Data k, Data a, Ord k) => Data (NEMap k a) where + gfoldl f z m = z fromList `f` toList m + toConstr _ = fromListConstr + gunfold k z c = case constrIndex c of + 1 -> k (z fromList) + _ -> error "gunfold" + dataTypeOf _ = mapDataType + dataCast2 = gcast2 +#else +#ifndef __HLINT__ +instance (Data k, Data a, Ord k) => Data (NEMap k a) where + gfoldl f z m = z fromList `f` toList m + toConstr _ = fromListConstr + gunfold k z c = case constrIndex c of + 1 -> k (z fromList) + _ -> error "gunfold" + dataTypeOf _ = mapDataType + dataCast2 f = gcast2 f +#endif +#endif + +fromListConstr :: Constr +fromListConstr = mkConstr mapDataType "fromList" [] Prefix + +mapDataType :: DataType +mapDataType = mkDataType "Data.Map.NonEmpty.NonEmpty.Internal.NEMap" [fromListConstr] + +instance (A.ToJSONKey k, A.ToJSON a) => A.ToJSON (NEMap k a) where + toJSON = A.toJSON . toMap + toEncoding = A.toEncoding . toMap + +instance (A.FromJSONKey k, Ord k, A.FromJSON a) => A.FromJSON (NEMap k a) where + parseJSON = + withNonEmpty (fail err) pure + <=< A.parseJSON + where + err = "NEMap: Non-empty map expected, but empty map found" + +-- | @since 0.3.4.4 +instance Ord k => Alt (NEMap k) where + () = union + {-# INLINE () #-} + +-- | /O(n)/. Fold the values in the map using the given right-associative +-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'elems'@. +-- +-- > elemsList map = foldr (:) [] map +-- +-- > let f a len = len + (length a) +-- > foldr f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4 +foldr :: (a -> b -> b) -> b -> NEMap k a -> b +foldr f z (NEMap _ v m) = v `f` M.foldr f z m +{-# INLINE foldr #-} + +-- | /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. +foldr' :: (a -> b -> b) -> b -> NEMap k a -> b +foldr' f z (NEMap _ v m) = v `f` y + where + !y = M.foldr' f z m +{-# INLINE foldr' #-} + +-- | /O(n)/. A version of 'foldr' that uses the value at the maximal key in +-- the map as the starting value. +-- +-- Note that, unlike 'Data.Foldable.foldr1' for 'Map', this function is +-- total if the input function is total. +foldr1 :: (a -> a -> a) -> NEMap k a -> a +foldr1 f (NEMap _ v m) = + maybe v (f v . uncurry (M.foldr f)) + . M.maxView + $ m +{-# INLINE foldr1 #-} + +-- | /O(n)/. Fold the values in the map using the given left-associative +-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'elems'@. +-- +-- > elemsList = reverse . foldl (flip (:)) [] +-- +-- > let f len a = len + (length a) +-- > foldl f 0 (fromList ((5,"a") :| [(3,"bbb")])) == 4 +foldl :: (a -> b -> a) -> a -> NEMap k b -> a +foldl f z (NEMap _ v m) = M.foldl f (f z v) m +{-# INLINE foldl #-} + +-- | /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. +foldl' :: (a -> b -> a) -> a -> NEMap k b -> a +foldl' f z (NEMap _ v m) = M.foldl' f x m + where + !x = f z v +{-# INLINE foldl' #-} + +-- | /O(n)/. A version of 'foldl' that uses the value at the minimal key in +-- the map as the starting value. +-- +-- Note that, unlike 'Data.Foldable.foldl1' for 'Map', this function is +-- total if the input function is total. +foldl1 :: (a -> a -> a) -> NEMap k a -> a +foldl1 f (NEMap _ v m) = M.foldl f v m +{-# INLINE foldl1 #-} + +-- | /O(n)/. Fold the keys and values in the map using the given semigroup, +-- such that +-- +-- @'foldMapWithKey' f = 'Data.Semigroup.Foldable.fold1' . 'Data.Map.NonEmpty.mapWithKey' f@ +-- +-- This can be an asymptotically faster than +-- 'Data.Map.NonEmpty.foldrWithKey' or 'Data.Map.NonEmpty.foldlWithKey' for +-- some monoids. + +-- TODO: benchmark against maxView method +foldMapWithKey :: + Semigroup m => + (k -> a -> m) -> + NEMap k a -> + m +#if MIN_VERSION_base(4,11,0) +foldMapWithKey f (NEMap k0 v m) = maybe (f k0 v) (f k0 v <>) + . M.foldMapWithKey (\k -> Just . f k) + $ m +#else +foldMapWithKey f (NEMap k0 v m) = option (f k0 v) (f k0 v <>) + . M.foldMapWithKey (\k -> Option . Just . f k) + $ m +#endif +{-# INLINE foldMapWithKey #-} + +-- | /O(n)/. Map a function over all values in the map. +-- +-- > map (++ "x") (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "bx") :| [(5, "ax")]) +map :: (a -> b) -> NEMap k a -> NEMap k b +map f (NEMap k0 v m) = NEMap k0 (f v) (M.map f m) +{-# NOINLINE [1] map #-} + +{-# RULES +"map/map" forall f g xs. map f (map g xs) = map (f . g) xs + #-} +{-# RULES +"map/coerce" map coerce = coerce + #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and +-- @t2@. It prefers @t1@ when duplicate keys are encountered, i.e. +-- (@'union' == 'Data.Map.NonEmpty.unionWith' 'const'@). +-- +-- > union (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "a"), (7, "C")]) +union :: + Ord k => + NEMap k a -> + NEMap k a -> + NEMap k a +union n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + LT -> NEMap k1 v1 . M.union m1 . toMap $ n2 + EQ -> NEMap k1 v1 . M.union m1 $ m2 + GT -> NEMap k2 v2 . M.union (toMap n1) $ m2 +{-# INLINE union #-} + +-- | The left-biased union of a non-empty list of maps. +-- +-- > unions (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) +-- > == fromList [(3, "b"), (5, "a"), (7, "C")] +-- > unions (fromList ((5, "A3") :| [(3, "B3")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "a") :| [(3, "b")])]) +-- > == fromList ((3, "B3") :| [(5, "A3"), (7, "C")]) +unions :: + (Foldable1 f, Ord k) => + f (NEMap k a) -> + NEMap k a +unions (F1.toNonEmpty -> (m :| ms)) = F.foldl' union m ms +{-# INLINE unions #-} + +-- | /O(n)/. +-- Return all elements of the map in the ascending order of their keys. +-- +-- > elems (fromList ((5,"a") :| [(3,"b")])) == ("b" :| ["a"]) +elems :: NEMap k a -> NonEmpty a +elems (NEMap _ v m) = v :| M.elems m +{-# INLINE elems #-} + +-- | /O(1)/. The number of elements in the map. Guaranteed to be greater +-- than zero. +-- +-- > size (singleton 1 'a') == 1 +-- > size (fromList ((1,'a') :| [(2,'c'), (3,'b')])) == 3 +size :: NEMap k a -> Int +size (NEMap _ _ m) = 1 + M.size m +{-# INLINE size #-} + +-- | /O(log n)/. +-- Convert a non-empty map back into a normal possibly-empty map, for usage +-- with functions that expect 'Map'. +-- +-- Can be thought of as "obscuring" the non-emptiness of the map in its +-- type. See the 'Data.Map.NonEmpty.IsNotEmpty' pattern. +-- +-- 'nonEmptyMap' and @'maybe' 'Data.Map.empty' 'toMap'@ form an isomorphism: they +-- are perfect structure-preserving inverses of eachother. +-- +-- > toMap (fromList ((3,"a") :| [(5,"b")])) == Data.Map.fromList [(3,"a"), (5,"b")] +toMap :: NEMap k a -> Map k a +toMap (NEMap k v m) = insertMinMap k v m +{-# INLINE toMap #-} + +-- | /O(n)/. +-- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ +-- That is, behaves exactly like a regular 'traverse' except that the traversing +-- function also has access to the key associated with a value. +-- +-- /Use 'traverseWithKey1'/ whenever possible (if your 'Applicative' +-- also has 'Apply' instance). This version is provided only for types +-- that do not have 'Apply' instance, since 'Apply' is not at the moment +-- (and might not ever be) an official superclass of 'Applicative'. +-- +-- @ +-- 'traverseWithKey' f = 'unwrapApplicative' . 'traverseWithKey1' (\\k -> WrapApplicative . f k) +-- @ +traverseWithKey :: + Applicative t => + (k -> a -> t b) -> + NEMap k a -> + t (NEMap k b) +traverseWithKey f (NEMap k v m0) = NEMap k <$> f k v <*> M.traverseWithKey f m0 +{-# INLINE traverseWithKey #-} + +-- | /O(n)/. +-- @'traverseWithKey1' f m == 'fromList' <$> 'traverse1' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ +-- +-- That is, behaves exactly like a regular 'traverse1' except that the traversing +-- function also has access to the key associated with a value. +-- +-- Is more general than 'traverseWithKey', since works with all 'Apply', +-- and not just 'Applicative'. + +-- TODO: benchmark against maxView-based methods +traverseWithKey1 :: + Apply t => + (k -> a -> t b) -> + NEMap k a -> + t (NEMap k b) +traverseWithKey1 f (NEMap k0 v m0) = case runMaybeApply m1 of + Left m2 -> NEMap k0 <$> f k0 v <.> m2 + Right m2 -> flip (NEMap k0) m2 <$> f k0 v + where + m1 = M.traverseWithKey (\k -> MaybeApply . Left . f k) m0 +{-# INLINEABLE traverseWithKey1 #-} + +-- | /O(n)/. Convert the map to a non-empty list of key\/value pairs. +-- +-- > toList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +toList :: NEMap k a -> NonEmpty (k, a) +toList (NEMap k v m) = (k, v) :| M.toList m +{-# INLINE toList #-} + +-- | /O(log n)/. Smart constructor for an 'NEMap' from a 'Map'. Returns +-- 'Nothing' if the 'Map' was originally actually empty, and @'Just' n@ +-- with an 'NEMap', if the 'Map' was not empty. +-- +-- 'nonEmptyMap' and @'maybe' 'Data.Map.empty' 'toMap'@ form an +-- isomorphism: they are perfect structure-preserving inverses of +-- eachother. +-- +-- See 'Data.Map.NonEmpty.IsNonEmpty' for a pattern synonym that lets you +-- "match on" the possiblity of a 'Map' being an 'NEMap'. +-- +-- > nonEmptyMap (Data.Map.fromList [(3,"a"), (5,"b")]) == Just (fromList ((3,"a") :| [(5,"b")])) +nonEmptyMap :: Map k a -> Maybe (NEMap k a) +nonEmptyMap = (fmap . uncurry . uncurry) NEMap . M.minViewWithKey +{-# INLINE nonEmptyMap #-} + +-- | /O(log n)/. A general continuation-based way to consume a 'Map' as if +-- it were an 'NEMap'. @'withNonEmpty' def f@ will take a 'Map'. If map is +-- empty, it will evaluate to @def@. Otherwise, a non-empty map 'NEMap' +-- will be fed to the function @f@ instead. +-- +-- @'nonEmptyMap' == 'withNonEmpty' 'Nothing' 'Just'@ +withNonEmpty :: + -- | value to return if map is empty + r -> + -- | function to apply if map is not empty + (NEMap k a -> r) -> + Map k a -> + r +withNonEmpty def f = maybe def f . nonEmptyMap +{-# INLINE withNonEmpty #-} + +-- | /O(n*log n)/. Build a non-empty map from a non-empty list of +-- key\/value pairs. See also 'Data.Map.NonEmpty.fromAscList'. If the list +-- contains more than one value for the same key, the last value for the +-- key is retained. +-- +-- > fromList ((5,"a") :| [(3,"b"), (5, "c")]) == fromList ((5,"c") :| [(3,"b")]) +-- > fromList ((5,"c") :| [(3,"b"), (5, "a")]) == fromList ((5,"a") :| [(3,"b")]) + +-- TODO: write manually and optimize to be equivalent to +-- 'fromDistinctAscList' if items are ordered, just like the actual +-- 'M.fromList'. +fromList :: Ord k => NonEmpty (k, a) -> NEMap k a +fromList ((k, v) :| xs) = + withNonEmpty (singleton k v) (insertWith (const id) k v) + . M.fromList + $ xs +{-# INLINE fromList #-} + +-- | /O(1)/. A map with a single element. +-- +-- > singleton 1 'a' == fromList ((1, 'a') :| []) +-- > size (singleton 1 'a') == 1 +singleton :: k -> a -> NEMap k a +singleton k v = NEMap k v M.empty +{-# INLINE singleton #-} + +-- | /O(log n)/. Insert with a function, combining new value and old value. +-- @'insertWith' f key value mp@ will insert the pair (key, value) into +-- @mp@ if key does not exist in the map. If the key does exist, the +-- function will insert the pair @(key, f new_value old_value)@. +-- +-- See 'Data.Map.NonEmpty.insertMapWith' for a version where the first +-- argument is a 'Map'. +-- +-- > insertWith (++) 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "xxxa")]) +-- > insertWith (++) 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +insertWith :: + Ord k => + (a -> a -> a) -> + k -> + a -> + NEMap k a -> + NEMap k a +insertWith f k v n@(NEMap k0 v0 m) = case compare k k0 of + LT -> NEMap k v . toMap $ n + EQ -> NEMap k (f v v0) m + GT -> NEMap k0 v0 $ M.insertWith f k v m +{-# INLINE insertWith #-} + +-- | Left-biased union +instance Ord k => Semigroup (NEMap k a) where + (<>) = union + {-# INLINE (<>) #-} + sconcat = unions + {-# INLINE sconcat #-} + +instance Functor (NEMap k) where + fmap = map + {-# INLINE fmap #-} + x <$ NEMap k _ m = NEMap k x (x <$ m) + {-# INLINE (<$) #-} + +-- | @since 0.3.4.4 +instance Invariant (NEMap k) where + invmap f _ = fmap f + {-# INLINE invmap #-} + +-- | Traverses elements in order of ascending keys +-- +-- 'Data.Foldable.foldr1', 'Data.Foldable.foldl1', 'Data.Foldable.minimum', +-- 'Data.Foldable.maximum' are all total. +#if MIN_VERSION_base(4,11,0) +instance F.Foldable (NEMap k) where + fold (NEMap _ v m) = v <> F.fold m + {-# INLINE fold #-} + foldMap f (NEMap _ v m) = f v <> F.foldMap f m + {-# INLINE foldMap #-} + foldr = foldr + {-# INLINE foldr #-} + foldr' = foldr' + {-# INLINE foldr' #-} + foldr1 = foldr1 + {-# INLINE foldr1 #-} + foldl = foldl + {-# INLINE foldl #-} + foldl' = foldl' + {-# INLINE foldl' #-} + foldl1 = foldl1 + {-# INLINE foldl1 #-} + null _ = False + {-# INLINE null #-} + length = size + {-# INLINE length #-} + elem x (NEMap _ v m) = F.elem x m + || x == v + {-# INLINE elem #-} + -- TODO: use build + toList = F.toList . elems + {-# INLINE toList #-} +#else +instance F.Foldable (NEMap k) where + fold (NEMap _ v m) = v `mappend` F.fold m + {-# INLINE fold #-} + foldMap f (NEMap _ v m) = f v `mappend` F.foldMap f m + {-# INLINE foldMap #-} + foldr = foldr + {-# INLINE foldr #-} + foldr' = foldr' + {-# INLINE foldr' #-} + foldr1 = foldr1 + {-# INLINE foldr1 #-} + foldl = foldl + {-# INLINE foldl #-} + foldl' = foldl' + {-# INLINE foldl' #-} + foldl1 = foldl1 + {-# INLINE foldl1 #-} + null _ = False + {-# INLINE null #-} + length = size + {-# INLINE length #-} + elem x (NEMap _ v m) = F.elem x m + || x == v + {-# INLINE elem #-} + -- TODO: use build + toList = F.toList . elems + {-# INLINE toList #-} +#endif + +-- | Traverses elements in order of ascending keys +instance Traversable (NEMap k) where + traverse f (NEMap k v m) = NEMap k <$> f v <*> traverse f m + {-# INLINE traverse #-} + sequenceA (NEMap k v m) = NEMap k <$> v <*> sequenceA m + {-# INLINE sequenceA #-} + +-- | Traverses elements in order of ascending keys +#if MIN_VERSION_base(4,11,0) +instance Foldable1 (NEMap k) where + fold1 (NEMap _ v m) = maybe v (v <>) + . F.foldMap Just + $ m + {-# INLINE fold1 #-} + foldMap1 f = foldMapWithKey (const f) + {-# INLINE foldMap1 #-} + toNonEmpty = elems + {-# INLINE toNonEmpty #-} +#else +instance Foldable1 (NEMap k) where + fold1 (NEMap _ v m) = option v (v <>) + . F.foldMap (Option . Just) + $ m + {-# INLINE fold1 #-} + foldMap1 f = foldMapWithKey (const f) + {-# INLINE foldMap1 #-} + toNonEmpty = elems + {-# INLINE toNonEmpty #-} +#endif + +-- | Traverses elements in order of ascending keys +instance Traversable1 (NEMap k) where + traverse1 f = traverseWithKey1 (const f) + {-# INLINE traverse1 #-} + sequence1 (NEMap k v m0) = case runMaybeApply m1 of + Left m2 -> NEMap k <$> v <.> m2 + Right m2 -> flip (NEMap k) m2 <$> v + where + m1 = traverse (MaybeApply . Left) m0 + {-# INLINEABLE sequence1 #-} + +-- | 'extract' gets the value at the minimal key, and 'duplicate' produces +-- a map of maps comprised of all keys from the original map greater than +-- or equal to the current key. +-- +-- @since 0.1.1.0 +instance Comonad (NEMap k) where + extract = nemV0 + {-# INLINE extract #-} + duplicate n0@(NEMap k0 _ m0) = + NEMap k0 n0 + . snd + . M.mapAccumWithKey go m0 + $ m0 + where + go m k v = (m', NEMap k v m') + where + !m' = M.deleteMin m + {-# INLINE duplicate #-} + +-- | /O(n)/. Test if the internal map structure is valid. +valid :: Ord k => NEMap k a -> Bool +valid (NEMap k _ m) = + M.valid m + && all ((k <) . fst . fst) (M.minViewWithKey m) + +-- | /O(log n)/. Insert new key and value into a map where keys are +-- /strictly greater than/ the new key. That is, the new key must be +-- /strictly less than/ all keys present in the 'Map'. /The precondition +-- is not checked./ +-- +-- While this has the same asymptotics as @Data.Map.insert@, it saves +-- a constant factor for key comparison (so may be helpful if comparison is +-- expensive) and also does not require an 'Ord' instance for the key type. +insertMinMap :: k -> a -> Map k a -> Map k a +insertMinMap kx x = \case + Tip -> M.singleton kx x + Bin _ ky y l r -> M.balanceL ky y (insertMinMap kx x l) r +{-# INLINEABLE insertMinMap #-} + +-- | /O(log n)/. Insert new key and value into a map where keys are +-- /strictly less than/ the new key. That is, the new key must be +-- /strictly greater than/ all keys present in the 'Map'. /The +-- precondition is not checked./ +-- +-- While this has the same asymptotics as @Data.Map.insert@, it saves +-- a constant factor for key comparison (so may be helpful if comparison is +-- expensive) and also does not require an 'Ord' instance for the key type. +insertMaxMap :: k -> a -> Map k a -> Map k a +insertMaxMap kx x = \case + Tip -> M.singleton kx x + Bin _ ky y l r -> M.balanceR ky y l (insertMaxMap kx x r) +{-# INLINEABLE insertMaxMap #-} diff --git a/src/Data/Map/NonEmpty/Strict.hs b/src/Data/Map/NonEmpty/Strict.hs new file mode 100644 --- /dev/null +++ b/src/Data/Map/NonEmpty/Strict.hs @@ -0,0 +1,2492 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module : Data.Map.NonEmpty.Strict +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- = Non-Empty Finite Maps (strict interface) +-- +-- The @'NEMap' k v@ type represents a non-empty finite map (sometimes +-- called a dictionary) from keys of type @k@ to values of type @v@. +-- An 'NEMap' is strict in its keys and values. +-- +-- See documentation for 'NEMap' for information on how to convert and +-- manipulate such non-empty maps. +-- +-- This module essentially re-imports the API of "Data.Map.Strict" and its +-- 'Map' type, along with semantics and asymptotics. In most situations, +-- asymptotics are different only by a constant factor. In some +-- situations, asmyptotics are even better (constant-time instead of +-- log-time). All typeclass constraints are identical to their "Data.Map" +-- counterparts. +-- +-- Because 'NEMap' is implemented using 'Map', all of the caveats of using +-- 'Map' apply (such as the limitation of the maximum size of maps). +-- +-- All functions take non-empty maps as inputs. In situations where their +-- results can be guarunteed to also be non-empty, they also return +-- non-empty maps. In situations where their results could potentially be +-- empty, 'Map' is returned instead. +-- +-- Some variants of functions (like 'alter'', 'alterF'', 'adjustAt', +-- 'adjustMin', 'adjustMax', 'adjustMinWithKey', 'adjustMaxWithKey') are +-- provided in a way restructured to preserve guaruntees of non-empty maps +-- being returned. +-- +-- Some functions (like 'mapEither', 'partition', 'spanAntitone', 'split') +-- have modified return types to account for possible configurations of +-- non-emptiness. +-- +-- This module is intended to be imported qualified, to avoid name clashes with +-- "Prelude" and "Data.Map" functions: +-- +-- > import qualified Data.Map.NonEmpty.Strict as NEM +-- +-- Import "Data.Map.NonEmpty.Lazy" for a variant lazy in values. +module Data.Map.NonEmpty.Strict ( + -- * Non-Empty Map type + NEMap, + + -- ** Conversions between empty and non-empty maps + pattern IsNonEmpty, + pattern IsEmpty, + nonEmptyMap, + toMap, + withNonEmpty, + insertMap, + insertMapWith, + insertMapWithKey, + insertMapMin, + insertMapMax, + unsafeFromMap, + + -- * Construction + singleton, + fromSet, + + -- ** From Unordered Lists + fromList, + fromListWith, + fromListWithKey, + + -- ** From Ascending Lists + fromAscList, + fromAscListWith, + fromAscListWithKey, + fromDistinctAscList, + + -- ** From Descending Lists + fromDescList, + fromDescListWith, + fromDescListWithKey, + fromDistinctDescList, + + -- * Insertion + insert, + insertWith, + insertWithKey, + insertLookupWithKey, + + -- * Deletion\/Update + delete, + deleteMaybe, + adjust, + adjustWithKey, + update, + updateWithKey, + updateLookupWithKey, + alter, + alterF, + alter', + alterF', + + -- * Query + + -- ** Lookup + lookup, + (!?), + (!), + findWithDefault, + member, + notMember, + lookupLT, + lookupGT, + lookupLE, + lookupGE, + absurdNEMap, + + -- ** Size + size, + + -- * Combine + + -- ** Union + union, + unionMapLeft, + unionMapRight, + unionWith, + unionMapWithLeft, + unionMapWithRight, + unionWithKey, + unionMapWithKeyLeft, + unionMapWithKeyRight, + unions, + unionsWith, + + -- ** Difference + difference, + (\\), + differenceWith, + differenceWithKey, + + -- ** Intersection + intersection, + intersectionWith, + intersectionWithKey, + -- -- ** Unsafe general combining function + -- , mergeWithKey + + -- * Traversal + + -- ** Map + map, + mapWithKey, + traverseWithKey1, + traverseWithKey, + traverseMaybeWithKey1, + traverseMaybeWithKey, + mapAccum, + mapAccumWithKey, + mapAccumRWithKey, + mapKeys, + mapKeysWith, + mapKeysMonotonic, + + -- * Folds + foldr, + foldl, + foldr1, + foldl1, + foldrWithKey, + foldlWithKey, + foldMapWithKey, + + -- ** Strict folds + foldr', + foldr1', + foldl', + foldl1', + foldrWithKey', + foldlWithKey', + + -- * Conversion + elems, + keys, + assocs, + keysSet, + + -- ** Lists + toList, + + -- ** Ordered lists + toAscList, + toDescList, + + -- * Filter + filter, + filterWithKey, + restrictKeys, + withoutKeys, + partition, + partitionWithKey, + takeWhileAntitone, + dropWhileAntitone, + spanAntitone, + mapMaybe, + mapMaybeWithKey, + mapEither, + mapEitherWithKey, + split, + splitLookup, + splitRoot, + + -- * Submap + isSubmapOf, + isSubmapOfBy, + isProperSubmapOf, + isProperSubmapOfBy, + + -- * Indexed + lookupIndex, + findIndex, + elemAt, + updateAt, + adjustAt, + deleteAt, + take, + drop, + splitAt, + + -- * Min\/Max + findMin, + findMax, + deleteMin, + deleteMax, + deleteFindMin, + deleteFindMax, + updateMin, + updateMax, + adjustMin, + adjustMax, + updateMinWithKey, + updateMaxWithKey, + adjustMinWithKey, + adjustMaxWithKey, + minView, + maxView, + + -- * Debugging + valid, +) where + +import Control.Applicative +import Data.Bifunctor +import qualified Data.Foldable as F +import Data.Function +import Data.Functor.Apply +import Data.Functor.Identity +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE +import Data.Map (Map) +import Data.Map.NonEmpty.Strict.Internal +import qualified Data.Map.Strict as M +import Data.Maybe hiding (mapMaybe) +import qualified Data.Maybe as Maybe +import Data.Semigroup.Foldable (Foldable1) +import qualified Data.Semigroup.Foldable as F1 +import Data.Set (Set) +import qualified Data.Set as S +import Data.Set.NonEmpty.Internal (NESet (..)) +import Data.These +import Data.Void +import Prelude hiding (Foldable (..), drop, filter, lookup, map, splitAt, take) + +-- | /O(1)/ match, /O(log n)/ usage of contents. The 'IsNonEmpty' and +-- 'IsEmpty' patterns allow you to treat a 'Map' as if it were either +-- a @'IsNonEmpty' n@ (where @n@ is a 'NEMap') or an 'IsEmpty'. +-- +-- For example, you can pattern match on a 'Map': +-- +-- @ +-- myFunc :: 'Map' K X -> Y +-- myFunc ('IsNonEmpty' n) = -- here, the user provided a non-empty map, and @n@ is the 'NEMap' +-- myFunc 'IsEmpty' = -- here, the user provided an empty map. +-- @ +-- +-- Matching on @'IsNonEmpty' n@ means that the original 'Map' was /not/ +-- empty, and you have a verified-non-empty 'NEMap' @n@ to use. +-- +-- Note that patching on this pattern is /O(1)/. However, using the +-- contents requires a /O(log n)/ cost that is deferred until after the +-- pattern is matched on (and is not incurred at all if the contents are +-- never used). +-- +-- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides +-- complete coverage. +-- +-- This is a bidirectional pattern, so you can use 'IsNonEmpty' to convert +-- a 'NEMap' back into a 'Map', obscuring its non-emptiness (see 'toMap'). +pattern IsNonEmpty :: NEMap k a -> Map k a +pattern IsNonEmpty n <- (nonEmptyMap -> Just n) + where + IsNonEmpty n = toMap n + +-- | /O(1)/. The 'IsNonEmpty' and 'IsEmpty' patterns allow you to treat +-- a 'Map' as if it were either a @'IsNonEmpty' n@ (where @n@ is +-- a 'NEMap') or an 'IsEmpty'. +-- +-- Matching on 'IsEmpty' means that the original 'Map' was empty. +-- +-- A case statement handling both 'IsNonEmpty' and 'IsEmpty' provides +-- complete coverage. +-- +-- This is a bidirectional pattern, so you can use 'IsEmpty' as an +-- expression, and it will be interpreted as 'Data.Map.empty'. +-- +-- See 'IsNonEmpty' for more information. +pattern IsEmpty :: Map k a +pattern IsEmpty <- (M.null -> True) + where + IsEmpty = M.empty + +{-# COMPLETE IsNonEmpty, IsEmpty #-} + +-- | /O(log n)/. Unsafe version of 'nonEmptyMap'. Coerces a 'Map' into an +-- 'NEMap', but is undefined (throws a runtime exception when evaluation is +-- attempted) for an empty 'Map'. +unsafeFromMap :: + Map k a -> + NEMap k a +unsafeFromMap = withNonEmpty e id + where + e = errorWithoutStackTrace "NEMap.unsafeFromMap: empty map" +{-# INLINE unsafeFromMap #-} + +-- | /O(n)/. Build a non-empty map from a non-empty set of keys and +-- a function which for each key computes its value. +-- +-- > fromSet (\k -> replicate k 'a') (Data.Set.NonEmpty.fromList (3 :| [5])) == fromList ((5,"aaaaa") :| [(3,"aaa")]) +fromSet :: + (k -> a) -> + NESet k -> + NEMap k a +fromSet f (NESet k ks) = NEMap k (f k) (M.fromSet f ks) +{-# INLINE fromSet #-} + +-- | /O(log n)/. Lookup the value at a key in the map. +-- +-- The function will return the corresponding value as @('Just' value)@, +-- or 'Nothing' if the key isn't in the map. +-- +-- An example of using @lookup@: +-- +-- > import Prelude hiding (lookup) +-- > import Data.Map.NonEmpty +-- > +-- > employeeDept = fromList (("John","Sales") :| [("Bob","IT")]) +-- > deptCountry = fromList (("IT","USA") :| [("Sales","France")]) +-- > countryCurrency = fromList (("USA", "Dollar") :| [("France", "Euro")]) +-- > +-- > employeeCurrency :: String -> Maybe String +-- > employeeCurrency name = do +-- > dept <- lookup name employeeDept +-- > country <- lookup dept deptCountry +-- > lookup country countryCurrency +-- > +-- > main = do +-- > putStrLn $ "John's currency: " ++ (show (employeeCurrency "John")) +-- > putStrLn $ "Pete's currency: " ++ (show (employeeCurrency "Pete")) +-- +-- The output of this program: +-- +-- > John's currency: Just "Euro" +-- > Pete's currency: Nothing +lookup :: + Ord k => + k -> + NEMap k a -> + Maybe a +lookup k (NEMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Just v + GT -> M.lookup k m +{-# INLINE lookup #-} + +-- | /O(log n)/. Find the value at a key. Returns 'Nothing' when the +-- element can not be found. +-- +-- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 1 == Nothing +-- prop> fromList ((5, 'a') :| [(3, 'b')]) !? 5 == Just 'a' +(!?) :: Ord k => NEMap k a -> k -> Maybe a +(!?) = flip lookup +{-# INLINE (!?) #-} + +-- | /O(log n)/. Find the value at a key. Calls 'error' when the element +-- can not be found. +-- +-- > fromList ((5,'a') :| [(3,'b')]) ! 1 Error: element not in the map +-- > fromList ((5,'a') :| [(3,'b')]) ! 5 == 'a' +(!) :: Ord k => NEMap k a -> k -> a +(!) m k = fromMaybe e $ m !? k + where + e = error "NEMap.!: given key is not an element in the map" +{-# INLINE (!) #-} + +infixl 9 !? +infixl 9 ! + +-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns +-- the value at key @k@ or returns default value @def@ +-- when the key is not in the map. +-- +-- > findWithDefault 'x' 1 (fromList ((5,'a') :| [(3,'b')])) == 'x' +-- > findWithDefault 'x' 5 (fromList ((5,'a') :| [(3,'b')])) == 'a' +findWithDefault :: + Ord k => + a -> + k -> + NEMap k a -> + a +findWithDefault def k (NEMap k0 v m) = case compare k k0 of + LT -> def + EQ -> v + GT -> M.findWithDefault def k m +{-# INLINE findWithDefault #-} + +-- | /O(log n)/. Is the key a member of the map? See also 'notMember'. +-- +-- > member 5 (fromList ((5,'a') :| [(3,'b')])) == True +-- > member 1 (fromList ((5,'a') :| [(3,'b')])) == False +member :: Ord k => k -> NEMap k a -> Bool +member k (NEMap k0 _ m) = case compare k k0 of + LT -> False + EQ -> True + GT -> M.member k m +{-# INLINE member #-} + +-- | /O(log n)/. Is the key not a member of the map? See also 'member'. +-- +-- > notMember 5 (fromList ((5,'a') :| [(3,'b')])) == False +-- > notMember 1 (fromList ((5,'a') :| [(3,'b')])) == True +notMember :: Ord k => k -> NEMap k a -> Bool +notMember k (NEMap k0 _ m) = case compare k k0 of + LT -> True + EQ -> False + GT -> M.notMember k m +{-# INLINE notMember #-} + +-- | /O(log n)/. Find largest key smaller than the given one and return the +-- corresponding (key, value) pair. +-- +-- > lookupLT 3 (fromList ((3,'a') :| [(5,'b')])) == Nothing +-- > lookupLT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +lookupLT :: Ord k => k -> NEMap k a -> Maybe (k, a) +lookupLT k (NEMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Nothing + GT -> M.lookupLT k m <|> Just (k0, v) +{-# INLINE lookupLT #-} + +-- | /O(log n)/. Find smallest key greater than the given one and return the +-- corresponding (key, value) pair. +-- +-- > lookupGT 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +-- > lookupGT 5 (fromList ((3,'a') :| [(5,'b')])) == Nothing +lookupGT :: Ord k => k -> NEMap k a -> Maybe (k, a) +lookupGT k (NEMap k0 v m) = case compare k k0 of + LT -> Just (k0, v) + EQ -> M.lookupMin m + GT -> M.lookupGT k m +{-# INLINE lookupGT #-} + +-- | /O(log n)/. Find largest key smaller or equal to the given one and return +-- the corresponding (key, value) pair. +-- +-- > lookupLE 2 (fromList ((3,'a') :| [(5,'b')])) == Nothing +-- > lookupLE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +-- > lookupLE 5 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +lookupLE :: Ord k => k -> NEMap k a -> Maybe (k, a) +lookupLE k (NEMap k0 v m) = case compare k k0 of + LT -> Nothing + EQ -> Just (k0, v) + GT -> M.lookupLE k m <|> Just (k0, v) +{-# INLINE lookupLE #-} + +-- | /O(log n)/. Find smallest key greater or equal to the given one and return +-- the corresponding (key, value) pair. +-- +-- > lookupGE 3 (fromList ((3,'a') :| [(5,'b')])) == Just (3, 'a') +-- > lookupGE 4 (fromList ((3,'a') :| [(5,'b')])) == Just (5, 'b') +-- > lookupGE 6 (fromList ((3,'a') :| [(5,'b')])) == Nothing +lookupGE :: Ord k => k -> NEMap k a -> Maybe (k, a) +lookupGE k (NEMap k0 v m) = case compare k k0 of + LT -> Just (k0, v) + EQ -> Just (k0, v) + GT -> M.lookupGE k m +{-# INLINE lookupGE #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union with a combining function. +-- +-- > unionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "aA"), (7, "C")]) +unionWith :: + Ord k => + (a -> a -> a) -> + NEMap k a -> + NEMap k a -> + NEMap k a +unionWith f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + LT -> NEMap k1 v1 . M.unionWith f m1 . toMap $ n2 + EQ -> NEMap k1 (f v1 v2) . M.unionWith f m1 $ m2 + GT -> NEMap k2 v2 . M.unionWith f (toMap n1) $ m2 +{-# INLINE unionWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a possibly-empty +-- 'Map' and a non-empty map. +-- +-- @since 0.3.6.0 +unionMapLeft :: Ord k => Map k a -> NEMap k a -> NEMap k a +unionMapLeft m n = withNonEmpty n (`union` n) m +{-# INLINE unionMapLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Left-biased union of a non-empty map and a +-- possibly-empty 'Map'. +-- +-- @since 0.3.6.0 +unionMapRight :: Ord k => NEMap k a -> Map k a -> NEMap k a +unionMapRight n = withNonEmpty n (union n) +{-# INLINE unionMapRight #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'Map' and a +-- non-empty map with a combining function. +-- +-- @since 0.3.6.0 +unionMapWithLeft :: Ord k => (a -> a -> a) -> Map k a -> NEMap k a -> NEMap k a +unionMapWithLeft f m n = withNonEmpty n (\m' -> unionWith f m' n) m +{-# INLINE unionMapWithLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a +-- possibly-empty 'Map' with a combining function. +-- +-- @since 0.3.6.0 +unionMapWithRight :: Ord k => (a -> a -> a) -> NEMap k a -> Map k a -> NEMap k a +unionMapWithRight f n = withNonEmpty n (unionWith f n) +{-# INLINE unionMapWithRight #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- Union with a combining function, given the matching key. +-- +-- > let f key left_value right_value = (show key) ++ ":" ++ left_value ++ "|" ++ right_value +-- > unionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == fromList ((3, "b") :| [(5, "5:a|A"), (7, "C")]) +unionWithKey :: + Ord k => + (k -> a -> a -> a) -> + NEMap k a -> + NEMap k a -> + NEMap k a +unionWithKey f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + LT -> NEMap k1 v1 . M.unionWithKey f m1 . toMap $ n2 + EQ -> NEMap k1 (f k1 v1 v2) . M.unionWithKey f m1 $ m2 + GT -> NEMap k2 v2 . M.unionWithKey f (toMap n1) $ m2 +{-# INLINE unionWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a possibly-empty 'Map' and a +-- non-empty map with a combining function, given the matching key. +-- +-- @since 0.3.6.0 +unionMapWithKeyLeft :: + Ord k => + (k -> a -> a -> a) -> + Map k a -> + NEMap k a -> + NEMap k a +unionMapWithKeyLeft f m n = withNonEmpty n (\m' -> unionWithKey f m' n) m +{-# INLINE unionMapWithKeyLeft #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Union of a non-empty map and a +-- possibly-empty 'Map' with a combining function, given the matching key. +-- +-- @since 0.3.6.0 +unionMapWithKeyRight :: + Ord k => + (k -> a -> a -> a) -> + NEMap k a -> + Map k a -> + NEMap k a +unionMapWithKeyRight f n = withNonEmpty n (unionWithKey f n) +{-# INLINE unionMapWithKeyRight #-} + +-- | The union of a non-empty list of maps, with a combining operation: +-- (@'unionsWith' f == 'Data.Foldable.foldl1' ('unionWith' f)@). +-- +-- > unionsWith (++) (fromList ((5, "a") :| [(3, "b")]) :| [fromList ((5, "A") :| [(7, "C")]), fromList ((5, "A3") :| [(3, "B3")])]) +-- > == fromList ((3, "bB3") :| [(5, "aAA3"), (7, "C")]) +unionsWith :: + (Foldable1 f, Ord k) => + (a -> a -> a) -> + f (NEMap k a) -> + NEMap k a +unionsWith f (F1.toNonEmpty -> (m :| ms)) = F.foldl' (unionWith f) m ms +{-# INLINE unionsWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Difference of two maps. +-- Return elements of the first map not existing in the second map. +-- +-- Returns a potentially empty map ('Map'), in case the first map is +-- a subset of the second map. +-- +-- > difference (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 3 "b" +difference :: + Ord k => + NEMap k a -> + NEMap k b -> + Map k a +difference n1@(NEMap k1 v1 m1) n2@(NEMap k2 _ m2) = case compare k1 k2 of + -- k1 is not in n2, so cannot be deleted + LT -> insertMinMap k1 v1 $ m1 `M.difference` toMap n2 + -- k2 deletes k1, and only k1 + EQ -> m1 `M.difference` m2 + -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. + GT -> toMap n1 `M.difference` m2 +{-# INLINE difference #-} + +-- | Same as 'difference'. +(\\) :: + Ord k => + NEMap k a -> + NEMap k b -> + Map k a +(\\) = difference +{-# INLINE (\\) #-} + +-- | /O(n+m)/. Difference with a combining function. +-- When two equal keys are +-- encountered, the combining function is applied to the values of these keys. +-- If it returns 'Nothing', the element is discarded (proper set difference). If +-- it returns (@'Just' y@), the element is updated with a new value @y@. +-- +-- Returns a potentially empty map ('Map'), in case the first map is +-- a subset of the second map and the function returns 'Nothing' for every +-- pair. +-- +-- > let f al ar = if al == "b" then Just (al ++ ":" ++ ar) else Nothing +-- > differenceWith f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (7, "C")])) +-- > == Data.Map.singleton 3 "b:B" +differenceWith :: + Ord k => + (a -> b -> Maybe a) -> + NEMap k a -> + NEMap k b -> + Map k a +differenceWith f = differenceWithKey (const f) +{-# INLINE differenceWith #-} + +-- | /O(n+m)/. Difference with a combining function. When two equal keys are +-- encountered, the combining function is applied to the key and both values. +-- If it returns 'Nothing', the element is discarded (proper set difference). If +-- it returns (@'Just' y@), the element is updated with a new value @y@. +-- +-- Returns a potentially empty map ('Map'), in case the first map is +-- a subset of the second map and the function returns 'Nothing' for every +-- pair. +-- +-- > let f k al ar = if al == "b" then Just ((show k) ++ ":" ++ al ++ "|" ++ ar) else Nothing +-- > differenceWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(3, "B"), (10, "C")])) +-- > == Data.Map.singleton 3 "3:b|B" +differenceWithKey :: + Ord k => + (k -> a -> b -> Maybe a) -> + NEMap k a -> + NEMap k b -> + Map k a +differenceWithKey f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + -- k1 is not in n2, so cannot be deleted + LT -> insertMinMap k1 v1 $ M.differenceWithKey f m1 (toMap n2) + -- k2 deletes k1, and only k1 + EQ -> maybe id (insertMinMap k1) (f k1 v1 v2) (M.differenceWithKey f m1 m2) + -- k2 is not in n1, so cannot delete anything, so we can just difference n1 // m2. + GT -> M.differenceWithKey f (toMap n1) m2 +{-# INLINE differenceWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection of two maps. +-- Return data in the first map for the keys existing in both maps. +-- (@'intersection' m1 m2 == 'intersectionWith' 'const' m1 m2@). +-- +-- Returns a potentially empty map ('Map'), in case the two maps share no +-- keys in common. +-- +-- > intersection (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 5 "a" +intersection :: + Ord k => + NEMap k a -> + NEMap k b -> + Map k a +intersection n1@(NEMap k1 v1 m1) n2@(NEMap k2 _ m2) = case compare k1 k2 of + -- k1 is not in n2 + LT -> m1 `M.intersection` toMap n2 + -- k1 and k2 are a part of the result + EQ -> insertMinMap k1 v1 $ m1 `M.intersection` m2 + -- k2 is not in n1 + GT -> toMap n1 `M.intersection` m2 +{-# INLINE intersection #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. +-- +-- Returns a potentially empty map ('Map'), in case the two maps share no +-- keys in common. +-- +-- > intersectionWith (++) (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 5 "aA" +intersectionWith :: + Ord k => + (a -> b -> c) -> + NEMap k a -> + NEMap k b -> + Map k c +intersectionWith f = intersectionWithKey (const f) +{-# INLINE intersectionWith #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Intersection with a combining function. +-- +-- Returns a potentially empty map ('Map'), in case the two maps share no +-- keys in common. +-- +-- > let f k al ar = (show k) ++ ":" ++ al ++ "|" ++ ar +-- > intersectionWithKey f (fromList ((5, "a") :| [(3, "b")])) (fromList ((5, "A") :| [(7, "C")])) == Data.Map.singleton 5 "5:a|A" +intersectionWithKey :: + Ord k => + (k -> a -> b -> c) -> + NEMap k a -> + NEMap k b -> + Map k c +intersectionWithKey f n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + -- k1 is not in n2 + LT -> M.intersectionWithKey f m1 (toMap n2) + -- k1 and k2 are a part of the result + EQ -> insertMinMap k1 (f k1 v1 v2) $ M.intersectionWithKey f m1 m2 + -- k2 is not in n1 + GT -> M.intersectionWithKey f (toMap n1) m2 +{-# INLINE intersectionWithKey #-} + +-- | /O(n)/. A strict version of 'foldr1'. Each application of the operator +-- is evaluated before using the result in the next application. This +-- function is strict in the starting value. +foldr1' :: (a -> a -> a) -> NEMap k a -> a +foldr1' f (NEMap _ v m) = case M.maxView m of + Nothing -> v + Just (y, m') -> let !z = M.foldr' f y m' in v `f` z +{-# INLINE foldr1' #-} + +-- | /O(n)/. A strict version of 'foldl1'. Each application of the operator +-- is evaluated before using the result in the next application. This +-- function is strict in the starting value. +foldl1' :: (a -> a -> a) -> NEMap k a -> a +foldl1' f (NEMap _ v m) = M.foldl' f v m +{-# INLINE foldl1' #-} + +-- | /O(n)/. Fold the keys and values in the map using the given right-associative +-- binary operator, such that +-- @'foldrWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@. +-- +-- For example, +-- +-- > keysList map = foldrWithKey (\k x ks -> k:ks) [] map +foldrWithKey :: (k -> a -> b -> b) -> b -> NEMap k a -> b +foldrWithKey f z (NEMap k v m) = f k v . M.foldrWithKey f z $ m +{-# INLINE foldrWithKey #-} + +-- | /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. +foldrWithKey' :: (k -> a -> b -> b) -> b -> NEMap k a -> b +foldrWithKey' f z (NEMap k v m) = f k v y + where + !y = M.foldrWithKey f z m +{-# INLINE foldrWithKey' #-} + +-- | /O(n)/. Fold the keys and values in the map using the given left-associative +-- binary operator, such that +-- @'foldlWithKey' f z == 'Prelude.foldl' (\\z' (kx, x) -> f z' kx x) z . 'toAscList'@. +-- +-- For example, +-- +-- > keysList = reverse . foldlWithKey (\ks k x -> k:ks) [] +foldlWithKey :: (a -> k -> b -> a) -> a -> NEMap k b -> a +foldlWithKey f z (NEMap k v m) = M.foldlWithKey f (f z k v) m +{-# INLINE foldlWithKey #-} + +-- | /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. +foldlWithKey' :: (a -> k -> b -> a) -> a -> NEMap k b -> a +foldlWithKey' f z (NEMap k v m) = M.foldlWithKey' f x m + where + !x = f z k v +{-# INLINE foldlWithKey' #-} + +-- | /O(n)/. Return all keys of the map in ascending order. +-- +-- > keys (fromList ((5,"a") :| [(3,"b")])) == (3 :| [5]) +keys :: NEMap k a -> NonEmpty k +keys (NEMap k _ m) = k :| M.keys m +{-# INLINE keys #-} + +-- | /O(n)/. An alias for 'toAscList'. Return all key\/value pairs in the map +-- in ascending key order. +-- +-- > assocs (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +assocs :: NEMap k a -> NonEmpty (k, a) +assocs = toList +{-# INLINE assocs #-} + +-- | /O(n)/. The non-empty set of all keys of the map. +-- +-- > keysSet (fromList ((5,"a") :| [(3,"b")])) == Data.Set.NonEmpty.fromList (3 :| [5]) +keysSet :: NEMap k a -> NESet k +keysSet (NEMap k _ m) = NESet k (M.keysSet m) +{-# INLINE keysSet #-} + +-- | /O(n)/. Map a function over all values in the map. +-- +-- > let f key x = (show key) ++ ":" ++ x +-- > mapWithKey f (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "3:b") :| [(5, "5:a")]) +mapWithKey :: (k -> a -> b) -> NEMap k a -> NEMap k b +mapWithKey f (NEMap k v m) = NEMap k (f k v) (M.mapWithKey f m) +{-# NOINLINE [1] mapWithKey #-} + +{-# RULES +"mapWithKey/mapWithKey" forall f g xs. + mapWithKey f (mapWithKey g xs) = + mapWithKey (\k a -> f k (g k a)) xs +"mapWithKey/map" forall f g xs. + mapWithKey f (map g xs) = + mapWithKey (\k a -> f k (g a)) xs +"map/mapWithKey" forall f g xs. + map f (mapWithKey g xs) = + mapWithKey (\k a -> f (g k a)) xs + #-} + +-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys are +-- in ascending order. +-- +-- > toAscList (fromList ((5,"a") :| [(3,"b")])) == ((3,"b") :| [(5,"a")]) +toAscList :: NEMap k a -> NonEmpty (k, a) +toAscList = toList +{-# INLINE toAscList #-} + +-- | /O(n)/. Convert the map to a list of key\/value pairs where the keys +-- are in descending order. +-- +-- > toDescList (fromList ((5,"a") :| [(3,"b")])) == ((5,"a") :| [(3,"b")]) +toDescList :: NEMap k a -> NonEmpty (k, a) +toDescList (NEMap k0 v0 m) = M.foldlWithKey' go ((k0, v0) :| []) m + where + go xs k v = (k, v) NE.<| xs +{-# INLINE toDescList #-} + +-- | /O(log n)/. Convert a 'Map' into an 'NEMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. If key is already present, +-- will overwrite the original value. +-- +-- See 'insertMapMin' for a version that is constant-time if the new key is +-- /strictly smaller than/ all keys in the original map. +-- +-- > insertMap 4 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) +-- > insertMap 4 "c" Data.Map.empty == singleton 4 "c" +insertMap :: Ord k => k -> a -> Map k a -> NEMap k a +insertMap k v = withNonEmpty (singleton k v) (insert k v) +{-# INLINE insertMap #-} + +-- | /O(log n)/. Convert a 'Map' into an 'NEMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. Uses a combining function +-- with the new value as the first argument if the key is already present. +-- +-- > insertMapWith (++) 4 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(4,"c"), (5,"a")]) +-- > insertMapWith (++) 5 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"ca")]) +insertMapWith :: + Ord k => + (a -> a -> a) -> + k -> + a -> + Map k a -> + NEMap k a +insertMapWith f k v = withNonEmpty (singleton k v) (insertWith f k v) +{-# INLINE insertMapWith #-} + +-- | /O(log n)/. Convert a 'Map' into an 'NEMap' by adding a key-value +-- pair. Because of this, we know that the map must have at least one +-- element, and so therefore cannot be empty. Uses a combining function +-- with the key and new value as the first and second arguments if the key +-- is already present. +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertWithKey f 5 "xxx" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "5:xxx|a")]) +-- > insertWithKey f 7 "xxx" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +-- > insertWithKey f 5 "xxx" Data.Map.empty == singleton 5 "xxx" +insertMapWithKey :: + Ord k => + (k -> a -> a -> a) -> + k -> + a -> + Map k a -> + NEMap k a +insertMapWithKey f k v = withNonEmpty (singleton k v) (insertWithKey f k v) +{-# INLINE insertMapWithKey #-} + +-- | /O(1)/ Convert a 'Map' into an 'NEMap' by adding a key-value pair +-- where the key is /strictly less than/ all keys in the input map. The +-- keys in the original map must all be /strictly greater than/ the new +-- key. /The precondition is not checked./ +-- +-- > insertMapMin 2 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((2,"c") :| [(3,"b"), (5,"a")]) +-- > valid (insertMapMin 2 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == True +-- > valid (insertMapMin 7 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False +-- > valid (insertMapMin 3 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False +insertMapMin :: + k -> + a -> + Map k a -> + NEMap k a +insertMapMin = NEMap +{-# INLINE insertMapMin #-} + +-- | /O(log n)/ Convert a 'Map' into an 'NEMap' by adding a key-value pair +-- where the key is /strictly greater than/ all keys in the input map. The +-- keys in the original map must all be /strictly less than/ the new +-- key. /The precondition is not checked./ +-- +-- While this has the same asymptotics as 'insertMap', it saves a constant +-- factor for key comparison (so may be helpful if comparison is expensive) +-- and also does not require an 'Ord' instance for the key type. +-- +-- > insertMap 7 "c" (Data.Map.fromList [(5,"a"), (3,"b")]) == fromList ((3,"b") :| [(5,"a"), (7,"c")]) +-- > valid (insertMap 7 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == True +-- > valid (insertMap 2 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False +-- > valid (insertMap 5 "c" (Data.Map.fromList [(5,"a"), (3,"b")])) == False +insertMapMax :: + k -> + a -> + Map k a -> + NEMap k a +insertMapMax k v = withNonEmpty (singleton k v) go + where + go (NEMap k0 v0 m0) = NEMap k0 v0 . insertMaxMap k v $ m0 +{-# INLINE insertMapMax #-} + +-- | /O(log n)/. Insert a new key and value in the map. +-- If the key is already present in the map, the associated value is +-- replaced with the supplied value. 'insert' is equivalent to +-- @'insertWith' 'const'@. +-- +-- See 'insertMap' for a version where the first argument is a 'Map'. +-- +-- > insert 5 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'x')]) +-- > insert 7 'x' (fromList ((5,'a') :| [(3,'b')])) == fromList ((3, 'b') :| [(5, 'a'), (7, 'x')]) +insert :: + Ord k => + k -> + a -> + NEMap k a -> + NEMap k a +insert k v n@(NEMap k0 v0 m) = case compare k k0 of + LT -> NEMap k v . toMap $ n + EQ -> NEMap k v m + GT -> NEMap k0 v0 . M.insert k v $ m +{-# INLINE insert #-} + +-- | /O(log n)/. Insert with a function, combining key, new value and old +-- value. @'insertWithKey' f key value mp@ will insert the pair (key, +-- value) into @mp@ if key does not exist in the map. If the key does +-- exist, the function will insert the pair @(key,f key new_value +-- old_value)@. Note that the key passed to f is the same key passed to +-- 'insertWithKey'. +-- +-- See 'insertMapWithKey' for a version where the first argument is a 'Map'. +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:xxx|a")]) +-- > insertWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a"), (7, "xxx")]) +insertWithKey :: + Ord k => + (k -> a -> a -> a) -> + k -> + a -> + NEMap k a -> + NEMap k a +insertWithKey f k v n@(NEMap k0 v0 m) = case compare k k0 of + LT -> NEMap k v . toMap $ n + EQ -> NEMap k (f k v v0) m + GT -> NEMap k0 v0 $ M.insertWithKey f k v m +{-# INLINE insertWithKey #-} + +-- | /O(log n)/. Combines insert operation with old value retrieval. The +-- expression (@'insertLookupWithKey' f k x map@) is a pair where the first +-- element is equal to (@'lookup' k map@) and the second element equal to +-- (@'insertWithKey' f k x map@). +-- +-- > let f key new_value old_value = (show key) ++ ":" ++ new_value ++ "|" ++ old_value +-- > insertLookupWithKey f 5 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "5:xxx|a")])) +-- > insertLookupWithKey f 7 "xxx" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "xxx")])) +-- +-- This is how to define @insertLookup@ using @insertLookupWithKey@: +-- +-- > let insertLookup kx x t = insertLookupWithKey (\_ a _ -> a) kx x t +-- > insertLookup 5 "x" (fromList ((5,"a") :| [(3,"b")])) == (Just "a", fromList ((3, "b") :| [(5, "x")])) +-- > insertLookup 7 "x" (fromList ((5,"a") :| [(3,"b")])) == (Nothing, fromList ((3, "b") :| [(5, "a"), (7, "x")])) +insertLookupWithKey :: + Ord k => + (k -> a -> a -> a) -> + k -> + a -> + NEMap k a -> + (Maybe a, NEMap k a) +insertLookupWithKey f k v n@(NEMap k0 v0 m) = case compare k k0 of + LT -> (Nothing, NEMap k v . toMap $ n) + EQ -> (Just v, NEMap k (f k v v0) m) + GT -> NEMap k0 v0 <$> M.insertLookupWithKey f k v m +{-# INLINE insertLookupWithKey #-} + +-- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs +-- with a combining function. See also 'fromAscListWith'. +-- +-- > fromListWith (++) ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "ab") :| [(5, "aba")]) +fromListWith :: + Ord k => + (a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromListWith f = fromListWithKey (const f) +{-# INLINE fromListWith #-} + +-- | /O(n*log n)/. Build a map from a non-empty list of key\/value pairs +-- with a combining function. See also 'fromAscListWithKey'. +-- +-- > let f k a1 a2 = (show k) ++ a1 ++ a2 +-- > fromListWithKey f ((5,"a") :| [(5,"b"), (3,"b"), (3,"a"), (5,"a")]) == fromList ((3, "3ab") :| [(5, "5a5ba")]) +fromListWithKey :: + Ord k => + (k -> a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromListWithKey f ((k0, v0) :| xs) = F.foldl' go (singleton k0 v0) xs + where + go m (k, v) = insertWithKey f k v m + {-# INLINE go #-} +{-# INLINE fromListWithKey #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time. +-- /The precondition (input list is ascending) is not checked./ +-- +-- > fromAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) +-- > fromAscList ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "b")]) +-- > valid (fromAscList ((3,"b") :| [(5,"a"), (5,"b")])) == True +-- > valid (fromAscList ((5,"a") :| [(3,"b"), (5,"b")])) == False +fromAscList :: + Eq k => + NonEmpty (k, a) -> + NEMap k a +fromAscList = fromDistinctAscList . combineEq +{-# INLINE fromAscList #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is ascending) is not checked./ +-- +-- > fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b")]) == fromList ((3, "b") :| [(5, "ba")]) +-- > valid (fromAscListWith (++) ((3,"b") :| [(5,"a"), (5,"b"))]) == True +-- > valid (fromAscListWith (++) ((5,"a") :| [(3,"b"), (5,"b"))]) == False +fromAscListWith :: + Eq k => + (a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromAscListWith f = fromAscListWithKey (const f) +{-# INLINE fromAscListWith #-} + +-- | /O(n)/. Build a map from an ascending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is ascending) is not checked./ +-- +-- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 +-- > fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")]) == fromList ((3, "b") :| [(5, "5:b5:ba")]) +-- > valid (fromAscListWithKey f ((3,"b") :| [(5,"a"), (5,"b"), (5,"b")])) == True +-- > valid (fromAscListWithKey f ((5,"a") :| [(3,"b"), (5,"b"), (5,"b")])) == False +fromAscListWithKey :: + Eq k => + (k -> a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromAscListWithKey f = fromDistinctAscList . combineEqWith f +{-# INLINE fromAscListWithKey #-} + +-- | /O(n)/. Build a map from an ascending non-empty list of distinct +-- elements in linear time. /The precondition is not checked./ +-- +-- > fromDistinctAscList ((3,"b") :| [(5,"a")]) == fromList ((3, "b") :| [(5, "a")]) +-- > valid (fromDistinctAscList ((3,"b") :| [(5,"a")])) == True +-- > valid (fromDistinctAscList ((3,"b") :| [(5,"a"), (5,"b")])) == False +fromDistinctAscList :: NonEmpty (k, a) -> NEMap k a +fromDistinctAscList ((k, v) :| xs) = + insertMapMin k v + . M.fromDistinctAscList + $ xs +{-# INLINE fromDistinctAscList #-} + +-- | /O(n)/. Build a map from a descending non-empty list in linear time. +-- /The precondition (input list is descending) is not checked./ +-- +-- > fromDescList ((5,"a") :| [(3,"b")]) == fromList ((3, "b") :| [(5, "a")]) +-- > fromDescList ((5,"a") :| [(5,"b"), (3,"b")]) == fromList ((3, "b") :| [(5, "b")]) +-- > valid (fromDescList ((5,"a") :| [(5,"b"), (3,"b")])) == True +-- > valid (fromDescList ((5,"a") :| [(3,"b"), (5,"b")])) == False +fromDescList :: + Eq k => + NonEmpty (k, a) -> + NEMap k a +fromDescList = fromDistinctDescList . combineEq +{-# INLINE fromDescList #-} + +-- | /O(n)/. Build a map from a descending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is descending) is not checked./ +-- +-- > fromDescListWith (++) ((5,"a") :| [(5,"b"), (3,"b")]) == fromList ((3, "b") :| [(5, "ba")]) +-- > valid (fromDescListWith (++) ((5,"a") :| [(5,"b"), (3,"b")])) == True +-- > valid (fromDescListWith (++) ((5,"a") :| [(3,"b"), (5,"b")])) == False +fromDescListWith :: + Eq k => + (a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromDescListWith f = fromDescListWithKey (const f) +{-# INLINE fromDescListWith #-} + +-- | /O(n)/. Build a map from a descending non-empty list in linear time +-- with a combining function for equal keys. /The precondition (input list +-- is descending) is not checked./ +-- +-- > let f k a1 a2 = (show k) ++ ":" ++ a1 ++ a2 +-- > fromDescListWithKey f ((5,"a") :| [(5,"b"), (5,"b"), (3,"b")]) == fromList ((3, "b") :| [(5, "5:b5:ba")]) +-- > valid (fromDescListWithKey f ((5,"a") :| [(5,"b"), (5,"b"), (3,"b")])) == True +-- > valid (fromDescListWithKey f ((5,"a") :| [(3,"b"), (5,"b"), (5,"b")])) == False +fromDescListWithKey :: + Eq k => + (k -> a -> a -> a) -> + NonEmpty (k, a) -> + NEMap k a +fromDescListWithKey f = fromDistinctDescList . combineEqWith f +{-# INLINE fromDescListWithKey #-} + +-- | /O(n)/. Build a map from a descending list of distinct elements in linear time. +-- /The precondition is not checked./ +-- +-- > fromDistinctDescList ((5,"a") :| [(3,"b")]) == fromList ((3, "b") :| [(5, "a")]) +-- > valid (fromDistinctDescList ((5,"a") :| [(3,"b")])) == True +-- > valid (fromDistinctDescList ((5,"a") :| [(5,"b"), (3,"b")])) == False +-- +-- @since 0.5.8 +fromDistinctDescList :: NonEmpty (k, a) -> NEMap k a +fromDistinctDescList ((k, v) :| xs) = + insertMapMax k v + . M.fromDistinctDescList + $ xs +{-# INLINE fromDistinctDescList #-} + +-- | /O(log n)/. Delete a key and its value from the non-empty map. +-- A potentially empty map ('Map') is returned, since this might delete the +-- last item in the 'NEMap'. When the key is not a member of the map, is +-- equivalent to 'toMap'. +-- +-- > delete 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > delete 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.Singleton [(3, "b"), (5, "a")] +delete :: Ord k => k -> NEMap k a -> Map k a +delete k n@(NEMap k0 v m) = case compare k k0 of + LT -> toMap n + EQ -> m + GT -> insertMinMap k0 v . M.delete k $ m +{-# INLINE delete #-} + +-- | /O(log n)/. Delete a key and its value from the non-empty map, returning +-- 'Nothing' if the result would be empty. +-- +-- This is more efficient than @'nonEmptyMap' . 'delete' k@ because it avoids +-- converting the known-minimum representation back through 'Map' when the +-- deleted key is not the minimum. +-- +-- @since 0.3.6.0 +deleteMaybe :: Ord k => k -> NEMap k a -> Maybe (NEMap k a) +deleteMaybe k n@(NEMap k0 v m) = case compare k k0 of + LT -> Just n + EQ -> nonEmptyMap m + GT -> Just . NEMap k0 v . M.delete k $ m +{-# INLINE deleteMaybe #-} + +-- | /O(log n)/. Update a value at a specific key with the result of the +-- provided function. When the key is not a member of the map, the original +-- map is returned. +-- +-- > adjust ("new " ++) 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "new a")]) +-- > adjust ("new " ++) 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) +adjust :: + Ord k => + (a -> a) -> + k -> + NEMap k a -> + NEMap k a +adjust f = adjustWithKey (const f) +{-# INLINE adjust #-} + +-- | /O(log n)/. Adjust a value at a specific key. When the key is not +-- a member of the map, the original map is returned. +-- +-- > let f key x = (show key) ++ ":new " ++ x +-- > adjustWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "5:new a")]) +-- > adjustWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == fromList ((3, "b") :| [(5, "a")]) +adjustWithKey :: + Ord k => + (k -> a -> a) -> + k -> + NEMap k a -> + NEMap k a +adjustWithKey f k n@(NEMap k0 v m) = case compare k k0 of + LT -> n + EQ -> NEMap k0 (f k0 v) m + GT -> NEMap k0 v . M.adjustWithKey f k $ m +{-# INLINE adjustWithKey #-} + +-- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@ +-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is +-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. +-- +-- Returns a potentially empty map ('Map'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEMap'. +-- +-- > let f x = if x == "a" then Just "new a" else Nothing +-- > update f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "new a")] +-- > update f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a")] +-- > update f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +update :: + Ord k => + (a -> Maybe a) -> + k -> + NEMap k a -> + Map k a +update f = updateWithKey (const f) +{-# INLINE update #-} + +-- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the +-- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing', +-- the element is deleted. If it is (@'Just' y@), the key @k@ is bound +-- to the new value @y@. +-- +-- Returns a potentially empty map ('Map'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEMap'. +-- +-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing +-- > updateWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "5:new a")] +-- > updateWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a")] +-- > updateWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +updateWithKey :: + Ord k => + (k -> a -> Maybe a) -> + k -> + NEMap k a -> + Map k a +updateWithKey f k n@(NEMap k0 v m) = case compare k k0 of + LT -> toMap n + EQ -> maybe m (flip (insertMinMap k0) m) . f k0 $ v + GT -> insertMinMap k0 v . M.updateWithKey f k $ m +{-# INLINE updateWithKey #-} + +-- | /O(log n)/. Lookup and update. See also 'updateWithKey'. +-- The function returns changed value, if it is updated. +-- Returns the original key value if the map entry is deleted. +-- +-- Returns a potentially empty map ('Map') in the case that we delete the +-- final key of a singleton map. +-- +-- > let f k x = if x == "a" then Just ((show k) ++ ":new a") else Nothing +-- > updateLookupWithKey f 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "5:new a", Data.Map.fromList ((3, "b") :| [(5, "5:new a")])) +-- > updateLookupWithKey f 7 (fromList ((5,"a") :| [(3,"b")])) == (Nothing, Data.Map.fromList ((3, "b") :| [(5, "a")])) +-- > updateLookupWithKey f 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Data.Map.singleton 5 "a") +updateLookupWithKey :: + Ord k => + (k -> a -> Maybe a) -> + k -> + NEMap k a -> + (Maybe a, Map k a) +updateLookupWithKey f k n@(NEMap k0 v m) = case compare k k0 of + LT -> (Nothing, toMap n) + EQ -> + let u = f k0 v + in (u <|> Just v, maybe m (flip (insertMinMap k0) m) u) + GT -> fmap (insertMinMap k0 v) . M.updateLookupWithKey f k $ m +{-# INLINE updateLookupWithKey #-} + +-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at +-- @k@, or absence thereof. 'alter' can be used to insert, delete, or +-- update a value in a 'Map'. In short : @Data.Map.lookup k ('alter' +-- f k m) = f ('lookup' k m)@. +-- +-- Returns a potentially empty map ('Map'), because we can't know ahead of +-- time if the function returns 'Nothing' and deletes the final item in the +-- 'NEMap'. +-- +-- See 'alterF'' for a version that disallows deletion, and so therefore +-- can return 'NEMap'. +-- +-- > let f _ = Nothing +-- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a")] +-- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > +-- > let f _ = Just "c" +-- > alter f 7 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "a"), (7, "c")] +-- > alter f 5 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "c")] +alter :: + Ord k => + (Maybe a -> Maybe a) -> + k -> + NEMap k a -> + Map k a +alter f k n@(NEMap k0 v m) = case compare k k0 of + LT -> maybe id (insertMinMap k) (f Nothing) (toMap n) + EQ -> maybe id (insertMinMap k0) (f (Just v)) m + GT -> insertMinMap k0 v . M.alter f k $ m +{-# INLINE alter #-} + +-- | /O(log n)/. The expression (@'alterF' f k map@) alters the value @x@ +-- at @k@, or absence thereof. 'alterF' can be used to inspect, insert, +-- delete, or update a value in a 'Map'. In short: @Data.Map.lookup +-- k \<$\> 'alterF' f k m = f ('lookup' k m)@. +-- +-- Example: +-- +-- @ +-- interactiveAlter :: Int -> NEMap Int String -> IO (Map Int String) +-- interactiveAlter k m = alterF f k m where +-- f Nothing = do +-- putStrLn $ show k ++ +-- " was not found in the map. Would you like to add it?" +-- getUserResponse1 :: IO (Maybe String) +-- f (Just old) = do +-- putStrLn $ "The key is currently bound to " ++ show old ++ +-- ". Would you like to change or delete it?" +-- getUserResponse2 :: IO (Maybe String) +-- @ +-- +-- Like @Data.Map.alterF@ for 'Map', 'alterF' can be considered +-- to be a unifying generalization of 'lookup' and 'delete'; however, as +-- a constrast, it cannot be used to implement 'insert', because it must +-- return a 'Map' instead of an 'NEMap' (because the function might delete +-- the final item in the 'NEMap'). When used with trivial functors like +-- 'Identity' and 'Const', it is often slightly slower than +-- specialized 'lookup' and 'delete'. However, when the functor is +-- non-trivial and key comparison is not particularly cheap, it is the +-- fastest way. +-- +-- See 'alterF'' for a version that disallows deletion, and so therefore +-- can return 'NEMap' and be used to implement 'insert' +-- +-- Note on rewrite rules: +-- +-- This module includes GHC rewrite rules to optimize 'alterF' for +-- the 'Const' and 'Identity' functors. In general, these rules +-- improve performance. The sole exception is that when using +-- 'Identity', deleting a key that is already absent takes longer +-- than it would without the rules. If you expect this to occur +-- a very large fraction of the time, you might consider using a +-- private copy of the 'Identity' type. +-- +-- Note: Unlike @Data.Map.alterF@ for 'Map', 'alterF' is /not/ a flipped +-- version of the 'Control.Lens.At.at' combinator from "Control.Lens.At". +-- However, it match the shape expected from most functions expecting +-- lenses, getters, and setters, so can be thought of as a "psuedo-lens", +-- with virtually the same practical applications as a legitimate lens. +alterF :: + (Ord k, Functor f) => + (Maybe a -> f (Maybe a)) -> + k -> + NEMap k a -> + f (Map k a) +alterF f k n@(NEMap k0 v m) = case compare k k0 of + LT -> flip (maybe id (insertMinMap k)) (toMap n) <$> f Nothing + EQ -> flip (maybe id (insertMinMap k0)) m <$> f (Just v) + GT -> insertMinMap k0 v <$> M.alterF f k m +{-# INLINEABLE [2] alterF #-} + +-- if f ~ Const b, it's a lookup +{-# RULES +"alterF/Const" forall k (f :: Maybe a -> Const b (Maybe a)). + alterF f k = + Const . getConst . f . lookup k + #-} + +-- if f ~ Identity, it's an 'alter' +{-# RULES +"alterF/Identity" forall k (f :: Maybe a -> Identity (Maybe a)). + alterF f k = + Identity . alter (runIdentity . f) k + #-} + +-- | /O(log n)/. Variant of 'alter' that disallows deletion. Allows us to +-- guarantee that the result is also a non-empty Map. +alter' :: + Ord k => + (Maybe a -> a) -> + k -> + NEMap k a -> + NEMap k a +alter' f k n@(NEMap k0 v m) = case compare k k0 of + LT -> NEMap k (f Nothing) . toMap $ n + EQ -> NEMap k0 (f (Just v)) m + GT -> NEMap k0 v . M.alter (Just . f) k $ m +{-# INLINE alter' #-} + +-- | /O(log n)/. Variant of 'alterF' that disallows deletion. Allows us to +-- guarantee that the result is also a non-empty Map. +-- +-- Like @Data.Map.alterF@ for 'Map', can be used to generalize and unify +-- 'lookup' and 'insert'. However, because it disallows deletion, it +-- cannot be used to implement 'delete'. +-- +-- See 'alterF' for usage information and caveats. +-- +-- Note: Neither 'alterF' nor 'alterF'' can be considered flipped versions +-- of the 'Control.Lens.At.at' combinator from "Control.Lens.At". However, +-- this can match the shape expected from most functions expecting lenses, +-- getters, and setters, so can be thought of as a "psuedo-lens", with +-- virtually the same practical applications as a legitimate lens. +-- +-- __WARNING__: The rewrite rule for 'Identity' exposes an inconsistency in +-- undefined behavior for "Data.Map". @Data.Map.alterF@ will actually +-- /maintain/ the original key in the map when used with 'Identity'; +-- however, @Data.Map.insertWith@ will /replace/ the orginal key in the +-- map. The rewrite rule for 'alterF'' has chosen to be faithful to +-- @Data.Map.insertWith@, and /not/ @Data.Map.alterF@, for the sake of +-- a cleaner implementation. +alterF' :: + (Ord k, Functor f) => + (Maybe a -> f a) -> + k -> + NEMap k a -> + f (NEMap k a) +alterF' f k n@(NEMap k0 v m) = case compare k k0 of + LT -> flip (NEMap k) (toMap n) <$> f Nothing + EQ -> flip (NEMap k0) m <$> f (Just v) + GT -> NEMap k0 v <$> M.alterF (fmap Just . f) k m +{-# INLINEABLE [2] alterF' #-} + +-- if f ~ Const b, it's a lookup +{-# RULES +"alterF'/Const" forall k (f :: Maybe a -> Const b a). + alterF' f k = + Const . getConst . f . lookup k + #-} + +-- if f ~ Identity, it's an insertWith +{-# RULES +"alterF'/Identity" forall k (f :: Maybe a -> Identity a). + alterF' f k = + Identity . insertWith (\_ -> runIdentity . f . Just) k (runIdentity (f Nothing)) + #-} + +-- | /O(n)/. Traverse keys\/values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('Map'), our function might return +-- 'Nothing' on every item in the 'NEMap'. +-- +-- /Use 'traverseMaybeWithKey1'/ whenever possible (if your 'Applicative' +-- also has 'Apply' instance). This version is provided only for types +-- that do not have 'Apply' instance, since 'Apply' is not at the moment +-- (and might not ever be) an official superclass of 'Applicative'. +traverseMaybeWithKey :: + Applicative t => + (k -> a -> t (Maybe b)) -> + NEMap k a -> + t (Map k b) +traverseMaybeWithKey f (NEMap k0 v m0) = + combine <$> f k0 v <*> M.traverseMaybeWithKey f m0 + where + combine Nothing = id + combine (Just v') = insertMinMap k0 v' +{-# INLINE traverseMaybeWithKey #-} + +-- | /O(n)/. Traverse keys\/values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('Map'), our function might return +-- 'Nothing' on every item in the 'NEMap'. +-- +-- Is more general than 'traverseWithKey', since works with all 'Apply', +-- and not just 'Applicative'. + +-- TODO: benchmark against M.maxView version +traverseMaybeWithKey1 :: + Apply t => + (k -> a -> t (Maybe b)) -> + NEMap k a -> + t (Map k b) +traverseMaybeWithKey1 f (NEMap k0 v m0) = case runMaybeApply m1 of + Left m2 -> combine <$> f k0 v <.> m2 + Right m2 -> (`combine` m2) <$> f k0 v + where + m1 = M.traverseMaybeWithKey (\k -> MaybeApply . Left . f k) m0 + combine Nothing = id + combine (Just v') = insertMinMap k0 v' +{-# INLINE traverseMaybeWithKey1 #-} + +-- | /O(n)/. The function 'mapAccum' threads an accumulating argument +-- through the map in ascending order of keys. +-- +-- > let f a b = (a ++ b, b ++ "X") +-- > mapAccum f "Everything: " (fromList ((5,"a") :| [(3,"b")])) == ("Everything: ba", fromList ((3, "bX") :| [(5, "aX")])) +mapAccum :: + (a -> b -> (a, c)) -> + a -> + NEMap k b -> + (a, NEMap k c) +mapAccum f = mapAccumWithKey (\x _ -> f x) +{-# INLINE mapAccum #-} + +-- | /O(n)/. The function 'mapAccumWithKey' threads an accumulating +-- argument through the map in ascending order of keys. +-- +-- > let f a k b = (a ++ " " ++ (show k) ++ "-" ++ b, b ++ "X") +-- > mapAccumWithKey f "Everything:" (fromList ((5,"a") :| [(3,"b")])) == ("Everything: 3-b 5-a", fromList ((3, "bX") :| [(5, "aX")])) +mapAccumWithKey :: + (a -> k -> b -> (a, c)) -> + a -> + NEMap k b -> + (a, NEMap k c) +mapAccumWithKey f z0 (NEMap k v m) = (z2, NEMap k v' m') + where + ~(z1, v') = f z0 k v + ~(z2, m') = M.mapAccumWithKey f z1 m +{-# INLINE mapAccumWithKey #-} + +-- | /O(n)/. The function 'mapAccumRWithKey' threads an accumulating +-- argument through the map in descending order of keys. +mapAccumRWithKey :: + (a -> k -> b -> (a, c)) -> + a -> + NEMap k b -> + (a, NEMap k c) +mapAccumRWithKey f z0 (NEMap k v m) = (z2, NEMap k v' m') + where + ~(z1, m') = M.mapAccumRWithKey f z0 m + ~(z2, v') = f z1 k v +{-# INLINE mapAccumRWithKey #-} + +-- TODO: what other situations can we take advantage of lazy tuple pattern +-- matching? + +-- | /O(n*log n)/. +-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@. +-- +-- The size of the result may be smaller if @f@ maps two or more distinct +-- keys to the same new key. In this case the value at the greatest of the +-- original keys is retained. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeys (+ 1) (fromList ((5,"a") :| [(3,"b")])) == fromList ((4, "b") :| [(6, "a")]) +-- > mapKeys (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "c" +-- > mapKeys (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "c" +mapKeys :: + Ord k2 => + (k1 -> k2) -> + NEMap k1 a -> + NEMap k2 a +mapKeys f (NEMap k0 v0 m) = + fromListWith const + . ((f k0, v0) :|) + . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] + $ m +{-# INLINEABLE mapKeys #-} + +-- | /O(n*log n)/. +-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@. +-- +-- The size of the result may be smaller if @f@ maps two or more distinct +-- keys to the same new key. In this case the associated values will be +-- combined using @c@. The value at the greater of the two original keys +-- is used as the first argument to @c@. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeysWith (++) (\ _ -> 1) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 1 "cdab" +-- > mapKeysWith (++) (\ _ -> 3) (fromList ((1,"b") :| [(2,"a"), (3,"d"), (4,"c")])) == singleton 3 "cdab" +mapKeysWith :: + Ord k2 => + (a -> a -> a) -> + (k1 -> k2) -> + NEMap k1 a -> + NEMap k2 a +mapKeysWith c f (NEMap k0 v0 m) = + fromListWith c + . ((f k0, v0) :|) + . M.foldrWithKey (\k v kvs -> (f k, v) : kvs) [] + $ m +{-# INLINEABLE mapKeysWith #-} + +-- | /O(n)/. +-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@ +-- is strictly monotonic. +-- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@. +-- /The precondition is not checked./ +-- Semi-formally, we have: +-- +-- > and [x < y ==> f x < f y | x <- ls, y <- ls] +-- > ==> mapKeysMonotonic f s == mapKeys f s +-- > where ls = keys s +-- +-- This means that @f@ maps distinct original keys to distinct resulting keys. +-- This function has better performance than 'mapKeys'. +-- +-- While the size of the result map may be smaller than the input map, the +-- output map is still guaranteed to be non-empty if the input map is +-- non-empty. +-- +-- > mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")])) == fromList ((6, "b") :| [(10, "a")]) +-- > valid (mapKeysMonotonic (\ k -> k * 2) (fromList ((5,"a") :| [(3,"b")]))) == True +-- > valid (mapKeysMonotonic (\ _ -> 1) (fromList ((5,"a") :| [(3,"b")]))) == False +mapKeysMonotonic :: + (k1 -> k2) -> + NEMap k1 a -> + NEMap k2 a +mapKeysMonotonic f (NEMap k v m) = + NEMap (f k) v + . M.mapKeysMonotonic f + $ m +{-# INLINE mapKeysMonotonic #-} + +-- | /O(n)/. Filter all values that satisfy the predicate. +-- +-- Returns a potentially empty map ('Map'), because we could +-- potentailly filter out all items in the original 'NEMap'. +-- +-- > filter (> "a") (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > filter (> "x") (fromList ((5,"a") :| [(3,"b")])) == Data.Map.empty +-- > filter (< "a") (fromList ((5,"a") :| [(3,"b")])) == Data.Map.empty +filter :: + (a -> Bool) -> + NEMap k a -> + Map k a +filter f (NEMap k v m) + | f v = insertMinMap k v . M.filter f $ m + | otherwise = M.filter f m +{-# INLINE filter #-} + +-- | /O(n)/. Filter all keys\/values that satisfy the predicate. +-- +-- Returns a potentially empty map ('Map'), because we could +-- potentailly filter out all items in the original 'NEMap'. +-- +-- > filterWithKey (\k _ -> k > 4) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +filterWithKey :: + (k -> a -> Bool) -> + NEMap k a -> + Map k a +filterWithKey f (NEMap k v m) + | f k v = insertMinMap k v . M.filterWithKey f $ m + | otherwise = M.filterWithKey f m +{-# INLINE filterWithKey #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Restrict an 'NEMap' to only those keys +-- found in a 'Data.Set.Set'. +-- +-- @ +-- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m +-- m \`restrictKeys\` s = m ``intersection`` 'fromSet' (const ()) s +-- @ +restrictKeys :: + Ord k => + NEMap k a -> + Set k -> + Map k a +restrictKeys n@(NEMap k v m) xs = case S.minView xs of + Nothing -> M.empty + Just (y, ys) -> case compare k y of + -- k is not in xs + LT -> m `M.restrictKeys` xs + -- k and y are a part of the result + EQ -> insertMinMap k v $ m `M.restrictKeys` ys + -- y is not in m + GT -> toMap n `M.restrictKeys` ys +{-# INLINE restrictKeys #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Data.Set.Set' from +-- an 'NEMap'. +-- +-- @ +-- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m +-- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s +-- @ +withoutKeys :: + Ord k => + NEMap k a -> + Set k -> + Map k a +withoutKeys n@(NEMap k v m) xs = case S.minView xs of + Nothing -> toMap n + Just (y, ys) -> case compare k y of + -- k is not in xs, so cannot be deleted + LT -> insertMinMap k v $ m `M.withoutKeys` xs + -- y deletes k, and only k + EQ -> m `M.withoutKeys` ys + -- y is not in n, so cannot delete anything, so we can just difference n and ys + GT -> toMap n `M.withoutKeys` ys +{-# INLINE withoutKeys #-} + +-- | /O(n)/. Partition the map according to a predicate. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate was true for all items. +-- * @'That' n2@ means that the predicate was false for all items. +-- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the +-- predicate) and @n2@ (all of the items that were false for the +-- predicate). +-- +-- See also 'split'. +-- +-- > partition (> "a") (fromList ((5,"a") :| [(3,"b")])) == These (singleton 3 "b") (singleton 5 "a") +-- > partition (< "x") (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) +-- > partition (> "x") (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) +partition :: + (a -> Bool) -> + NEMap k a -> + These (NEMap k a) (NEMap k a) +partition f = partitionWithKey (const f) +{-# INLINE partition #-} + +-- | /O(n)/. Partition the map according to a predicate. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate was true for all items, +-- returning the original map. +-- * @'That' n2@ means that the predicate was false for all items, +-- returning the original map. +-- * @'These' n1 n2@ gives @n1@ (all of the items that were true for the +-- predicate) and @n2@ (all of the items that were false for the +-- predicate). +-- +-- See also 'split'. +-- +-- > partitionWithKey (\ k _ -> k > 3) (fromList ((5,"a") :| [(3,"b")])) == These (singleton 5 "a") (singleton 3 "b") +-- > partitionWithKey (\ k _ -> k < 7) (fromList ((5,"a") :| [(3,"b")])) == This (fromList ((3, "b") :| [(5, "a")])) +-- > partitionWithKey (\ k _ -> k > 7) (fromList ((5,"a") :| [(3,"b")])) == That (fromList ((3, "b") :| [(5, "a")])) +partitionWithKey :: + (k -> a -> Bool) -> + NEMap k a -> + These (NEMap k a) (NEMap k a) +partitionWithKey f n@(NEMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) + | f k v -> This n + | otherwise -> That n + (Just n1, Nothing) + | f k v -> This n + | otherwise -> These n1 (singleton k v) + (Nothing, Just n2) + | f k v -> These (singleton k v) n2 + | otherwise -> That n + (Just n1, Just n2) + | f k v -> These (insertMapMin k v m1) n2 + | otherwise -> These n1 (insertMapMin k v m2) + where + (m1, m2) = M.partitionWithKey f m0 +{-# INLINEABLE partitionWithKey #-} + +-- | /O(log n)/. Take while a predicate on the keys holds. +-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, +-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'. +-- +-- Returns a potentially empty map ('Map'), because the predicate might +-- fail on the first input. +-- +-- @ +-- takeWhileAntitone p = Data.Map.fromDistinctAscList . Data.List.takeWhile (p . fst) . Data.Foldable.toList +-- takeWhileAntitone p = 'filterWithKey' (\k _ -> p k) +-- @ +takeWhileAntitone :: + (k -> Bool) -> + NEMap k a -> + Map k a +takeWhileAntitone f (NEMap k v m) + | f k = insertMinMap k v . M.takeWhileAntitone f $ m + | otherwise = M.empty +{-# INLINE takeWhileAntitone #-} + +-- | /O(log n)/. Drop while a predicate on the keys holds. +-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, +-- @j \< k ==\> p j \>= p k@. See note at 'spanAntitone'. +-- +-- @ +-- dropWhileAntitone p = Data.Map.fromDistinctAscList . Data.List.dropWhile (p . fst) . Data.Foldable.toList +-- dropWhileAntitone p = 'filterWithKey' (\k -> not (p k)) +-- @ +dropWhileAntitone :: + (k -> Bool) -> + NEMap k a -> + Map k a +dropWhileAntitone f n@(NEMap k _ m) + | f k = M.dropWhileAntitone f m + | otherwise = toMap n +{-# INLINE dropWhileAntitone #-} + +-- | /O(log n)/. Divide a map at the point where a predicate on the keys stops holding. +-- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, +-- @j \< k ==\> p j \>= p k@. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the predicate never failed for any item, +-- returning the original map. +-- * @'That' n2@ means that the predicate failed for the first item, +-- returning the original map. +-- * @'These' n1 n2@ gives @n1@ (the map up to the point where the +-- predicate on the keys stops holding) and @n2@ (the map starting from +-- the point where the predicate stops holding) +-- +-- @ +-- spanAntitone p xs = partitionWithKey (\k _ -> p k) xs +-- @ +-- +-- Note: if @p@ is not actually antitone, then @spanAntitone@ will split the map +-- at some /unspecified/ point where the predicate switches from holding to not +-- holding (where the predicate is seen to hold before the first key and to fail +-- after the last key). +spanAntitone :: + (k -> Bool) -> + NEMap k a -> + These (NEMap k a) (NEMap k a) +spanAntitone f n@(NEMap k v m0) + | f k = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This n + (Just _, Nothing) -> This n + (Nothing, Just n2) -> These (singleton k v) n2 + (Just _, Just n2) -> These (insertMapMin k v m1) n2 + | otherwise = That n + where + (m1, m2) = M.spanAntitone f m0 +{-# INLINEABLE spanAntitone #-} + +-- | /O(n)/. Map values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('Map'), because the function could +-- potentially return 'Nothing' on all items in the 'NEMap'. +-- +-- > let f x = if x == "a" then Just "new a" else Nothing +-- > mapMaybe f (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "new a" +mapMaybe :: + (a -> Maybe b) -> + NEMap k a -> + Map k b +mapMaybe f = mapMaybeWithKey (const f) +{-# INLINE mapMaybe #-} + +-- | /O(n)/. Map keys\/values and collect the 'Just' results. +-- +-- Returns a potentially empty map ('Map'), because the function could +-- potentially return 'Nothing' on all items in the 'NEMap'. +-- +-- > let f k _ = if k < 5 then Just ("key : " ++ (show k)) else Nothing +-- > mapMaybeWithKey f (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "key : 3" +mapMaybeWithKey :: + (k -> a -> Maybe b) -> + NEMap k a -> + Map k b +mapMaybeWithKey f (NEMap k v m) = maybe id (insertMinMap k) (f k v) (M.mapMaybeWithKey f m) +{-# INLINE mapMaybeWithKey #-} + +-- | /O(n)/. Map values and separate the 'Left' and 'Right' results. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the results were all 'Left'. +-- * @'That' n2@ means that the results were all 'Right'. +-- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- and @n2@ (the map where the results were 'Right') +-- +-- > let f a = if a < "c" then Left a else Right a +-- > mapEither f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == These (fromList ((3,"b") :| [(5,"a")])) (fromList ((1,"x") :| [(7,"z")])) +-- > +-- > mapEither (\ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == That (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +mapEither :: + (a -> Either b c) -> + NEMap k a -> + These (NEMap k b) (NEMap k c) +mapEither f = mapEitherWithKey (const f) +{-# INLINE mapEither #-} + +-- | /O(n)/. Map keys\/values and separate the 'Left' and 'Right' results. +-- +-- Returns a 'These' with potentially two non-empty maps: +-- +-- * @'This' n1@ means that the results were all 'Left'. +-- * @'That' n2@ means that the results were all 'Right'. +-- * @'These' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- and @n2@ (the map where the results were 'Right') +-- +-- > let f k a = if k < 5 then Left (k * 2) else Right (a ++ a) +-- > mapEitherWithKey f (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == These (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) +-- > +-- > mapEitherWithKey (\_ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) +-- > == That (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) +mapEitherWithKey :: + (k -> a -> Either b c) -> + NEMap k a -> + These (NEMap k b) (NEMap k c) +mapEitherWithKey f (NEMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> case f k v of + Left v' -> This (singleton k v') + Right v' -> That (singleton k v') + (Just n1, Nothing) -> case f k v of + Left v' -> This (insertMapMin k v' m1) + Right v' -> These n1 (singleton k v') + (Nothing, Just n2) -> case f k v of + Left v' -> These (singleton k v') n2 + Right v' -> That (insertMapMin k v' m2) + (Just n1, Just n2) -> case f k v of + Left v' -> These (insertMapMin k v' m1) n2 + Right v' -> These n1 (insertMapMin k v' m2) + where + (m1, m2) = M.mapEitherWithKey f m0 +{-# INLINEABLE mapEitherWithKey #-} + +-- | /O(log n)/. The expression (@'split' k map@) is potentially a 'These' +-- containing up to two 'NEMap's based on splitting the map into maps +-- containing items before and after the given key @k@. It will never +-- return a map that contains @k@ itself. +-- +-- * 'Nothing' means that @k@ was the only key in the the original map, +-- and so there are no items before or after it. +-- * @'Just' ('This' n1)@ means @k@ was larger than or equal to all items +-- in the map, and @n1@ is the entire original map (minus @k@, if it was +-- present) +-- * @'Just' ('That' n2)@ means @k@ was smaller than or equal to all +-- items in the map, and @n2@ is the entire original map (minus @k@, if +-- it was present) +-- * @'Just' ('These' n1 n2)@ gives @n1@ (the map of all keys from the +-- original map less than @k@) and @n2@ (the map of all keys from the +-- original map greater than @k@) +-- +-- > split 2 (fromList ((5,"a") :| [(3,"b")])) == Just (That (fromList ((3,"b") :| [(5,"a")])) ) +-- > split 3 (fromList ((5,"a") :| [(3,"b")])) == Just (That (singleton 5 "a") ) +-- > split 4 (fromList ((5,"a") :| [(3,"b")])) == Just (These (singleton 3 "b") (singleton 5 "a")) +-- > split 5 (fromList ((5,"a") :| [(3,"b")])) == Just (This (singleton 3 "b") ) +-- > split 6 (fromList ((5,"a") :| [(3,"b")])) == Just (This (fromList ((3,"b") :| [(5,"a")])) ) +-- > split 5 (singleton 5 "a") == Nothing +split :: + Ord k => + k -> + NEMap k a -> + Maybe (These (NEMap k a) (NEMap k a)) +split k n@(NEMap k0 v m0) = case compare k k0 of + LT -> Just $ That n + EQ -> That <$> nonEmptyMap m0 + GT -> Just $ case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k0 v) + (Just _, Nothing) -> This (insertMapMin k0 v m1) + (Nothing, Just n2) -> These (singleton k0 v) n2 + (Just _, Just n2) -> These (insertMapMin k0 v m1) n2 + where + (m1, m2) = M.split k m0 +{-# INLINEABLE split #-} + +-- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just +-- like 'split' but also returns @'lookup' k map@, as the first field in +-- the 'These': +-- +-- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == That (That (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == These "b" (That (singleton 5 "a")) +-- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == That (These (singleton 3 "b") (singleton 5 "a")) +-- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == These "a" (This (singleton 3 "b")) +-- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == That (This (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 5 (singleton 5 "a") == This "a" +splitLookup :: + Ord k => + k -> + NEMap k a -> + These a (These (NEMap k a) (NEMap k a)) +splitLookup k n@(NEMap k0 v0 m0) = case compare k k0 of + LT -> That . That $ n + EQ -> maybe (This v0) (These v0 . That) . nonEmptyMap $ m0 + GT -> maybe That These v $ case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k0 v0) + (Just _, Nothing) -> This (insertMapMin k0 v0 m1) + (Nothing, Just n2) -> These (singleton k0 v0) n2 + (Just _, Just n2) -> These (insertMapMin k0 v0 m1) n2 + where + (m1, v, m2) = M.splitLookup k m0 +{-# INLINEABLE splitLookup #-} + +-- | /O(1)/. Decompose a map into pieces based on the structure of the +-- underlying tree. This function is useful for consuming a map in +-- parallel. +-- +-- No guarantee is made as to the sizes of the pieces; an internal, but +-- deterministic process determines this. However, it is guaranteed that +-- the pieces returned will be in ascending order (all elements in the +-- first submap less than all elements in the second, and so on). +-- +-- Note that the current implementation does not return more than four +-- submaps, but you should not depend on this behaviour because it can +-- change in the future without notice. +splitRoot :: + NEMap k a -> + NonEmpty (NEMap k a) +splitRoot (NEMap k v m) = + singleton k v + :| Maybe.mapMaybe nonEmptyMap (M.splitRoot m) +{-# INLINE splitRoot #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@). +isSubmapOf :: (Ord k, Eq a) => NEMap k a -> NEMap k a -> Bool +isSubmapOf = isSubmapOfBy (==) +{-# INLINE isSubmapOf #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. +-- The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if +-- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when +-- applied to their respective values. For example, the following +-- expressions are all 'True': +-- +-- > isSubmapOfBy (==) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (<=) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (fromList (('a',1) :| [('b',2)])) +-- +-- But the following are all 'False': +-- +-- > isSubmapOfBy (==) (singleton 'a' 2) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (<) (singleton 'a' 1) (fromList (('a',1) :| [('b',2)])) +-- > isSubmapOfBy (==) (fromList (('a',1) :| [('b',2)])) (singleton 'a' 1) +isSubmapOfBy :: + Ord k => + (a -> b -> Bool) -> + NEMap k a -> + NEMap k b -> + Bool +isSubmapOfBy f (NEMap k v m0) (toMap -> m1) = + kvSub + && M.isSubmapOfBy f m0 m1 + where + kvSub = case M.lookup k m1 of + Just v0 -> f v v0 + Nothing -> False +{-# INLINE isSubmapOfBy #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap +-- but not equal). Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' +-- (==)@). +isProperSubmapOf :: (Ord k, Eq a) => NEMap k a -> NEMap k a -> Bool +isProperSubmapOf = isProperSubmapOfBy (==) +{-# INLINE isProperSubmapOf #-} + +-- | /O(m*log(n\/m + 1)), m <= n/. Is this a proper submap? (ie. a submap +-- but not equal). The expression (@'isProperSubmapOfBy' f m1 m2@) returns +-- 'True' when @m1@ and @m2@ are not equal, all keys in @m1@ are in @m2@, +-- and when @f@ returns 'True' when applied to their respective values. For +-- example, the following expressions are all 'True': +-- +-- > isProperSubmapOfBy (==) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +-- > isProperSubmapOfBy (<=) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +-- +-- But the following are all 'False': +-- +-- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (fromList ((1,1) :| [(2,2)])) +-- > isProperSubmapOfBy (==) (fromList ((1,1) :| [(2,2)])) (singleton 1 1)) +-- > isProperSubmapOfBy (<) (singleton 1 1) (fromList ((1,1) :| [(2,2)])) +isProperSubmapOfBy :: + Ord k => + (a -> b -> Bool) -> + NEMap k a -> + NEMap k b -> + Bool +isProperSubmapOfBy f m1 m2 = + M.size (nemMap m1) < M.size (nemMap m2) + && isSubmapOfBy f m1 m2 +{-# INLINE isProperSubmapOfBy #-} + +-- | /O(log n)/. Lookup the /index/ of a key, which is its zero-based index +-- in the sequence sorted by keys. The index is a number from /0/ up to, +-- but not including, the 'size' of the map. +-- +-- > isJust (lookupIndex 2 (fromList ((5,"a") :| [(3,"b")]))) == False +-- > fromJust (lookupIndex 3 (fromList ((5,"a") :| [(3,"b")]))) == 0 +-- > fromJust (lookupIndex 5 (fromList ((5,"a") :| [(3,"b")]))) == 1 +-- > isJust (lookupIndex 6 (fromList ((5,"a") :| [(3,"b")]))) == False +lookupIndex :: + Ord k => + k -> + NEMap k a -> + Maybe Int +lookupIndex k (NEMap k0 _ m) = case compare k k0 of + LT -> Nothing + EQ -> Just 0 + GT -> (+ 1) <$> M.lookupIndex k m +{-# INLINE lookupIndex #-} + +-- | /O(log n)/. Return the /index/ of a key, which is its zero-based index +-- in the sequence sorted by keys. The index is a number from /0/ up to, +-- but not including, the 'size' of the map. Calls 'error' when the key is +-- not a 'member' of the map. +-- +-- > findIndex 2 (fromList ((5,"a") :| [(3,"b")])) Error: element is not in the map +-- > findIndex 3 (fromList ((5,"a") :| [(3,"b")])) == 0 +-- > findIndex 5 (fromList ((5,"a") :| [(3,"b")])) == 1 +-- > findIndex 6 (fromList ((5,"a") :| [(3,"b")])) Error: element is not in the map +findIndex :: + Ord k => + k -> + NEMap k a -> + Int +findIndex k = fromMaybe e . lookupIndex k + where + e = error "NEMap.findIndex: element is not in the map" +{-# INLINE findIndex #-} + +-- | /O(log n)/. Retrieve an element by its /index/, i.e. by its zero-based +-- index in the sequence sorted by keys. If the /index/ is out of range +-- (less than zero, greater or equal to 'size' of the map), 'error' is +-- called. +-- +-- > elemAt 0 (fromList ((5,"a") :| [(3,"b")])) == (3,"b") +-- > elemAt 1 (fromList ((5,"a") :| [(3,"b")])) == (5, "a") +-- > elemAt 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +elemAt :: + Int -> + NEMap k a -> + (k, a) +elemAt 0 (NEMap k v _) = (k, v) +elemAt i (NEMap _ _ m) = M.elemAt (i - 1) m +{-# INLINEABLE elemAt #-} + +-- | /O(log n)/. Update the element at /index/, i.e. by its zero-based index in +-- the sequence sorted by keys. If the /index/ is out of range (less than zero, +-- greater or equal to 'size' of the map), 'error' is called. +-- +-- Returns a possibly empty map ('Map'), because the function might end up +-- deleting the last key in the map. See 'adjustAt' for a version that +-- disallows deletion, guaranteeing that the result is also a non-empty +-- Map. +-- +-- > updateAt (\ _ _ -> Just "x") 0 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "x"), (5, "a")] +-- > updateAt (\ _ _ -> Just "x") 1 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "x")] +-- > updateAt (\ _ _ -> Just "x") 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +-- > updateAt (\ _ _ -> Just "x") (-1) (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +-- > updateAt (\_ _ -> Nothing) 0 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +-- > updateAt (\_ _ -> Nothing) 1 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > updateAt (\_ _ -> Nothing) 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +-- > updateAt (\_ _ -> Nothing) (-1) (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +updateAt :: + (k -> a -> Maybe a) -> + Int -> + NEMap k a -> + Map k a +updateAt f 0 (NEMap k v m) = maybe m (flip (insertMinMap k) m) $ f k v +updateAt f i (NEMap k v m) = insertMinMap k v . M.updateAt f (i - 1) $ m +{-# INLINEABLE updateAt #-} + +-- | /O(log n)/. Variant of 'updateAt' that disallows deletion. Allows us +-- to guarantee that the result is also a non-empty Map. +adjustAt :: + (k -> a -> a) -> + Int -> + NEMap k a -> + NEMap k a +adjustAt f 0 (NEMap k0 v m) = NEMap k0 (f k0 v) m +adjustAt f i (NEMap k0 v m) = + NEMap k0 v + . M.updateAt (\k -> Just . f k) (i - 1) + $ m +{-# INLINEABLE adjustAt #-} + +-- | /O(log n)/. Delete the element at /index/, i.e. by its zero-based +-- index in the sequence sorted by keys. If the /index/ is out of range +-- (less than zero, greater or equal to 'size' of the map), 'error' is +-- called. +-- +-- Returns a potentially empty map ('Map') because of the possibility of +-- deleting the last item in a map. +-- +-- > deleteAt 0 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +-- > deleteAt 1 (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +-- > deleteAt 2 (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +-- > deleteAt (-1) (fromList ((5,"a") :| [(3,"b")])) Error: index out of range +deleteAt :: + Int -> + NEMap k a -> + Map k a +deleteAt 0 (NEMap _ _ m) = m +deleteAt i (NEMap k v m) = insertMinMap k v . M.deleteAt (i - 1) $ m +{-# INLINEABLE deleteAt #-} + +-- | Take a given number of entries in key order, beginning with the +-- smallest keys. +-- +-- Returns a possibly empty map ('Map'), which can only happen if we call +-- @take 0@. +-- +-- @ +-- take n = Data.Map.fromDistinctAscList . Data.List.NonEmpty.take n . 'toList' +-- @ +take :: + Int -> + NEMap k a -> + Map k a +take 0 NEMap{} = M.empty +take i (NEMap k v m) = insertMinMap k v . M.take (i - 1) $ m +{-# INLINEABLE take #-} + +-- | Drop a given number of entries in key order, beginning +-- with the smallest keys. +-- +-- Returns a possibly empty map ('Map'), in case we drop all of the +-- elements (which can happen if we drop a number greater than or equal to +-- the number of items in the map) +-- +-- @ +-- drop n = Data.Map.fromDistinctAscList . Data.List.NonEmpty.drop' n . 'toList' +-- @ +drop :: + Int -> + NEMap k a -> + Map k a +drop 0 n = toMap n +drop i (NEMap _ _ m) = M.drop (i - 1) m +{-# INLINEABLE drop #-} + +-- | /O(log n)/. Split a map at a particular index @i@. +-- +-- * @'This' n1@ means that there are less than @i@ items in the map, and +-- @n1@ is the original map. +-- * @'That' n2@ means @i@ was 0; we dropped 0 items, so @n2@ is the +-- original map. +-- * @'These' n1 n2@ gives @n1@ (taking @i@ items from the original map) +-- and @n2@ (dropping @i@ items from the original map)) +splitAt :: + Int -> + NEMap k a -> + These (NEMap k a) (NEMap k a) +splitAt 0 n = That n +splitAt i n@(NEMap k v m0) = case (nonEmptyMap m1, nonEmptyMap m2) of + (Nothing, Nothing) -> This (singleton k v) + (Just _, Nothing) -> This n + (Nothing, Just n2) -> These (singleton k v) n2 + (Just _, Just n2) -> These (insertMapMin k v m1) n2 + where + (m1, m2) = M.splitAt (i - 1) m0 +{-# INLINEABLE splitAt #-} + +-- | /O(1)/. The minimal key of the map. Note that this is total, making +-- 'Data.Map.lookupMin' obsolete. It is constant-time, so has better +-- asymptotics than @Data.Map.lookupMin@ and @Data.Map.findMin@, as well. +-- +-- > findMin (fromList ((5,"a") :| [(3,"b")])) == (3,"b") +findMin :: NEMap k a -> (k, a) +findMin (NEMap k v _) = (k, v) +{-# INLINE findMin #-} + +-- | /O(log n)/. The maximal key of the map. Note that this is total, making +-- 'Data.Map.lookupMin' obsolete. +-- +-- > findMax (fromList ((5,"a") :| [(3,"b")])) == (5,"a") +findMax :: NEMap k a -> (k, a) +findMax (NEMap k v m) = fromMaybe (k, v) . M.lookupMax $ m +{-# INLINE findMax #-} + +-- | /O(1)/. Delete the minimal key. Returns a potentially empty map +-- ('Map'), because we might end up deleting the final key in a singleton +-- map. It is constant-time, so has better asymptotics than +-- 'Data.Map.deleteMin'. +-- +-- > deleteMin (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.Map.fromList [(5,"a"), (7,"c")] +-- > deleteMin (singleton 5 "a") == Data.Map.empty +deleteMin :: NEMap k a -> Map k a +deleteMin (NEMap _ _ m) = m +{-# INLINE deleteMin #-} + +-- | /O(log n)/. Delete the maximal key. Returns a potentially empty map +-- ('Map'), because we might end up deleting the final key in a singleton +-- map. +-- +-- > deleteMax (fromList ((5,"a") :| [(3,"b"), (7,"c")])) == Data.Map.fromList [(3,"b"), (5,"a")] +-- > deleteMax (singleton 5 "a") == Data.Map.empty +deleteMax :: NEMap k a -> Map k a +deleteMax (NEMap k v m) = case M.maxView m of + Nothing -> M.empty + Just (_, m') -> insertMinMap k v m' +{-# INLINE deleteMax #-} + +-- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the +-- minimal key. Returns a potentially empty map ('Map'), because we might +-- end up deleting the final key in the map if the function returns +-- 'Nothing'. See 'adjustMin' for a version that can guaruntee that we +-- return a non-empty map. +-- +-- > updateMin (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "Xb"), (5, "a")] +-- > updateMin (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +updateMin :: (a -> Maybe a) -> NEMap k a -> Map k a +updateMin f = updateMinWithKey (const f) +{-# INLINE updateMin #-} + +-- | /O(1)/. A version of 'updateMin' that disallows deletion, allowing us +-- to guarantee that the result is also non-empty. +adjustMin :: (a -> a) -> NEMap k a -> NEMap k a +adjustMin f = adjustMinWithKey (const f) +{-# INLINE adjustMin #-} + +-- | /O(1)/ if delete, /O(log n)/ otherwise. Update the value at the +-- minimal key. Returns a potentially empty map ('Map'), because we might +-- end up deleting the final key in the map if the function returns +-- 'Nothing'. See 'adjustMinWithKey' for a version that guaruntees +-- a non-empty map. +-- +-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3,"3:b"), (5,"a")] +-- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +updateMinWithKey :: (k -> a -> Maybe a) -> NEMap k a -> Map k a +updateMinWithKey f (NEMap k v m) = maybe id (insertMinMap k) (f k v) m +{-# INLINE updateMinWithKey #-} + +-- | /O(1)/. A version of 'adjustMaxWithKey' that disallows deletion, +-- allowing us to guarantee that the result is also non-empty. Note that +-- it also is able to have better asymptotics than 'updateMinWithKey' in +-- general. +adjustMinWithKey :: (k -> a -> a) -> NEMap k a -> NEMap k a +adjustMinWithKey f (NEMap k v m) = NEMap k (f k v) m +{-# INLINE adjustMinWithKey #-} + +-- | /O(log n)/. Update the value at the maximal key. Returns +-- a potentially empty map ('Map'), because we might end up deleting the +-- final key in the map if the function returns 'Nothing'. See 'adjustMax' +-- for a version that can guarantee that we return a non-empty map. +-- +-- > updateMax (\ a -> Just ("X" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3, "b"), (5, "Xa")] +-- > updateMax (\ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 3 "b" +updateMax :: (a -> Maybe a) -> NEMap k a -> Map k a +updateMax f = updateMaxWithKey (const f) +{-# INLINE updateMax #-} + +-- | /O(log n)/. A version of 'updateMax' that disallows deletion, allowing +-- us to guarantee that the result is also non-empty. +adjustMax :: (a -> a) -> NEMap k a -> NEMap k a +adjustMax f = adjustMaxWithKey (const f) +{-# INLINE adjustMax #-} + +-- | /O(log n)/. Update the value at the maximal key. Returns +-- a potentially empty map ('Map'), because we might end up deleting the +-- final key in the map if the function returns 'Nothing'. See +-- 'adjustMaxWithKey' for a version that guaruntees a non-empty map. +-- +-- > updateMinWithKey (\ k a -> Just ((show k) ++ ":" ++ a)) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.fromList [(3,"3:b"), (5,"a")] +-- > updateMinWithKey (\ _ _ -> Nothing) (fromList ((5,"a") :| [(3,"b")])) == Data.Map.singleton 5 "a" +updateMaxWithKey :: (k -> a -> Maybe a) -> NEMap k a -> Map k a +updateMaxWithKey f (NEMap k v m) + | M.null m = maybe m (M.singleton k) $ f k v + | otherwise = + insertMinMap k v + . M.updateMaxWithKey f + $ m +{-# INLINE updateMaxWithKey #-} + +-- | /O(log n)/. A version of 'updateMaxWithKey' that disallows deletion, +-- allowing us to guarantee that the result is also non-empty. +adjustMaxWithKey :: (k -> a -> a) -> NEMap k a -> NEMap k a +adjustMaxWithKey f (NEMap k0 v m) + | M.null m = NEMap k0 (f k0 v) m + | otherwise = + insertMapMin k0 v + . M.updateMaxWithKey (\k -> Just . f k) + $ m +{-# INLINE adjustMaxWithKey #-} + +-- | /O(1)/. Retrieves the value associated with minimal key of the +-- map, and the map stripped of that element. It is constant-time, so has +-- better asymptotics than @Data.Map.minView@ for 'Map'. +-- +-- Note that unlike @Data.Map.minView@ for 'Map', this cannot ever fail, +-- so doesn't need to return in a 'Maybe'. However, the result 'Map' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > minView (fromList ((5,"a") :| [(3,"b")])) == ("b", Data.Map.singleton 5 "a") +minView :: NEMap k a -> (a, Map k a) +minView = first snd . deleteFindMin +{-# INLINE minView #-} + +-- | /O(1)/. Delete and find the minimal key-value pair. It is +-- constant-time, so has better asymptotics that @Data.Map.minView@ for +-- 'Map'. +-- +-- Note that unlike @Data.Map.deleteFindMin@ for 'Map', this cannot ever +-- fail, and so is a total function. However, the result 'Map' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > deleteFindMin (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((3,"b"), Data.Map.fromList [(5,"a"), (10,"c")]) +deleteFindMin :: NEMap k a -> ((k, a), Map k a) +deleteFindMin (NEMap k v m) = ((k, v), m) +{-# INLINE deleteFindMin #-} + +-- | /O(log n)/. Retrieves the value associated with maximal key of the +-- map, and the map stripped of that element. +-- +-- Note that unlike @Data.Map.maxView@ from 'Map', this cannot ever fail, +-- so doesn't need to return in a 'Maybe'. However, the result 'Map' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > maxView (fromList ((5,"a") :| [(3,"b")])) == ("a", Data.Map.singleton 3 "b") +maxView :: NEMap k a -> (a, Map k a) +maxView = first snd . deleteFindMax +{-# INLINE maxView #-} + +-- | /O(log n)/. Delete and find the minimal key-value pair. +-- +-- Note that unlike @Data.Map.deleteFindMax@ for 'Map', this cannot ever +-- fail, and so is a total function. However, the result 'Map' is +-- potentially empty, since the original map might have contained just +-- a single item. +-- +-- > deleteFindMax (fromList ((5,"a") :| [(3,"b"), (10,"c")])) == ((10,"c"), Data.Map.fromList [(3,"b"), (5,"a")]) +deleteFindMax :: NEMap k a -> ((k, a), Map k a) +deleteFindMax (NEMap k v m) = + maybe ((k, v), M.empty) (second (insertMinMap k v)) + . M.maxViewWithKey + $ m +{-# INLINE deleteFindMax #-} + +-- | Special property of non-empty maps: The type of non-empty maps over +-- uninhabited keys is itself uninhabited. +-- +-- This property also exists for /values/ inside a non-empty container +-- (like for 'NESet', 'NESeq', and 'NEIntMap'); this can be witnessed using +-- the function @'absurd' . 'fold1'@. +-- +-- @since 0.3.1.0 +absurdNEMap :: NEMap Void a -> b +absurdNEMap = \case {} + +-- --------------------------- +-- Combining functions +-- --------------------------- +-- +-- Code comes from "Data.Map.Internal" from containers, modified slightly +-- to work with NonEmpty +-- +-- Copyright : (c) Daan Leijen 2002 +-- (c) Andriy Palamarchuk 2008 + +combineEq :: Eq a => NonEmpty (a, b) -> NonEmpty (a, b) +combineEq = \case + x :| [] -> x :| [] + x :| xx@(_ : _) -> go x xx + where + go z [] = z :| [] + go z@(kz, _) (x@(kx, xx) : xs') + | kx == kz = go (kx, xx) xs' + | otherwise = z NE.<| go x xs' + +combineEqWith :: + Eq a => + (a -> b -> b -> b) -> + NonEmpty (a, b) -> + NonEmpty (a, b) +combineEqWith f = \case + x :| [] -> x :| [] + x :| xx@(_ : _) -> go x xx + where + go z [] = z :| [] + go z@(kz, zz) (x@(kx, xx) : xs') + | kx == kz = let yy = f kx xx zz in go (kx, yy) xs' + | otherwise = z NE.<| go x xs' diff --git a/src/Data/Map/NonEmpty/Strict/Internal.hs b/src/Data/Map/NonEmpty/Strict/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Map/NonEmpty/Strict/Internal.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_HADDOCK not-home #-} + +-- | +-- Module : Data.Map.NonEmpty.Strict.Internal +-- Copyright : (c) Justin Le 2018 +-- License : BSD3 +-- +-- Maintainer : justin@jle.im +-- Stability : experimental +-- Portability : non-portable +-- +-- Strict internal-use functions used in the implementation of +-- "Data.Map.NonEmpty.Strict". These share the same 'NEMap' type as the +-- lazy modules; only construction is strict in the value. +module Data.Map.NonEmpty.Strict.Internal ( + -- * Non-Empty Map type + NEMap, + pattern NEMap, + nemMap, + singleton, + nonEmptyMap, + withNonEmpty, + fromList, + toList, + map, + insertWith, + union, + unions, + elems, + size, + toMap, + + -- * Folds + foldr, + foldr', + foldr1, + foldl, + foldl', + foldl1, + + -- * Traversals + traverseWithKey, + traverseWithKey1, + foldMapWithKey, + + -- * Unsafe Map Functions + insertMinMap, + insertMaxMap, + + -- * Debug + valid, +) where + +import Control.Applicative +import qualified Data.Foldable as F +import Data.Functor.Apply (Apply, MaybeApply (..), (<.>)) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Map.Internal (Map (..)) +import qualified Data.Map.Internal as MI +import qualified Data.Map.NonEmpty.Lazy.Internal as L +import qualified Data.Map.Strict as M +import Data.Semigroup.Foldable (Foldable1) +import qualified Data.Semigroup.Foldable as F1 +import Prelude hiding (Foldable (..), foldl, foldl1, foldr, foldr1, map) + +type NEMap = L.NEMap + +pattern NEMap :: k -> a -> Map k a -> NEMap k a +pattern NEMap k v m <- L.NEMap k v m + where + NEMap k !v m = L.NEMap k v m + +{-# COMPLETE NEMap #-} + +nemMap :: NEMap k a -> Map k a +nemMap (NEMap _ _ m) = m +{-# INLINE nemMap #-} + +singleton :: k -> a -> NEMap k a +singleton k !v = L.NEMap k v M.empty +{-# INLINE singleton #-} + +nonEmptyMap :: Map k a -> Maybe (NEMap k a) +nonEmptyMap = L.nonEmptyMap +{-# INLINE nonEmptyMap #-} + +withNonEmpty :: b -> (NEMap k a -> b) -> Map k a -> b +withNonEmpty = L.withNonEmpty +{-# INLINE withNonEmpty #-} + +fromList :: Ord k => NonEmpty (k, a) -> NEMap k a +fromList ((k, v) :| xs) = F.foldl' (\m (k', v') -> insertWith const k' v' m) (singleton k v) xs +{-# INLINE fromList #-} + +toList :: NEMap k a -> NonEmpty (k, a) +toList = L.toList +{-# INLINE toList #-} + +map :: (a -> b) -> NEMap k a -> NEMap k b +map f (NEMap k v m) = NEMap k (f v) (M.map f m) +{-# INLINE map #-} + +insertWith :: Ord k => (a -> a -> a) -> k -> a -> NEMap k a -> NEMap k a +insertWith f k !v n@(NEMap k0 v0 m) = case compare k k0 of + LT -> NEMap k v (toMap n) + EQ -> NEMap k0 (f v v0) m + GT -> NEMap k0 v0 (M.insertWith f k v m) +{-# INLINE insertWith #-} + +union :: Ord k => NEMap k a -> NEMap k a -> NEMap k a +union n1@(NEMap k1 v1 m1) n2@(NEMap k2 v2 m2) = case compare k1 k2 of + LT -> NEMap k1 v1 . M.union m1 . toMap $ n2 + EQ -> NEMap k1 v1 . M.union m1 $ m2 + GT -> NEMap k2 v2 . M.union (toMap n1) $ m2 +{-# INLINE union #-} + +unions :: (Foldable1 f, Ord k) => f (NEMap k a) -> NEMap k a +unions ns = case F1.toNonEmpty ns of + m :| ms -> F.foldl' union m ms +{-# INLINE unions #-} + +elems :: NEMap k a -> NonEmpty a +elems = fmap snd . toList +{-# INLINE elems #-} + +size :: NEMap k a -> Int +size = L.size +{-# INLINE size #-} + +toMap :: NEMap k a -> Map k a +toMap (NEMap k v m) = insertMinMap k v m +{-# INLINE toMap #-} + +foldr :: (a -> b -> b) -> b -> NEMap k a -> b +foldr = L.foldr +{-# INLINE foldr #-} + +foldr' :: (a -> b -> b) -> b -> NEMap k a -> b +foldr' = L.foldr' +{-# INLINE foldr' #-} + +foldr1 :: (a -> a -> a) -> NEMap k a -> a +foldr1 = L.foldr1 +{-# INLINE foldr1 #-} + +foldl :: (b -> a -> b) -> b -> NEMap k a -> b +foldl = L.foldl +{-# INLINE foldl #-} + +foldl' :: (b -> a -> b) -> b -> NEMap k a -> b +foldl' = L.foldl' +{-# INLINE foldl' #-} + +foldl1 :: (a -> a -> a) -> NEMap k a -> a +foldl1 = L.foldl1 +{-# INLINE foldl1 #-} + +traverseWithKey :: Applicative f => (k -> a -> f b) -> NEMap k a -> f (NEMap k b) +traverseWithKey f (NEMap k v m) = NEMap k <$> f k v <*> M.traverseWithKey f m +{-# INLINE traverseWithKey #-} + +traverseWithKey1 :: Apply f => (k -> a -> f b) -> NEMap k a -> f (NEMap k b) +traverseWithKey1 f (NEMap k0 v m0) = case runMaybeApply m1 of + Left m2 -> NEMap k0 <$> f k0 v <.> m2 + Right m2 -> flip (NEMap k0) m2 <$> f k0 v + where + m1 = M.traverseWithKey (\k -> MaybeApply . Left . f k) m0 +{-# INLINE traverseWithKey1 #-} + +foldMapWithKey :: Monoid m => (k -> a -> m) -> NEMap k a -> m +foldMapWithKey = L.foldMapWithKey +{-# INLINE foldMapWithKey #-} + +valid :: Ord k => NEMap k a -> Bool +valid (NEMap k _ m) = + M.valid m + && all ((k <) . fst . fst) (M.minViewWithKey m) + +insertMinMap :: k -> a -> Map k a -> Map k a +insertMinMap kx !x = go + where + go Tip = Bin 1 kx x Tip Tip + go (Bin _ ky y l r) = MI.balanceL ky y (insertMinMap kx x l) r +{-# INLINE insertMinMap #-} + +insertMaxMap :: k -> a -> Map k a -> Map k a +insertMaxMap kx !x = go + where + go Tip = Bin 1 kx x Tip Tip + go (Bin _ ky y l r) = MI.balanceR ky y l (insertMaxMap kx x r) +{-# INLINE insertMaxMap #-} diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -2,8 +2,10 @@ -- import Test.Tasty.Ingredients.ConsoleReporter import Test.Tasty import Tests.IntMap +import Tests.IntMap.Strict import Tests.IntSet import Tests.Map +import Tests.Map.Strict import Tests.NonEmptyList import Tests.Sequence import Tests.Set @@ -21,8 +23,10 @@ testGroup "Tests" [ mapTests + , mapStrictTests , setTests , intMapTests + , intMapStrictTests , intSetTests , nonEmptyListTests , sequenceTests diff --git a/test/Tests/IntMap.hs b/test/Tests/IntMap.hs --- a/test/Tests/IntMap.hs +++ b/test/Tests/IntMap.hs @@ -6,7 +6,9 @@ import Control.Applicative import Control.Comonad +import Control.Exception (ErrorCall, evaluate, try) import Data.Coerce +import Data.Either (isLeft) import Data.Foldable import qualified Data.Foldable.WithIndex as IFoldable import Data.Functor.Alt @@ -14,6 +16,8 @@ import qualified Data.Functor.WithIndex as IFunctor import qualified Data.IntMap as M import qualified Data.IntMap.NonEmpty as NEM +import qualified Data.IntMap.NonEmpty.Lazy as NEML +import qualified Data.IntMap.NonEmpty.Strict as NEMS import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Semigroup.Foldable @@ -35,6 +39,19 @@ prop_valid = property $ assert . NEM.valid =<< forAll neIntMapGen + +prop_lazy_singleton_does_not_force_value :: Property +prop_lazy_singleton_does_not_force_value = property $ do + _ <- evalIO $ evaluate (NEML.singleton 0 (error "forced lazy NEIntMap value" :: Int)) + success + +prop_strict_singleton_forces_value :: Property +prop_strict_singleton_forces_value = property $ do + r <- + evalIO $ + try @ErrorCall $ + evaluate (NEMS.singleton 0 (error "forced strict NEIntMap value" :: Int)) + assert (isLeft r) -- | We cannot implement these because there is no 'valid' for IntSet -- prop_valid_toMap :: Property diff --git a/test/Tests/IntMap/Strict.hs b/test/Tests/IntMap/Strict.hs new file mode 100644 --- /dev/null +++ b/test/Tests/IntMap/Strict.hs @@ -0,0 +1,1208 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} + +module Tests.IntMap.Strict (intMapStrictTests) where + +import Control.Applicative +import Control.Comonad +import Data.Coerce +import Data.Foldable +import qualified Data.Foldable.WithIndex as IFoldable +import Data.Functor.Alt +import Data.Functor.Identity +import qualified Data.Functor.WithIndex as IFunctor +import qualified Data.IntMap as M +import qualified Data.IntMap.NonEmpty.Lazy as NEML +import qualified Data.IntMap.NonEmpty.Strict as NEM +import qualified Data.IntMap.NonEmpty.Strict as NEMS +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE +import Data.Semigroup.Foldable +import Data.Semigroup.Traversable +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Traversable.WithIndex as TWI +import qualified GHC.Exts as Exts +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Tasty +import Tests.Util + +intMapStrictTests :: TestTree +intMapStrictTests = groupTree $$discover + +prop_valid :: Property +prop_valid = + property $ + assert . NEM.valid =<< forAll neIntMapGen + +-- | Pick an existing key out of a generated map, so the branch that +-- actually applies the user function is guaranteed to run. +existingKeyOf :: MonadGen m => NEMS.NEIntMap a -> m NEMS.Key +existingKeyOf = Gen.element . NE.toList . NEMS.keys + +prop_lazy_singleton_does_not_force_value :: Property +prop_lazy_singleton_does_not_force_value = property $ do + k <- forAll intKeyGen + assertNotForced (NEML.singleton k (error "forced lazy NEIntMap value" :: Text)) + +prop_strict_singleton_forces_value :: Property +prop_strict_singleton_forces_value = property $ do + k <- forAll intKeyGen + assertForced (NEMS.singleton k (error "forced strict NEIntMap value" :: Text)) + +prop_lazy_insertWith_does_not_force_value :: Property +prop_lazy_insertWith_does_not_force_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ + NEML.insertWith (\_ _ -> error "forced lazy NEIntMap value") k T.empty m + +prop_strict_insertWith_forces_value :: Property +prop_strict_insertWith_forces_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertForced $ + NEMS.insertWith (\_ _ -> error "forced strict NEIntMap value") k T.empty m + +prop_lazy_adjustWithKey_does_not_force_value :: Property +prop_lazy_adjustWithKey_does_not_force_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ NEML.adjustWithKey (\_ _ -> error "forced lazy NEIntMap value") k m + +prop_strict_adjustWithKey_forces_value :: Property +prop_strict_adjustWithKey_forces_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertForced $ NEMS.adjustWithKey (\_ _ -> error "forced strict NEIntMap value") k m + +prop_lazy_alter_does_not_force_value :: Property +prop_lazy_alter_does_not_force_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ NEML.alter (const (Just (error "forced lazy NEIntMap value"))) k m + +prop_strict_alter_forces_value :: Property +prop_strict_alter_forces_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertForced $ NEMS.alter (const (Just (error "forced strict NEIntMap value"))) k m + +prop_lazy_mapWithKey_does_not_force_value :: Property +prop_lazy_mapWithKey_does_not_force_value = property $ do + m <- forAll neIntMapGen + assertNotForced $ NEML.mapWithKey (\_ _ -> error "forced lazy NEIntMap value") m + +prop_strict_mapWithKey_forces_value :: Property +prop_strict_mapWithKey_forces_value = property $ do + m <- forAll neIntMapGen + assertForced $ NEMS.mapWithKey (\_ _ -> error "forced strict NEIntMap value") m + +prop_lazy_unionWith_does_not_force_value :: Property +prop_lazy_unionWith_does_not_force_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ + NEML.unionWith (\_ _ -> error "forced lazy NEIntMap value") m (NEML.singleton k T.empty) + +prop_strict_unionWith_forces_value :: Property +prop_strict_unionWith_forces_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertForced $ + NEMS.unionWith (\_ _ -> error "forced strict NEIntMap value") m (NEMS.singleton k T.empty) + +prop_lazy_mapMaybeWithKey_does_not_force_value :: Property +prop_lazy_mapMaybeWithKey_does_not_force_value = property $ do + m <- forAll neIntMapGen + assertNotForced $ NEML.mapMaybeWithKey (\_ _ -> Just (error "forced lazy NEIntMap value")) m + +prop_strict_mapMaybeWithKey_forces_value :: Property +prop_strict_mapMaybeWithKey_forces_value = property $ do + m <- forAll neIntMapGen + assertForced $ NEMS.mapMaybeWithKey (\_ _ -> Just (error "forced strict NEIntMap value")) m + +prop_lazy_mapAccumWithKey_does_not_force_value :: Property +prop_lazy_mapAccumWithKey_does_not_force_value = property $ do + m <- forAll neIntMapGen + assertNotForced $ + snd (NEML.mapAccumWithKey (\acc _ _ -> (acc, error "forced lazy NEIntMap value" :: Text)) () m) + +prop_strict_mapAccumWithKey_forces_value :: Property +prop_strict_mapAccumWithKey_forces_value = property $ do + m <- forAll neIntMapGen + assertForced $ + snd (NEMS.mapAccumWithKey (\acc _ _ -> (acc, error "forced strict NEIntMap value" :: Text)) () m) + +prop_lazy_fromListWith_does_not_force_value :: Property +prop_lazy_fromListWith_does_not_force_value = property $ do + k <- forAll intKeyGen + assertNotForced $ + NEML.fromListWith (\_ _ -> error "forced lazy NEIntMap value") ((k, T.empty) :| [(k, T.empty)]) + +prop_strict_fromListWith_forces_value :: Property +prop_strict_fromListWith_forces_value = property $ do + k <- forAll intKeyGen + assertForced $ + NEMS.fromListWith (\_ _ -> error "forced strict NEIntMap value") ((k, T.empty) :| [(k, T.empty)]) + +prop_lazy_insertMapWith_does_not_force_value :: Property +prop_lazy_insertMapWith_does_not_force_value = property $ do + k <- forAll intKeyGen + assertNotForced $ + NEML.insertMapWith (\_ _ -> error "forced lazy NEIntMap value") k T.empty (M.singleton k T.empty) + +prop_strict_insertMapWith_forces_value :: Property +prop_strict_insertMapWith_forces_value = property $ do + k <- forAll intKeyGen + assertForced $ + NEMS.insertMapWith (\_ _ -> error "forced strict NEIntMap value") k T.empty (M.singleton k T.empty) + +prop_lazy_updateWithKey_does_not_force_value :: Property +prop_lazy_updateWithKey_does_not_force_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ NEML.updateWithKey (\_ _ -> Just (error "forced lazy NEIntMap value")) k m + +prop_strict_updateWithKey_forces_value :: Property +prop_strict_updateWithKey_forces_value = property $ do + m <- forAll neIntMapGen + k <- forAll (existingKeyOf m) + assertForced $ NEMS.updateWithKey (\_ _ -> Just (error "forced strict NEIntMap value")) k m + +-- | Two-key map with both keys deliberately mapped to the same target key, +-- so the combining function is guaranteed to run. +collidingMapKeysFixture :: MonadGen m => m (NEMS.Key, NEMS.NEIntMap Text) +collidingMapKeysFixture = do + k <- intKeyGen + pure (k, NEML.fromList ((k, T.empty) :| [(k + 1, T.empty)])) + +prop_lazy_mapKeysWith_does_not_force_value :: Property +prop_lazy_mapKeysWith_does_not_force_value = property $ do + (k, m) <- forAll collidingMapKeysFixture + assertNotForced $ NEML.mapKeysWith (\_ _ -> error "forced lazy NEIntMap value") (const k) m + +prop_strict_mapKeysWith_forces_value :: Property +prop_strict_mapKeysWith_forces_value = property $ do + (k, m) <- forAll collidingMapKeysFixture + assertForced $ NEMS.mapKeysWith (\_ _ -> error "forced strict NEIntMap value") (const k) m + +prop_lazy_traverseWithKey_does_not_force_value :: Property +prop_lazy_traverseWithKey_does_not_force_value = property $ do + m <- forAll neIntMapGen + assertNotForced $ + runIdentity (NEML.traverseWithKey (\_ _ -> Identity (error "forced lazy NEIntMap value" :: Text)) m) + +prop_strict_traverseWithKey_forces_value :: Property +prop_strict_traverseWithKey_forces_value = property $ do + m <- forAll neIntMapGen + assertForced $ + runIdentity + (NEMS.traverseWithKey (\_ _ -> Identity (error "forced strict NEIntMap value" :: Text)) m) + +prop_lazy_traverseWithKey1_does_not_force_value :: Property +prop_lazy_traverseWithKey1_does_not_force_value = property $ do + m <- forAll neIntMapGen + assertNotForced $ + runIdentity + (NEML.traverseWithKey1 (\_ _ -> Identity (error "forced lazy NEIntMap value" :: Text)) m) + +prop_strict_traverseWithKey1_forces_value :: Property +prop_strict_traverseWithKey1_forces_value = property $ do + m <- forAll neIntMapGen + assertForced $ + runIdentity + (NEMS.traverseWithKey1 (\_ _ -> Identity (error "forced strict NEIntMap value" :: Text)) m) + +-- | We cannot implement these because there is no 'valid' for IntSet +-- prop_valid_toMap :: Property +-- prop_valid_toMap = property $ +-- assert . M.valid . NEM.toMap =<< forAll neIntMapGen + +-- prop_valid_insertMinIntMap :: Property +-- prop_valid_insertMinIntMap = property $ do +-- n <- forAll $ do +-- m <- intMapGen +-- let k = maybe 0 (subtract 1 . fst) $ M.lookupMin m +-- v <- valGen +-- pure $ NEM.insertMinIntMap k v m +-- assert $ M.valid n + +-- prop_valid_insertMaxIntMap :: Property +-- prop_valid_insertMaxIntMap = property $ do +-- n <- forAll $ do +-- m <- intMapGen +-- let k = maybe 0 ((+ 1) . fst) $ M.lookupMax m +-- v <- valGen +-- pure $ NEM.insertMaxIntMap k v m +-- assert $ M.valid n + +prop_valid_insertMapMin :: Property +prop_valid_insertMapMin = property $ do + n <- forAll $ do + m <- intMapGen + let k = maybe 0 (subtract 1 . fst) $ M.lookupMin m + v <- valGen + pure $ NEM.insertMapMin k v m + assert $ NEM.valid n + +prop_valid_insertMapMax :: Property +prop_valid_insertMapMax = property $ do + n <- forAll $ do + m <- intMapGen + let k = maybe 0 ((+ 1) . fst) $ M.lookupMax m + v <- valGen + pure $ NEM.insertMapMax k v m + assert $ NEM.valid n + +prop_toMapIso1 :: Property +prop_toMapIso1 = property $ do + m0 <- forAll intMapGen + tripping + m0 + NEM.nonEmptyMap + (Identity . maybe M.empty NEM.toMap) + +prop_toMapIso2 :: Property +prop_toMapIso2 = property $ do + m0 <- forAll $ Gen.maybe neIntMapGen + tripping + m0 + (maybe M.empty NEM.toMap) + (Identity . NEM.nonEmptyMap) + +prop_read_show :: Property +prop_read_show = readShow neIntMapGen + +prop_read1_show1 :: Property +prop_read1_show1 = readShow1 neIntMapGen + +prop_show_show1 :: Property +prop_show_show1 = showShow1 neIntMapGen + +prop_splitRoot :: Property +prop_splitRoot = property $ do + n <- forAll neIntMapGen + let rs = NEM.splitRoot n + allItems = foldMap1 NEM.keys rs + n' = NEM.unions rs + assert $ ascending allItems + mapM_ (assert . (`NEM.isSubmapOf` n)) rs + length allItems === length n' + n === n' + where + ascending (x :| xs) = case NE.nonEmpty xs of + Nothing -> True + Just ys@(y :| _) -> x < y && ascending ys + +prop_functorWithIndex :: Property +prop_functorWithIndex = + property $ do + m <- forAll neIntMapGen + let f k v = v <> T.pack (show k) + IFunctor.imap f m === NEM.mapWithKey f m + +prop_foldableWithIndex :: Property +prop_foldableWithIndex = + property $ do + m <- forAll neIntMapGen + IFoldable.ifoldMap (\k v -> [(k, v)]) m === toList (NEM.toList m) + +prop_traversableWithIndex :: Property +prop_traversableWithIndex = + property $ do + m <- forAll neIntMapGen + let f k v = v <> T.pack (show k) + TWI.itraverse (\k v -> Identity (f k v)) m === Identity (NEM.mapWithKey f m) + TWI.itraverse (\k v -> Const [(k, v)]) m === Const (toList (NEM.toList m)) + +prop_extract_duplicate :: Property +prop_extract_duplicate = property $ do + n <- forAll neIntMapGen + tripping + n + duplicate + (Identity . extract) + +prop_fmap_extract_duplicate :: Property +prop_fmap_extract_duplicate = property $ do + n <- forAll neIntMapGen + tripping + n + duplicate + (Identity . fmap extract) + +prop_duplicate_duplicate :: Property +prop_duplicate_duplicate = property $ do + n <- forAll neIntMapGen + let dd1 = duplicate . duplicate $ n + dd2 = fmap duplicate . duplicate $ n + assert $ NEM.valid dd1 + assert $ NEM.valid dd2 + dd1 === dd2 + +prop_insertMapWithKey :: Property +prop_insertMapWithKey = + ttProp + (gf3 valGen :?> GTIntKey :-> GTVal :-> GTIntMap :-> TTNEIntMap) + M.insertWithKey + NEM.insertMapWithKey + +prop_singleton :: Property +prop_singleton = + ttProp + (GTIntKey :-> GTVal :-> TTNEIntMap) + M.singleton + NEM.singleton + +prop_fromSet :: Property +prop_fromSet = + ttProp + (gf1 valGen :?> GTNEIntSet :-> TTNEIntMap) + M.fromSet + NEM.fromSet + +prop_fromAscList :: Property +prop_fromAscList = + ttProp + (GTSorted STAsc (GTNEList Nothing (GTIntKey :&: GTVal)) :-> TTNEIntMap) + M.fromAscList + NEM.fromAscList + +prop_fromAscListWithKey :: Property +prop_fromAscListWithKey = + ttProp + (gf3 valGen :?> GTSorted STAsc (GTNEList Nothing (GTIntKey :&: GTVal)) :-> TTNEIntMap) + M.fromAscListWithKey + NEM.fromAscListWithKey + +prop_fromDistinctAscList :: Property +prop_fromDistinctAscList = + ttProp + (GTSorted STDistinctAsc (GTNEList Nothing (GTIntKey :&: GTVal)) :-> TTNEIntMap) + M.fromDistinctAscList + NEM.fromDistinctAscList + +prop_fromListWithKey :: Property +prop_fromListWithKey = + ttProp + (gf3 valGen :?> GTNEList Nothing (GTIntKey :&: GTVal) :-> TTNEIntMap) + M.fromListWithKey + NEM.fromListWithKey + +prop_toFromOverloadedList :: Property +prop_toFromOverloadedList = + property $ do + s <- forAll neIntMapGen + s === Exts.fromList (Exts.toList s) + +prop_fromToOverloadedList :: Property +prop_fromToOverloadedList = + property $ do + l <- forAll neIntTextListUniqGen + l === Exts.toList (Exts.fromList @(NEM.NEIntMap Text) l) + +prop_insert :: Property +prop_insert = + ttProp + (GTIntKey :-> GTVal :-> GTNEIntMap :-> TTNEIntMap) + M.insert + NEM.insert + +prop_insertWithKey :: Property +prop_insertWithKey = + ttProp + (gf3 valGen :?> GTIntKey :-> GTVal :-> GTNEIntMap :-> TTNEIntMap) + M.insertWithKey + NEM.insertWithKey + +prop_delete :: Property +prop_delete = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTOther) + M.delete + NEM.delete + +prop_deleteMaybe :: Property +prop_deleteMaybe = + property $ do + k <- forAll intKeyGen + m <- forAll neIntMapGen + NEM.deleteMaybe k m === NEM.nonEmptyMap (M.delete k (NEM.toMap m)) + +prop_adjustWithKey :: Property +prop_adjustWithKey = + ttProp + (gf2 valGen :?> GTIntKey :-> GTNEIntMap :-> TTNEIntMap) + M.adjustWithKey + NEM.adjustWithKey + +prop_updateWithKey :: Property +prop_updateWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTIntKey :-> GTNEIntMap :-> TTOther) + M.updateWithKey + NEM.updateWithKey + +prop_updateLookupWithKey :: Property +prop_updateLookupWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTIntKey :-> GTNEIntMap :-> TTMaybe TTVal :*: TTOther) + M.updateLookupWithKey + NEM.updateLookupWithKey + +prop_alter :: Property +prop_alter = + ttProp + (gf1 (Gen.maybe valGen) :?> GTIntKey :-> GTNEIntMap :-> TTOther) + M.alter + NEM.alter + +prop_alter' :: Property +prop_alter' = + ttProp + (gf1 valGen :?> GTIntKey :-> GTNEIntMap :-> TTNEIntMap) + (M.alter . fmap Just) + NEM.alter' + +prop_alterF :: Property +prop_alterF = + ttProp + ( gf1 (Gen.maybe valGen) + :?> GTIntKey + :-> GTNEIntMap + :-> TTCtx (GTMaybe GTVal :-> TTOther) (TTMaybe TTVal) + ) + (M.alterF . Context) + (NEM.alterF . Context) + +prop_alterF_rules_Const :: Property +prop_alterF_rules_Const = + ttProp + ( gf1 (Const <$> valGen) + :?> GTIntKey + :-> GTNEIntMap + :-> TTOther + ) + (\f k m -> getConst (M.alterF f k m)) + (\f k m -> getConst (NEM.alterF f k m)) + +prop_alterF_rules_Identity :: Property +prop_alterF_rules_Identity = + ttProp + ( gf1 (Identity <$> Gen.maybe valGen) + :?> GTIntKey + :-> GTNEIntMap + :-> TTOther + ) + (\f k m -> runIdentity (M.alterF f k m)) + (\f k m -> runIdentity (NEM.alterF f k m)) + +prop_alterF' :: Property +prop_alterF' = + ttProp + (gf1 valGen :?> GTIntKey :-> GTNEIntMap :-> TTCtx (GTVal :-> TTNEIntMap) (TTMaybe TTVal)) + (M.alterF . Context . fmap Just) + (NEM.alterF' . Context) + +prop_alterF'_rules_Const :: Property +prop_alterF'_rules_Const = + ttProp + ( gf1 (Const <$> valGen) + :?> GTIntKey + :-> GTNEIntMap + :-> TTOther + ) + (\f k m -> let f' = fmap Just . f in getConst (M.alterF f' k m)) + (\f k m -> getConst (NEM.alterF' f k m)) + +-- -- | This fails, but isn't possible to fix without copying-and-pasting more +-- -- in code from containers. +-- prop_alterF'_rules_Identity :: Property +-- prop_alterF'_rules_Identity = ttProp ( gf1 (Identity <$> valGen) +-- :?> GTIntKey +-- :-> GTNEIntMap +-- :-> TTNEIntMap +-- ) +-- (\f k m -> let f' = fmap Just . f in runIdentity (M.alterF f' k m)) +-- (\f k m -> runIdentity (NEM.alterF' f k m)) + +prop_lookup :: Property +prop_lookup = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTMaybe TTVal) + M.lookup + NEM.lookup + +prop_findWithDefault :: Property +prop_findWithDefault = + ttProp + (GTVal :-> GTIntKey :-> GTNEIntMap :-> TTVal) + M.findWithDefault + NEM.findWithDefault + +prop_member :: Property +prop_member = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTOther) + M.member + NEM.member + +prop_notMember :: Property +prop_notMember = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTOther) + M.notMember + NEM.notMember + +prop_lookupLT :: Property +prop_lookupLT = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTMaybe (TTOther :*: TTVal)) + M.lookupLT + NEM.lookupLT + +prop_lookupGT :: Property +prop_lookupGT = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTMaybe (TTOther :*: TTVal)) + M.lookupGT + NEM.lookupGT + +prop_lookupLE :: Property +prop_lookupLE = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTMaybe (TTOther :*: TTVal)) + M.lookupLE + NEM.lookupLE + +prop_lookupGE :: Property +prop_lookupGE = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTMaybe (TTOther :*: TTVal)) + M.lookupGE + NEM.lookupGE + +prop_size :: Property +prop_size = + ttProp + (GTNEIntMap :-> TTOther) + M.size + NEM.size + +prop_union :: Property +prop_union = + ttProp + (GTNEIntMap :-> GTNEIntMap :-> TTNEIntMap) + M.union + NEM.union + +prop_unionMapLeft :: Property +prop_unionMapLeft = + ttProp + (GTIntMap :-> GTNEIntMap :-> TTNEIntMap) + M.union + NEM.unionMapLeft + +prop_unionMapRight :: Property +prop_unionMapRight = + ttProp + (GTNEIntMap :-> GTIntMap :-> TTNEIntMap) + M.union + NEM.unionMapRight + +prop_unionWith :: Property +prop_unionWith = + ttProp + (gf2 valGen :?> GTNEIntMap :-> GTNEIntMap :-> TTNEIntMap) + M.unionWith + NEM.unionWith + +prop_unionMapWithLeft :: Property +prop_unionMapWithLeft = + ttProp + (gf2 valGen :?> GTIntMap :-> GTNEIntMap :-> TTNEIntMap) + M.unionWith + NEM.unionMapWithLeft + +prop_unionMapWithRight :: Property +prop_unionMapWithRight = + ttProp + (gf2 valGen :?> GTNEIntMap :-> GTIntMap :-> TTNEIntMap) + M.unionWith + NEM.unionMapWithRight + +prop_unionWithKey :: Property +prop_unionWithKey = + ttProp + (gf3 valGen :?> GTNEIntMap :-> GTNEIntMap :-> TTNEIntMap) + M.unionWithKey + NEM.unionWithKey + +prop_unionMapWithKeyLeft :: Property +prop_unionMapWithKeyLeft = + ttProp + (gf3 valGen :?> GTIntMap :-> GTNEIntMap :-> TTNEIntMap) + M.unionWithKey + NEM.unionMapWithKeyLeft + +prop_unionMapWithKeyRight :: Property +prop_unionMapWithKeyRight = + ttProp + (gf3 valGen :?> GTNEIntMap :-> GTIntMap :-> TTNEIntMap) + M.unionWithKey + NEM.unionMapWithKeyRight + +prop_unions :: Property +prop_unions = + ttProp + (GTNEList (Just (Range.linear 2 5)) GTNEIntMap :-> TTNEIntMap) + M.unions + NEM.unions + +prop_unionsWith :: Property +prop_unionsWith = + ttProp + (gf2 valGen :?> GTNEList (Just (Range.linear 2 5)) GTNEIntMap :-> TTNEIntMap) + M.unionsWith + NEM.unionsWith + +prop_difference :: Property +prop_difference = + ttProp + (GTNEIntMap :-> GTNEIntMap :-> TTOther) + M.difference + NEM.difference + +prop_differenceWithKey :: Property +prop_differenceWithKey = + ttProp + (gf3 (Gen.maybe valGen) :?> GTNEIntMap :-> GTNEIntMap :-> TTOther) + M.differenceWithKey + NEM.differenceWithKey + +prop_intersection :: Property +prop_intersection = + ttProp + (GTNEIntMap :-> GTNEIntMap :-> TTOther) + M.intersection + NEM.intersection + +prop_intersectionWithKey :: Property +prop_intersectionWithKey = + ttProp + (gf3 valGen :?> GTNEIntMap :-> GTNEIntMap :-> TTOther) + M.intersectionWithKey + NEM.intersectionWithKey + +prop_map :: Property +prop_map = + ttProp + (gf1 valGen :?> GTNEIntMap :-> TTNEIntMap) + M.map + NEM.map + +prop_map_rules_map :: Property +prop_map_rules_map = + ttProp + (gf1 valGen :?> gf1 valGen :?> GTNEIntMap :-> TTNEIntMap) + (\f g xs -> M.map f (M.map g xs)) + (\f g xs -> NEM.map f (NEM.map g xs)) + +prop_map_rules_coerce :: Property +prop_map_rules_coerce = + ttProp + (GTNEIntMap :-> TTNEIntMap) + (M.map @Text @Text coerce) + (NEM.map @Text @Text coerce) + +prop_map_rules_mapWithKey :: Property +prop_map_rules_mapWithKey = + ttProp + (gf1 valGen :?> gf2 valGen :?> GTNEIntMap :-> TTNEIntMap) + (\f g xs -> M.map f (M.mapWithKey g xs)) + (\f g xs -> NEM.map f (NEM.mapWithKey g xs)) + +prop_mapWithKey :: Property +prop_mapWithKey = + ttProp + (gf2 valGen :?> GTNEIntMap :-> TTNEIntMap) + M.mapWithKey + NEM.mapWithKey + +prop_mapWithKey_rules_mapWithKey :: Property +prop_mapWithKey_rules_mapWithKey = + ttProp + (gf2 valGen :?> gf2 valGen :?> GTNEIntMap :-> TTNEIntMap) + (\f g xs -> M.mapWithKey f (M.mapWithKey g xs)) + (\f g xs -> NEM.mapWithKey f (NEM.mapWithKey g xs)) + +prop_mapWithKey_rules_map :: Property +prop_mapWithKey_rules_map = + ttProp + (gf2 valGen :?> gf1 valGen :?> GTNEIntMap :-> TTNEIntMap) + (\f g xs -> M.mapWithKey f (M.map g xs)) + (\f g xs -> NEM.mapWithKey f (NEM.map g xs)) + +prop_traverseWithKey1 :: Property +prop_traverseWithKey1 = + ttProp + (gf1 valGen :?> GTNEIntMap :-> TTBazaar GTVal TTNEIntMap TTVal) + (\f -> M.traverseWithKey (\k -> (`More` Done (f . (k,))))) + (\f -> NEM.traverseWithKey1 (\k -> (`More` Done (f . (k,))))) + +prop_traverseWithKey :: Property +prop_traverseWithKey = + ttProp + (gf1 valGen :?> GTNEIntMap :-> TTBazaar GTVal TTNEIntMap TTVal) + (\f -> M.traverseWithKey (\k -> (`More` Done (f . (k,))))) + (\f -> NEM.traverseWithKey (\k -> (`More` Done (f . (k,))))) + +prop_sequence1 :: Property +prop_sequence1 = + ttProp + (GTNEIntMap :-> TTBazaar GTVal TTNEIntMap TTVal) + (traverse (`More` Done id)) + (traverse1 (`More` Done id)) + +prop_sequenceA :: Property +prop_sequenceA = + ttProp + (GTNEIntMap :-> TTBazaar GTVal TTNEIntMap TTVal) + (traverse (`More` Done id)) + (traverse (`More` Done id)) + +prop_mapAccumWithKey :: Property +prop_mapAccumWithKey = + ttProp + ( gf3 ((,) <$> valGen <*> valGen) + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + :*: TTNEIntMap + ) + M.mapAccumWithKey + NEM.mapAccumWithKey + +prop_mapAccumRWithKey :: Property +prop_mapAccumRWithKey = + ttProp + ( gf3 ((,) <$> valGen <*> valGen) + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + :*: TTNEIntMap + ) + M.mapAccumRWithKey + NEM.mapAccumRWithKey + +prop_mapKeys :: Property +prop_mapKeys = + ttProp + (gf1 intKeyGen :?> GTNEIntMap :-> TTNEIntMap) + M.mapKeys + NEM.mapKeys + +prop_mapKeysWith :: Property +prop_mapKeysWith = + ttProp + ( gf2 valGen + :?> gf1 intKeyGen + :?> GTNEIntMap + :-> TTNEIntMap + ) + M.mapKeysWith + NEM.mapKeysWith + +prop_mapKeysMonotonic :: Property +prop_mapKeysMonotonic = + ttProp + (GTNEIntMap :-> TTNEIntMap) + (M.mapKeysMonotonic (* 2)) + (NEM.mapKeysMonotonic (* 2)) + +prop_foldr :: Property +prop_foldr = + ttProp + ( gf2 valGen + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + ) + M.foldr + NEM.foldr + +prop_foldl :: Property +prop_foldl = + ttProp + ( gf2 valGen + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + ) + M.foldl + NEM.foldl + +prop_foldr1 :: Property +prop_foldr1 = + ttProp + ( gf2 valGen + :?> GTNEIntMap + :-> TTOther + ) + foldr1 + NEM.foldr1 + +prop_foldl1 :: Property +prop_foldl1 = + ttProp + ( gf2 valGen + :?> GTNEIntMap + :-> TTOther + ) + foldl1 + NEM.foldl1 + +prop_foldrWithKey :: Property +prop_foldrWithKey = + ttProp + ( gf3 valGen + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + ) + M.foldrWithKey + NEM.foldrWithKey + +prop_foldlWithKey :: Property +prop_foldlWithKey = + ttProp + ( gf3 valGen + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + ) + M.foldlWithKey + NEM.foldlWithKey + +prop_foldMapWithKey :: Property +prop_foldMapWithKey = + ttProp + (gf2 valGen :?> GTNEIntMap :-> TTOther) + (\f -> foldMap (uncurry f) . M.toList) + NEM.foldMapWithKey + +prop_foldr' :: Property +prop_foldr' = + ttProp + ( gf2 valGen + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + ) + M.foldr' + NEM.foldr' + +prop_foldl' :: Property +prop_foldl' = + ttProp + ( gf2 valGen + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + ) + M.foldl' + NEM.foldl' + +prop_foldr1' :: Property +prop_foldr1' = + ttProp + ( gf2 valGen + :?> GTNEIntMap + :-> TTOther + ) + foldr1 + NEM.foldr1' + +prop_foldl1' :: Property +prop_foldl1' = + ttProp + ( gf2 valGen + :?> GTNEIntMap + :-> TTOther + ) + foldl1 + NEM.foldl1' + +prop_foldrWithKey' :: Property +prop_foldrWithKey' = + ttProp + ( gf3 valGen + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + ) + M.foldrWithKey' + NEM.foldrWithKey' + +prop_foldlWithKey' :: Property +prop_foldlWithKey' = + ttProp + ( gf3 valGen + :?> GTOther valGen + :-> GTNEIntMap + :-> TTOther + ) + M.foldlWithKey' + NEM.foldlWithKey' + +prop_elems :: Property +prop_elems = + ttProp + (GTNEIntMap :-> TTNEList TTVal) + M.elems + NEM.elems + +prop_keys :: Property +prop_keys = + ttProp + (GTNEIntMap :-> TTNEList TTOther) + M.keys + NEM.keys + +prop_assocs :: Property +prop_assocs = + ttProp + (GTNEIntMap :-> TTNEList (TTOther :*: TTVal)) + M.assocs + NEM.assocs + +prop_keysSet :: Property +prop_keysSet = + ttProp + (GTNEIntMap :-> TTNEIntSet) + M.keysSet + NEM.keysSet + +prop_toList :: Property +prop_toList = + ttProp + (GTNEIntMap :-> TTNEList (TTOther :*: TTVal)) + M.toList + NEM.toList + +prop_toDescList :: Property +prop_toDescList = + ttProp + (GTNEIntMap :-> TTNEList (TTOther :*: TTVal)) + M.toDescList + NEM.toDescList + +prop_filter :: Property +prop_filter = + ttProp + (gf1 Gen.bool :?> GTNEIntMap :-> TTOther) + M.filter + NEM.filter + +prop_filterWithKey :: Property +prop_filterWithKey = + ttProp + (gf2 Gen.bool :?> GTNEIntMap :-> TTOther) + M.filterWithKey + NEM.filterWithKey + +prop_restrictKeys :: Property +prop_restrictKeys = + ttProp + (GTNEIntMap :-> GTIntSet :-> TTOther) + M.restrictKeys + NEM.restrictKeys + +prop_withoutKeys :: Property +prop_withoutKeys = + ttProp + (GTNEIntMap :-> GTIntSet :-> TTOther) + M.withoutKeys + NEM.withoutKeys + +prop_partitionWithKey :: Property +prop_partitionWithKey = + ttProp + (gf2 Gen.bool :?> GTNEIntMap :-> TTThese TTNEIntMap TTNEIntMap) + M.partitionWithKey + NEM.partitionWithKey + +prop_mapMaybeWithKey :: Property +prop_mapMaybeWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTNEIntMap :-> TTOther) + M.mapMaybeWithKey + NEM.mapMaybeWithKey + +prop_mapEitherWithKey :: Property +prop_mapEitherWithKey = + ttProp + ( gf2 (Gen.choice [Left <$> valGen, Right <$> valGen]) + :?> GTNEIntMap + :-> TTThese TTNEIntMap TTNEIntMap + ) + M.mapEitherWithKey + NEM.mapEitherWithKey + +prop_split :: Property +prop_split = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTMThese TTNEIntMap TTNEIntMap) + M.split + NEM.split + +prop_splitLookup :: Property +prop_splitLookup = + ttProp + (GTIntKey :-> GTNEIntMap :-> TTTThese TTVal TTNEIntMap TTNEIntMap) + (\k -> (\(x, y, z) -> (y, x, z)) . M.splitLookup k) + NEM.splitLookup + +prop_isSubmapOfBy :: Property +prop_isSubmapOfBy = + ttProp + (gf2 Gen.bool :?> GTNEIntMap :-> GTNEIntMap :-> TTOther) + M.isSubmapOfBy + NEM.isSubmapOfBy + +prop_isProperSubmapOfBy :: Property +prop_isProperSubmapOfBy = + ttProp + (gf2 Gen.bool :?> GTNEIntMap :-> GTNEIntMap :-> TTOther) + M.isProperSubmapOfBy + NEM.isProperSubmapOfBy + +prop_findMin :: Property +prop_findMin = + ttProp + (GTNEIntMap :-> TTOther :*: TTVal) + M.findMin + NEM.findMin + +prop_findMax :: Property +prop_findMax = + ttProp + (GTNEIntMap :-> TTOther :*: TTVal) + M.findMax + NEM.findMax + +prop_deleteMin :: Property +prop_deleteMin = + ttProp + (GTNEIntMap :-> TTOther) + M.deleteMin + NEM.deleteMin + +prop_deleteMax :: Property +prop_deleteMax = + ttProp + (GTNEIntMap :-> TTOther) + M.deleteMax + NEM.deleteMax + +prop_deleteFindMin :: Property +prop_deleteFindMin = + ttProp + (GTNEIntMap :-> (TTOther :*: TTVal) :*: TTOther) + M.deleteFindMin + NEM.deleteFindMin + +prop_deleteFindMax :: Property +prop_deleteFindMax = + ttProp + (GTNEIntMap :-> (TTOther :*: TTVal) :*: TTOther) + M.deleteFindMax + NEM.deleteFindMax + +prop_updateMinWithKey :: Property +prop_updateMinWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTNEIntMap :-> TTOther) + M.updateMinWithKey + NEM.updateMinWithKey + +prop_updateMaxWithKey :: Property +prop_updateMaxWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTNEIntMap :-> TTOther) + M.updateMaxWithKey + NEM.updateMaxWithKey + +prop_adjustMinWithKey :: Property +prop_adjustMinWithKey = + ttProp + (gf2 valGen :?> GTNEIntMap :-> TTNEIntMap) + (M.updateMinWithKey . (fmap . fmap) Just) + NEM.adjustMinWithKey + +prop_adjustMaxWithKey :: Property +prop_adjustMaxWithKey = + ttProp + (gf2 valGen :?> GTNEIntMap :-> TTNEIntMap) + (M.updateMaxWithKey . (fmap . fmap) Just) + NEM.adjustMaxWithKey + +prop_minView :: Property +prop_minView = + ttProp + (GTNEIntMap :-> TTMaybe (TTVal :*: TTOther)) + M.minView + (Just . NEM.minView) + +prop_maxView :: Property +prop_maxView = + ttProp + (GTNEIntMap :-> TTMaybe (TTVal :*: TTOther)) + M.maxView + (Just . NEM.maxView) + +prop_elem :: Property +prop_elem = + ttProp + (GTVal :-> GTNEIntMap :-> TTOther) + elem + elem + +prop_fold1 :: Property +prop_fold1 = + ttProp + (GTNEIntMap :-> TTVal) + fold + fold1 + +prop_fold :: Property +prop_fold = + ttProp + (GTNEIntMap :-> TTVal) + fold + fold + +prop_foldMap1 :: Property +prop_foldMap1 = + ttProp + (gf1 valGen :?> GTNEIntMap :-> TTOther) + (\f -> foldMap ((: []) . f)) + (\f -> foldMap1 ((: []) . f)) + +prop_foldMap :: Property +prop_foldMap = + ttProp + (gf1 valGen :?> GTNEIntMap :-> TTOther) + (\f -> foldMap ((: []) . f)) + (\f -> foldMap ((: []) . f)) + +prop_alt :: Property +prop_alt = + ttProp + (GTNEIntMap :-> GTNEIntMap :-> TTNEIntMap) + () + () diff --git a/test/Tests/Map.hs b/test/Tests/Map.hs --- a/test/Tests/Map.hs +++ b/test/Tests/Map.hs @@ -5,7 +5,9 @@ import Control.Applicative import Control.Comonad +import Control.Exception (ErrorCall, evaluate, try) import Data.Coerce +import Data.Either (isLeft) import Data.Foldable import qualified Data.Foldable.WithIndex as IFoldable import Data.Functor.Alt @@ -16,6 +18,8 @@ import qualified Data.Map as M import qualified Data.Map.NonEmpty as NEM import qualified Data.Map.NonEmpty.Internal as NEM +import qualified Data.Map.NonEmpty.Lazy as NEML +import qualified Data.Map.NonEmpty.Strict as NEMS import Data.Semigroup.Foldable import Data.Semigroup.Traversable import Data.Text (Text) @@ -35,6 +39,19 @@ prop_valid = property $ assert . NEM.valid =<< forAll neMapGen + +prop_lazy_singleton_does_not_force_value :: Property +prop_lazy_singleton_does_not_force_value = property $ do + _ <- evalIO $ evaluate (NEML.singleton dummyKey (error "forced lazy NEMap value" :: Int)) + success + +prop_strict_singleton_forces_value :: Property +prop_strict_singleton_forces_value = property $ do + r <- + evalIO $ + try @ErrorCall $ + evaluate (NEMS.singleton dummyKey (error "forced strict NEMap value" :: Int)) + assert (isLeft r) prop_valid_toMap :: Property prop_valid_toMap = diff --git a/test/Tests/Map/Strict.hs b/test/Tests/Map/Strict.hs new file mode 100644 --- /dev/null +++ b/test/Tests/Map/Strict.hs @@ -0,0 +1,1338 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Tests.Map.Strict (mapStrictTests) where + +import Control.Applicative +import Control.Comonad +import Data.Coerce +import Data.Foldable +import qualified Data.Foldable.WithIndex as IFoldable +import Data.Functor.Alt +import Data.Functor.Identity +import qualified Data.Functor.WithIndex as IFunctor +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as M +import qualified Data.Map.NonEmpty.Lazy as NEML +import qualified Data.Map.NonEmpty.Strict as NEM +import qualified Data.Map.NonEmpty.Strict as NEMS +import qualified Data.Map.NonEmpty.Strict.Internal as NEM +import Data.Semigroup.Foldable +import Data.Semigroup.Traversable +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Traversable.WithIndex as TWI +import qualified GHC.Exts as Exts +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Tasty +import Tests.Util + +mapStrictTests :: TestTree +mapStrictTests = groupTree $$discover + +prop_valid :: Property +prop_valid = + property $ + assert . NEM.valid =<< forAll neMapGen + +-- | Pick an existing key out of a generated map, so the branch that +-- actually applies the user function is guaranteed to run. +existingKeyOf :: MonadGen m => NEMS.NEMap KeyType a -> m KeyType +existingKeyOf = Gen.element . NE.toList . NEMS.keys + +prop_lazy_singleton_does_not_force_value :: Property +prop_lazy_singleton_does_not_force_value = property $ do + k <- forAll keyGen + assertNotForced (NEML.singleton k (error "forced lazy NEMap value" :: Text)) + +prop_strict_singleton_forces_value :: Property +prop_strict_singleton_forces_value = property $ do + k <- forAll keyGen + assertForced (NEMS.singleton k (error "forced strict NEMap value" :: Text)) + +prop_lazy_insertWith_does_not_force_value :: Property +prop_lazy_insertWith_does_not_force_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ + NEML.insertWith (\_ _ -> error "forced lazy NEMap value") k T.empty m + +prop_strict_insertWith_forces_value :: Property +prop_strict_insertWith_forces_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertForced $ + NEMS.insertWith (\_ _ -> error "forced strict NEMap value") k T.empty m + +prop_lazy_adjustWithKey_does_not_force_value :: Property +prop_lazy_adjustWithKey_does_not_force_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ NEML.adjustWithKey (\_ _ -> error "forced lazy NEMap value") k m + +prop_strict_adjustWithKey_forces_value :: Property +prop_strict_adjustWithKey_forces_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertForced $ NEMS.adjustWithKey (\_ _ -> error "forced strict NEMap value") k m + +prop_lazy_alter_does_not_force_value :: Property +prop_lazy_alter_does_not_force_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ NEML.alter (const (Just (error "forced lazy NEMap value"))) k m + +prop_strict_alter_forces_value :: Property +prop_strict_alter_forces_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertForced $ NEMS.alter (const (Just (error "forced strict NEMap value"))) k m + +prop_lazy_mapWithKey_does_not_force_value :: Property +prop_lazy_mapWithKey_does_not_force_value = property $ do + m <- forAll neMapGen + assertNotForced $ NEML.mapWithKey (\_ _ -> error "forced lazy NEMap value") m + +prop_strict_mapWithKey_forces_value :: Property +prop_strict_mapWithKey_forces_value = property $ do + m <- forAll neMapGen + assertForced $ NEMS.mapWithKey (\_ _ -> error "forced strict NEMap value") m + +prop_lazy_unionWith_does_not_force_value :: Property +prop_lazy_unionWith_does_not_force_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ + NEML.unionWith (\_ _ -> error "forced lazy NEMap value") m (NEML.singleton k T.empty) + +prop_strict_unionWith_forces_value :: Property +prop_strict_unionWith_forces_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertForced $ + NEMS.unionWith (\_ _ -> error "forced strict NEMap value") m (NEMS.singleton k T.empty) + +prop_lazy_mapMaybeWithKey_does_not_force_value :: Property +prop_lazy_mapMaybeWithKey_does_not_force_value = property $ do + m <- forAll neMapGen + assertNotForced $ NEML.mapMaybeWithKey (\_ _ -> Just (error "forced lazy NEMap value")) m + +prop_strict_mapMaybeWithKey_forces_value :: Property +prop_strict_mapMaybeWithKey_forces_value = property $ do + m <- forAll neMapGen + assertForced $ NEMS.mapMaybeWithKey (\_ _ -> Just (error "forced strict NEMap value")) m + +prop_lazy_mapAccumWithKey_does_not_force_value :: Property +prop_lazy_mapAccumWithKey_does_not_force_value = property $ do + m <- forAll neMapGen + assertNotForced $ + snd (NEML.mapAccumWithKey (\acc _ _ -> (acc, error "forced lazy NEMap value" :: Text)) () m) + +prop_strict_mapAccumWithKey_forces_value :: Property +prop_strict_mapAccumWithKey_forces_value = property $ do + m <- forAll neMapGen + assertForced $ + snd (NEMS.mapAccumWithKey (\acc _ _ -> (acc, error "forced strict NEMap value" :: Text)) () m) + +prop_lazy_fromListWith_does_not_force_value :: Property +prop_lazy_fromListWith_does_not_force_value = property $ do + k <- forAll keyGen + assertNotForced $ + NEML.fromListWith (\_ _ -> error "forced lazy NEMap value") ((k, T.empty) :| [(k, T.empty)]) + +prop_strict_fromListWith_forces_value :: Property +prop_strict_fromListWith_forces_value = property $ do + k <- forAll keyGen + assertForced $ + NEMS.fromListWith (\_ _ -> error "forced strict NEMap value") ((k, T.empty) :| [(k, T.empty)]) + +prop_lazy_insertMapWith_does_not_force_value :: Property +prop_lazy_insertMapWith_does_not_force_value = property $ do + k <- forAll keyGen + assertNotForced $ + NEML.insertMapWith (\_ _ -> error "forced lazy NEMap value") k T.empty (M.singleton k T.empty) + +prop_strict_insertMapWith_forces_value :: Property +prop_strict_insertMapWith_forces_value = property $ do + k <- forAll keyGen + assertForced $ + NEMS.insertMapWith (\_ _ -> error "forced strict NEMap value") k T.empty (M.singleton k T.empty) + +prop_lazy_updateWithKey_does_not_force_value :: Property +prop_lazy_updateWithKey_does_not_force_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertNotForced $ NEML.updateWithKey (\_ _ -> Just (error "forced lazy NEMap value")) k m + +prop_strict_updateWithKey_forces_value :: Property +prop_strict_updateWithKey_forces_value = property $ do + m <- forAll neMapGen + k <- forAll (existingKeyOf m) + assertForced $ NEMS.updateWithKey (\_ _ -> Just (error "forced strict NEMap value")) k m + +-- | Two-key map with both keys deliberately mapped to the same target key, +-- so the combining function is guaranteed to run. +collidingMapKeysFixture :: MonadGen m => m (KeyType, NEMS.NEMap KeyType Text) +collidingMapKeysFixture = do + k <- keyGen + pure (k, NEML.fromList ((k, T.empty) :| [(overKX (+ 1) k, T.empty)])) + +prop_lazy_mapKeysWith_does_not_force_value :: Property +prop_lazy_mapKeysWith_does_not_force_value = property $ do + (k, m) <- forAll collidingMapKeysFixture + assertNotForced $ NEML.mapKeysWith (\_ _ -> error "forced lazy NEMap value") (const k) m + +prop_strict_mapKeysWith_forces_value :: Property +prop_strict_mapKeysWith_forces_value = property $ do + (k, m) <- forAll collidingMapKeysFixture + assertForced $ NEMS.mapKeysWith (\_ _ -> error "forced strict NEMap value") (const k) m + +prop_lazy_traverseWithKey_does_not_force_value :: Property +prop_lazy_traverseWithKey_does_not_force_value = property $ do + m <- forAll neMapGen + assertNotForced $ + runIdentity (NEML.traverseWithKey (\_ _ -> Identity (error "forced lazy NEMap value" :: Text)) m) + +prop_strict_traverseWithKey_forces_value :: Property +prop_strict_traverseWithKey_forces_value = property $ do + m <- forAll neMapGen + assertForced $ + runIdentity (NEMS.traverseWithKey (\_ _ -> Identity (error "forced strict NEMap value" :: Text)) m) + +prop_lazy_traverseWithKey1_does_not_force_value :: Property +prop_lazy_traverseWithKey1_does_not_force_value = property $ do + m <- forAll neMapGen + assertNotForced $ + runIdentity (NEML.traverseWithKey1 (\_ _ -> Identity (error "forced lazy NEMap value" :: Text)) m) + +prop_strict_traverseWithKey1_forces_value :: Property +prop_strict_traverseWithKey1_forces_value = property $ do + m <- forAll neMapGen + assertForced $ + runIdentity (NEMS.traverseWithKey1 (\_ _ -> Identity (error "forced strict NEMap value" :: Text)) m) + +prop_lazy_traverseMaybeWithKey1_does_not_force_value :: Property +prop_lazy_traverseMaybeWithKey1_does_not_force_value = property $ do + m <- forAll neMapGen + assertNotForced $ + runIdentity + (NEML.traverseMaybeWithKey1 (\_ _ -> Identity (Just (error "forced lazy NEMap value" :: Text))) m) + +prop_strict_traverseMaybeWithKey1_forces_value :: Property +prop_strict_traverseMaybeWithKey1_forces_value = property $ do + m <- forAll neMapGen + assertForced $ + runIdentity + (NEMS.traverseMaybeWithKey1 (\_ _ -> Identity (Just (error "forced strict NEMap value" :: Text))) m) + +prop_valid_toMap :: Property +prop_valid_toMap = + property $ + assert . M.valid . NEM.toMap =<< forAll neMapGen + +prop_valid_insertMinMap :: Property +prop_valid_insertMinMap = property $ do + n <- forAll $ do + m <- mapGen + let k = maybe dummyKey (subtract 1 . fst) $ M.lookupMin m + v <- valGen + pure $ NEM.insertMinMap k v m + assert $ M.valid n + +prop_valid_insertMaxMap :: Property +prop_valid_insertMaxMap = property $ do + n <- forAll $ do + m <- mapGen + let k = maybe dummyKey ((+ 1) . fst) $ M.lookupMax m + v <- valGen + pure $ NEM.insertMaxMap k v m + assert $ M.valid n + +prop_valid_insertMapMin :: Property +prop_valid_insertMapMin = property $ do + n <- forAll $ do + m <- mapGen + let k = maybe dummyKey (subtract 1 . fst) $ M.lookupMin m + v <- valGen + pure $ NEM.insertMapMin k v m + assert $ NEM.valid n + +prop_valid_insertMapMax :: Property +prop_valid_insertMapMax = property $ do + n <- forAll $ do + m <- mapGen + let k = maybe dummyKey ((+ 1) . fst) $ M.lookupMax m + v <- valGen + pure $ NEM.insertMapMax k v m + assert $ NEM.valid n + +prop_toMapIso1 :: Property +prop_toMapIso1 = property $ do + m0 <- forAll mapGen + tripping + m0 + NEM.nonEmptyMap + (Identity . maybe M.empty NEM.toMap) + +prop_toMapIso2 :: Property +prop_toMapIso2 = property $ do + m0 <- forAll $ Gen.maybe neMapGen + tripping + m0 + (maybe M.empty NEM.toMap) + (Identity . NEM.nonEmptyMap) + +prop_read_show :: Property +prop_read_show = readShow neMapGen + +prop_read1_show1 :: Property +prop_read1_show1 = readShow1 neMapGen + +prop_show_show1 :: Property +prop_show_show1 = showShow1 neMapGen + +prop_show_show2 :: Property +prop_show_show2 = showShow2 neMapGen + +prop_splitRoot :: Property +prop_splitRoot = property $ do + n <- forAll neMapGen + let rs = NEM.splitRoot n + allItems = foldMap1 NEM.keys rs + n' = NEM.unions rs + assert $ ascending allItems + mapM_ (assert . (`NEM.isSubmapOf` n)) rs + length allItems === length n' + n === n' + where + ascending (x :| xs) = case NE.nonEmpty xs of + Nothing -> True + Just ys@(y :| _) -> x < y && ascending ys + +prop_functorWithIndex :: Property +prop_functorWithIndex = + property $ do + m <- forAll neMapGen + let f k v = v <> T.pack (show (getKX k)) + IFunctor.imap f m === NEM.mapWithKey f m + +prop_foldableWithIndex :: Property +prop_foldableWithIndex = + property $ do + m <- forAll neMapGen + IFoldable.ifoldMap (\k v -> [(k, v)]) m === toList (NEM.toList m) + +prop_traversableWithIndex :: Property +prop_traversableWithIndex = + property $ do + m <- forAll neMapGen + let f k v = v <> T.pack (show (getKX k)) + TWI.itraverse (\k v -> Identity (f k v)) m === Identity (NEM.mapWithKey f m) + TWI.itraverse (\k v -> Const [(k, v)]) m === Const (toList (NEM.toList m)) + +prop_extract_duplicate :: Property +prop_extract_duplicate = property $ do + n <- forAll neMapGen + tripping + n + duplicate + (Identity . extract) + +prop_fmap_extract_duplicate :: Property +prop_fmap_extract_duplicate = property $ do + n <- forAll neMapGen + tripping + n + duplicate + (Identity . fmap extract) + +prop_duplicate_duplicate :: Property +prop_duplicate_duplicate = property $ do + n <- forAll neMapGen + let dd1 = duplicate . duplicate $ n + dd2 = fmap duplicate . duplicate $ n + assert $ NEM.valid dd1 + assert $ NEM.valid dd2 + dd1 === dd2 + +prop_insertMapWithKey :: Property +prop_insertMapWithKey = + ttProp + (gf3 valGen :?> GTKey :-> GTVal :-> GTMap :-> TTNEMap) + M.insertWithKey + NEM.insertMapWithKey + +prop_singleton :: Property +prop_singleton = + ttProp + (GTKey :-> GTVal :-> TTNEMap) + M.singleton + NEM.singleton + +prop_fromSet :: Property +prop_fromSet = + ttProp + (gf1 valGen :?> GTNESet :-> TTNEMap) + M.fromSet + NEM.fromSet + +prop_fromAscList :: Property +prop_fromAscList = + ttProp + (GTSorted STAsc (GTNEList Nothing (GTKey :&: GTVal)) :-> TTNEMap) + M.fromAscList + NEM.fromAscList + +prop_fromDescList :: Property +prop_fromDescList = + ttProp + (GTSorted STDesc (GTNEList Nothing (GTKey :&: GTVal)) :-> TTNEMap) + M.fromDescList + NEM.fromDescList + +prop_fromAscListWithKey :: Property +prop_fromAscListWithKey = + ttProp + (gf3 valGen :?> GTSorted STAsc (GTNEList Nothing (GTKey :&: GTVal)) :-> TTNEMap) + M.fromAscListWithKey + NEM.fromAscListWithKey + +prop_fromDescListWithKey :: Property +prop_fromDescListWithKey = + ttProp + (gf3 valGen :?> GTSorted STDesc (GTNEList Nothing (GTKey :&: GTVal)) :-> TTNEMap) + M.fromDescListWithKey + NEM.fromDescListWithKey + +prop_fromDistinctAscList :: Property +prop_fromDistinctAscList = + ttProp + (GTSorted STDistinctAsc (GTNEList Nothing (GTKey :&: GTVal)) :-> TTNEMap) + M.fromDistinctAscList + NEM.fromDistinctAscList + +prop_fromDistinctDescList :: Property +prop_fromDistinctDescList = + ttProp + (GTSorted STDistinctDesc (GTNEList Nothing (GTKey :&: GTVal)) :-> TTNEMap) + M.fromDistinctDescList + NEM.fromDistinctDescList + +prop_fromListWithKey :: Property +prop_fromListWithKey = + ttProp + (gf3 valGen :?> GTNEList Nothing (GTKey :&: GTVal) :-> TTNEMap) + M.fromListWithKey + NEM.fromListWithKey + +prop_toFromOverloadedList :: Property +prop_toFromOverloadedList = + property $ do + s <- forAll neMapGen + s === Exts.fromList (Exts.toList s) + +prop_fromToOverloadedList :: Property +prop_fromToOverloadedList = + property $ do + l <- forAll neKeyListUniqGen + l === Exts.toList (Exts.fromList @(NEM.NEMap KeyType Text) l) + +prop_insert :: Property +prop_insert = + ttProp + (GTKey :-> GTVal :-> GTNEMap :-> TTNEMap) + M.insert + NEM.insert + +prop_insertWithKey :: Property +prop_insertWithKey = + ttProp + (gf3 valGen :?> GTKey :-> GTVal :-> GTNEMap :-> TTNEMap) + M.insertWithKey + NEM.insertWithKey + +prop_delete :: Property +prop_delete = + ttProp + (GTKey :-> GTNEMap :-> TTMap) + M.delete + NEM.delete + +prop_deleteMaybe :: Property +prop_deleteMaybe = + property $ do + k <- forAll keyGen + m <- forAll neMapGen + NEM.deleteMaybe k m === NEM.nonEmptyMap (M.delete k (NEM.toMap m)) + +prop_adjustWithKey :: Property +prop_adjustWithKey = + ttProp + (gf2 valGen :?> GTKey :-> GTNEMap :-> TTNEMap) + M.adjustWithKey + NEM.adjustWithKey + +prop_updateWithKey :: Property +prop_updateWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTKey :-> GTNEMap :-> TTMap) + M.updateWithKey + NEM.updateWithKey + +prop_updateLookupWithKey :: Property +prop_updateLookupWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTKey :-> GTNEMap :-> TTMaybe TTVal :*: TTMap) + M.updateLookupWithKey + NEM.updateLookupWithKey + +prop_alter :: Property +prop_alter = + ttProp + (gf1 (Gen.maybe valGen) :?> GTKey :-> GTNEMap :-> TTMap) + M.alter + NEM.alter + +prop_alter' :: Property +prop_alter' = + ttProp + (gf1 valGen :?> GTKey :-> GTNEMap :-> TTNEMap) + (M.alter . fmap Just) + NEM.alter' + +prop_alterF :: Property +prop_alterF = + ttProp + ( gf1 (Gen.maybe valGen) + :?> GTKey + :-> GTNEMap + :-> TTCtx (GTMaybe GTVal :-> TTMap) (TTMaybe TTVal) + ) + (M.alterF . Context) + (NEM.alterF . Context) + +prop_alterF_rules_Const :: Property +prop_alterF_rules_Const = + ttProp + ( gf1 (Const <$> valGen) + :?> GTKey + :-> GTNEMap + :-> TTOther + ) + (\f k m -> getConst (M.alterF f k m)) + (\f k m -> getConst (NEM.alterF f k m)) + +prop_alterF_rules_Identity :: Property +prop_alterF_rules_Identity = + ttProp + ( gf1 (Identity <$> Gen.maybe valGen) + :?> GTKey + :-> GTNEMap + :-> TTMap + ) + (\f k m -> runIdentity (M.alterF f k m)) + (\f k m -> runIdentity (NEM.alterF f k m)) + +prop_alterF' :: Property +prop_alterF' = + ttProp + (gf1 valGen :?> GTKey :-> GTNEMap :-> TTCtx (GTVal :-> TTNEMap) (TTMaybe TTVal)) + (M.alterF . Context . fmap Just) + (NEM.alterF' . Context) + +prop_alterF'_rules_Const :: Property +prop_alterF'_rules_Const = + ttProp + ( gf1 (Const <$> valGen) + :?> GTKey + :-> GTNEMap + :-> TTOther + ) + (\f k m -> let f' = fmap Just . f in getConst (M.alterF f' k m)) + (\f k m -> getConst (NEM.alterF' f k m)) + +-- -- | This fails, but isn't possible to fix without copying-and-pasting more +-- -- in code from containers. +-- prop_alterF'_rules_Identity :: Property +-- prop_alterF'_rules_Identity = ttProp ( gf1 (Identity <$> valGen) +-- :?> GTKey +-- :-> GTNEMap +-- :-> TTNEMap +-- ) +-- (\f k m -> let f' = fmap Just . f in runIdentity (M.alterF f' k m)) +-- (\f k m -> runIdentity (NEM.alterF' f k m)) + +prop_lookup :: Property +prop_lookup = + ttProp + (GTKey :-> GTNEMap :-> TTMaybe TTVal) + M.lookup + NEM.lookup + +prop_findWithDefault :: Property +prop_findWithDefault = + ttProp + (GTVal :-> GTKey :-> GTNEMap :-> TTVal) + M.findWithDefault + NEM.findWithDefault + +prop_member :: Property +prop_member = + ttProp + (GTKey :-> GTNEMap :-> TTOther) + M.member + NEM.member + +prop_notMember :: Property +prop_notMember = + ttProp + (GTKey :-> GTNEMap :-> TTOther) + M.notMember + NEM.notMember + +prop_lookupLT :: Property +prop_lookupLT = + ttProp + (GTKey :-> GTNEMap :-> TTMaybe (TTKey :*: TTVal)) + M.lookupLT + NEM.lookupLT + +prop_lookupGT :: Property +prop_lookupGT = + ttProp + (GTKey :-> GTNEMap :-> TTMaybe (TTKey :*: TTVal)) + M.lookupGT + NEM.lookupGT + +prop_lookupLE :: Property +prop_lookupLE = + ttProp + (GTKey :-> GTNEMap :-> TTMaybe (TTKey :*: TTVal)) + M.lookupLE + NEM.lookupLE + +prop_lookupGE :: Property +prop_lookupGE = + ttProp + (GTKey :-> GTNEMap :-> TTMaybe (TTKey :*: TTVal)) + M.lookupGE + NEM.lookupGE + +prop_size :: Property +prop_size = + ttProp + (GTNEMap :-> TTOther) + M.size + NEM.size + +prop_union :: Property +prop_union = + ttProp + (GTNEMap :-> GTNEMap :-> TTNEMap) + M.union + NEM.union + +prop_unionMapLeft :: Property +prop_unionMapLeft = + ttProp + (GTMap :-> GTNEMap :-> TTNEMap) + M.union + NEM.unionMapLeft + +prop_unionMapRight :: Property +prop_unionMapRight = + ttProp + (GTNEMap :-> GTMap :-> TTNEMap) + M.union + NEM.unionMapRight + +prop_unionWith :: Property +prop_unionWith = + ttProp + (gf2 valGen :?> GTNEMap :-> GTNEMap :-> TTNEMap) + M.unionWith + NEM.unionWith + +prop_unionMapWithLeft :: Property +prop_unionMapWithLeft = + ttProp + (gf2 valGen :?> GTMap :-> GTNEMap :-> TTNEMap) + M.unionWith + NEM.unionMapWithLeft + +prop_unionMapWithRight :: Property +prop_unionMapWithRight = + ttProp + (gf2 valGen :?> GTNEMap :-> GTMap :-> TTNEMap) + M.unionWith + NEM.unionMapWithRight + +prop_unionWithKey :: Property +prop_unionWithKey = + ttProp + (gf3 valGen :?> GTNEMap :-> GTNEMap :-> TTNEMap) + M.unionWithKey + NEM.unionWithKey + +prop_unionMapWithKeyLeft :: Property +prop_unionMapWithKeyLeft = + ttProp + (gf3 valGen :?> GTMap :-> GTNEMap :-> TTNEMap) + M.unionWithKey + NEM.unionMapWithKeyLeft + +prop_unionMapWithKeyRight :: Property +prop_unionMapWithKeyRight = + ttProp + (gf3 valGen :?> GTNEMap :-> GTMap :-> TTNEMap) + M.unionWithKey + NEM.unionMapWithKeyRight + +prop_unions :: Property +prop_unions = + ttProp + (GTNEList (Just (Range.linear 2 5)) GTNEMap :-> TTNEMap) + M.unions + NEM.unions + +prop_unionsWith :: Property +prop_unionsWith = + ttProp + (gf2 valGen :?> GTNEList (Just (Range.linear 2 5)) GTNEMap :-> TTNEMap) + M.unionsWith + NEM.unionsWith + +prop_difference :: Property +prop_difference = + ttProp + (GTNEMap :-> GTNEMap :-> TTMap) + M.difference + NEM.difference + +prop_differenceWithKey :: Property +prop_differenceWithKey = + ttProp + (gf3 (Gen.maybe valGen) :?> GTNEMap :-> GTNEMap :-> TTMap) + M.differenceWithKey + NEM.differenceWithKey + +prop_intersection :: Property +prop_intersection = + ttProp + (GTNEMap :-> GTNEMap :-> TTMap) + M.intersection + NEM.intersection + +prop_intersectionWithKey :: Property +prop_intersectionWithKey = + ttProp + (gf3 valGen :?> GTNEMap :-> GTNEMap :-> TTMap) + M.intersectionWithKey + NEM.intersectionWithKey + +prop_map :: Property +prop_map = + ttProp + (gf1 valGen :?> GTNEMap :-> TTNEMap) + M.map + NEM.map + +prop_map_rules_map :: Property +prop_map_rules_map = + ttProp + (gf1 valGen :?> gf1 valGen :?> GTNEMap :-> TTNEMap) + (\f g xs -> M.map f (M.map g xs)) + (\f g xs -> NEM.map f (NEM.map g xs)) + +prop_map_rules_coerce :: Property +prop_map_rules_coerce = + ttProp + (GTNEMap :-> TTNEMap) + (M.map @Text @Text coerce) + (NEM.map @Text @Text coerce) + +prop_map_rules_mapWithKey :: Property +prop_map_rules_mapWithKey = + ttProp + (gf1 valGen :?> gf2 valGen :?> GTNEMap :-> TTNEMap) + (\f g xs -> M.map f (M.mapWithKey g xs)) + (\f g xs -> NEM.map f (NEM.mapWithKey g xs)) + +prop_mapWithKey :: Property +prop_mapWithKey = + ttProp + (gf2 valGen :?> GTNEMap :-> TTNEMap) + M.mapWithKey + NEM.mapWithKey + +prop_mapWithKey_rules_mapWithKey :: Property +prop_mapWithKey_rules_mapWithKey = + ttProp + (gf2 valGen :?> gf2 valGen :?> GTNEMap :-> TTNEMap) + (\f g xs -> M.mapWithKey f (M.mapWithKey g xs)) + (\f g xs -> NEM.mapWithKey f (NEM.mapWithKey g xs)) + +prop_mapWithKey_rules_map :: Property +prop_mapWithKey_rules_map = + ttProp + (gf2 valGen :?> gf1 valGen :?> GTNEMap :-> TTNEMap) + (\f g xs -> M.mapWithKey f (M.map g xs)) + (\f g xs -> NEM.mapWithKey f (NEM.map g xs)) + +prop_traverseWithKey1 :: Property +prop_traverseWithKey1 = + ttProp + (gf2 valGen :?> GTNEMap :-> TTBazaar GTVal TTNEMap TTVal) + (\f -> M.traverseWithKey (\k -> (`More` Done (f k)))) + (\f -> NEM.traverseWithKey1 (\k -> (`More` Done (f k)))) + +prop_traverseWithKey :: Property +prop_traverseWithKey = + ttProp + (gf2 valGen :?> GTNEMap :-> TTBazaar GTVal TTNEMap TTVal) + (\f -> M.traverseWithKey (\k -> (`More` Done (f k)))) + (\f -> NEM.traverseWithKey (\k -> (`More` Done (f k)))) + +prop_traverseMaybeWithKey1 :: Property +prop_traverseMaybeWithKey1 = + ttProp + (gf2 valGen :?> GTNEMap :-> TTBazaar (GTMaybe GTVal) TTMap TTVal) + (\f -> M.traverseMaybeWithKey (\k -> (`More` Done (fmap (f k))))) + (\f -> NEM.traverseMaybeWithKey1 (\k -> (`More` Done (fmap (f k))))) + +prop_traverseMaybeWithKey :: Property +prop_traverseMaybeWithKey = + ttProp + (gf2 valGen :?> GTNEMap :-> TTBazaar (GTMaybe GTVal) TTMap TTVal) + (\f -> M.traverseMaybeWithKey (\k -> (`More` Done (fmap (f k))))) + (\f -> NEM.traverseMaybeWithKey (\k -> (`More` Done (fmap (f k))))) + +prop_sequence1 :: Property +prop_sequence1 = + ttProp + (GTNEMap :-> TTBazaar GTVal TTNEMap TTVal) + (sequenceA . fmap (`More` Done id)) + (sequence1 . fmap (`More` Done id)) +{-# ANN prop_sequence1 "HLint: ignore Use traverse" #-} + +prop_sequenceA :: Property +prop_sequenceA = + ttProp + (GTNEMap :-> TTBazaar GTVal TTNEMap TTVal) + (sequenceA . fmap (`More` Done id)) + (sequenceA . fmap (`More` Done id)) +{-# ANN prop_sequenceA "HLint: ignore Use traverse" #-} + +prop_mapAccumWithKey :: Property +prop_mapAccumWithKey = + ttProp + ( gf3 ((,) <$> valGen <*> valGen) + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + :*: TTNEMap + ) + M.mapAccumWithKey + NEM.mapAccumWithKey + +prop_mapAccumRWithKey :: Property +prop_mapAccumRWithKey = + ttProp + ( gf3 ((,) <$> valGen <*> valGen) + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + :*: TTNEMap + ) + M.mapAccumRWithKey + NEM.mapAccumRWithKey + +prop_mapKeys :: Property +prop_mapKeys = + ttProp + (gf1 keyGen :?> GTNEMap :-> TTNEMap) + M.mapKeys + NEM.mapKeys + +prop_mapKeysWith :: Property +prop_mapKeysWith = + ttProp + ( gf2 valGen + :?> gf1 keyGen + :?> GTNEMap + :-> TTNEMap + ) + M.mapKeysWith + NEM.mapKeysWith + +prop_mapKeysMonotonic :: Property +prop_mapKeysMonotonic = + ttProp + (GF valGen go :?> GTNEMap :-> TTNEMap) + M.mapKeysMonotonic + NEM.mapKeysMonotonic + where + go f (K i t) = K (i * 2) (f t) + +prop_foldr :: Property +prop_foldr = + ttProp + ( gf2 valGen + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + ) + M.foldr + NEM.foldr + +prop_foldl :: Property +prop_foldl = + ttProp + ( gf2 valGen + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + ) + M.foldl + NEM.foldl + +prop_foldr1 :: Property +prop_foldr1 = + ttProp + ( gf2 valGen + :?> GTNEMap + :-> TTOther + ) + foldr1 + NEM.foldr1 + +prop_foldl1 :: Property +prop_foldl1 = + ttProp + ( gf2 valGen + :?> GTNEMap + :-> TTOther + ) + foldl1 + NEM.foldl1 + +prop_foldrWithKey :: Property +prop_foldrWithKey = + ttProp + ( gf3 valGen + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + ) + M.foldrWithKey + NEM.foldrWithKey + +prop_foldlWithKey :: Property +prop_foldlWithKey = + ttProp + ( gf3 valGen + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + ) + M.foldlWithKey + NEM.foldlWithKey + +prop_foldMapWithKey :: Property +prop_foldMapWithKey = + ttProp + (gf2 valGen :?> GTNEMap :-> TTOther) + M.foldMapWithKey + NEM.foldMapWithKey + +prop_foldr' :: Property +prop_foldr' = + ttProp + ( gf2 valGen + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + ) + M.foldr' + NEM.foldr' + +prop_foldl' :: Property +prop_foldl' = + ttProp + ( gf2 valGen + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + ) + M.foldl' + NEM.foldl' + +prop_foldr1' :: Property +prop_foldr1' = + ttProp + ( gf2 valGen + :?> GTNEMap + :-> TTOther + ) + foldr1 + NEM.foldr1' + +prop_foldl1' :: Property +prop_foldl1' = + ttProp + ( gf2 valGen + :?> GTNEMap + :-> TTOther + ) + foldl1 + NEM.foldl1' + +prop_foldrWithKey' :: Property +prop_foldrWithKey' = + ttProp + ( gf3 valGen + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + ) + M.foldrWithKey' + NEM.foldrWithKey' + +prop_foldlWithKey' :: Property +prop_foldlWithKey' = + ttProp + ( gf3 valGen + :?> GTOther valGen + :-> GTNEMap + :-> TTOther + ) + M.foldlWithKey' + NEM.foldlWithKey' + +prop_elems :: Property +prop_elems = + ttProp + (GTNEMap :-> TTNEList TTVal) + M.elems + NEM.elems + +prop_keys :: Property +prop_keys = + ttProp + (GTNEMap :-> TTNEList TTKey) + M.keys + NEM.keys + +prop_assocs :: Property +prop_assocs = + ttProp + (GTNEMap :-> TTNEList (TTKey :*: TTVal)) + M.assocs + NEM.assocs + +prop_keysSet :: Property +prop_keysSet = + ttProp + (GTNEMap :-> TTNESet) + M.keysSet + NEM.keysSet + +prop_toList :: Property +prop_toList = + ttProp + (GTNEMap :-> TTNEList (TTKey :*: TTVal)) + M.toList + NEM.toList + +prop_toDescList :: Property +prop_toDescList = + ttProp + (GTNEMap :-> TTNEList (TTKey :*: TTVal)) + M.toDescList + NEM.toDescList + +prop_filter :: Property +prop_filter = + ttProp + (gf1 Gen.bool :?> GTNEMap :-> TTMap) + M.filter + NEM.filter + +prop_filterWithKey :: Property +prop_filterWithKey = + ttProp + (gf2 Gen.bool :?> GTNEMap :-> TTMap) + M.filterWithKey + NEM.filterWithKey + +prop_restrictKeys :: Property +prop_restrictKeys = + ttProp + (GTNEMap :-> GTSet :-> TTMap) + M.restrictKeys + NEM.restrictKeys + +prop_withoutKeys :: Property +prop_withoutKeys = + ttProp + (GTNEMap :-> GTSet :-> TTMap) + M.withoutKeys + NEM.withoutKeys + +prop_partitionWithKey :: Property +prop_partitionWithKey = + ttProp + (gf2 Gen.bool :?> GTNEMap :-> TTThese TTNEMap TTNEMap) + M.partitionWithKey + NEM.partitionWithKey + +prop_takeWhileAntitone :: Property +prop_takeWhileAntitone = + ttProp + (GTNEMap :-> TTMap) + (M.takeWhileAntitone ((< 0) . getKX)) + (NEM.takeWhileAntitone ((< 0) . getKX)) + +prop_dropWhileAntitone :: Property +prop_dropWhileAntitone = + ttProp + (GTNEMap :-> TTMap) + (M.dropWhileAntitone ((< 0) . getKX)) + (NEM.dropWhileAntitone ((< 0) . getKX)) + +prop_spanAntitone :: Property +prop_spanAntitone = + ttProp + (GTNEMap :-> TTThese TTNEMap TTNEMap) + (M.spanAntitone ((< 0) . getKX)) + (NEM.spanAntitone ((< 0) . getKX)) + +prop_mapMaybeWithKey :: Property +prop_mapMaybeWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTNEMap :-> TTMap) + M.mapMaybeWithKey + NEM.mapMaybeWithKey + +prop_mapEitherWithKey :: Property +prop_mapEitherWithKey = + ttProp + ( gf2 (Gen.choice [Left <$> valGen, Right <$> valGen]) + :?> GTNEMap + :-> TTThese TTNEMap TTNEMap + ) + M.mapEitherWithKey + NEM.mapEitherWithKey + +prop_split :: Property +prop_split = + ttProp + (GTKey :-> GTNEMap :-> TTMThese TTNEMap TTNEMap) + M.split + NEM.split + +prop_splitLookup :: Property +prop_splitLookup = + ttProp + (GTKey :-> GTNEMap :-> TTTThese TTVal TTNEMap TTNEMap) + (\k -> (\(x, y, z) -> (y, x, z)) . M.splitLookup k) + NEM.splitLookup + +prop_isSubmapOfBy :: Property +prop_isSubmapOfBy = + ttProp + (gf2 Gen.bool :?> GTNEMap :-> GTNEMap :-> TTOther) + M.isSubmapOfBy + NEM.isSubmapOfBy + +prop_isProperSubmapOfBy :: Property +prop_isProperSubmapOfBy = + ttProp + (gf2 Gen.bool :?> GTNEMap :-> GTNEMap :-> TTOther) + M.isProperSubmapOfBy + NEM.isProperSubmapOfBy + +prop_lookupIndex :: Property +prop_lookupIndex = + ttProp + (GTKey :-> GTNEMap :-> TTMaybe TTOther) + M.lookupIndex + NEM.lookupIndex + +prop_elemAt :: Property +prop_elemAt = + ttProp + (GTSize :-> GTNEMap :-> TTKey :*: TTVal) + (\i m -> M.elemAt (i `mod` M.size m) m) + (\i m -> NEM.elemAt (i `mod` NEM.size m) m) + +prop_adjustAt :: Property +prop_adjustAt = + ttProp + (gf2 valGen :?> GTSize :-> GTNEMap :-> TTNEMap) + (\f i m -> M.updateAt (\k -> Just . f k) (i `mod` M.size m) m) + (\f i m -> NEM.adjustAt f (i `mod` NEM.size m) m) + +prop_updateAt :: Property +prop_updateAt = + ttProp + (gf2 (Gen.maybe valGen) :?> GTSize :-> GTNEMap :-> TTMap) + (\f i m -> M.updateAt f (i `mod` M.size m) m) + (\f i m -> NEM.updateAt f (i `mod` NEM.size m) m) + +prop_deleteAt :: Property +prop_deleteAt = + ttProp + (GTSize :-> GTNEMap :-> TTMap) + (\i m -> M.deleteAt (i `mod` M.size m) m) + (\i m -> NEM.deleteAt (i `mod` NEM.size m) m) + +prop_take :: Property +prop_take = + ttProp + (GTSize :-> GTNEMap :-> TTMap) + M.take + NEM.take + +prop_drop :: Property +prop_drop = + ttProp + (GTSize :-> GTNEMap :-> TTMap) + M.drop + NEM.drop + +prop_splitAt :: Property +prop_splitAt = + ttProp + (GTSize :-> GTNEMap :-> TTThese TTNEMap TTNEMap) + M.splitAt + NEM.splitAt + +prop_findMin :: Property +prop_findMin = + ttProp + (GTNEMap :-> TTKey :*: TTVal) + M.findMin + NEM.findMin + +prop_findMax :: Property +prop_findMax = + ttProp + (GTNEMap :-> TTKey :*: TTVal) + M.findMax + NEM.findMax + +prop_deleteMin :: Property +prop_deleteMin = + ttProp + (GTNEMap :-> TTMap) + M.deleteMin + NEM.deleteMin + +prop_deleteMax :: Property +prop_deleteMax = + ttProp + (GTNEMap :-> TTMap) + M.deleteMax + NEM.deleteMax + +prop_deleteFindMin :: Property +prop_deleteFindMin = + ttProp + (GTNEMap :-> (TTKey :*: TTVal) :*: TTMap) + M.deleteFindMin + NEM.deleteFindMin + +prop_deleteFindMax :: Property +prop_deleteFindMax = + ttProp + (GTNEMap :-> (TTKey :*: TTVal) :*: TTMap) + M.deleteFindMax + NEM.deleteFindMax + +prop_updateMinWithKey :: Property +prop_updateMinWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTNEMap :-> TTMap) + M.updateMinWithKey + NEM.updateMinWithKey + +prop_updateMaxWithKey :: Property +prop_updateMaxWithKey = + ttProp + (gf2 (Gen.maybe valGen) :?> GTNEMap :-> TTMap) + M.updateMaxWithKey + NEM.updateMaxWithKey + +prop_adjustMinWithKey :: Property +prop_adjustMinWithKey = + ttProp + (gf2 valGen :?> GTNEMap :-> TTNEMap) + (M.updateMinWithKey . (fmap . fmap) Just) + NEM.adjustMinWithKey + +prop_adjustMaxWithKey :: Property +prop_adjustMaxWithKey = + ttProp + (gf2 valGen :?> GTNEMap :-> TTNEMap) + (M.updateMaxWithKey . (fmap . fmap) Just) + NEM.adjustMaxWithKey + +prop_minView :: Property +prop_minView = + ttProp + (GTNEMap :-> TTMaybe (TTVal :*: TTMap)) + M.minView + (Just . NEM.minView) + +prop_maxView :: Property +prop_maxView = + ttProp + (GTNEMap :-> TTMaybe (TTVal :*: TTMap)) + M.maxView + (Just . NEM.maxView) + +prop_elem :: Property +prop_elem = + ttProp + (GTVal :-> GTNEMap :-> TTOther) + elem + elem + +prop_fold1 :: Property +prop_fold1 = + ttProp + (GTNEMap :-> TTVal) + fold + fold1 + +prop_fold :: Property +prop_fold = + ttProp + (GTNEMap :-> TTVal) + fold + fold + +prop_foldMap1 :: Property +prop_foldMap1 = + ttProp + (gf1 valGen :?> GTNEMap :-> TTOther) + (\f -> foldMap ((: []) . f)) + (\f -> foldMap1 ((: []) . f)) + +prop_foldMap :: Property +prop_foldMap = + ttProp + (gf1 valGen :?> GTNEMap :-> TTOther) + (\f -> foldMap ((: []) . f)) + (\f -> foldMap ((: []) . f)) + +prop_alt :: Property +prop_alt = + ttProp + (GTNEMap :-> GTNEMap :-> TTNEMap) + () + () diff --git a/test/Tests/Util.hs b/test/Tests/Util.hs --- a/test/Tests/Util.hs +++ b/test/Tests/Util.hs @@ -27,6 +27,8 @@ TestType (..), ttProp, groupTree, + assertForced, + assertNotForced, readShow, readShow1, showShow1, @@ -55,9 +57,11 @@ ) where import Control.Applicative +import Control.Exception (ErrorCall, evaluate, try) import Control.Monad import Data.Bifunctor import Data.Char +import Data.Either (isLeft) import Data.Foldable import Data.Function import Data.Functor.Apply @@ -116,6 +120,22 @@ mkName = map deUnderscore . drop (length @[] @Char "prop_") deUnderscore '_' = ' ' deUnderscore c = c + +-- | Assert that evaluating a value to WHNF throws (i.e. that constructing +-- it must have forced some 'error'-laden thunk buried inside). Used to +-- test the strict interfaces. +assertForced :: a -> PropertyT IO () +assertForced x = do + r <- evalIO $ try @ErrorCall (evaluate x) + assert (isLeft r) + +-- | Assert that evaluating a value to WHNF does /not/ throw, even when it +-- contains an 'error'-laden thunk that only a strict interface would have +-- forced. Used to test the lazy interfaces. +assertNotForced :: a -> PropertyT IO () +assertNotForced x = do + _ <- evalIO $ evaluate x + success -- | test for stability data K a b = K {getKX :: !a, getKY :: !b}