-- | Hedgehog-style shrink trees
--
-- Intended for qualified import.
--
-- > import Test.Falsify
-- > import qualified Test.Falsify.ShrinkTree as ShrinkTree
module Test.Falsify.ShrinkTree (
    ShrinkTree(..)
    -- * Construction
  , unfold
  ) where

import qualified Data.Tree as Rose

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Hedgehog-style shrink tree
newtype ShrinkTree a = WrapShrinkTree{
      forall a. ShrinkTree a -> Tree a
unwrapShrinkTree :: Rose.Tree a
    }
  deriving stock (ShrinkTree a -> ShrinkTree a -> Bool
(ShrinkTree a -> ShrinkTree a -> Bool)
-> (ShrinkTree a -> ShrinkTree a -> Bool) -> Eq (ShrinkTree a)
forall a. Eq a => ShrinkTree a -> ShrinkTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ShrinkTree a -> ShrinkTree a -> Bool
== :: ShrinkTree a -> ShrinkTree a -> Bool
$c/= :: forall a. Eq a => ShrinkTree a -> ShrinkTree a -> Bool
/= :: ShrinkTree a -> ShrinkTree a -> Bool
Eq, (forall a b. (a -> b) -> ShrinkTree a -> ShrinkTree b)
-> (forall a b. a -> ShrinkTree b -> ShrinkTree a)
-> Functor ShrinkTree
forall a b. a -> ShrinkTree b -> ShrinkTree a
forall a b. (a -> b) -> ShrinkTree a -> ShrinkTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ShrinkTree a -> ShrinkTree b
fmap :: forall a b. (a -> b) -> ShrinkTree a -> ShrinkTree b
$c<$ :: forall a b. a -> ShrinkTree b -> ShrinkTree a
<$ :: forall a b. a -> ShrinkTree b -> ShrinkTree a
Functor)

instance Show a => Show (ShrinkTree a) where
  show :: ShrinkTree a -> String
show = Tree String -> String
Rose.drawTree (Tree String -> String)
-> (ShrinkTree a -> Tree String) -> ShrinkTree a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> Tree a -> Tree String
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> String
forall a. Show a => a -> String
show (Tree a -> Tree String)
-> (ShrinkTree a -> Tree a) -> ShrinkTree a -> Tree String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShrinkTree a -> Tree a
forall a. ShrinkTree a -> Tree a
unwrapShrinkTree

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

-- | Quickcheck-style manual shrinking
unfold :: a -> (a -> [a]) -> ShrinkTree a
unfold :: forall a. a -> (a -> [a]) -> ShrinkTree a
unfold a
x a -> [a]
f = Tree a -> ShrinkTree a
forall a. Tree a -> ShrinkTree a
WrapShrinkTree (Tree a -> ShrinkTree a) -> Tree a -> ShrinkTree a
forall a b. (a -> b) -> a -> b
$ (a -> (a, [a])) -> a -> Tree a
forall b a. (b -> (a, [b])) -> b -> Tree a
Rose.unfoldTree (\a
a -> (a
a, a -> [a]
f a
a)) a
x