Skip to content

fromSetA follow up changes #1165

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
L0neGamer wants to merge 4 commits into
base: master
Choose a base branch
from
Open

fromSetA follow up changes #1165

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
46c2e55
remove unneeded Bot instances
L0neGamer Nov 16, 2025
46f25aa
check maps are well constructed in fromSetA action order props
L0neGamer Nov 16, 2025
93d9a4a
use liftA3 instead of other applicative operations
L0neGamer Nov 16, 2025
0b474aa
add validity to `fromSet` testing
L0neGamer Nov 17, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 0 additions & 6 deletions containers-tests/tests/Utils/Strictness.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
--------------------------------------------------------------------}
Expand Down
14 changes: 11 additions & 3 deletions containers-tests/tests/intmap-properties.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
14 changes: 11 additions & 3 deletions containers-tests/tests/map-properties.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
5 changes: 1 addition & 4 deletions containers/src/Data/Map/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 2 additions & 4 deletions containers/src/Data/Map/Strict/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down