module Test.QuickCheck.DynamicLogic.SmartShrinking (shrinkSmart) where

import Test.QuickCheck

-- | This combinator captures the 'smart shrinking' implemented for the
-- `Smart` type wrapper in [Test.QuickCheck.Modifiers](https://hackage.haskell.org/package/QuickCheck-2.14.3/docs/Test-QuickCheck-Modifiers.html#t:Smart).
-- It interleaves the output of the given shrinker to try to converge to more
-- interesting values faster.
shrinkSmart :: (a -> [a]) -> Smart a -> [Smart a]
shrinkSmart :: forall a. (a -> [a]) -> Smart a -> [Smart a]
shrinkSmart a -> [a]
shrinker (Smart Int
i a
x) = Int -> [Smart a] -> [Smart a]
forall a. Int -> [a] -> [a]
take Int
i' [Smart a]
ys [Smart a] -> [Smart a] -> [Smart a]
forall {a}. [a] -> [a] -> [a]
`interleave` Int -> [Smart a] -> [Smart a]
forall a. Int -> [a] -> [a]
drop Int
i' [Smart a]
ys
  where
    ys :: [Smart a]
ys = [Int -> a -> Smart a
forall a. Int -> a -> Smart a
Smart Int
j a
y | (Int
j, a
y) <- [Int
0 ..] [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` a -> [a]
shrinker a
x]

    i' :: Int
i' = Int
0 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)

    [] interleave :: [a] -> [a] -> [a]
`interleave` [a]
bs = [a]
bs
    [a]
as `interleave` [] = [a]
as
    (a
a : [a]
as) `interleave` (a
b : [a]
bs) = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a]
as [a] -> [a] -> [a]
`interleave` [a]
bs)