Shrinking

shrinking.elm

property : String -> (a -> Bool) -> Arbitrary a -> Property
property name predicate arbitrary n seed =
  let
      -- failingTestCase' : Seed -> Int -> Trampoline (Result (a, Seed, Int) Int)
      failingTestCase' seed accum =
        if accum >= n
        then
          Done (Ok n)
        else
          let
              (value, nextSeed) = Random.generate arbitrary.generator seed
          in
            if predicate value
            then
              Continue (\() -> failingTestCase' nextSeed (accum + 1))
            else
              Done (Err (value, nextSeed, accum + 1))


      -- failingTestCase : Result (a, Seed, Int) Int
      failingTestCase =
        trampoline (failingTestCase' seed 0)


  in case failingTestCase of
    Ok n ->
      Ok
        { name          = name
        , seed          = seed
        , numberOfTests = max 0 n
        }

    Err (failingValue, seed, n) ->
      let
          shrink value numberOfShrinks =
            let
                shrunks = arbitrary.shrinker value

                failingShrunks =
                  List.filter (\shrunk -> not (predicate shrunk)) shrunks

            in case List.head failingShrunks of
              Nothing ->
                Done (value, numberOfShrinks)

              Just failing ->
                Continue (\() -> shrink failing (numberOfShrinks + 1))

          (minimal, numberOfShrinks) =
            trampoline (shrink failingValue 0)

      in
        Err
          { name  = name
          , value = toString minimal
          , seed  = seed
          , numberOfTests   = n
          , numberOfShrinks = numberOfShrinks
          }