{-# 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 :: a -> a -> [a] towards a destination a x = if a destination a -> a -> Bool forall a. Eq a => a -> a -> Bool == a x then [] -- special case for 1-bit numbers else if a destination a -> a -> Bool forall a. Eq a => a -> a -> Bool == a 0 Bool -> Bool -> Bool && a x a -> a -> Bool forall a. Eq a => a -> a -> Bool == a 1 then [a 0] 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 :: a diff = (a x a -> a -> a forall a. Integral a => a -> a -> a `quot` a 2) a -> a -> a forall a. Num a => a -> a -> a - (a destination a -> a -> a forall a. Integral a => a -> a -> a `quot` a 2) in a destination a -> [a] -> [a] forall a. Eq a => a -> [a] -> [a] `consNub` (a -> a) -> [a] -> [a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a x a -> a -> a forall a. Num a => a -> a -> a -) (a -> [a] forall a. Integral a => a -> [a] halves a 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 :: a -> a -> [a] towardsFloat a destination a x = if a destination a -> a -> Bool forall a. Eq a => a -> a -> Bool == a x then [] else let diff :: a diff = a x a -> a -> a forall a. Num a => a -> a -> a - a destination ok :: a -> Bool ok a y = a y a -> a -> Bool forall a. Eq a => a -> a -> Bool /= a x Bool -> Bool -> Bool && Bool -> Bool not (a -> Bool forall a. RealFloat a => a -> Bool isNaN a y) Bool -> Bool -> Bool && Bool -> Bool not (a -> Bool forall a. RealFloat a => a -> Bool isInfinite a y) in (a -> Bool) -> [a] -> [a] forall a. (a -> Bool) -> [a] -> [a] takeWhile a -> Bool ok ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a] forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> a) -> [a] -> [a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a x a -> a -> a forall a. Num a => a -> a -> a -) ([a] -> [a]) -> [a] -> [a] forall a b. (a -> b) -> a -> b $ (a -> a) -> a -> [a] forall a. (a -> a) -> a -> [a] iterate (a -> a -> a forall a. Fractional a => a -> a -> a / a 2) a 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 :: [a] -> [[a]] list [a] xs = (Int -> [[a]]) -> [Int] -> [[a]] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (\Int k -> Int -> [a] -> [[a]] forall a. Int -> [a] -> [[a]] removes Int k [a] xs) (Int -> [Int] forall a. Integral a => a -> [a] halves (Int -> [Int]) -> Int -> [Int] forall a b. (a -> b) -> a -> b $ [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [a] xs) -- | Produce all permutations of removing 'k' elements from a list. -- -- >>> removes 2 "abcdef" -- ["cdef","abef","abcd"] -- removes :: Int -> [a] -> [[a]] removes :: Int -> [a] -> [[a]] removes Int k0 [a] xs0 = let loop :: Int -> Int -> [a] -> [[a]] loop Int k Int n [a] xs = let ([a] hd, [a] tl) = Int -> [a] -> ([a], [a]) forall a. Int -> [a] -> ([a], [a]) splitAt Int k [a] xs in if Int k Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int n then [] else if [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [a] tl then [[]] else [a] tl [a] -> [[a]] -> [[a]] forall a. a -> [a] -> [a] : ([a] -> [a]) -> [[a]] -> [[a]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ([a] hd [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++) (Int -> Int -> [a] -> [[a]] loop Int k (Int n Int -> Int -> Int forall a. Num a => a -> a -> a - Int k) [a] tl) in Int -> Int -> [a] -> [[a]] forall a. Int -> Int -> [a] -> [[a]] loop Int k0 ([a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [a] xs0) [a] 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 :: a -> [a] halves = (a -> Bool) -> [a] -> [a] forall a. (a -> Bool) -> [a] -> [a] takeWhile (a -> a -> Bool forall a. Eq a => a -> a -> Bool /= a 0) ([a] -> [a]) -> (a -> [a]) -> a -> [a] forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> a) -> a -> [a] forall a. (a -> a) -> a -> [a] iterate (a -> a -> a forall a. Integral a => a -> a -> a `quot` a 2) -- | Cons an element on to the front of a list unless it is already there. -- consNub :: Eq a => a -> [a] -> [a] consNub :: a -> [a] -> [a] consNub a x [a] ys0 = case [a] ys0 of [] -> a x a -> [a] -> [a] forall a. a -> [a] -> [a] : [] a y : [a] ys -> if a x a -> a -> Bool forall a. Eq a => a -> a -> Bool == a y then a y a -> [a] -> [a] forall a. a -> [a] -> [a] : [a] ys else a x a -> [a] -> [a] forall a. a -> [a] -> [a] : a y a -> [a] -> [a] forall a. a -> [a] -> [a] : [a] ys