{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE LambdaCase #-}
module Hedgehog.Classes.Foldable (foldableLaws) where
import Hedgehog
import Hedgehog.Classes.Common
import Control.Monad.IO.Class (MonadIO(..))
import Control.Exception (ErrorCall(..), try, evaluate)
import Data.Monoid (Sum(..), Endo(..), Dual(..))
import qualified Data.Foldable as Foldable
foldableLaws ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Laws
foldableLaws :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Laws
foldableLaws forall x. Gen x -> Gen (f x)
gen = String -> [(String, Property)] -> Laws
Laws String
"Foldable"
[ (String
"fold", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFold forall x. Gen x -> Gen (f x)
gen)
, (String
"foldMap", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldMap forall x. Gen x -> Gen (f x)
gen)
, (String
"foldr", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldr forall x. Gen x -> Gen (f x)
gen)
, (String
"foldr'", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldr' forall x. Gen x -> Gen (f x)
gen)
, (String
"foldl", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldl forall x. Gen x -> Gen (f x)
gen)
, (String
"foldl'", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldl' forall x. Gen x -> Gen (f x)
gen)
, (String
"foldl1", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldl1 forall x. Gen x -> Gen (f x)
gen)
, (String
"foldr1", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldr1 forall x. Gen x -> Gen (f x)
gen)
, (String
"toList", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableToList forall x. Gen x -> Gen (f x)
gen)
, (String
"null", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableNull forall x. Gen x -> Gen (f x)
gen)
, (String
"length", forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableLength forall x. Gen x -> Gen (f x)
gen)
]
foldableFold ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableFold :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFold forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f [Integer]
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> Gen [a]
genVerySmallList Gen Integer
genSmallInteger
let lhs :: [Integer]
lhs = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold f [Integer]
a
let rhs :: [Integer]
rhs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap forall a. a -> a
id f [Integer]
a
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Fold"
, lawContextLawBody :: String
lawContextLawBody = String
"fold" String -> String -> String
`congruency` String
"foldMap id"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showA :: String
showA = forall a. Show a => a -> String
show f [Integer]
a
in [String] -> String
lawWhere
[ String
"fold a" String -> String -> String
`congruency` String
"foldMap id a, where"
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced [Integer]
lhs [Integer]
rhs
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx [Integer]
lhs [Integer]
rhs Context
ctx
foldableFoldMap ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableFoldMap :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldMap forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f Integer
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
QuadraticEquation
e <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen QuadraticEquation
genQuadraticEquation
let f :: Integer -> [Integer]
f = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuadraticEquation -> Integer -> Integer
runQuadraticEquation QuadraticEquation
e
let lhs :: [Integer]
lhs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap Integer -> [Integer]
f f Integer
a
let rhs :: [Integer]
rhs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr (forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
f) forall a. Monoid a => a
mempty f Integer
a
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"FoldMap"
, lawContextLawBody :: String
lawContextLawBody = String
"foldMap f" String -> String -> String
`congruency` String
"foldr (mappend . f) mempty"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showA :: String
showA = forall a. Show a => a -> String
show f Integer
a
showF :: String
showF = String
"(:[]) $ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show QuadraticEquation
e
in [String] -> String
lawWhere
[ String
"foldMap f a" String -> String -> String
`congruency` String
"foldr (mappend . f) mempty a, where"
, String
"f = " forall a. [a] -> [a] -> [a]
++ String
showF
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced [Integer]
lhs [Integer]
rhs
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx [Integer]
lhs [Integer]
rhs Context
ctx
foldableFoldr ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableFoldr :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldr forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
LinearEquationTwo
e <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen LinearEquationTwo
genLinearEquationTwo
Integer
z <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Integer
genSmallInteger
f Integer
t <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
let f :: Integer -> Integer -> Integer
f = LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo LinearEquationTwo
e
let lhs :: Integer
lhs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr Integer -> Integer -> Integer
f Integer
z f Integer
t
let rhs :: Integer
rhs = forall a. Endo a -> a -> a
appEndo (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
f) f Integer
t) Integer
z
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Foldr"
, lawContextLawBody :: String
lawContextLawBody = String
"foldr f z t" String -> String -> String
`congruency` String
"appEndo (foldMap (Endo . f) t) z"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showT :: String
showT = forall a. Show a => a -> String
show f Integer
t
showF :: String
showF = forall a. Show a => a -> String
show LinearEquationTwo
e
showZ :: String
showZ = forall a. Show a => a -> String
show Integer
z
in [String] -> String
lawWhere
[ String
"foldr f z t" String -> String -> String
`congruency` String
"appEndo (foldMap (Endo . f) t) z"
, String
"f = " forall a. [a] -> [a] -> [a]
++ String
showF
, String
"z = " forall a. [a] -> [a] -> [a]
++ String
showZ
, String
"t = " forall a. [a] -> [a] -> [a]
++ String
showT
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Integer
lhs Integer
rhs
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Integer
lhs Integer
rhs Context
ctx
foldableFoldl ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableFoldl :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldl forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
LinearEquationTwo
e <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen LinearEquationTwo
genLinearEquationTwo
Integer
z <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Integer
genSmallInteger
f Integer
t <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
let f :: Integer -> Integer -> Integer
f = LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo LinearEquationTwo
e
let lhs :: Integer
lhs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl Integer -> Integer -> Integer
f Integer
z f Integer
t
let rhs :: Integer
rhs = forall a. Endo a -> a -> a
appEndo (forall a. Dual a -> a
getDual (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (forall a. a -> Dual a
Dual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Integer
f) f Integer
t)) Integer
z
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Foldl"
, lawContextLawBody :: String
lawContextLawBody = String
"foldl f z t" String -> String -> String
`congruency` String
"appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showT :: String
showT = forall a. Show a => a -> String
show f Integer
t
showF :: String
showF = forall a. Show a => a -> String
show LinearEquationTwo
e
showZ :: String
showZ = forall a. Show a => a -> String
show Integer
z
in [String] -> String
lawWhere
[ String
"foldl f z t" String -> String -> String
`congruency` String
"appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z"
, String
"f = " forall a. [a] -> [a] -> [a]
++ String
showF
, String
"z = " forall a. [a] -> [a] -> [a]
++ String
showZ
, String
"t = " forall a. [a] -> [a] -> [a]
++ String
showT
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Integer
lhs Integer
rhs
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Integer
lhs Integer
rhs Context
ctx
ctxNotStrict :: String -> Context
ctxNotStrict :: String -> Context
ctxNotStrict String
str = String -> Context
Context forall a b. (a -> b) -> a -> b
$ String
"Your implementation of " forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
" is not strict."
foldableFoldr' ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableFoldr' :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldr' forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f (Bottom Integer)
xs <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen (forall a. Gen a -> Gen (Bottom a)
genBottom Gen Integer
genSmallInteger)
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 -> forall a. HasCallStack => String -> a
error String
"foldableFoldr': your foldr' is not strict!"
BottomValue Integer
v -> if forall a. Integral a => a -> Bool
even Integer
v then Integer
v else Integer
b
Integer
z0 <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Integer
genSmallInteger
(Maybe Integer
rhs, Context
ctx1) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 forall a b. (a -> b) -> a -> b
$! Bottom Integer -> Integer -> Integer
f Bottom Integer
x Integer
z
Either ErrorCall Integer
e <- forall e a. Exception e => IO a -> IO (Either e a)
try (forall a. a -> IO a
evaluate (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl forall {b}. (Integer -> b) -> Bottom Integer -> Integer -> b
f' forall a. a -> a
id f (Bottom Integer)
xs Integer
z0))
case Either ErrorCall Integer
e of
Left (ErrorCall
_ :: ErrorCall) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, String -> Context
ctxNotStrict String
"foldr'")
Right Integer
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Integer
i, Context
NoContext)
(Maybe Integer
lhs, Context
ctx2) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Either ErrorCall Integer
e <- forall e a. Exception e => IO a -> IO (Either e a)
try (forall a. a -> IO a
evaluate (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr' Bottom Integer -> Integer -> Integer
f Integer
z0 f (Bottom Integer)
xs))
case Either ErrorCall Integer
e of
Left (ErrorCall
_ :: ErrorCall) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, String -> Context
ctxNotStrict String
"foldr'")
Right Integer
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Integer
i, Context
NoContext)
let ctx :: Context
ctx = case Context
ctx1 of
Context
NoContext -> case Context
ctx2 of
Context
NoContext -> LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Foldr'"
, lawContextLawBody :: String
lawContextLawBody = String
"foldr' f z0 t" String -> String -> String
`congruency` String
"foldl f' id t z0, where f' k x z = k $! f x z"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showT :: String
showT = forall a. Show a => a -> String
show f (Bottom Integer)
xs
showF :: String
showF = String
"\\a b -> case a of\n BottomUndefined -> error \"foldableFoldr': not strict\"\n BottomValue v -> if even v then v else b"
showZ :: String
showZ = forall a. Show a => a -> String
show Integer
z0
in [String] -> String
lawWhere
[ String
"foldr' f z0 t" String -> String -> String
`congruency` String
"foldl f' id t z0, where f' k x z = k $! f x z"
, String
"f = " forall a. [a] -> [a] -> [a]
++ String
showF
, String
"z0 = " forall a. [a] -> [a] -> [a]
++ String
showZ
, String
"t = " forall a. [a] -> [a] -> [a]
++ String
showT
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Maybe Integer
lhs Maybe Integer
rhs
}
Context
c2 -> Context
c2
Context
c1 -> Context
c1
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Maybe Integer
lhs Maybe Integer
rhs Context
ctx
foldableFoldl' ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableFoldl' :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldl' forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f (Bottom Integer)
xs <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen (forall a. Gen a -> Gen (Bottom a)
genBottom Gen Integer
genSmallInteger)
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 -> forall a. HasCallStack => String -> a
error String
"foldableFoldl': your foldl' is not strict!"
BottomValue Integer
v -> if forall a. Integral a => a -> Bool
even Integer
v then Integer
a else Integer
v
let z0 :: Integer
z0 = Integer
0
(Maybe Integer
rhs,Context
ctx1) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 forall a b. (a -> b) -> a -> b
$! Integer -> Bottom Integer -> Integer
f Integer
z Bottom Integer
x
Either ErrorCall Integer
e <- forall e a. Exception e => IO a -> IO (Either e a)
try (forall a. a -> IO a
evaluate (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr forall {b}. Bottom Integer -> (Integer -> b) -> Integer -> b
f' forall a. a -> a
id f (Bottom Integer)
xs Integer
z0))
case Either ErrorCall Integer
e of
Left (ErrorCall
_ :: ErrorCall) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, String -> Context
ctxNotStrict String
"foldl'")
Right Integer
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Integer
i, Context
NoContext)
(Maybe Integer
lhs,Context
ctx2) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Either ErrorCall Integer
e <- forall e a. Exception e => IO a -> IO (Either e a)
try (forall a. a -> IO a
evaluate (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Integer -> Bottom Integer -> Integer
f Integer
z0 f (Bottom Integer)
xs))
case Either ErrorCall Integer
e of
Left (ErrorCall
_ :: ErrorCall) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, String -> Context
ctxNotStrict String
"foldl'")
Right Integer
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Integer
i, Context
NoContext)
let ctx :: Context
ctx = case Context
ctx1 of
Context
NoContext -> case Context
ctx2 of
Context
NoContext -> LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Foldl'"
, lawContextLawBody :: String
lawContextLawBody = String
"foldl' f z0 xs" String -> String -> String
`congruency` String
"foldr f' id xs z0, where f' x k z = k $! f z x"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showT :: String
showT = forall a. Show a => a -> String
show f (Bottom Integer)
xs
showF :: String
showF = String
"\\a b -> case a of\n BottomUndefined -> error \"foldableFoldr': not strict\"\n BottomValue v -> if even v then v else b"
showZ :: String
showZ = forall a. Show a => a -> String
show Integer
z0
in [String] -> String
lawWhere
[ String
"foldl' f z0 xs" String -> String -> String
`congruency` String
"foldr f' id xs z0, where f' x k z = k $! f z x"
, String
"f = " forall a. [a] -> [a] -> [a]
++ String
showF
, String
"z0 = " forall a. [a] -> [a] -> [a]
++ String
showZ
, String
"t = " forall a. [a] -> [a] -> [a]
++ String
showT
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Maybe Integer
lhs Maybe Integer
rhs
}
Context
c2 -> Context
c2
Context
c1 -> Context
c1
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Maybe Integer
lhs Maybe Integer
rhs Context
ctx
foldableFoldl1 ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableFoldl1 :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldl1 forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
LinearEquationTwo
e <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen LinearEquationTwo
genLinearEquationTwo
f Integer
t <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
case forall (f :: * -> *) a. Foldable f => f a -> [a]
compatToList f Integer
t of
[] -> forall (m :: * -> *). MonadTest m => m ()
success
(Integer
x:[Integer]
xs) ->
let f :: Integer -> Integer -> Integer
f = LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo LinearEquationTwo
e
lhs :: Integer
lhs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Foldable.foldl1 Integer -> Integer -> Integer
f f Integer
t
rhs :: Integer
rhs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl Integer -> Integer -> Integer
f Integer
x [Integer]
xs
ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Foldl1"
, lawContextLawBody :: String
lawContextLawBody = String
"foldl1 f t" String -> String -> String
`congruency` String
"let (x:xs) = toList t in foldl f x xs"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showF :: String
showF = forall a. Show a => a -> String
show LinearEquationTwo
e
showT :: String
showT = forall a. Show a => a -> String
show f Integer
t
showX :: String
showX = forall a. Show a => a -> String
show Integer
x
showXS :: String
showXS = forall a. Show a => a -> String
show [Integer]
xs
in [String] -> String
lawWhere
[ String
"foldl1 f t" String -> String -> String
`congruency` String
"let (x:xs) = toList t in foldl f x xs, where"
, String
"f = " forall a. [a] -> [a] -> [a]
++ String
showF
, String
"t = " forall a. [a] -> [a] -> [a]
++ String
showT
, String
"x = " forall a. [a] -> [a] -> [a]
++ String
showX
, String
"xs = " forall a. [a] -> [a] -> [a]
++ String
showXS
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Integer
lhs Integer
rhs
}
in forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Integer
lhs Integer
rhs Context
ctx
foldableFoldr1 ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableFoldr1 :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableFoldr1 forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
LinearEquationTwo
e <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen LinearEquationTwo
genLinearEquationTwo
f Integer
t <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
case forall a. [a] -> Maybe ([a], a)
unsnoc (forall (f :: * -> *) a. Foldable f => f a -> [a]
compatToList f Integer
t) of
Maybe ([Integer], Integer)
Nothing -> forall (m :: * -> *). MonadTest m => m ()
success
Just ([Integer]
xs, Integer
x) ->
let f :: Integer -> Integer -> Integer
f = LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo LinearEquationTwo
e
lhs :: Integer
lhs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Foldable.foldr1 Integer -> Integer -> Integer
f f Integer
t
rhs :: Integer
rhs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr Integer -> Integer -> Integer
f Integer
x [Integer]
xs
ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Foldr1"
, lawContextLawBody :: String
lawContextLawBody = String
"foldr1 f t" String -> String -> String
`congruency` String
"let (xs, x) = unsnoc (toList t) in foldr f x xs"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showF :: String
showF = forall a. Show a => a -> String
show LinearEquationTwo
e
showT :: String
showT = forall a. Show a => a -> String
show f Integer
t
showX :: String
showX = forall a. Show a => a -> String
show Integer
x
showXS :: String
showXS = forall a. Show a => a -> String
show [Integer]
xs
in [String] -> String
lawWhere
[ String
"foldr1 f t" String -> String -> String
`congruency` String
"let (xs, x) = unsnoc (toList t) in foldr f x xs, where"
, String
"f = " forall a. [a] -> [a] -> [a]
++ String
showF
, String
"t = " forall a. [a] -> [a] -> [a]
++ String
showT
, String
"x = " forall a. [a] -> [a] -> [a]
++ String
showX
, String
"xs = " forall a. [a] -> [a] -> [a]
++ String
showXS
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Integer
lhs Integer
rhs
}
in forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Integer
lhs Integer
rhs Context
ctx
foldableToList ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableToList :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableToList forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f Integer
t <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
let lhs :: [Integer]
lhs = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList f Integer
t
let rhs :: [Integer]
rhs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr (:) [] f Integer
t
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"ToList"
, lawContextLawBody :: String
lawContextLawBody = String
"toList" String -> String -> String
`congruency` String
"foldr (:) []"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showT :: String
showT = forall a. Show a => a -> String
show f Integer
t
in [String] -> String
lawWhere
[ String
"toList t" String -> String -> String
`congruency` String
"foldr (:) [] t, where"
, String
"t = " forall a. [a] -> [a] -> [a]
++ String
showT
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced [Integer]
lhs [Integer]
rhs
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx [Integer]
lhs [Integer]
rhs Context
ctx
foldableNull ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableNull :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableNull forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f Integer
t <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
let lhs :: Bool
lhs = forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null f Integer
t
let rhs :: Bool
rhs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr (forall a b. a -> b -> a
const (forall a b. a -> b -> a
const Bool
False)) Bool
True f Integer
t
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Null"
, lawContextLawBody :: String
lawContextLawBody = String
"null" String -> String -> String
`congruency` String
"foldr (const (const False)) True"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showT :: String
showT = forall a. Show a => a -> String
show f Integer
t
in [String] -> String
lawWhere
[ String
"null t" String -> String -> String
`congruency` String
"foldr (const (const False)) True t, where"
, String
"t = " forall a. [a] -> [a] -> [a]
++ String
showT
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Bool
lhs Bool
rhs
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Bool
lhs Bool
rhs Context
ctx
foldableLength ::
( Foldable f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
foldableLength :: forall (f :: * -> *).
(Foldable f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Property
foldableLength forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f Integer
t <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
let lhs :: Int
lhs = forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length f Integer
t
let rhs :: Int
rhs = forall a. Sum a -> a
getSum (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (forall a b. a -> b -> a
const (forall a. a -> Sum a
Sum Int
1)) f Integer
t)
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Length"
, lawContextLawBody :: String
lawContextLawBody = String
"length" String -> String -> String
`congruency` String
"getSum . foldMap (const (Sum 1))"
, lawContextTcName :: String
lawContextTcName = String
"Foldable"
, lawContextTcProp :: String
lawContextTcProp =
let showT :: String
showT = forall a. Show a => a -> String
show f Integer
t
in [String] -> String
lawWhere
[ String
"length t" String -> String -> String
`congruency` String
"getSum . foldMap (const (Sum 1)) $ t, where"
, String
"t = " forall a. [a] -> [a] -> [a]
++ String
showT
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Int
lhs Int
rhs
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Int
lhs Int
rhs Context
ctx
unsnoc :: [a] -> Maybe ([a], a)
unsnoc :: forall a. [a] -> Maybe ([a], a)
unsnoc = \case
[] -> forall a. Maybe a
Nothing
[a
x] -> forall a. a -> Maybe a
Just ([], a
x)
(a
x:a
y:[a]
xs) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([a]
bs,a
b) -> (a
xforall a. a -> [a] -> [a]
:[a]
bs,a
b)) (forall a. [a] -> Maybe ([a], a)
unsnoc (a
y forall a. a -> [a] -> [a]
: [a]
xs))
compatToList :: Foldable f => f a -> [a]
compatToList :: forall (f :: * -> *) a. Foldable f => f a -> [a]
compatToList = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (\a
x -> [a
x])