diff --git a/containers-tests/tests/Utils/Strictness.hs b/containers-tests/tests/Utils/Strictness.hs index eead2666b..755745170 100644 --- a/containers-tests/tests/Utils/Strictness.hs +++ b/containers-tests/tests/Utils/Strictness.hs @@ -27,12 +27,6 @@ instance Arbitrary a => Arbitrary (Bot a) where , (4, Bot <$> arbitrary) ] -instance CoArbitrary a => CoArbitrary (Bot a) where - coarbitrary (Bot x) = coarbitrary x - -instance Function a => Function (Bot a) where - function = functionMap (\(Bot x) -> x) Bot - {-------------------------------------------------------------------- Lazy functions --------------------------------------------------------------------} diff --git a/containers-tests/tests/intmap-properties.hs b/containers-tests/tests/intmap-properties.hs index 561c3bd4c..4f129588d 100644 --- a/containers-tests/tests/intmap-properties.hs +++ b/containers-tests/tests/intmap-properties.hs @@ -1701,16 +1701,24 @@ prop_keysSet keys = prop_fromSet :: [Int] -> Fun Int A -> Property prop_fromSet keys funF = let f = apply funF - in fromSet f (IntSet.fromList keys) === fromList (fmap (id &&& f) keys) + m = fromSet f (IntSet.fromList keys) + in + valid m .&&. + m === fromList (fmap (id &&& f) keys) prop_fromSetA_action_order :: [Int] -> Fun Int A -> Property prop_fromSetA_action_order keys funF = - let iSet = IntSet.fromList keys + let set = IntSet.fromList keys + setList = IntSet.toList set f = apply funF action = \k -> let v = f k in tell [v] $> v - in execWriter (fromSetA action iSet) === List.map f (IntSet.toList iSet) + (writtenMap, writtenOutput) = runWriter (fromSetA action set) + in + valid writtenMap .&&. + writtenOutput === List.map f setList .&&. + toList writtenMap === fmap (id &&& f) setList newtype Identity a = Identity a deriving (Eq, Show) diff --git a/containers-tests/tests/map-properties.hs b/containers-tests/tests/map-properties.hs index d1e5a8e1e..a05d8ce8c 100644 --- a/containers-tests/tests/map-properties.hs +++ b/containers-tests/tests/map-properties.hs @@ -1723,16 +1723,24 @@ prop_argSet xs = prop_fromSet :: [OrdA] -> Fun OrdA B -> Property prop_fromSet keys funF = let f = apply funF - in fromSet f (Set.fromList keys) === fromList (fmap (id &&& f) keys) + m = fromSet f (Set.fromList keys) + in + valid m .&&. + m === fromList (fmap (id &&& f) keys) prop_fromSetA_action_order :: [OrdA] -> Fun OrdA B -> Property prop_fromSetA_action_order keys funF = - let iSet = Set.fromList keys + let set = Set.fromList keys + setList = Set.toList set f = apply funF action = \k -> let v = f k in tell [v] $> v - in execWriter (fromSetA action iSet) === List.map f (Set.toList iSet) + (writtenMap, writtenOutput) = runWriter (fromSetA action set) + in + valid writtenMap .&&. + writtenOutput === List.map f setList .&&. + toList writtenMap === fmap (id &&& f) setList prop_fromArgSet :: [(OrdA, B)] -> Property prop_fromArgSet ys = diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs index 398e1e9cb..28b517a5b 100644 --- a/containers/src/Data/Map/Internal.hs +++ b/containers/src/Data/Map/Internal.hs @@ -3551,10 +3551,7 @@ fromSet f = runIdentity . fromSetA (pure . f) fromSetA :: Applicative f => (k -> f a) -> Set.Set k -> f (Map k a) fromSetA _ Set.Tip = pure Tip fromSetA f (Set.Bin sz x l r) = - flip (Bin sz x) - <$> fromSetA f l - <*> f x - <*> fromSetA f r + liftA3 (flip (Bin sz x)) (fromSetA f l) (f x) (fromSetA f r) #if __GLASGOW_HASKELL__ {-# INLINABLE fromSetA #-} #else diff --git a/containers/src/Data/Map/Strict/Internal.hs b/containers/src/Data/Map/Strict/Internal.hs index de7edf82f..d4060881d 100644 --- a/containers/src/Data/Map/Strict/Internal.hs +++ b/containers/src/Data/Map/Strict/Internal.hs @@ -1482,10 +1482,8 @@ fromSet f = runIdentity . fromSetA (pure . f) fromSetA :: Applicative f => (k -> f a) -> Set.Set k -> f (Map k a) fromSetA _ Set.Tip = pure Tip fromSetA f (Set.Bin sz x l r) = - flip (Bin sz x $!) - <$> fromSetA f l - <*> f x - <*> fromSetA f r + liftA3 (flip (Bin sz x $!)) (fromSetA f l) (f x) (fromSetA f r) + #if __GLASGOW_HASKELL__ {-# INLINABLE fromSetA #-} #else