{-# 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
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