{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if HAVE_QUANTIFIED_CONSTRAINTS
{-# LANGUAGE QuantifiedConstraints #-}
#endif

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Foldable
  (
#if HAVE_UNARY_LAWS
    foldableLaws
#endif
  ) where

import Data.Monoid
import Data.Foldable
import Test.QuickCheck hiding ((.&.))
import Control.Exception (ErrorCall,try,evaluate)
import Control.Monad.Trans.Class (lift)
#if HAVE_UNARY_LAWS
import Test.QuickCheck.Arbitrary (Arbitrary1(..))
#endif
import Test.QuickCheck.Monadic (monadicIO)
#if HAVE_UNARY_LAWS
import Data.Functor.Classes (Eq1,Show1)
#endif
import Test.QuickCheck.Property (Property)

import qualified Data.Foldable as F
import qualified Data.Semigroup as SG

import Test.QuickCheck.Classes.Internal

#if HAVE_UNARY_LAWS

-- | Tests the following 'Foldable' properties:
--
-- [/fold/]
--   @'fold' ≡ 'foldMap' 'id'@
-- [/foldMap/]
--   @'foldMap' f ≡ 'foldr' ('mappend' . f) 'mempty'@
-- [/foldr/]
--   @'foldr' f z t ≡ 'appEndo' ('foldMap' ('Endo' . f) t ) z@
-- [/foldr'/]
--   @'foldr'' f z0 xs ≡ let f\' k x z = k '$!' f x z in 'foldl' f\' 'id' xs z0@
-- [/foldr1/]
--   @'foldr1' f t ≡ let 'Just' (xs,x) = 'unsnoc' ('toList' t) in 'foldr' f x xs@
-- [/foldl/]
--   @'foldl' f z t ≡ 'appEndo' ('getDual' ('foldMap' ('Dual' . 'Endo' . 'flip' f) t)) z@
-- [/foldl'/]
--   @'foldl'' f z0 xs ≡ let f' x k z = k '$!' f z x in 'foldr' f\' 'id' xs z0@
-- [/foldl1/]
--   @'foldl1' f t ≡ let x : xs = 'toList' t in 'foldl' f x xs@
-- [/toList/]
--   @'F.toList' ≡ 'foldr' (:) []@
-- [/null/]
--   @'null' ≡ 'foldr' ('const' ('const' 'False')) 'True'@
-- [/length/]
--   @'length' ≡ 'getSum' . 'foldMap' ('const' ('Sum' 1))@
--
-- Note that this checks to ensure that @foldl\'@ and @foldr\'@
-- are suitably strict.
foldableLaws :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Foldable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Foldable f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Laws
foldableLaws :: proxy f -> Laws
foldableLaws = proxy f -> Laws
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Foldable f, forall a. Eq a => Eq (f a),
 forall a. Show a => Show (f a),
 forall a. Arbitrary a => Arbitrary (f a)) =>
proxy f -> Laws
foldableLawsInternal

foldableLawsInternal :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Foldable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Foldable f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Laws
foldableLawsInternal :: proxy f -> Laws
foldableLawsInternal proxy f
p = String -> [(String, Property)] -> Laws
Laws String
"Foldable"
  [ (,) String
"fold" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f (VerySmallList Integer) -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f (VerySmallList Integer) -> Bool) -> Property)
-> (Apply f (VerySmallList Integer) -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f (VerySmallList Integer)
a :: f (VerySmallList Integer))) ->
      f (VerySmallList Integer) -> VerySmallList Integer
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold f (VerySmallList Integer)
a VerySmallList Integer -> VerySmallList Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (VerySmallList Integer -> VerySmallList Integer)
-> f (VerySmallList Integer) -> VerySmallList Integer
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap VerySmallList Integer -> VerySmallList Integer
forall a. a -> a
id f (VerySmallList Integer)
a
  , (,) String
"foldMap" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> QuadraticEquation -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> QuadraticEquation -> Bool) -> Property)
-> (Apply f Integer -> QuadraticEquation -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
a :: f Integer)) (QuadraticEquation
e :: QuadraticEquation) ->
      let f :: Integer -> VerySmallList Integer
