    {-# OPTIONS_GHC -fno-warn-orphans #-}
    module Test.QuickCheck.Instances.DataFix () where

    import Prelude ()
    import Test.QuickCheck.Instances.CustomPrelude

    import Data.Fix        (Fix (..), Mu (..), Nu (..), unfoldMu, unfoldNu, foldMu, foldNu)
    import Test.QuickCheck (Arbitrary (..), Arbitrary1 (..), Gen, sized)

    import Math.NumberTheory.Logarithms (intLog2)

    -------------------------------------------------------------------------------
    -- data-fix
    -------------------------------------------------------------------------------

    instance Arbitrary1 f => Arbitrary (Fix f) where
        arbitrary :: Gen (Fix f)
    arbitrary = (Int -> Gen (Fix f)) -> Gen (Fix f)
    forall a. (Int -> Gen a) -> Gen a
    sized Int -> Gen (Fix f)
    forall (f :: * -> *). Arbitrary1 f => Int -> Gen (Fix f)
    arb where
            arb :: Arbitrary1 f => Int -> Gen (Fix f)
            arb :: forall (f :: * -> *). Arbitrary1 f => Int -> Gen (Fix f)
    arb Int
    n = (f (Fix f) -> Fix f) -> Gen (f (Fix f)) -> Gen (Fix f)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f (Fix f) -> Fix f
    forall (f :: * -> *). f (Fix f) -> Fix f
    Fix (Gen (f (Fix f)) -> Gen (Fix f)) -> Gen (f (Fix f)) -> Gen (Fix f)
    forall a b. (a -> b) -> a -> b
    $ Gen (Fix f) -> Gen (f (Fix f))
    forall a. Gen a -> Gen (f a)
    forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
    liftArbitrary (Int -> Gen (Fix f)
    forall (f :: * -> *). Arbitrary1 f => Int -> Gen (Fix f)
    arb (Int -> Int
    smaller Int
    n))

            smaller :: Int -> Int
    smaller Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0    = Int
    0
                      | Bool
    otherwise = Int -> Int
    intLog2 Int
    n

        shrink :: Fix f -> [Fix f]
    shrink = Fix f -> [Fix f]
    forall (f :: * -> *). Arbitrary1 f => Fix f -> [Fix f]
    go where go :: Fix f -> [Fix f]
    go (Fix f (Fix f)
    f) = (f (Fix f) -> Fix f) -> [f (Fix f)] -> [Fix f]
    forall a b. (a -> b) -> [a] -> [b]
    map f (Fix f) -> Fix f
    forall (f :: * -> *). f (Fix f) -> Fix f
    Fix ((Fix f -> [Fix f]) -> f (Fix f) -> [f (Fix f)]
    forall a. (a -> [a]) -> f a -> [f a]
    forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
    liftShrink Fix f -> [Fix f]
    go f (Fix f)
    f)

    instance (Arbitrary1 f, Functor f) => Arbitrary (Mu f) where
        arbitrary :: Gen (Mu f)
    arbitrary = (Fix f -> f (Fix f)) -> Fix f -> Mu f
    forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Mu f
    unfoldMu Fix f -> f (Fix f)
    forall (f :: * -> *). Fix f -> f (Fix f)
    unFix (Fix f -> Mu f) -> Gen (Fix f) -> Gen (Mu f)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen (Fix f)
    forall a. Arbitrary a => Gen a
    arbitrary
        shrink :: Mu f -> [Mu f]
    shrink Mu f
    mu = (Fix f -> f (Fix f)) -> Fix f -> Mu f
    forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Mu f
    unfoldMu Fix f -> f (Fix f)
    forall (f :: * -> *). Fix f -> f (Fix f)
    unFix (Fix f -> Mu f) -> [Fix f] -> [Mu f]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Fix f -> [Fix f]
    forall a. Arbitrary a => a -> [a]
    shrink ((f (Fix f) -> Fix f) -> Mu f -> Fix f
    forall (f :: * -> *) a. (f a -> a) -> Mu f -> a
    foldMu f (Fix f) -> Fix f
    forall (f :: * -> *). f (Fix f) -> Fix f
    Fix Mu f
    mu)

    instance (Arbitrary1 f, Functor f) => Arbitrary (Nu f) where
        arbitrary :: Gen (Nu f)
    arbitrary = (Fix f -> f (Fix f)) -> Fix f -> Nu f
    forall a (f :: * -> *). (a -> f a) -> a -> Nu f
    unfoldNu Fix f -> f (Fix f)
    forall (f :: * -> *). Fix f -> f (Fix f)
    unFix (Fix f -> Nu f) -> Gen (Fix f) -> Gen (Nu f)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen (Fix f)
    forall a. Arbitrary a => Gen a
    arbitrary
        shrink :: Nu f -> [Nu f]
    shrink Nu f
    nu = (Fix f -> f (Fix f)) -> Fix f -> Nu f
    forall a (f :: * -> *). (a -> f a) -> a -> Nu f
    unfoldNu Fix f -> f (Fix f)
    forall (f :: * -> *). Fix f -> f (Fix f)
    unFix (Fix f -> Nu f) -> [Fix f] -> [Nu f]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Fix f -> [Fix f]
    forall a. Arbitrary a => a -> [a]
    shrink ((f (Fix f) -> Fix f) -> Nu f -> Fix f
    forall (f :: * -> *) a. Functor f => (f a -> a) -> Nu f -> a
    foldNu f (Fix f) -> Fix f
    forall (f :: * -> *). f (Fix f) -> Fix f
    Fix Nu f
    nu)