Skip to content

Simplify arbitrary instances for map and set #1166

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

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft

Simplify arbitrary instances for map and set #1166

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
510368c
simplify arbitrary instances for map and set
L0neGamer Nov 26, 2025
38d45a1
add some more documentation
L0neGamer Nov 26, 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
54 changes: 13 additions & 41 deletions containers-tests/tests/map-properties.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
Comment on lines +3 to +4
Copy link
Contributor

@meooow25 meooow25 Nov 27, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

As brought up in #1165, we would like to get tests working with MHS, which does not support type families. So this is potentially setting up a future problem.


#ifdef STRICT
import Data.Map.Strict as Data.Map
Expand Down Expand Up @@ -313,46 +315,7 @@ main = defaultMain $ testGroup "map-properties"
, testProperty "mapAccumRWithKey" prop_mapAccumRWithKey
]

{--------------------------------------------------------------------
Arbitrary, reasonably balanced trees
--------------------------------------------------------------------}

-- | The IsInt class lets us constrain a type variable to be Int in an entirely
-- standard way. The constraint @ IsInt a @ is essentially equivalent to the
-- GHC-only constraint @ a ~ Int @, but @ IsInt @ requires manual intervention
-- to use. If ~ is ever standardized, we should certainly use it instead.
-- Earlier versions used an Enum constraint, but this is confusing because
-- not all Enum instances will work properly for the Arbitrary instance here.
class (Show a, Read a, Integral a, Arbitrary a) => IsInt a where
fromIntF :: f Int -> f a

instance IsInt Int where
fromIntF = id

-- | Convert an Int to any instance of IsInt
fromInt :: IsInt a => Int -> a
fromInt = runIdentity . fromIntF . Identity

{- We don't actually need this, but we can add it if we ever do
toIntF :: IsInt a => g a -> g Int
toIntF = unf . fromIntF . F $ id

newtype F g a b = F {unf :: g b -> a}

toInt :: IsInt a => a -> Int
toInt = runIdentity . toIntF . Identity -}


-- How much the minimum key of an arbitrary map should vary
positionFactor :: Int
positionFactor = 1

-- How much the gap between consecutive keys in an arbitrary
-- map should vary
gapRange :: Int
gapRange = 5