f = [Integer] -> VerySmallList Integer
forall a. [a] -> VerySmallList a
VerySmallList ([Integer] -> VerySmallList Integer)
-> (Integer -> [Integer]) -> Integer -> VerySmallList Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> [Integer])
-> (Integer -> Integer) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadraticEquation -> Integer -> Integer
runQuadraticEquation QuadraticEquation
e
       in (Integer -> VerySmallList Integer)
-> f Integer -> VerySmallList Integer
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Integer -> VerySmallList Integer
f f Integer
a VerySmallList Integer -> VerySmallList Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer -> VerySmallList Integer -> VerySmallList Integer)
-> VerySmallList Integer -> f Integer -> VerySmallList Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (VerySmallList Integer
-> VerySmallList Integer -> VerySmallList Integer
forall a. Monoid a => a -> a -> a
mappend (VerySmallList Integer
 -> VerySmallList Integer -> VerySmallList Integer)
-> (Integer -> VerySmallList Integer)
-> Integer
-> VerySmallList Integer
-> VerySmallList Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> VerySmallList Integer
f) VerySmallList Integer
forall a. Monoid a => a
mempty f Integer
a
  , (,) String
"foldr" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (LinearEquationTwo -> Integer -> Apply f Integer -> Bool)
-> Property
forall prop. Testable prop => prop -> Property
property ((LinearEquationTwo -> Integer -> Apply f Integer -> Bool)
 -> Property)
-> (LinearEquationTwo -> Integer -> Apply f Integer -> Bool)
-> Property
forall a b. (a -> b) -> a -> b
$ \(LinearEquationTwo
e :: LinearEquationTwo) (Integer
z :: Integer) (Apply (f Integer
t :: f Integer)) ->
      let f :: Integer -> Integer -> Integer
f = LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo LinearEquationTwo
e
       in (Integer -> Integer -> Integer) -> Integer -> f Integer -> Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr Integer -> Integer -> Integer
f Integer
z f Integer
t Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Endo Integer -> Integer -> Integer
forall a. Endo a -> a -> a
SG.appEndo ((Integer -> Endo Integer) -> f Integer -> Endo Integer
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Integer -> Integer) -> Endo Integer
forall a. (a -> a) -> Endo a
SG.Endo ((Integer -> Integer) -> Endo Integer)
-> (Integer -> Integer -> Integer) -> Integer -> Endo Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
f) f Integer
t) Integer
z
  , (,) String
"foldr'" (proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Foldable f, forall a. Eq a => Eq (f a),
 forall a. Show a => Show (f a),
 forall a. Arbitrary a => Arbitrary (f a)) =>
proxy f -> Property
foldableFoldr' proxy f
p)
  , (,) String
"foldl" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (LinearEquationTwo -> Integer -> Apply f Integer -> Bool)
-> Property
forall prop. Testable prop => prop -> Property
property ((LinearEquationTwo -> Integer -> Apply f Integer -> Bool)
 -> Property)
-> (LinearEquationTwo -> Integer -> Apply f Integer -> Bool)
-> Property
forall a b. (a -> b) -> a -> b
$ \(LinearEquationTwo
e :: LinearEquationTwo) (Integer
z :: Integer) (Apply (f Integer
t :: f Integer)) ->
      let f :: Integer -> Integer -> Integer
f = LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo LinearEquationTwo
e
       in (Integer -> Integer -> Integer) -> Integer -> f Integer -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl Integer -> Integer -> Integer
