{-# 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 :: forall a. Integral a => a -> a -> [a]
towards a
destination a
x =
  if a
destination forall a. Eq a => a -> a -> Bool
== a
x then
    []
  -- special case for 1-bit numbers
  else if a
destination forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a
x 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 forall a. Integral a => a -> a -> a
`quot` a
2) forall a. Num a => a -> a -> a
- (a
destination forall a. Integral a => a -> a -> a
`quot` a
2)
    in
      a
destination forall a. Eq a => a -> [a] -> [a]
`consNub` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Num 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 :: forall a. RealFloat a => a -> a -> [a]
towardsFloat a
destination a
x =
  if a
destination forall a. Eq a => a -> a -> Bool
== a
x then
    []
  else
    let
      diff :: a
diff =
        a
x forall a. Num a => a -> a -> a
- a
destination

      ok :: a -> Bool
ok a
y =
        a
y forall a. Eq a => a -> a -> Bool
/= a
x Bool -> Bool -> Bool
&& Bool -> Bool
not (forall a. RealFloat a => a -> Bool
isNaN a
y) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall a. RealFloat a => a -> Bool
isInfinite a
y)
    in
      forall a. (a -> Bool) -> [a] -> [a]
takeWhile a -> Bool
ok forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x forall a. Num a => a -> a -> a
-) forall a b. (a -> b) -> a -> b
$
      forall a. (a -> a) -> a -> [a]
iterate (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 :: forall a. [a] -> [[a]]
list [a]
xs =
 forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
   (\Int
k -> forall a. Int -> [a] -> [[a]]
removes Int
k [a]
xs)
   (forall a. Integral a => a -> [a]
halves forall a b. (a -> b) -> a -> b
$ 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 :: forall a. 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) =
          forall a. Int -> [a] -> ([a], [a])
splitAt Int
k [a]
xs
      in
        if Int
k forall a. Ord a => a -> a -> Bool
> Int
n then
          []
        else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
tl then
          [[]]
        else
          [a]
tl forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a]
hd forall a. [a] -> [a] -> [a]
++) (Int -> Int -> [a] -> [[a]]
loop Int
k (Int
n forall a. Num a => a -> a -> a
- Int
k) [a]
tl)
  in
    forall {a}. Int -> Int -> [a] -> [[a]]
loop Int
k0 (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 :: forall a. Integral a => a -> [a]
halves =
  forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= a
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate (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 :: forall a. Eq a => a -> [a] -> [a]
consNub a
x [a]
ys0 =
  case [a]
ys0 of
    [] ->
      a
x forall a. a -> [a] -> [a]
: []
    a
y : [a]
ys ->
      if a
x forall a. Eq a => a -> a -> Bool
== a
y then
        a
y forall a. a -> [a] -> [a]
: [a]
ys
      else
        a
x forall a. a -> [a] -> [a]
: a
y forall a. a -> [a] -> [a]
: [a]
ys