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

-- | Tests the following 'Foldable' laws:
--
-- [__Fold__]: @'Foldable.fold' ≡ 'Foldable.foldMap' 'id'@
-- [__FoldMap__]: @'Foldable.foldMap' f ≡ 'Foldable.foldr' ('mappend' '.' f) 'mempty'@
-- [__Foldr__]: @'Foldable.foldr' f z t ≡ 'appEndo' ('Foldable.foldMap' ('Endo' '.' f) t) z@
-- [__Foldr'__]: @'Foldable.foldr'' f z0 t ≡ 'Foldable.foldl' f' 'id' t z0, where f' k x z = k '$!' f x z@
-- [__Foldl__]: @'Foldable.foldl' f z t ≡ 'appEndo' ('getDual' ('Foldable.foldMap' ('Dual' '.' 'Endo' '.' 'flip' f) t)) z@
-- [__Foldl'__]: @'Foldable.foldl'' f z0 xs ≡ 'Foldable.foldr' f' 'id' xs z0, where f' x k z = k '$!' f z x@
-- [__Foldl1__]: @'Foldable.foldl1' f t ≡ let (x:xs) = 'Foldable.toList' t in 'foldl' f x xs@
-- [__Foldr1__]: @'Foldable.foldr1' f t ≡ let (xs,x)@ = @unsnoc ('Foldable.toList' t) in 'foldr' f x xs@
-- [__ToList__]: @'Foldable.toList' ≡ 'Foldable.foldr' (:) []@
-- [__Null__]: @'Foldable.null' ≡ 'Foldable.foldr' ('const' ('const' 'False')) 'True'@
-- [__Length__]: @'Foldable.length' ≡ 'getSum' '.' 'Foldable.foldMap' ('const' ('Sum' 1))@
--
-- This additionally tests that the user's implementations of 'Foldable.foldr'' and 'Foldable.foldl'' are strict in their accumulators.
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])