f Integer
z f Integer
t Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Endo Integer -> Integer -> Integer
forall a. Endo a -> a -> a
SG.appEndo (Dual (Endo Integer) -> Endo Integer
forall a. Dual a -> a
SG.getDual ((Integer -> Dual (Endo Integer))
-> f Integer -> Dual (Endo Integer)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (Endo Integer -> Dual (Endo Integer)
forall a. a -> Dual a
SG.Dual (Endo Integer -> Dual (Endo Integer))
-> (Integer -> Endo Integer) -> Integer -> Dual (Endo Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> Endo Integer
forall a. (a -> a) -> Endo a
SG.Endo ((Integer -> Integer) -> Endo Integer)
-> (Integer -> Integer -> Integer) -> Integer -> Endo Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
f) f Integer
t)) Integer
z
  , (,) String
"foldl'" (proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Foldable f, forall a. Eq a => Eq (f a),
 forall a. Show a => Show (f a),
 forall a. Arbitrary a => Arbitrary (f a)) =>
proxy f -> Property
foldableFoldl' proxy f
p)
  , (,) String
"foldl1" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (LinearEquationTwo -> Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((LinearEquationTwo -> Apply f Integer -> Bool) -> Property)
-> (LinearEquationTwo -> Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(LinearEquationTwo
e :: LinearEquationTwo) (Apply (f Integer
t :: f Integer)) ->
      case f Integer -> [Integer]
forall (f :: * -> *) a. Foldable f => f a -> [a]
compatToList f Integer
t of
        [] -> Bool
True
        Integer
x : [Integer]
xs ->
          let f :: Integer -> Integer -> Integer
f = LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo LinearEquationTwo
e
           in (Integer -> Integer -> Integer) -> f Integer -> Integer
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldl1 Integer -> Integer -> Integer
f f Integer
t Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl Integer -> Integer -> Integer
f Integer
x [Integer]
xs
  , (,) String
"foldr1" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (LinearEquationTwo -> Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((LinearEquationTwo -> Apply f Integer -> Bool) -> Property)
-> (LinearEquationTwo -> Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(LinearEquationTwo
e :: LinearEquationTwo) (Apply (f Integer
t :: f Integer)) ->
      case [Integer] -> Maybe ([Integer], Integer)
forall a. [a] -> Maybe ([a], a)
unsnoc (f Integer -> [Integer]
forall (f :: * -> *) a. Foldable f => f a -> [a]
compatToList f Integer
t) of
        Maybe ([Integer], Integer)
Nothing -> Bool
True
        Just ([Integer]
xs,Integer
x) ->
          let f :: Integer -> Integer -> Integer
f = LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo LinearEquationTwo
e
           in (Integer -> Integer -> Integer) -> f Integer -> Integer
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
F.foldr1 Integer -> Integer -> Integer
f f Integer
t Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr Integer -> Integer -> Integer
f Integer
x [Integer]
xs
  , (,) String
"toList" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
t :: f Integer)) ->
      [Integer] -> [Integer] -> Bool
forall (f :: * -> *) a.
(forall x. Eq x => Eq (f x), Eq a) =>
f a -> f a -> Bool
eq1 (f Integer -> [Integer]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f Integer
t) ((Integer -> [Integer] -> [Integer])
-> [Integer] -> f Integer -> [Integer]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (:) [] f Integer
t)
#if MIN_VERSION_base(4,8,0)
  , (,) String
"null" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
t :: f Integer)) ->
      f Integer -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f Integer
t Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer -> Bool -> Bool) -> Bool -> f Integer -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((Bool -> Bool) -> Integer -> Bool -> Bool
forall a b. a -> b -> a
const (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
False)) Bool
True f Integer
t
  , (,) String
"length" (Property -> (String, Property)) -> Property -> (String, Property)
forall a b. (a -> b) -> a -> b
$ (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
t :: f Integer)) ->
      f Integer -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length f Integer
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Sum Int -> Int
forall a. Sum a -> a
SG.getSum ((Integer -> Sum Int) -> f Integer -> Sum Int
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (Sum Int -> Integer -> Sum Int
forall a b. a -> b -> a
const (Int -> Sum Int
forall a. a -> Sum a
SG.Sum Int
1)) f Integer
t)
#endif
  ]