instance (IsInt k, Arbitrary v) => Arbitrary (Map k v) where
instance (Int ~ k, Arbitrary v) => Arbitrary (Map k v) where
arbitrary = sized (\sz0 -> do
sz <- choose (0, sz0)
middle <- choose (-positionFactor * (sz + 1), positionFactor * (sz + 1))
Expand All @@ -366,7 +329,16 @@ instance (IsInt k, Arbitrary v) => Arbitrary (Map k v) where
diff <- lift $ choose (1, gapRange)
let i' = i + diff
put i'
pure (fromInt i')
pure i'

-- How much the minimum key of an arbitrary map should vary
positionFactor :: Int
positionFactor = 1

-- How much the gap between consecutive keys in an arbitrary
-- map should vary
gapRange :: Int
gapRange = 5

-- A type with a peculiar Eq instance designed to make sure keys
-- come from where they're supposed to.
Expand Down
87 changes: 27 additions & 60 deletions containers-tests/tests/set-properties.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
import qualified Data.IntSet as IntSet
import Data.List (nub, sort, sortBy)
import qualified Data.List as List
Expand Down Expand Up @@ -192,42 +194,7 @@ test_deleteAt = do
Arbitrary, reasonably balanced trees
--------------------------------------------------------------------}

-- | The IsInt class lets us constrain a type variable to be Int in an entirely
-- standard way. The constraint @ IsInt a @ is essentially equivalent to the
-- GHC-only constraint @ a ~ Int @, but @ IsInt @ requires manual intervention
-- to use. If ~ is ever standardized, we should certainly use it instead.
-- Earlier versions used an Enum constraint, but this is confusing because
-- not all Enum instances will work properly for the Arbitrary instance here.
class (Show a, Read a, Integral a, Arbitrary a) => IsInt a where
fromIntF :: f Int -> f a

instance IsInt Int where
fromIntF = id

-- | Convert an Int to any instance of IsInt
fromInt :: IsInt a => Int -> a
fromInt = runIdentity . fromIntF . Identity

{- We don't actually need this, but we can add it if we ever do
toIntF :: IsInt a => g a -> g Int
toIntF = unf . fromIntF . F $ id

newtype F g a b = F {unf :: g b -> a}

toInt :: IsInt a => a -> Int
toInt = runIdentity . toIntF . Identity -}


-- How much the minimum value of an arbitrary set should vary
positionFactor :: Int
positionFactor = 1

-- How much the gap between consecutive elements in an arbitrary
-- set should vary
gapRange :: Int
gapRange = 5

instance IsInt a => Arbitrary (Set a) where
instance (Int ~ a) => Arbitrary (Set a) where
arbitrary = sized (\sz0 -> do
sz <- choose (0, sz0)
middle <- choose (-positionFactor * (sz + 1), positionFactor * (sz + 1))
Expand All @@ -241,45 +208,45 @@ instance IsInt a => Arbitrary (Set a) where
diff <- lift $ choose (1, gapRange)
let i' = i + diff
put i'
pure (fromInt i')
pure i'

data TwoSets = TwoSets (Set Int) (Set Int) deriving (Show)
-- How much the minimum value of an arbitrary set should vary
positionFactor :: Int
positionFactor = 1

data TwoLists a = TwoLists [a] [a]
-- How much the gap between consecutive elements in an arbitrary
-- set should vary
gapRange :: Int
gapRange = 5

data Options2 = One2 | Two2 | Both2 deriving (Bounded, Enum)
instance Arbitrary Options2 where
arbitrary = arbitraryBoundedEnum
data TwoSets = TwoSets (Set Int) (Set Int) deriving (Show)

-- We produce two lists from a simple "universe". This instance
-- is intended to give good results when the two lists are then
-- combined with each other; if other elements are used with them,
-- they may or may not behave particularly well.
instance IsInt a => Arbitrary (TwoLists a) where
arbitrary = sized $ \sz0 -> do
sz <- choose (0, sz0)
let universe = [0,3..3*(fromInt sz - 1)]
divide2Gen universe

instance Arbitrary TwoSets where
arbitrary = do
TwoLists l r <- arbitrary
(l, r) <- sized $ \sz0 -> do
sz <- choose (0, sz0)
let universe = [0,3..3*(sz - 1)]
Copy link
Contributor

@treeowl treeowl Nov 26, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I know I wrote the original code, but I no longer remember the purpose of using products of 3. Has your work here given you any hints?

Copy link
Contributor Author

@L0neGamer L0neGamer Nov 26, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Not immediately; I would presume because they're not incredibly densely packed that lets other manipulations happen, but I can't say for certain.

Copy link
Contributor

@treeowl treeowl Nov 26, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah, I think it's probably to get some gaps for testing with values in neither? I can't imagine that's the best way to do it; Please feel free to do something else about that.

divide2Gen universe
TwoSets <$> setFromList l <*> setFromList r

divide2Gen :: [a] -> Gen (TwoLists a)
divide2Gen [] = pure (TwoLists [] [])
divide2Gen (x : xs) = do
way <- arbitrary
TwoLists ls rs <- divide2Gen xs
case way of
One2 -> pure (TwoLists (x : ls) rs)
Two2 -> pure (TwoLists ls (x : rs))
Both2 -> pure (TwoLists (x : ls) (x : rs))
where
divide2Gen :: [a] -> Gen ([a], [a])
divide2Gen [] = pure ([], [])
divide2Gen (x : xs) = do
mIsFirst <- arbitrary
(ls, rs) <- divide2Gen xs
pure $ case mIsFirst of
Just True -> ((x : ls), rs)
Just False -> (ls, (x : rs))
Nothing -> ((x : ls), (x : rs))
Copy link
Contributor

@treeowl treeowl Nov 26, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This seems strictly less clear. It also produces more "both" results than the current code, which might be fine.

Copy link
Contributor

@treeowl treeowl Nov 26, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If you don't want another type, you could do something basic with rem inline.

Copy link
Contributor Author

@L0neGamer L0neGamer Nov 26, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would prefer a more numeric approach, I think that makes more sense than the ternary data types here.


{--------------------------------------------------------------------
Valid trees
--------------------------------------------------------------------}
forValid :: (IsInt a,Testable b) => (Set a -> b) -> Property
forValid :: (Int ~ a, Testable b) => (Set a -> b) -> Property
forValid f = forAll arbitrary $ \t ->
classify (size t == 0) "empty" $
classify (size t > 0 && size t <= 10) "small" $
Expand Down