{-# 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
    []
  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