unsnoc :: [a] -> Maybe ([a],a)
unsnoc :: [a] -> Maybe ([a], a)
unsnoc [] = Maybe ([a], a)
forall a. Maybe a
Nothing
unsnoc [a
x] = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just ([],a
x)
unsnoc (a
x:a
y:[a]
xs) = (([a], a) -> ([a], a)) -> Maybe ([a], a) -> Maybe ([a], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([a]
bs,a
b) -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs,a
b)) ([a] -> Maybe ([a], a)
forall a. [a] -> Maybe ([a], a)
unsnoc (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs))

compatToList :: Foldable f => f a -> [a]
compatToList :: f a -> [a]
compatToList = (a -> [a]) -> f a -> [a]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a
x -> [a
x])

foldableFoldl' :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Foldable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Foldable f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Property
foldableFoldl' :: proxy f -> Property
foldableFoldl' proxy f
_ = (ChooseSecond
 -> LastNothing -> Apply f (Bottom Integer) -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((ChooseSecond
  -> LastNothing -> Apply f (Bottom Integer) -> Property)
 -> Property)
-> (ChooseSecond
    -> LastNothing -> Apply f (Bottom Integer) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(ChooseSecond
_ :: ChooseSecond) (LastNothing
_ :: LastNothing) (Apply (f (Bottom Integer)
xs :: f (Bottom Integer))) ->
  PropertyM IO Bool -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO Bool -> Property) -> PropertyM IO Bool -> Property
forall a b. (a -> b) -> a -> b
$ do
    let f :: Integer -> Bottom Integer -> Integer
        f :: Integer -> Bottom Integer -> Integer
f Integer
a Bottom Integer
b = case Bottom Integer
b of
          Bottom Integer
BottomUndefined -> String -> Integer
forall a. HasCallStack => String -> a
error String
"foldableFoldl' example"
          BottomValue Integer
v -> if Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
v
            then Integer
a
            else Integer
v
        z0 :: Integer
z0 = Integer
0
    Maybe Integer
r1 <- IO (Maybe Integer) -> PropertyM IO (Maybe Integer)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Integer) -> PropertyM IO (Maybe Integer))
-> IO (Maybe Integer) -> PropertyM IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ do
      let f' :: Bottom Integer -> (Integer -> b) -> Integer -> b
f' Bottom Integer
x Integer -> b
k Integer
z = Integer -> b
k (Integer -> b) -> Integer -> b
forall a b. (a -> b) -> a -> b
$! Integer -> Bottom Integer -> Integer
f Integer
z Bottom Integer
x
      Either ErrorCall Integer
e <- IO Integer -> IO (Either ErrorCall Integer)
forall e a. Exception e => IO a -> IO (Either e a)
try (Integer -> IO Integer
forall a. a -> IO a
evaluate ((Bottom Integer -> (Integer -> Integer) -> Integer -> Integer)
-> (Integer -> Integer) -> f (Bottom Integer) -> Integer -> Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr Bottom Integer -> (Integer -> Integer) -> Integer -> Integer
forall b. Bottom Integer -> (Integer -> b) -> Integer -> b
f' Integer -> Integer
forall a. a -> a
id f (Bottom Integer)
xs Integer
z0))
      case Either ErrorCall Integer
e of
        Left (ErrorCall
_ :: ErrorCall) -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
        Right Integer
i -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i)
    Maybe Integer
r2 <- IO (Maybe Integer) -> PropertyM IO (Maybe Integer)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Integer) -> PropertyM IO (Maybe Integer))
-> IO (Maybe Integer) -> PropertyM IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ do
      Either ErrorCall Integer
e <- IO Integer -> IO (Either ErrorCall Integer)
forall e a. Exception e => IO a -> IO (Either e a)
try (Integer -> IO Integer
forall a. a -> IO a
evaluate ((Integer -> Bottom Integer -> Integer)
-> Integer -> f (Bottom Integer) -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Integer -> Bottom Integer -> Integer
f Integer
z0 f (Bottom Integer)
xs))
      case Either ErrorCall Integer
