{-# OPTIONS_HADDOCK not-home #-} module Hedgehog.Internal.Shrink ( towards , towardsFloat , list , halves , removes , consNub ) where -- | Shrink an integral number by edging towards a destination. -- -- >>> towards 0 100 -- [0,50,75,88,94,97,99] -- -- >>> towards 500 1000 -- [500,750,875,938,969,985,993,997,999] -- -- >>> towards (-50) (-26) -- [-50,-38,-32,-29,-27] -- -- /Note we always try the destination first, as that is the optimal shrink./ -- towards :: Integral a => a -> a -> [a] towards destination x = if destination == x then [] else let -- Halve the operands before subtracting them so they don't overflow. -- Consider 'minBound' and 'maxBound' for a fixed sized type like 'Int64'. diff = (x `quot` 2) - (destination `quot` 2) in destination `consNub` fmap (x -) (halves diff) -- | Shrink a floating-point number by edging towards a destination. -- -- >>> take 7 (towardsFloat 0.0 100) -- [0.0,50.0,75.0,87.5,93.75,96.875,98.4375] -- -- >>> take 7 (towardsFloat 1.0 0.5) -- [1.0,0.75,0.625,0.5625,0.53125,0.515625,0.5078125] -- -- /Note we always try the destination first, as that is the optimal shrink./ -- towardsFloat :: RealFloat a => a -> a -> [a] towardsFloat destination x = if destination == x then [] else let diff = x - destination ok y = y /= x && not (isNaN y) && not (isInfinite y) in takeWhile ok . fmap (x -) $ iterate (/ 2) diff -- | Shrink a list by edging towards the empty list. -- -- >>> list [1,2,3] -- [[],[2,3],[1,3],[1,2]] -- -- >>> list "abcd" -- ["","cd","ab","bcd","acd","abd","abc"] -- -- /Note we always try the empty list first, as that is the optimal shrink./ -- list :: [a] -> [[a]] list xs = concatMap (\k -> removes k xs) (halves $ length xs) -- | Produce all permutations of removing 'k' elements from a list. -- -- >>> removes 2 "abcdef" -- ["cdef","abef","abcd"] -- removes :: Int -> [a] -> [[a]] removes k0 xs0 = let loop k n xs = let (hd, tl) = splitAt k xs in if k > n then [] else if null tl then [[]] else tl : fmap (hd ++) (loop k (n - k) tl) in loop k0 (length xs0) xs0 -- | Produce a list containing the progressive halving of an integral. -- -- >>> halves 15 -- [15,7,3,1] -- -- >>> halves 100 -- [100,50,25,12,6,3,1] -- -- >>> halves (-26) -- [-26,-13,-6,-3,-1] -- halves :: Integral a => a -> [a] halves = takeWhile (/= 0) . iterate (`quot` 2) -- | Cons an element on to the front of a list unless it is already there. -- consNub :: Eq a => a -> [a] -> [a] consNub x ys0 = case ys0 of [] -> x : [] y : ys -> if x == y then y : ys else x : y : ys