From 91eaba3f755efacb97b054c5afdb708b477a03b5 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Mon, 25 Jul 2022 02:45:44 -0400 Subject: [PATCH] Fix #818: add unsafe functions for converting between Set and Map --- containers-tests/tests/map-properties.hs | 48 +++++++++++++++++++ containers/src/Data/Map/Internal.hs | 56 ++++++++++++++++++++++ containers/src/Data/Map/Lazy.hs | 4 ++ containers/src/Data/Map/Strict.hs | 4 ++ containers/src/Data/Map/Strict/Internal.hs | 33 +++++++++++++ 5 files changed, 145 insertions(+) diff --git a/containers-tests/tests/map-properties.hs b/containers-tests/tests/map-properties.hs index 8614b9d42..08ba1beb4 100644 --- a/containers-tests/tests/map-properties.hs +++ b/containers-tests/tests/map-properties.hs @@ -104,6 +104,10 @@ main = defaultMain $ testGroup "map-properties" , testCase "argSet" test_argSet , testCase "fromSet" test_fromSet , testCase "fromArgSet" test_fromArgSet + , testCase "unsafeSet" test_unsafeSet + , testCase "unsafeSetA" test_unsafeSetA + , testCase "unsafeFromSet" test_unsafeFromSet + , testCase "unsafeFromSetA" test_unsafeFromSetA , testCase "toList" test_toList , testCase "fromList" test_fromList , testCase "fromListWith" test_fromListWith @@ -252,6 +256,10 @@ main = defaultMain $ testGroup "map-properties" , testProperty "argSet" prop_argSet , testProperty "fromSet" prop_fromSet , testProperty "fromArgSet" prop_fromArgSet + , testProperty "unsafeSet" prop_unsafeSet + , testProperty "unsafeSetA" prop_unsafeSetA + , testProperty "unsafeFromSet" prop_unsafeFromSet + , testProperty "unsafeFromSetA" prop_unsafeFromSetA , testProperty "takeWhileAntitone" prop_takeWhileAntitone , testProperty "dropWhileAntitone" prop_dropWhileAntitone , testProperty "spanAntitone" prop_spanAntitone @@ -707,6 +715,26 @@ test_fromArgSet = do fromArgSet (Set.fromList [Arg 3 "aaa", Arg 5 "aaaaa"]) @?= fromList [(5,"aaaaa"), (3,"aaa")] fromArgSet Set.empty @?= (empty :: IMap) +test_unsafeSet :: Assertion +test_unsafeSet = do + unsafeSet (,) (fromList [(5,"a"), (3,"b")]) @?= Set.fromList [(5,"a"), (3,"b")] + unsafeSet undefined (empty :: UMap) @?= (Set.empty :: Set.Set Int) + +test_unsafeSetA :: Assertion +test_unsafeSetA = do + unsafeSetA (\x y -> Just (x,y)) (fromList [(5,"a"), (3,"b")]) @?= Just (Set.fromList [(5,"a"), (3,"b")]) + unsafeSetA undefined (empty :: UMap) @?= Identity (Set.empty :: Set.Set Int) + +test_unsafeFromSet :: Assertion +test_unsafeFromSet = do + unsafeFromSet (\k -> (k+1, replicate k 'a')) (Set.fromList [2, 4]) @?= fromList [(5,"aaaa"), (3,"aa")] + unsafeFromSet undefined Set.empty @?= (empty :: IMap) + +test_unsafeFromSetA :: Assertion +test_unsafeFromSetA = do + unsafeFromSetA (\k -> Just (k+1, replicate k 'a')) (Set.fromList [2, 4]) @?= Just (fromList [(5,"aaaa"), (3,"aa")]) + unsafeFromSetA undefined Set.empty @?= Identity (empty :: IMap) + ---------------------------------------------------------------- -- Lists @@ -1672,6 +1700,26 @@ prop_fromArgSet ys = let xs = List.nubBy ((==) `on` fst) ys in fromArgSet (Set.fromList $ List.map (uncurry Arg) xs) == fromList xs +prop_unsafeSet :: [(Int, Int)] -> Bool +prop_unsafeSet ys = + let xs = List.nubBy ((==) `on` fst) ys + in unsafeSet (,) (fromList xs) == Set.fromList xs + +prop_unsafeSetA :: [(Int, Int)] -> Bool +prop_unsafeSetA ys = + let xs = List.nubBy ((==) `on` fst) ys + in unsafeSetA (\x y -> Identity (x,y)) (fromList xs) == Identity (Set.fromList xs) + +prop_unsafeFromSet :: [(Int, Int)] -> Bool +prop_unsafeFromSet ys = + let xs = List.nubBy ((==) `on` fst) ys + in unsafeFromSet id (Set.fromList xs) == fromList xs + +prop_unsafeFromSetA :: [(Int, Int)] -> Bool +prop_unsafeFromSetA ys = + let xs = List.nubBy ((==) `on` fst) ys + in unsafeFromSetA Identity (Set.fromList xs) == Identity (fromList xs) + prop_eq :: Map Int A -> Map Int A -> Property prop_eq m1 m2 = (m1 == m2) === (toList m1 == toList m2) diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs index 2f97aeb95..476504a26 100644 --- a/containers/src/Data/Map/Internal.hs +++ b/containers/src/Data/Map/Internal.hs @@ -270,6 +270,10 @@ module Data.Map.Internal ( , argSet , fromSet , fromArgSet + , unsafeSet + , unsafeSetA + , unsafeFromSet + , unsafeFromSetA -- ** Lists , toList @@ -3504,6 +3508,58 @@ fromArgSet :: Set.Set (Arg k a) -> Map k a fromArgSet Set.Tip = Tip fromArgSet (Set.Bin sz (Arg x v) l r) = Bin sz x v (fromArgSet l) (fromArgSet r) +-- | \(O(n)\). Build a set from the elements in a map and a function which for each +-- element computes its value. The function must preserve the relative ordering +-- of the keys. /The precondition is not checked./ +-- +-- > unsafeSet id (fromList [(5,"a"), (3,"b")]) == Data.Set.fromList [(3,"b"),(5,"a")] +-- > unsafeSet undefined empty == Data.Set.empty + +unsafeSet :: (k -> a -> b) -> Map k a -> Set.Set b +unsafeSet f = go + where + go Tip = Set.Tip + go (Bin sz kx x l r) = Set.Bin sz (f kx x) (go l) (go r) + +-- | \(O(n)\). Build a set from the elements in a map and a function which for each +-- element computes its value inside an 'Applicative'. The function must preserve +-- the relative ordering of the keys. /The precondition is not checked./ +-- +-- > unsafeSetA Identity (fromList [(5,"a"), (3,"b")]) == Data.Set.fromList [(3,"b"),(5,"a")] +-- > unsafeSetA undefined empty == Identity (Data.Set.empty) + +unsafeSetA :: Applicative t => (k -> a -> t b) -> Map k a -> t (Set.Set b) +unsafeSetA f = go + where + go Tip = pure Set.Tip + go (Bin sz kx x l r) = liftA3 (Set.Bin sz) (f kx x) (go l) (go r) + +-- | \(O(n)\). Build a map from a set of elements and a function which for each +-- element computes its key and value. The function must preserve the relative +-- ordering of the elements. /The precondition is not checked./ +-- +-- > unsafeFromSet id (Data.Set.fromList [(3,"aaa"), (5,"aaaaa")]) == fromList [(5,"aaaaa"), (3,"aaa")] +-- > unsafeFromSet undefined Data.Set.empty == empty + +unsafeFromSet :: (b -> (k, a)) -> Set.Set b -> Map k a +unsafeFromSet f = go + where + go Set.Tip = Tip + go (Set.Bin sz x l r) = uncurry (Bin sz) (f x) (go l) (go r) + +-- | \(O(n)\). Build a map from a set of elements and a function which for each +-- element computes its key and value inside an 'Applicative'. The function must +-- preserve the relative ordering of the elements. /The precondition is not checked./ +-- +-- > unsafeFromSetA Identity (Data.Set.fromList [(3,"aaa"), (5,"aaaaa")]) == Identity (fromList [(5,"aaaaa"), (3,"aaa")]) +-- > unsafeFromSetA undefined Data.Set.empty == Identity empty + +unsafeFromSetA :: Applicative t => (b -> t (k, a)) -> Set.Set b -> t (Map k a) +unsafeFromSetA f = go + where + go Set.Tip = pure Tip + go (Set.Bin sz x l r) = liftA3 (uncurry (Bin sz)) (f x) (go l) (go r) + {-------------------------------------------------------------------- Lists --------------------------------------------------------------------} diff --git a/containers/src/Data/Map/Lazy.hs b/containers/src/Data/Map/Lazy.hs index e6260e54e..6cfa37681 100644 --- a/containers/src/Data/Map/Lazy.hs +++ b/containers/src/Data/Map/Lazy.hs @@ -99,6 +99,8 @@ module Data.Map.Lazy ( , singleton , fromSet , fromArgSet + , unsafeFromSet + , unsafeFromSetA -- ** From Unordered Lists , fromList @@ -218,6 +220,8 @@ module Data.Map.Lazy ( , assocs , keysSet , argSet + , unsafeSet + , unsafeSetA -- ** Lists , toList diff --git a/containers/src/Data/Map/Strict.hs b/containers/src/Data/Map/Strict.hs index 9d7203c41..406b5b6d2 100644 --- a/containers/src/Data/Map/Strict.hs +++ b/containers/src/Data/Map/Strict.hs @@ -114,6 +114,8 @@ module Data.Map.Strict , singleton , fromSet , fromArgSet + , unsafeFromSet + , unsafeFromSetA -- ** From Unordered Lists , fromList @@ -233,6 +235,8 @@ module Data.Map.Strict , assocs , keysSet , argSet + , unsafeSet + , unsafeSetA -- ** Lists , toList diff --git a/containers/src/Data/Map/Strict/Internal.hs b/containers/src/Data/Map/Strict/Internal.hs index 6535ec2af..35afa87ec 100644 --- a/containers/src/Data/Map/Strict/Internal.hs +++ b/containers/src/Data/Map/Strict/Internal.hs @@ -232,6 +232,10 @@ module Data.Map.Strict.Internal , argSet , fromSet , fromArgSet + , unsafeSet + , unsafeSetA + , unsafeFromSet + , unsafeFromSetA -- ** Lists , toList @@ -420,6 +424,8 @@ import Data.Map.Internal , toDescList , union , unions + , unsafeSet + , unsafeSetA , withoutKeys ) import Data.Map.Internal.Debug (valid) @@ -1476,6 +1482,33 @@ fromArgSet :: Set.Set (Arg k a) -> Map k a fromArgSet Set.Tip = Tip fromArgSet (Set.Bin sz (Arg x v) l r) = v `seq` Bin sz x v (fromArgSet l) (fromArgSet r) +-- | \(O(n)\). Build a map from a set of elements and a function which for each +-- element computes its key and value. The function must preserve the relative +-- ordering of the elements. /The precondition is not checked./ +-- +-- > unsafeFromSet id (Data.Set.fromList [(3,"aaa"), (5,"aaaaa")]) == fromList [(5,"aaaaa"), (3,"aaa")] +-- > unsafeFromSet undefined Data.Set.empty == empty + +unsafeFromSet :: (b -> (k, a)) -> Set.Set b -> Map k a +unsafeFromSet f = go + where + go Set.Tip = Tip + go (Set.Bin sz x l r) = case f x of + (k,!v) -> Bin sz k v (go l) (go r) + +-- | \(O(n)\). Build a map from a set of elements and a function which for each +-- element computes its key and value inside an 'Applicative'. The function must +-- preserve the relative ordering of the elements. /The precondition is not checked./ +-- +-- > unsafeFromSetA Identity (Data.Set.fromList [(3,"aaa"), (5,"aaaaa")]) == Identity (fromList [(5,"aaaaa"), (3,"aaa")]) +-- > unsafeFromSetA undefined Data.Set.empty == Identity empty + +unsafeFromSetA :: Applicative t => (b -> t (k, a)) -> Set.Set b -> t (Map k a) +unsafeFromSetA f = go + where + go Set.Tip = pure Tip + go (Set.Bin sz x l r) = liftA3 (\(k,!v) -> Bin sz k v) (f x) (go l) (go r) + {-------------------------------------------------------------------- Lists --------------------------------------------------------------------}