e of
        Left (ErrorCall
_ :: ErrorCall) -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
        Right Integer
i -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i)
    Bool -> PropertyM IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer
r1 Maybe Integer -> Maybe Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Integer
r2)

foldableFoldr' :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Foldable f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Foldable f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Property
foldableFoldr' :: proxy f -> Property
foldableFoldr' proxy f
_ = (ChooseFirst
 -> LastNothing -> Apply f (Bottom Integer) -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((ChooseFirst
  -> LastNothing -> Apply f (Bottom Integer) -> Property)
 -> Property)
-> (ChooseFirst
    -> LastNothing -> Apply f (Bottom Integer) -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(ChooseFirst
_ :: ChooseFirst) (LastNothing
_ :: LastNothing) (Apply (f (Bottom Integer)
xs :: f (Bottom Integer))) ->
  PropertyM IO Bool -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO Bool -> Property) -> PropertyM IO Bool -> Property
forall a b. (a -> b) -> a -> b
$ do
    let f :: Bottom Integer -> Integer -> Integer
        f :: Bottom Integer -> Integer -> Integer
f Bottom Integer
a Integer
b = case Bottom Integer
a of
          Bottom Integer
BottomUndefined -> String -> Integer
forall a. HasCallStack => String -> a
error String
"foldableFoldl' example"
          BottomValue Integer
v -> if Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
v
            then Integer
v
            else Integer
b
        z0 :: Integer
z0 = Integer
0
    Maybe Integer
r1 <- IO (Maybe Integer) -> PropertyM IO (Maybe Integer)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Integer) -> PropertyM IO (Maybe Integer))
-> IO (Maybe Integer) -> PropertyM IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ do
      let f' :: (Integer -> b) -> Bottom Integer -> Integer -> b
f' Integer -> b
k Bottom Integer
x Integer
z = Integer -> b
k (Integer -> b) -> Integer -> b
forall a b. (a -> b) -> a -> b
$! Bottom Integer -> Integer -> Integer
f Bottom Integer
x Integer
z
      Either ErrorCall Integer
e <- IO Integer -> IO (Either ErrorCall Integer)
forall e a. Exception e => IO a -> IO (Either e a)
try (Integer -> IO Integer
forall a. a -> IO a
evaluate (((Integer -> Integer) -> Bottom Integer -> Integer -> Integer)
-> (Integer -> Integer) -> f (Bottom Integer) -> Integer -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl (Integer -> Integer) -> Bottom Integer -> Integer -> Integer
forall b. (Integer -> b) -> Bottom Integer -> Integer -> b
f' Integer -> Integer
forall a. a -> a
id f (Bottom Integer)
xs Integer
z0))
      case Either ErrorCall Integer
e of
        Left (ErrorCall
_ :: ErrorCall) -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
        Right Integer
i -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i)
    Maybe Integer
r2 <- IO (Maybe Integer) -> PropertyM IO (Maybe Integer)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Integer) -> PropertyM IO (Maybe Integer))
-> IO (Maybe Integer) -> PropertyM IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ do
      Either ErrorCall Integer
e <- IO Integer -> IO (Either ErrorCall Integer)
forall e a. Exception e => IO a -> IO (Either e a)
try (Integer -> IO Integer
forall a. a -> IO a
evaluate ((Bottom Integer -> Integer -> Integer)
-> Integer -> f (Bottom Integer) -> Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr' Bottom Integer -> Integer -> Integer
f Integer
z0 f (Bottom Integer)
xs))
      case Either ErrorCall Integer
e of
        Left (ErrorCall
_ :: ErrorCall) -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
        Right Integer
i -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i)
    Bool -> PropertyM IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer
r1 Maybe Integer -> Maybe Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Integer
r2)

#endif