**diff options**

author | jle <> | 2019-06-11 22:34:00 (GMT) |
---|---|---|

committer | hdiff <hdiff@hdiff.luite.com> | 2019-06-11 22:34:00 (GMT) |

commit | 40583fe48fa4addc0750315fa7ea9f421fd82bdf (patch) | |

tree | 99b116508d7ebad08d2cad395e01bd5b9557b53e | |

parent | 562b14bf0b2a8eb746f2e127d7b3e855df8c51d4 (diff) |

version 0.3.0.00.3.0.0

-rw-r--r-- | CHANGELOG.md | 12 | ||||

-rw-r--r-- | README.md | 16 | ||||

-rw-r--r-- | nonempty-containers.cabal | 14 | ||||

-rw-r--r-- | src/Data/IntMap/NonEmpty.hs | 163 | ||||

-rw-r--r-- | src/Data/IntSet/NonEmpty.hs | 98 | ||||

-rw-r--r-- | src/Data/Map/NonEmpty.hs | 205 | ||||

-rw-r--r-- | src/Data/Sequence/NonEmpty.hs | 115 | ||||

-rw-r--r-- | src/Data/Set/NonEmpty.hs | 133 | ||||

-rw-r--r-- | test/Tests/Util.hs | 58 |

9 files changed, 410 insertions, 404 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md index c637a4a..bb1868a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,20 @@ Changelog ========= +Version 0.3.0.0 +--------------- + +*June 10, 2019* + +<https://github.com/mstksg/nonempty-containers/releases/tag/v0.3.0.0> + +* Switch back from *data-or* to *these*, due to changes in the organization + of *these* that get rid of the high dependency footprint. + Version 0.2.0.0 --------------- -*December 8, 2018* +*May 14, 2019* <https://github.com/mstksg/nonempty-containers/releases/tag/v0.2.0.0> @@ -36,16 +36,16 @@ non-emptiness and emptiness as concepts, including: mapEither :: (a -> Either b c) -> Map k a -> (Map k b, Map k c) ``` - The final result is always a total partition (every item in the original map - is represented in the result), so, to reflect this, `Or` from the - [`data-or`][data-or] library is returned instead: + The final result is always a total partition (every item in the original + map is represented in the result), so, to reflect this, [`These`][these] is + returned instead: ```haskell - data Or a b = Fst a - | Both a b - | Snd b + data These a b = This a + | That b + | These a b - mapEither :: (a -> Either b c) -> NEMap k a -> Or (NEMap k b) (NEMap k c) + mapEither :: (a -> Either b c) -> NEMap k a -> These (NEMap k b) (NEMap k c) ``` This preserves the invariance of non-emptiness: either we have a non-empty @@ -53,7 +53,7 @@ non-emptiness and emptiness as concepts, including: the second camp (containing all original values), or a split between two non-empty maps in either camp. - [data-or]: https://hackage.haskell.org/package/data-or + [these]: https://hackage.haskell.org/package/these 3. Typeclass-polymorphic functions are made more general (or have more general variants provided) whenever possible. This means that functions like diff --git a/nonempty-containers.cabal b/nonempty-containers.cabal index d0e44c8..7591a88 100644 --- a/nonempty-containers.cabal +++ b/nonempty-containers.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 68afc97dfb79be7ecf93dc7044ffdacbc3fd69c80ca77b3ff84ac9400f05c7ce +-- hash: 87d86a711cd539b74db2c65e4aad0b063f44dcafe10649bef05ae1b731f9ea36 name: nonempty-containers -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Non-empty variants of containers data types, with full API description: Efficient and optimized non-empty versions of types from /containers/. Inspired by /non-empty-containers/ library, except attempting a more @@ -55,9 +55,9 @@ library base >=4.9 && <5 , comonad , containers >=0.5.9 - , data-or >=0.1 , deepseq , semigroupoids + , these default-language: Haskell2010 test-suite nonempty-containers-test @@ -78,12 +78,12 @@ test-suite nonempty-containers-test base >=4.9 && <5 , comonad , containers >=0.5.9 - , data-or >=0.1 - , hedgehog - , hedgehog-fn + , hedgehog >=1.0 + , hedgehog-fn >=1.0 , nonempty-containers , semigroupoids , tasty - , tasty-hedgehog + , tasty-hedgehog >=1.0 , text + , these default-language: Haskell2010 diff --git a/src/Data/IntMap/NonEmpty.hs b/src/Data/IntMap/NonEmpty.hs index 274cc5c..62c1ff5 100644 --- a/src/Data/IntMap/NonEmpty.hs +++ b/src/Data/IntMap/NonEmpty.hs @@ -237,23 +237,22 @@ module Data.IntMap.NonEmpty ( 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(..), Key) 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 Data.Maybe hiding (mapMaybe) +import Data.Semigroup.Foldable (Foldable1) +import Data.These +import Prelude hiding (map, filter, lookup, foldl, foldr, foldl1, foldr1) +import qualified Data.Foldable as F +import qualified Data.IntMap as M +import qualified Data.IntSet as S import qualified Data.List.NonEmpty as NE -import Data.Maybe hiding (mapMaybe) import qualified Data.Maybe as Maybe -import Data.Or (Or(..)) -import Data.Semigroup.Foldable (Foldable1) import qualified Data.Semigroup.Foldable as F1 -import Prelude hiding - (filter, foldl, foldl1, foldr, foldr1, 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 @@ -1472,60 +1471,60 @@ withoutKeys n@(NEIntMap k v m) xs = case S.minView xs of -- | /O(n)/. Partition the map according to a predicate. -- --- Returns an 'Or' with potentially two non-empty maps: +-- Returns a 'These' with potentially two non-empty maps: -- --- * @'Fst' n1@ means that the predicate was true for all items. --- * @'Snd' n2@ means that the predicate was false for all items. --- * @'Both' n1 n2@ gives @n1@ (all of the items that were true for the +-- * @'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")])) == Both (singleton 3 "b") (singleton 5 "a") --- > partition (< "x") (fromList ((5,"a") :| [(3,"b")])) == Fst (fromList ((3, "b") :| [(5, "a")])) --- > partition (> "x") (fromList ((5,"a") :| [(3,"b")])) == Snd (fromList ((3, "b") :| [(5, "a")])) +-- > 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 - -> Or (NEIntMap a) (NEIntMap a) + -> These (NEIntMap a) (NEIntMap a) partition f = partitionWithKey (const f) {-# INLINE partition #-} -- | /O(n)/. Partition the map according to a predicate. -- --- Returns an 'Or' with potentially two non-empty maps: +-- Returns a 'These' with potentially two non-empty maps: -- --- * @'Fst' n1@ means that the predicate was true for all items, +-- * @'This' n1@ means that the predicate was true for all items, -- returning the original map. --- * @'Snd' n2@ means that the predicate was false for all items, +-- * @'That' n2@ means that the predicate was false for all items, -- returning the original map. --- * @'Both' n1 n2@ gives @n1@ (all of the items that were true for the +-- * @'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")])) == Both (singleton 5 "a") (singleton 3 "b") --- > partitionWithKey (\ k _ -> k < 7) (fromList ((5,"a") :| [(3,"b")])) == Fst (fromList ((3, "b") :| [(5, "a")])) --- > partitionWithKey (\ k _ -> k > 7) (fromList ((5,"a") :| [(3,"b")])) == Snd (fromList ((3, "b") :| [(5, "a")])) +-- > 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 - -> Or (NEIntMap a) (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 -> Fst n - | otherwise -> Snd n + | f k v -> This n + | otherwise -> That n (Just n1, Nothing) - | f k v -> Fst n - | otherwise -> Both n1 (singleton k v) + | f k v -> This n + | otherwise -> These n1 (singleton k v) (Nothing, Just n2) - | f k v -> Both (singleton k v) n2 - | otherwise -> Snd n + | f k v -> These (singleton k v) n2 + | otherwise -> That n (Just n1, Just n2) - | f k v -> Both (insertMapMin k v m1) n2 - | otherwise -> Both n1 (insertMapMin k v m2) + | f k v -> These (insertMapMin k v m1) n2 + | otherwise -> These n1 (insertMapMin k v m2) where (m1, m2) = M.partitionWithKey f m0 {-# INLINABLE partitionWithKey #-} @@ -1562,97 +1561,97 @@ mapMaybeWithKey f (NEIntMap k v m) = ($ M.mapMaybeWithKey f m) -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. -- --- Returns an 'Or' with potentially two non-empty maps: +-- Returns a 'These' with potentially two non-empty maps: -- --- * @'Fst' n1@ means that the results were all 'Left'. --- * @'Snd' n2@ means that the results were all 'Right'. --- * @'Both' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- * @'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")])) --- > == Both (fromList ((3,"b") :| [(5,"a")])) (fromList ((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")])) --- > == Snd (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 - -> Or (NEIntMap b) (NEIntMap c) + -> 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 an 'Or' with potentially two non-empty maps: +-- Returns a 'These' with potentially two non-empty maps: -- --- * @'Fst' n1@ means that the results were all 'Left'. --- * @'Snd' n2@ means that the results were all 'Right'. --- * @'Both' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- * @'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")])) --- > == Both (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) +-- > == These (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) -- > -- > mapEitherWithKey (\_ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == Snd (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) +-- > == That (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) mapEitherWithKey :: (Key -> a -> Either b c) -> NEIntMap a - -> Or (NEIntMap b) (NEIntMap c) + -> 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' -> Fst (singleton k v') - Right v' -> Snd (singleton k v') + Left v' -> This (singleton k v') + Right v' -> That (singleton k v') (Just n1, Nothing) -> case f k v of - Left v' -> Fst (insertMapMin k v' m1) - Right v' -> Both n1 (singleton k v') + Left v' -> This (insertMapMin k v' m1) + Right v' -> These n1 (singleton k v') (Nothing, Just n2) -> case f k v of - Left v' -> Both (singleton k v') n2 - Right v' -> Snd (insertMapMin k v' m2) + 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' -> Both (insertMapMin k v' m1) n2 - Right v' -> Both n1 (insertMapMin k v' m2) + Left v' -> These (insertMapMin k v' m1) n2 + Right v' -> These n1 (insertMapMin k v' m2) where (m1, m2) = M.mapEitherWithKey f m0 {-# INLINABLE mapEitherWithKey #-} --- | /O(log n)/. The expression (@'split' k map@) is potentially a 'Both' +-- | /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' ('Fst' n1)@ means @k@ was larger than or equal to all items +-- * @'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' ('Snd' n2)@ means @k@ was smaller than or equal to all +-- * @'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' ('Both' n1 n2)@ gives @n1@ (the map of all keys from the +-- * @'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 (Snd (fromList ((3,"b") :| [(5,"a")])) ) --- > split 3 (fromList ((5,"a") :| [(3,"b")])) == Just (Snd (singleton 5 "a") ) --- > split 4 (fromList ((5,"a") :| [(3,"b")])) == Just (Both (singleton 3 "b") (singleton 5 "a")) --- > split 5 (fromList ((5,"a") :| [(3,"b")])) == Just (Fst (singleton 3 "b") ) --- > split 6 (fromList ((5,"a") :| [(3,"b")])) == Just (Fst (fromList ((3,"b") :| [(5,"a")])) ) +-- > 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 (Or (NEIntMap a) (NEIntMap a)) + -> Maybe (These (NEIntMap a) (NEIntMap a)) split k n@(NEIntMap k0 v m0) = case compare k k0 of - LT -> Just $ Snd n - EQ -> Snd <$> nonEmptyMap m0 + LT -> Just $ That n + EQ -> That <$> nonEmptyMap m0 GT -> case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> Just $ Fst (singleton k0 v) - (Just _ , Nothing) -> Just $ Fst (insertMapMin k0 v m1) - (Nothing, Just n2) -> Just $ Both (singleton k0 v) n2 - (Just _ , Just n2) -> Just $ Both (insertMapMin k0 v m1) n2 + (Nothing, Nothing) -> Just $ This (singleton k0 v) + (Just _ , Nothing) -> Just $ This (insertMapMin k0 v m1) + (Nothing, Just n2) -> Just $ These (singleton k0 v) n2 + (Just _ , Just n2) -> Just $ These (insertMapMin k0 v m1) n2 where (m1, m2) = M.split k m0 {-# INLINABLE split #-} @@ -1660,24 +1659,24 @@ split k n@(NEIntMap k0 v m0) = case compare k k0 of -- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just -- like 'split' but also returns @'lookup' k map@, as a @'Maybe' a@. -- --- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (Snd (fromList ((3,"b") :| [(5,"a")])))) --- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Just (Snd (singleton 5 "a"))) --- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (Both (singleton 3 "b") (singleton 5 "a"))) --- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "a", Just (Fst (singleton 3 "b")) --- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (Fst (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (That (fromList ((3,"b") :| [(5,"a")])))) +-- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Just (That (singleton 5 "a"))) +-- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (These (singleton 3 "b") (singleton 5 "a"))) +-- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "a", Just (This (singleton 3 "b")) +-- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (This (fromList ((3,"b") :| [(5,"a")]))) -- > splitLookup 5 (singleton 5 "a") == (Just "a", Nothing) splitLookup :: Key -> NEIntMap a - -> (Maybe a, Maybe (Or (NEIntMap a) (NEIntMap a))) + -> (Maybe a, Maybe (These (NEIntMap a) (NEIntMap a))) splitLookup k n@(NEIntMap k0 v0 m0) = case compare k k0 of - LT -> (Nothing, Just $ Snd n) - EQ -> (Just v0, Snd <$> nonEmptyMap m0) + LT -> (Nothing, Just $ That n) + EQ -> (Just v0, That <$> nonEmptyMap m0) GT -> (v ,) $ case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> Just $ Fst (singleton k0 v0) - (Just _ , Nothing) -> Just $ Fst (insertMapMin k0 v0 m1) - (Nothing, Just n2) -> Just $ Both (singleton k0 v0) n2 - (Just _ , Just n2) -> Just $ Both (insertMapMin k0 v0 m1) n2 + (Nothing, Nothing) -> Just $ This (singleton k0 v0) + (Just _ , Nothing) -> Just $ This (insertMapMin k0 v0 m1) + (Nothing, Just n2) -> Just $ These (singleton k0 v0) n2 + (Just _ , Just n2) -> Just $ These (insertMapMin k0 v0 m1) n2 where (m1, v, m2) = M.splitLookup k m0 {-# INLINABLE splitLookup #-} diff --git a/src/Data/IntSet/NonEmpty.hs b/src/Data/IntSet/NonEmpty.hs index 73c7baf..56f209c 100644 --- a/src/Data/IntSet/NonEmpty.hs +++ b/src/Data/IntSet/NonEmpty.hs @@ -134,17 +134,17 @@ module Data.IntSet.NonEmpty ( , valid ) where + import Control.Applicative import Data.Bifunctor import Data.IntSet (IntSet) -import qualified Data.IntSet as S import Data.IntSet.NonEmpty.Internal import Data.List.NonEmpty (NonEmpty(..)) -import qualified Data.List.NonEmpty as NE import Data.Maybe -import Data.Or (Or(..)) -import Prelude hiding - (filter, foldl, foldl1, foldr, foldr1, map) +import Data.These +import Prelude hiding (foldr, foldl, foldr1, foldl1, filter, map) +import qualified Data.IntSet as S +import qualified Data.List.NonEmpty as NE -- | /O(1)/ match, /O(log n)/ usage of contents. The 'IsNonEmpty' and -- 'IsEmpty' patterns allow you to treat a 'IntSet' as if it were either @@ -536,75 +536,75 @@ filter f (NEIntSet x s1) -- | /O(n)/. Partition the map according to a predicate. -- --- Returns an 'Or' with potentially two non-empty sets: +-- Returns a 'These' with potentially two non-empty sets: -- --- * @'Fst' n1@ means that the predicate was true for all items. --- * @'Snd' n2@ means that the predicate was false for all items. --- * @'Both' n1 n2@ gives @n1@ (all of the items that were true for the +-- * @'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 (> 3) (fromList (5 :| [3])) == Both (singleton 5) (singleton 3) --- > partition (< 7) (fromList (5 :| [3])) == Fst (fromList (3 :| [5])) --- > partition (> 7) (fromList (5 :| [3])) == Snd (fromList (3 :| [5])) +-- > partition (> 3) (fromList (5 :| [3])) == These (singleton 5) (singleton 3) +-- > partition (< 7) (fromList (5 :| [3])) == This (fromList (3 :| [5])) +-- > partition (> 7) (fromList (5 :| [3])) == That (fromList (3 :| [5])) partition :: (Key -> Bool) -> NEIntSet - -> Or NEIntSet NEIntSet + -> These NEIntSet NEIntSet partition f n@(NEIntSet x s0) = case (nonEmptySet s1, nonEmptySet s2) of (Nothing, Nothing) - | f x -> Fst n - | otherwise -> Snd n + | f x -> This n + | otherwise -> That n (Just n1, Nothing) - | f x -> Fst n - | otherwise -> Both n1 (singleton x) + | f x -> This n + | otherwise -> These n1 (singleton x) (Nothing, Just n2) - | f x -> Both (singleton x) n2 - | otherwise -> Snd n + | f x -> These (singleton x) n2 + | otherwise -> That n (Just n1, Just n2) - | f x -> Both (insertSetMin x s1) n2 - | otherwise -> Both n1 (insertSetMin x s2) + | f x -> These (insertSetMin x s1) n2 + | otherwise -> These n1 (insertSetMin x s2) where (s1, s2) = S.partition f s0 {-# INLINABLE partition #-} --- | /O(log n)/. The expression (@'split' x set@) is potentially a 'Both' +-- | /O(log n)/. The expression (@'split' x set@) is potentially a 'These' -- containing up to two 'NEIntSet's based on splitting the set into sets -- containing items before and after the value @x@. It will never return -- a set that contains @x@ itself. -- -- * 'Nothing' means that @x@ was the only value in the the original set, -- and so there are no items before or after it. --- * @'Just' ('Fst' n1)@ means @x@ was larger than or equal to all items +-- * @'Just' ('This' n1)@ means @x@ was larger than or equal to all items -- in the set, and @n1@ is the entire original set (minus @x@, if it -- was present) --- * @'Just' ('Snd' n2)@ means @x@ was smaller than or equal to all +-- * @'Just' ('That' n2)@ means @x@ was smaller than or equal to all -- items in the set, and @n2@ is the entire original set (minus @x@, if -- it was present) --- * @'Just' ('Both' n1 n2)@ gives @n1@ (the set of all values from the +-- * @'Just' ('These' n1 n2)@ gives @n1@ (the set of all values from the -- original set less than @x@) and @n2@ (the set of all values from the -- original set greater than @x@). -- --- > split 2 (fromList (5 :| [3])) == Just (Snd (fromList (3 :| [5])) ) --- > split 3 (fromList (5 :| [3])) == Just (Snd (singleton 5) ) --- > split 4 (fromList (5 :| [3])) == Just (Both (singleton 3) (singleton 5)) --- > split 5 (fromList (5 :| [3])) == Just (Fst (singleton 3) ) --- > split 6 (fromList (5 :| [3])) == Just (Fst (fromList (3 :| [5])) ) +-- > split 2 (fromList (5 :| [3])) == Just (That (fromList (3 :| [5])) ) +-- > split 3 (fromList (5 :| [3])) == Just (That (singleton 5) ) +-- > split 4 (fromList (5 :| [3])) == Just (These (singleton 3) (singleton 5)) +-- > split 5 (fromList (5 :| [3])) == Just (This (singleton 3) ) +-- > split 6 (fromList (5 :| [3])) == Just (This (fromList (3 :| [5])) ) -- > split 5 (singleton 5) == Nothing split :: Key -> NEIntSet - -> Maybe (Or NEIntSet NEIntSet) + -> Maybe (These NEIntSet NEIntSet) split x n@(NEIntSet x0 s0) = case compare x x0 of - LT -> Just $ Snd n - EQ -> Snd <$> nonEmptySet s0 + LT -> Just $ That n + EQ -> That <$> nonEmptySet s0 GT -> case (nonEmptySet s1, nonEmptySet s2) of - (Nothing, Nothing) -> Just $ Fst (singleton x0) - (Just _ , Nothing) -> Just $ Fst (insertSetMin x0 s1) - (Nothing, Just n2) -> Just $ Both (singleton x0) n2 - (Just _ , Just n2) -> Just $ Both (insertSetMin x0 s1) n2 + (Nothing, Nothing) -> Just $ This (singleton x0) + (Just _ , Nothing) -> Just $ This (insertSetMin x0 s1) + (Nothing, Just n2) -> Just $ These (singleton x0) n2 + (Just _ , Just n2) -> Just $ These (insertSetMin x0 s1) n2 where (s1, s2) = S.split x s0 {-# INLINABLE split #-} @@ -613,24 +613,24 @@ split x n@(NEIntSet x0 s0) = case compare x x0 of -- like 'split' but also returns @'member' x set@ (whether or not @x@ was -- in @set@) -- --- > splitMember 2 (fromList (5 :| [3])) == (False, Just (Snd (fromList (3 :| [5)])))) --- > splitMember 3 (fromList (5 :| [3])) == (True , Just (Snd (singleton 5))) --- > splitMember 4 (fromList (5 :| [3])) == (False, Just (Both (singleton 3) (singleton 5))) --- > splitMember 5 (fromList (5 :| [3])) == (True , Just (Fst (singleton 3)) --- > splitMember 6 (fromList (5 :| [3])) == (False, Just (Fst (fromList (3 :| [5]))) +-- > splitMember 2 (fromList (5 :| [3])) == (False, Just (That (fromList (3 :| [5)])))) +-- > splitMember 3 (fromList (5 :| [3])) == (True , Just (That (singleton 5))) +-- > splitMember 4 (fromList (5 :| [3])) == (False, Just (These (singleton 3) (singleton 5))) +-- > splitMember 5 (fromList (5 :| [3])) == (True , Just (This (singleton 3)) +-- > splitMember 6 (fromList (5 :| [3])) == (False, Just (This (fromList (3 :| [5]))) -- > splitMember 5 (singleton 5) == (True , Nothing) splitMember :: Key -> NEIntSet - -> (Bool, Maybe (Or NEIntSet NEIntSet)) + -> (Bool, Maybe (These NEIntSet NEIntSet)) splitMember x n@(NEIntSet x0 s0) = case compare x x0 of - LT -> (False, Just $ Snd n) - EQ -> (True , Snd <$> nonEmptySet s0) + LT -> (False, Just $ That n) + EQ -> (True , That <$> nonEmptySet s0) GT -> (mem ,) $ case (nonEmptySet s1, nonEmptySet s2) of - (Nothing, Nothing) -> Just $ Fst (singleton x0) - (Just _ , Nothing) -> Just $ Fst (insertSetMin x0 s1) - (Nothing, Just n2) -> Just $ Both (singleton x0) n2 - (Just _ , Just n2) -> Just $ Both (insertSetMin x0 s1) n2 + (Nothing, Nothing) -> Just $ This (singleton x0) + (Just _ , Nothing) -> Just $ This (insertSetMin x0 s1) + (Nothing, Just n2) -> Just $ These (singleton x0) n2 + (Just _ , Just n2) -> Just $ These (insertSetMin x0 s1) n2 where (s1, mem, s2) = S.splitMember x s0 {-# INLINABLE splitMember #-} diff --git a/src/Data/Map/NonEmpty.hs b/src/Data/Map/NonEmpty.hs index 2dfcfa5..fec88bc 100644 --- a/src/Data/Map/NonEmpty.hs +++ b/src/Data/Map/NonEmpty.hs @@ -253,25 +253,24 @@ module Data.Map.NonEmpty ( 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.Or (Or(..)) +import Data.Maybe hiding (mapMaybe) 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 Prelude hiding - (drop, filter, foldl, foldl1, foldr, foldr1, lookup, map, splitAt, take) +import Data.These +import Prelude hiding (lookup, foldr1, foldl1, foldr, foldl, filter, map, take, drop, splitAt) +import qualified Data.Foldable as F +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as M +import qualified Data.Maybe as Maybe +import qualified Data.Semigroup.Foldable as F1 +import qualified Data.Set as S -- | /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 @@ -1624,60 +1623,60 @@ withoutKeys n@(NEMap k v m) xs = case S.minView xs of -- | /O(n)/. Partition the map according to a predicate. -- --- Returns an 'Or' with potentially two non-empty maps: +-- Returns a 'These' with potentially two non-empty maps: -- --- * @'Fst' n1@ means that the predicate was true for all items. --- * @'Snd' n2@ means that the predicate was false for all items. --- * @'Both' n1 n2@ gives @n1@ (all of the items that were true for the +-- * @'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")])) == Both (singleton 3 "b") (singleton 5 "a") --- > partition (< "x") (fromList ((5,"a") :| [(3,"b")])) == Fst (fromList ((3, "b") :| [(5, "a")])) --- > partition (> "x") (fromList ((5,"a") :| [(3,"b")])) == Snd (fromList ((3, "b") :| [(5, "a")])) +-- > 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 - -> Or (NEMap k a) (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 an 'Or' with potentially two non-empty maps: +-- Returns a 'These' with potentially two non-empty maps: -- --- * @'Fst' n1@ means that the predicate was true for all items, +-- * @'This' n1@ means that the predicate was true for all items, -- returning the original map. --- * @'Snd' n2@ means that the predicate was false for all items, +-- * @'That' n2@ means that the predicate was false for all items, -- returning the original map. --- * @'Both' n1 n2@ gives @n1@ (all of the items that were true for the +-- * @'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")])) == Both (singleton 5 "a") (singleton 3 "b") --- > partitionWithKey (\ k _ -> k < 7) (fromList ((5,"a") :| [(3,"b")])) == Fst (fromList ((3, "b") :| [(5, "a")])) --- > partitionWithKey (\ k _ -> k > 7) (fromList ((5,"a") :| [(3,"b")])) == Snd (fromList ((3, "b") :| [(5, "a")])) +-- > 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 - -> Or (NEMap k a) (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 -> Fst n - | otherwise -> Snd n + | f k v -> This n + | otherwise -> That n (Just n1, Nothing) - | f k v -> Fst n - | otherwise -> Both n1 (singleton k v) + | f k v -> This n + | otherwise -> These n1 (singleton k v) (Nothing, Just n2) - | f k v -> Both (singleton k v) n2 - | otherwise -> Snd n + | f k v -> These (singleton k v) n2 + | otherwise -> That n (Just n1, Just n2) - | f k v -> Both (insertMapMin k v m1) n2 - | otherwise -> Both n1 (insertMapMin k v m2) + | f k v -> These (insertMapMin k v m1) n2 + | otherwise -> These n1 (insertMapMin k v m2) where (m1, m2) = M.partitionWithKey f m0 {-# INLINABLE partitionWithKey #-} @@ -1723,13 +1722,13 @@ dropWhileAntitone f n@(NEMap k _ m) -- The user is responsible for ensuring that for all keys @j@ and @k@ in the map, -- @j \< k ==\> p j \>= p k@. -- --- Returns an 'Or' with potentially two non-empty maps: +-- Returns a 'These' with potentially two non-empty maps: -- --- * @'Fst' n1@ means that the predicate never failed for any item, +-- * @'This' n1@ means that the predicate never failed for any item, -- returning the original map. --- * @'Snd' n2@ means that the predicate failed for the first item, +-- * @'That' n2@ means that the predicate failed for the first item, -- returning the original map. --- * @'Both' n1 n2@ gives @n1@ (the map up to the point where the +-- * @'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) -- @@ -1744,14 +1743,14 @@ dropWhileAntitone f n@(NEMap k _ m) spanAntitone :: (k -> Bool) -> NEMap k a - -> Or (NEMap k a) (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) -> Fst n - (Just _ , Nothing) -> Fst n - (Nothing, Just n2) -> Both (singleton k v) n2 - (Just _ , Just n2) -> Both (insertMapMin k v m1) n2 - | otherwise = Snd n + (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 {-# INLINABLE spanAntitone #-} @@ -1788,98 +1787,98 @@ mapMaybeWithKey f (NEMap k v m) = ($ M.mapMaybeWithKey f m) -- | /O(n)/. Map values and separate the 'Left' and 'Right' results. -- --- Returns an 'Or' with potentially two non-empty maps: +-- Returns a 'These' with potentially two non-empty maps: -- --- * @'Fst' n1@ means that the results were all 'Left'. --- * @'Snd' n2@ means that the results were all 'Right'. --- * @'Both' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- * @'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")])) --- > == Both (fromList ((3,"b") :| [(5,"a")])) (fromList ((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")])) --- > == Snd (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 - -> Or (NEMap k b) (NEMap k c) + -> 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 an 'Or' with potentially two non-empty maps: +-- Returns a 'These' with potentially two non-empty maps: -- --- * @'Fst' n1@ means that the results were all 'Left'. --- * @'Snd' n2@ means that the results were all 'Right'. --- * @'Both' n1 n2@ gives @n1@ (the map where the results were 'Left') +-- * @'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")])) --- > == Both (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) +-- > == These (fromList ((1,2) :| [(3,6)])) (fromList ((5,"aa") :| [(7,"zz")])) -- > -- > mapEitherWithKey (\_ a -> Right a) (fromList ((5,"a") :| [(3,"b"), (1,"x"), (7,"z")])) --- > == Snd (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) +-- > == That (fromList ((1,"x") :| [(3,"b"), (5,"a"), (7,"z")])) mapEitherWithKey :: (k -> a -> Either b c) -> NEMap k a - -> Or (NEMap k b) (NEMap k c) + -> 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' -> Fst (singleton k v') - Right v' -> Snd (singleton k v') + Left v' -> This (singleton k v') + Right v' -> That (singleton k v') (Just n1, Nothing) -> case f k v of - Left v' -> Fst (insertMapMin k v' m1) - Right v' -> Both n1 (singleton k v') + Left v' -> This (insertMapMin k v' m1) + Right v' -> These n1 (singleton k v') (Nothing, Just n2) -> case f k v of - Left v' -> Both (singleton k v') n2 - Right v' -> Snd (insertMapMin k v' m2) + 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' -> Both (insertMapMin k v' m1) n2 - Right v' -> Both n1 (insertMapMin k v' m2) + Left v' -> These (insertMapMin k v' m1) n2 + Right v' -> These n1 (insertMapMin k v' m2) where (m1, m2) = M.mapEitherWithKey f m0 {-# INLINABLE mapEitherWithKey #-} --- | /O(log n)/. The expression (@'split' k map@) is potentially a 'Both' +-- | /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' ('Fst' n1)@ means @k@ was larger than or equal to all items +-- * @'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' ('Snd' n2)@ means @k@ was smaller than or equal to all +-- * @'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' ('Both' n1 n2)@ gives @n1@ (the map of all keys from the +-- * @'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 (Snd (fromList ((3,"b") :| [(5,"a")])) ) --- > split 3 (fromList ((5,"a") :| [(3,"b")])) == Just (Snd (singleton 5 "a") ) --- > split 4 (fromList ((5,"a") :| [(3,"b")])) == Just (Both (singleton 3 "b") (singleton 5 "a")) --- > split 5 (fromList ((5,"a") :| [(3,"b")])) == Just (Fst (singleton 3 "b") ) --- > split 6 (fromList ((5,"a") :| [(3,"b")])) == Just (Fst (fromList ((3,"b") :| [(5,"a")])) ) +-- > 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 (Or (NEMap k a) (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 $ Snd n - EQ -> Snd <$> nonEmptyMap m0 + LT -> Just $ That n + EQ -> That <$> nonEmptyMap m0 GT -> case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> Just $ Fst (singleton k0 v) - (Just _ , Nothing) -> Just $ Fst (insertMapMin k0 v m1) - (Nothing, Just n2) -> Just $ Both (singleton k0 v) n2 - (Just _ , Just n2) -> Just $ Both (insertMapMin k0 v m1) n2 + (Nothing, Nothing) -> Just $ This (singleton k0 v) + (Just _ , Nothing) -> Just $ This (insertMapMin k0 v m1) + (Nothing, Just n2) -> Just $ These (singleton k0 v) n2 + (Just _ , Just n2) -> Just $ These (insertMapMin k0 v m1) n2 where (m1, m2) = M.split k m0 {-# INLINABLE split #-} @@ -1887,25 +1886,25 @@ split k n@(NEMap k0 v m0) = case compare k k0 of -- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just -- like 'split' but also returns @'lookup' k map@, as a @'Maybe' a@. -- --- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (Snd (fromList ((3,"b") :| [(5,"a")])))) --- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Just (Snd (singleton 5 "a"))) --- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (Both (singleton 3 "b") (singleton 5 "a"))) --- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "a", Just (Fst (singleton 3 "b")) --- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (Fst (fromList ((3,"b") :| [(5,"a")]))) +-- > splitLookup 2 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (That (fromList ((3,"b") :| [(5,"a")])))) +-- > splitLookup 3 (fromList ((5,"a") :| [(3,"b")])) == (Just "b", Just (That (singleton 5 "a"))) +-- > splitLookup 4 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (These (singleton 3 "b") (singleton 5 "a"))) +-- > splitLookup 5 (fromList ((5,"a") :| [(3,"b")])) == (Just "a", Just (This (singleton 3 "b")) +-- > splitLookup 6 (fromList ((5,"a") :| [(3,"b")])) == (Nothing , Just (This (fromList ((3,"b") :| [(5,"a")]))) -- > splitLookup 5 (singleton 5 "a") == (Just "a", Nothing) splitLookup :: Ord k => k -> NEMap k a - -> (Maybe a, Maybe (Or (NEMap k a) (NEMap k a))) + -> (Maybe a, Maybe (These (NEMap k a) (NEMap k a))) splitLookup k n@(NEMap k0 v0 m0) = case compare k k0 of - LT -> (Nothing, Just $ Snd n) - EQ -> (Just v0, Snd <$> nonEmptyMap m0) + LT -> (Nothing, Just $ That n) + EQ -> (Just v0, That <$> nonEmptyMap m0) GT -> (v ,) $ case (nonEmptyMap m1, nonEmptyMap m2) of - (Nothing, Nothing) -> Just $ Fst (singleton k0 v0) - (Just _ , Nothing) -> Just $ Fst (insertMapMin k0 v0 m1) - (Nothing, Just n2) -> Just $ Both (singleton k0 v0) n2 - (Just _ , Just n2) -> Just $ Both (insertMapMin k0 v0 m1) n2 + (Nothing, Nothing) -> Just $ This (singleton k0 v0) + (Just _ , Nothing) -> Just $ This (insertMapMin k0 v0 m1) + (Nothing, Just n2) -> Just $ These (singleton k0 v0) n2 + (Just _ , Just n2) -> Just $ These (insertMapMin k0 v0 m1) n2 where (m1, v, m2) = M.splitLookup k m0 {-# INLINABLE splitLookup #-} @@ -2145,22 +2144,22 @@ drop i (NEMap _ _ m) = M.drop (i - 1) m -- | /O(log n)/. Split a map at a particular index @i@. -- --- * @'Fst' n1@ means that there are less than @i@ items in the map, and +-- * @'This' n1@ means that there are less than @i@ items in the map, and -- @n1@ is the original map. --- * @'Snd' n2@ means @i@ was 0; we dropped 0 items, so @n2@ is the +-- * @'That' n2@ means @i@ was 0; we dropped 0 items, so @n2@ is the -- original map. --- * @'Both' n1 n2@ gives @n1@ (taking @i@ items from 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 - -> Or (NEMap k a) (NEMap k a) -splitAt 0 n = Snd n + -> 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) -> Fst (singleton k v) - (Just _ , Nothing) -> Fst n - (Nothing, Just n2) -> Both (singleton k v) n2 - (Just _ , Just n2) -> Both (insertMapMin k v m1) n2 + (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 {-# INLINABLE splitAt #-} diff --git a/src/Data/Sequence/NonEmpty.hs b/src/Data/Sequence/NonEmpty.hs index 90dee22..bbb3077 100644 --- a/src/Data/Sequence/NonEmpty.hs +++ b/src/Data/Sequence/NonEmpty.hs @@ -169,17 +169,14 @@ module Data.Sequence.NonEmpty ( ) where import Control.Applicative -import Control.Monad hiding (replicateM) +import Control.Monad hiding (replicateM) import Data.Bifunctor import Data.Functor.Apply -import Data.Or (Or(..)) import Data.Sequence (Seq(..)) -import qualified Data.Sequence as Seq import Data.Sequence.NonEmpty.Internal -import Prelude hiding - (drop, filter, head, init, last, length, lookup, map, replicate, reverse, - scanl, scanl1, scanr, scanr1, splitAt, tail, take, unzip, zip, zip3, - zipWith, zipWith3) +import Data.These +import Prelude hiding (length, scanl, scanl1, scanr, scanr1, splitAt, zip, zipWith, zip3, zipWith3, unzip, replicate, filter, reverse, lookup, take, drop, head, tail, init, last, map) +import qualified Data.Sequence as Seq -- | /O(1)/. The 'IsNonEmpty' and 'IsEmpty' patterns allow you to treat -- a 'Seq' as if it were either a @'IsNonEmpty' n@ (where @n@ is a 'NESeq') @@ -439,9 +436,9 @@ chunksOf :: Int -> NESeq a -> NESeq (NESeq a) chunksOf n = go where go xs = case splitAt n xs of - Fst ys -> singleton ys - Snd _ -> e - Both ys zs -> ys <| go zs + This ys -> singleton ys + That _ -> e + These ys zs -> ys <| go zs e = error "chunksOf: A non-empty sequence can only be broken up into positively-sized chunks." {-# INLINABLE chunksOf #-} @@ -496,23 +493,23 @@ dropWhileR p xs0@(xs :||> x) {-# INLINE dropWhileR #-} -- | \( O(i) \) where \( i \) is the prefix length. 'spanl', applied to --- a predicate @p@ and a sequence @xs@, returns a 'Both' based on the +-- a predicate @p@ and a sequence @xs@, returns a 'These' based on the -- point where the predicate fails: -- --- * @'Fst' ys@ means that the predicate was true for all items, and +-- * @'This' ys@ means that the predicate was true for all items, and -- @ys@ is the entire original sequence. --- * @'Snd' zs@ means that the predicate failed on the first item, and +-- * @'That' zs@ means that the predicate failed on the first item, and -- @zs@ is the entire original sequence. --- * @'Both' ys zs@ gives @ys@ (the prefix of elements that satisfy the +-- * @'These' ys zs@ gives @ys@ (the prefix of elements that satisfy the -- predicae) and @zs@ (the remainder of the sequence) -spanl :: (a -> Bool) -> NESeq a -> Or (NESeq a) (NESeq a) +spanl :: (a -> Bool) -> NESeq a -> These (NESeq a) (NESeq a) spanl p xs0@(x :<|| xs) | p x = case (nonEmptySeq ys, nonEmptySeq zs) of - (Nothing , Nothing ) -> Fst (singleton x) - (Just _ , Nothing ) -> Fst xs0 - (Nothing , Just zs') -> Both (singleton x) zs' - (Just ys', Just zs') -> Both (x <| ys') zs' - | otherwise = Snd xs0 + (Nothing , Nothing ) -> This (singleton x) + (Just _ , Nothing ) -> This xs0 + (Nothing , Just zs') -> These (singleton x) zs' + (Just ys', Just zs') -> These (x <| ys') zs' + | otherwise = That xs0 where (ys, zs) = Seq.spanl p xs {-# INLINABLE spanl #-} @@ -521,20 +518,20 @@ spanl p xs0@(x :<|| xs) -- a predicate @p@ and a sequence @xs@, returns a 'These' based on the -- point where the predicate fails: -- --- * @'Fst' ys@ means that the predicate was true for all items, and +-- * @'This' ys@ means that the predicate was true for all items, and -- @ys@ is the entire original sequence. --- * @'Snd' zs@ means that the predicate failed on the first item, and +-- * @'That' zs@ means that the predicate failed on the first item, and -- @zs@ is the entire original sequence. --- * @'Both' ys zs@ gives @ys@ (the suffix of elements that satisfy the +-- * @'These' ys zs@ gives @ys@ (the suffix of elements that satisfy the -- predicae) and @zs@ (the remainder of the sequence, before the suffix) -spanr :: (a -> Bool) -> NESeq a -> Or (NESeq a) (NESeq a) +spanr :: (a -> Bool) -> NESeq a -> These (NESeq a) (NESeq a) spanr p xs0@(xs :||> x) | p x = case (nonEmptySeq ys, nonEmptySeq zs) of - (Nothing , Nothing ) -> Fst (singleton x) - (Just _ , Nothing ) -> Fst xs0 - (Nothing , Just zs') -> Both (singleton x) zs' - (Just ys', Just zs') -> Both (ys' |> x ) zs' - | otherwise = Snd xs0 + (Nothing , Nothing ) -> This (singleton x) + (Just _ , Nothing ) -> This xs0 + (Nothing , Just zs') -> These (singleton x) zs' + (Just ys', Just zs') -> These (ys' |> x ) zs' + | otherwise = That xs0 where (ys, zs) = Seq.spanr p xs {-# INLINABLE spanr #-} @@ -542,42 +539,42 @@ spanr p xs0@(xs :||> x) -- | \( O(i) \) where \( i \) is the breakpoint index. -- -- @'breakl' p@ is @'spanl' (not . p)@. -breakl :: (a -> Bool) -> NESeq a -> Or (NESeq a) (NESeq a) +breakl :: (a -> Bool) -> NESeq a -> These (NESeq a) (NESeq a) breakl p = spanl (not . p) {-# INLINE breakl #-} -- | \( O(i) \) where \( i \) is the breakpoint index. -- -- @'breakr' p@ is @'spanr' (not . p)@. -breakr :: (a -> Bool) -> NESeq a -> Or (NESeq a) (NESeq a) +breakr :: (a -> Bool) -> NESeq a -> These (NESeq a) (NESeq a) breakr p = spanr (not . p) {-# INLINE breakr #-} -- | \( O(n) \). The 'partition' function takes a predicate @p@ and a -- sequence @xs@ and returns sequences of those elements which do and --- do not satisfy the predicate, as a 'Both': +-- do not satisfy the predicate, as a 'These': -- --- * @'Fst' ys@ means that the predicate was true for all items, and +-- * @'This' ys@ means that the predicate was true for all items, and -- @ys@ is the entire original sequence. --- * @'Snd' zs@ means that the predicate failed on the first item, and +-- * @'That' zs@ means that the predicate failed on the first item, and -- @zs@ is the entire original sequence. --- * @'Both' ys zs@ gives @ys@ (the sequence of elements for which the +-- * @'These' ys zs@ gives @ys@ (the sequence of elements for which the -- predicate was true) and @zs@ (the sequence of elements for which the -- predicate was false). -partition :: (a -> Bool) -> NESeq a -> Or (NESeq a) (NESeq a) +partition :: (a -> Bool) -> NESeq a -> These (NESeq a) (NESeq a) partition p xs0@(x :<|| xs) = case (nonEmptySeq ys, nonEmptySeq zs) of (Nothing , Nothing ) - | p x -> Fst (singleton x) - | otherwise -> Snd (singleton x) + | p x -> This (singleton x) + | otherwise -> That (singleton x) (Just ys', Nothing ) - | p x -> Fst xs0 - | otherwise -> Both ys' (singleton x) + | p x -> This xs0 + | otherwise -> These ys' (singleton x) (Nothing, Just zs' ) - | p x -> Both (singleton x) zs' - | otherwise -> Snd xs0 + | p x -> These (singleton x) zs' + | otherwise -> That xs0 (Just ys', Just zs') - | p x -> Both (x <| ys') zs' - | otherwise -> Both ys' (x <| zs') + | p x -> These (x <| ys') zs' + | otherwise -> These ys' (x <| zs') where (ys, zs) = Seq.partition p xs {-# INLINABLE partition #-} @@ -691,18 +688,18 @@ unstableSortOn f = unsafeFromSeq . unstableSortOnSeq f . toSeq insertBy :: (a -> a -> Ordering) -> a -> NESeq a -> NESeq a insertBy c x xs = case spanl ltx xs of - Fst ys -> ys |> x - Snd zs -> x <| zs - Both ys zs -> ys >< (x <| zs) + This ys -> ys |> x + That zs -> x <| zs + These ys zs -> ys >< (x <| zs) where ltx y = c x y == GT {-# INLINABLE insertBy #-} insertOn :: Ord b => (a -> b) -> a -> NESeq a -> NESeq a insertOn f x xs = case spanl ltx xs of - Fst ys -> ys |> x - Snd zs -> x <| zs - Both ys zs -> ys >< (x <| zs) + This ys -> ys |> x + That zs -> x <| zs + These ys zs -> ys >< (x <| zs) where fx = f x ltx y = fx > f y @@ -809,21 +806,21 @@ deleteAt i xs0@(x :<|| xs) = case compare i 0 of -- | \( O(\log(\min(i,n-i))) \). Split a sequence at a given position. -- --- * @'Fst' ys@ means that the given position was longer than the length +-- * @'This' ys@ means that the given position was longer than the length -- of the list, and @ys@ is the entire original system. --- * @'Snd' zs@ means that the given position was zero or smaller, and +-- * @'That' zs@ means that the given position was zero or smaller, and -- so @zs@ is the entire original sequence. --- * @'Both' ys zs@ gives @ys@ (the sequence of elements before the +-- * @'These' ys zs@ gives @ys@ (the sequence of elements before the -- given position, @take n xs@) and @zs@ (the sequence of elements -- after the given position, @drop n xs@). -splitAt :: Int -> NESeq a -> Or (NESeq a) (NESeq a) +splitAt :: Int -> NESeq a -> These (NESeq a) (NESeq a) splitAt n xs0@(x :<|| xs) - | n <= 0 = Snd xs0 + | n <= 0 = That xs0 | otherwise = case (nonEmptySeq ys, nonEmptySeq zs) of - (Nothing , Nothing ) -> Fst (singleton x) - (Just _ , Nothing ) -> Fst xs0 - (Nothing , Just zs') -> Both (singleton x) zs' - (Just ys', Just zs') -> Both (x <| ys') zs' + (Nothing , Nothing ) -> This (singleton x) + (Just _ , Nothing ) -> This xs0 + (Nothing , Just zs') -> These (singleton x) zs' + (Just ys', Just zs') -> These (x <| ys') zs' where (ys, zs) = Seq.splitAt (n - 1) xs {-# INLINABLE splitAt #-} diff --git a/src/Data/Set/NonEmpty.hs b/src/Data/Set/NonEmpty.hs index 1eb4d94..9ab1368 100644 --- a/src/Data/Set/NonEmpty.hs +++ b/src/Data/Set/NonEmpty.hs @@ -151,15 +151,14 @@ module Data.Set.NonEmpty ( import Control.Applicative import Data.Bifunctor import Data.List.NonEmpty (NonEmpty(..)) -import qualified Data.List.NonEmpty as NE import Data.Maybe -import Data.Or (Or(..)) -import qualified Data.Semigroup.Foldable as F1 import Data.Set (Set) -import qualified Data.Set as S import Data.Set.NonEmpty.Internal -import Prelude hiding - (drop, filter, foldl, foldr, map, splitAt, take) +import Data.These +import Prelude hiding (foldr, foldl, filter, map, take, drop, splitAt) +import qualified Data.List.NonEmpty as NE +import qualified Data.Semigroup.Foldable as F1 +import qualified Data.Set as S -- | /O(1)/ match, /O(log n)/ usage of contents. The 'IsNonEmpty' and -- 'IsEmpty' patterns allow you to treat a 'Set' as if it were either @@ -612,13 +611,13 @@ dropWhileAntitone f n@(NESet x s) -- elements stops holding. The user is responsible for ensuring that for -- all elements @j@ and @k@ in the set, @j \< k ==\> p j \>= p k@. -- --- Returns an 'Or' with potentially two non-empty sets: +-- Returns a 'These' with potentially two non-empty sets: -- --- * @'Fst' n1@ means that the predicate never failed for any item, +-- * @'This' n1@ means that the predicate never failed for any item, -- returning the original set --- * @'Snd' n2@ means that the predicate failed for the first item, +-- * @'That' n2@ means that the predicate failed for the first item, -- returning the original set --- * @'Both' n1 n2@ gives @n1@ (the set up to the point where the +-- * @'These' n1 n2@ gives @n1@ (the set up to the point where the -- predicate stops holding) and @n2@ (the set starting from -- the point where the predicate stops holding) -- @@ -633,90 +632,90 @@ dropWhileAntitone f n@(NESet x s) spanAntitone :: (a -> Bool) -> NESet a - -> Or (NESet a) (NESet a) + -> These (NESet a) (NESet a) spanAntitone f n@(NESet x s0) | f x = case (nonEmptySet s1, nonEmptySet s2) of - (Nothing, Nothing) -> Fst n - (Just _ , Nothing) -> Fst n - (Nothing, Just n2) -> Both (singleton x) n2 - (Just _ , Just n2) -> Both (insertSetMin x s1) n2 - | otherwise = Snd n + (Nothing, Nothing) -> This n + (Just _ , Nothing) -> This n + (Nothing, Just n2) -> These (singleton x) n2 + (Just _ , Just n2) -> These (insertSetMin x s1) n2 + | otherwise = That n where (s1, s2) = S.spanAntitone f s0 {-# INLINABLE spanAntitone #-} -- | /O(n)/. Partition the map according to a predicate. -- --- Returns an 'Or' with potentially two non-empty sets: +-- Returns a 'These' with potentially two non-empty sets: -- -- * @'This' n1@ means that the predicate was true for all items. --- * @'Snd' n2@ means that the predicate was false for all items. --- * @'Both' n1 n2@ gives @n1@ (all of the items that were true for the +-- * @'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 (> 3) (fromList (5 :| [3])) == Both (singleton 5) (singleton 3) +-- > partition (> 3) (fromList (5 :| [3])) == These (singleton 5) (singleton 3) -- > partition (< 7) (fromList (5 :| [3])) == This (fromList (3 :| [5])) --- > partition (> 7) (fromList (5 :| [3])) == Snd (fromList (3 :| [5])) +-- > partition (> 7) (fromList (5 :| [3])) == That (fromList (3 :| [5])) partition :: (a -> Bool) -> NESet a - -> Or (NESet a) (NESet a) + -> These (NESet a) (NESet a) partition f n@(NESet x s0) = case (nonEmptySet s1, nonEmptySet s2) of (Nothing, Nothing) - | f x -> Fst n - | otherwise -> Snd n + | f x -> This n + | otherwise -> That n (Just n1, Nothing) - | f x -> Fst n - | otherwise -> Both n1 (singleton x) + | f x -> This n + | otherwise -> These n1 (singleton x) (Nothing, Just n2) - | f x -> Both (singleton x) n2 - | otherwise -> Snd n + | f x -> These (singleton x) n2 + | otherwise -> That n (Just n1, Just n2) - | f x -> Both (insertSetMin x s1) n2 - | otherwise -> Both n1 (insertSetMin x s2) + | f x -> These (insertSetMin x s1) n2 + | otherwise -> These n1 (insertSetMin x s2) where (s1, s2) = S.partition f s0 {-# INLINABLE partition #-} --- | /O(log n)/. The expression (@'split' x set@) is potentially a 'Both' +-- | /O(log n)/. The expression (@'split' x set@) is potentially a 'These' -- containing up to two 'NESet's based on splitting the set into sets -- containing items before and after the value @x@. It will never return -- a set that contains @x@ itself. -- -- * 'Nothing' means that @x@ was the only value in the the original set, -- and so there are no items before or after it. --- * @'Just' ('Fst' n1)@ means @x@ was larger than or equal to all items +-- * @'Just' ('This' n1)@ means @x@ was larger than or equal to all items -- in the set, and @n1@ is the entire original set (minus @x@, if it -- was present) --- * @'Just' ('Snd' n2)@ means @x@ was smaller than or equal to all +-- * @'Just' ('That' n2)@ means @x@ was smaller than or equal to all -- items in the set, and @n2@ is the entire original set (minus @x@, if -- it was present) --- * @'Just' ('Both' n1 n2)@ gives @n1@ (the set of all values from the +-- * @'Just' ('These' n1 n2)@ gives @n1@ (the set of all values from the -- original set less than @x@) and @n2@ (the set of all values from the -- original set greater than @x@). -- --- > split 2 (fromList (5 :| [3])) == Just (Snd (fromList (3 :| [5])) ) --- > split 3 (fromList (5 :| [3])) == Just (Snd (singleton 5) ) --- > split 4 (fromList (5 :| [3])) == Just (Both (singleton 3) (singleton 5)) --- > split 5 (fromList (5 :| [3])) == Just (Fst (singleton 3) ) --- > split 6 (fromList (5 :| [3])) == Just (Fst (fromList (3 :| [5])) ) +-- > split 2 (fromList (5 :| [3])) == Just (That (fromList (3 :| [5])) ) +-- > split 3 (fromList (5 :| [3])) == Just (That (singleton 5) ) +-- > split 4 (fromList (5 :| [3])) == Just (These (singleton 3) (singleton 5)) +-- > split 5 (fromList (5 :| [3])) == Just (This (singleton 3) ) +-- > split 6 (fromList (5 :| [3])) == Just (This (fromList (3 :| [5])) ) -- > split 5 (singleton 5) == Nothing split :: Ord a => a -> NESet a - -> Maybe (Or (NESet a) (NESet a)) + -> Maybe (These (NESet a) (NESet a)) split x n@(NESet x0 s0) = case compare x x0 of - LT -> Just $ Snd n - EQ -> Snd <$> nonEmptySet s0 + LT -> Just $ That n + EQ -> That <$> nonEmptySet s0 GT -> case (nonEmptySet s1, nonEmptySet s2) of - (Nothing, Nothing) -> Just $ Fst (singleton x0) - (Just _ , Nothing) -> Just $ Fst (insertSetMin x0 s1) - (Nothing, Just n2) -> Just $ Both (singleton x0) n2 - (Just _ , Just n2) -> Just $ Both (insertSetMin x0 s1) n2 + (Nothing, Nothing) -> Just $ This (singleton x0) + (Just _ , Nothing) -> Just $ This (insertSetMin x0 s1) + (Nothing, Just n2) -> Just $ These (singleton x0) n2 + (Just _ , Just n2) -> Just $ These (insertSetMin x0 s1) n2 where (s1, s2) = S.split x s0 {-# INLINABLE split #-} @@ -725,25 +724,25 @@ split x n@(NESet x0 s0) = case compare x x0 of -- like 'split' but also returns @'member' x set@ (whether or not @x@ was -- in @set@) -- --- > splitMember 2 (fromList (5 :| [3])) == (False, Just (Snd (fromList (3 :| [5)])))) --- > splitMember 3 (fromList (5 :| [3])) == (True , Just (Snd (singleton 5))) --- > splitMember 4 (fromList (5 :| [3])) == (False, Just (Both (singleton 3) (singleton 5))) --- > splitMember 5 (fromList (5 :| [3])) == (True , Just (Fst (singleton 3)) --- > splitMember 6 (fromList (5 :| [3])) == (False, Just (Fst (fromList (3 :| [5]))) +-- > splitMember 2 (fromList (5 :| [3])) == (False, Just (That (fromList (3 :| [5)])))) +-- > splitMember 3 (fromList (5 :| [3])) == (True , Just (That (singleton 5))) +-- > splitMember 4 (fromList (5 :| [3])) == (False, Just (These (singleton 3) (singleton 5))) +-- > splitMember 5 (fromList (5 :| [3])) == (True , Just (This (singleton 3)) +-- > splitMember 6 (fromList (5 :| [3])) == (False, Just (This (fromList (3 :| [5]))) -- > splitMember 5 (singleton 5) == (True , Nothing) splitMember :: Ord a => a -> NESet a - -> (Bool, Maybe (Or (NESet a) (NESet a))) + -> (Bool, Maybe (These (NESet a) (NESet a))) splitMember x n@(NESet x0 s0) = case compare x x0 of - LT -> (False, Just $ Snd n) - EQ -> (True , Snd <$> nonEmptySet s0) + LT -> (False, Just $ That n) + EQ -> (True , That <$> nonEmptySet s0) GT -> (mem ,) $ case (nonEmptySet s1, nonEmptySet s2) of - (Nothing, Nothing) -> Just $ Fst (singleton x0) - (Just _ , Nothing) -> Just $ Fst (insertSetMin x0 s1) - (Nothing, Just n2) -> Just $ Both (singleton x0) n2 - (Just _ , Just n2) -> Just $ Both (insertSetMin x0 s1) n2 + (Nothing, Nothing) -> Just $ This (singleton x0) + (Just _ , Nothing) -> Just $ This (insertSetMin x0 s1) + (Nothing, Just n2) -> Just $ These (singleton x0) n2 + (Just _ , Just n2) -> Just $ These (insertSetMin x0 s1) n2 where (s1, mem, s2) = S.splitMember x s0 {-# INLINABLE splitMember #-} @@ -877,22 +876,22 @@ drop n (NESet _ s) = S.drop (n - 1) s -- | /O(log n)/. Split a set at a particular index @i@. -- --- * @'Fst' n1@ means that there are less than @i@ items in the set, and +-- * @'This' n1@ means that there are less than @i@ items in the set, and -- @n1@ is the original set. --- * @'Snd' n2@ means @i@ was 0; we dropped 0 items, so @n2@ is the +-- * @'That' n2@ means @i@ was 0; we dropped 0 items, so @n2@ is the -- original set. --- * @'Both' n1 n2@ gives @n1@ (taking @i@ items from the original set) +-- * @'These' n1 n2@ gives @n1@ (taking @i@ items from the original set) -- and @n2@ (dropping @i@ items from the original set)) splitAt :: Int -> NESet a - -> Or (NESet a) (NESet a) -splitAt 0 n = Snd n + -> These (NESet a) (NESet a) +splitAt 0 n = That n splitAt i n@(NESet x s0) = case (nonEmptySet s1, nonEmptySet s2) of - (Nothing, Nothing) -> Fst (singleton x) - (Just _ , Nothing) -> Fst n - (Nothing, Just n2) -> Both (singleton x) n2 - (Just _ , Just n2) -> Both (insertSetMin x s1) n2 + (Nothing, Nothing) -> This (singleton x) + (Just _ , Nothing) -> This n + (Nothing, Just n2) -> These (singleton x) n2 + (Just _ , Just n2) -> These (insertSetMin x s1) n2 where (s1, s2) = S.splitAt (i - 1) s0 {-# INLINABLE splitAt #-} diff --git a/test/Tests/Util.hs b/test/Tests/Util.hs index ad0c2b5..dfcd959 100644 --- a/test/Tests/Util.hs +++ b/test/Tests/Util.hs @@ -37,41 +37,42 @@ import Data.Foldable import Data.Function import Data.Functor.Apply import Data.Functor.Classes +import Data.Functor.Identity import Data.IntMap (IntMap) -import qualified Data.IntMap as IM import Data.IntMap.NonEmpty (NEIntMap) -import qualified Data.IntMap.NonEmpty as NEIM import Data.IntSet (IntSet, Key) -import qualified Data.IntSet as IS import Data.IntSet.NonEmpty (NEIntSet) -import qualified Data.IntSet.NonEmpty as NEIS import Data.Kind 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 (NEMap) -import qualified Data.Map.NonEmpty as NEM import Data.Maybe -import Data.Or (Or(..)) import Data.Semigroup.Foldable import Data.Sequence (Seq(..)) import Data.Sequence.NonEmpty (NESeq(..)) -import qualified Data.Sequence.NonEmpty as NESeq import Data.Set (Set) -import qualified Data.Set as S import Data.Set.NonEmpty (NESet) -import qualified Data.Set.NonEmpty as NES import Data.Text (Text) -import qualified Data.Text as T +import Data.These import Hedgehog -import Hedgehog.Function hiding ((:*:)) -import qualified Hedgehog.Gen as Gen +import Hedgehog.Function hiding ((:*:)) import Hedgehog.Internal.Property -import qualified Hedgehog.Range as Range import Test.Tasty import Test.Tasty.Hedgehog import Text.Read +import qualified Data.IntMap as IM +import qualified Data.IntMap.NonEmpty as NEIM +import qualified Data.IntSet as IS +import qualified Data.IntSet.NonEmpty as NEIS +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as M +import qualified Data.Map.NonEmpty as NEM +import qualified Data.Sequence.NonEmpty as NESeq +import qualified Data.Set as S +import qualified Data.Set.NonEmpty as NES +import qualified Data.Text as T +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range #if !MIN_VERSION_base(4,11,0) import Data.Semigroup (Semigroup(..)) @@ -240,11 +241,11 @@ data TestType :: Type -> Type -> Type where TTThese :: (Eq a, Show a, Monoid a, Eq c, Show c, Monoid c) => TestType a b -> TestType c d - -> TestType (a, c) (Or b d) + -> TestType (a, c) (These b d) TTMThese :: (Eq a, Show a, Monoid a, Eq c, Show c, Monoid c) => TestType a b -> TestType c d - -> TestType (a, c) (Maybe (Or b d)) + -> TestType (a, c) (Maybe (These b d)) TTMaybe :: TestType a b -> TestType (Maybe a) (Maybe b) TTEither :: TestType a b @@ -344,26 +345,26 @@ runTT = \case TTVal -> (===) TTOther -> (===) TTThese t1 t2 -> \(x1, x2) -> \case - Fst y1 -> do + This y1 -> do runTT t1 x1 y1 x2 === mempty - Snd y2 -> do + That y2 -> do x1 === mempty runTT t2 x2 y2 - Both y1 y2 -> do + These y1 y2 -> do runTT t1 x1 y1 runTT t2 x2 y2 TTMThese t1 t2 -> \(x1, x2) -> \case Nothing -> do x1 === mempty x2 === mempty - Just (Fst y1) -> do + Just (This y1) -> do runTT t1 x1 y1 x2 === mempty - Just (Snd y2) -> do + Just (That y2) -> do x1 === mempty runTT t2 x2 y2 - Just (Both y1 y2) -> do + Just (These y1 y2) -> do runTT t1 x1 y1 runTT t2 x2 y2 TTMaybe tt -> \x y -> do @@ -502,13 +503,13 @@ mapSize = Range.exponential 4 8 mapGen :: MonadGen m => m (Map KeyType Text) mapGen = Gen.map mapSize $ (,) <$> keyGen <*> valGen -neMapGen :: MonadGen m => m (NEMap KeyType Text) +neMapGen :: (MonadGen m, GenBase m ~ Identity) => m (NEMap KeyType Text) neMapGen = Gen.just $ NEM.nonEmptyMap <$> mapGen setGen :: MonadGen m => m (Set KeyType) setGen = Gen.set mapSize keyGen -neSetGen :: MonadGen m => m (NESet KeyType) +neSetGen :: (MonadGen m, GenBase m ~ Identity) => m (NESet KeyType) neSetGen = Gen.just $ NES.nonEmptySet <$> setGen intKeyGen :: MonadGen m => m Key @@ -517,19 +518,19 @@ intKeyGen = Gen.int (Range.linear (-100) 100) intMapGen :: MonadGen m => m (IntMap Text) intMapGen = IM.fromDistinctAscList . M.toList <$> Gen.map mapSize ((,) <$> intKeyGen <*> valGen) -neIntMapGen :: MonadGen m => m (NEIntMap Text) +neIntMapGen :: (MonadGen m, GenBase m ~ Identity) => m (NEIntMap Text) neIntMapGen = Gen.just $ NEIM.nonEmptyMap <$> intMapGen intSetGen :: MonadGen m => m IntSet intSetGen = IS.fromDistinctAscList . S.toList <$> Gen.set mapSize intKeyGen -neIntSetGen :: MonadGen m => m NEIntSet +neIntSetGen :: (MonadGen m, GenBase m ~ Identity) => m NEIntSet neIntSetGen = Gen.just $ NEIS.nonEmptySet <$> intSetGen seqGen :: MonadGen m => m (Seq Text) seqGen = Gen.seq mapSize valGen -neSeqGen :: MonadGen m => m (NESeq Text) +neSeqGen :: (MonadGen m, GenBase m ~ Identity) => m (NESeq Text) neSeqGen = Gen.just $ NESeq.nonEmptySeq <$> seqGen @@ -551,3 +552,4 @@ instance Vary Char where instance Vary Text where vary = contramap T.unpack vary + |