{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wall #-}

{-|

This module provides property tests for functions that operate on
list-like data types. If your data type is fully polymorphic in its
element type, is it recommended that you use @foldableLaws@ and
@traversableLaws@ from @Test.QuickCheck.Classes@. However, if your
list-like data type is either monomorphic in its element type
(like @Text@ or @ByteString@) or if it requires a typeclass
constraint on its element (like @Data.Vector.Unboxed@), the properties
provided here can be helpful for testing that your functions have
the expected behavior. All properties in this module require your data
type to have an 'IsList' instance.

-}
module Test.QuickCheck.Classes.Base.IsList
  ( 
#if MIN_VERSION_base(4,7,0)
    isListLaws 
  , foldrProp
  , foldlProp
  , foldlMProp
  , mapProp
  , imapProp
  , imapMProp
  , traverseProp
  , generateProp
  , generateMProp
  , replicateProp
  , replicateMProp
  , filterProp
  , filterMProp
  , mapMaybeProp
  , mapMaybeMProp
#endif
  ) where

#if MIN_VERSION_base(4,7,0)
import Control.Applicative
import Control.Monad.ST (ST,runST)
import Control.Monad (mapM,filterM,replicateM)
import Control.Applicative (liftA2)
import GHC.Exts (IsList,Item,toList,fromList,fromListN)
import Data.Maybe (mapMaybe,catMaybes)
import Data.Proxy (Proxy)
import Data.Foldable (foldlM)
import Data.Traversable (traverse)
import Test.QuickCheck (Property,Arbitrary,CoArbitrary,(===),property,
  NonNegative(..))
#if MIN_VERSION_QuickCheck(2,10,0)
import Test.QuickCheck.Function (Function,Fun,applyFun,applyFun2)
#else
import Test.QuickCheck.Function (Function,Fun,apply)
#endif
import qualified Data.List as L

import Test.QuickCheck.Classes.Internal (Laws(..), myForAllShrink)

-- | Tests the following properties:
--
-- [/Partial Isomorphism/]
--   @fromList . toList ≡ id@
-- [/Length Preservation/]
--   @fromList xs ≡ fromListN (length xs) xs@
--
-- /Note:/ This property test is only available when
-- using @base-4.7@ or newer.
isListLaws :: (IsList a, Show a, Show (Item a), Arbitrary a, Arbitrary (Item a), Eq a) => Proxy a -> Laws
isListLaws :: Proxy a -> Laws
isListLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"IsList"
  [ (String
"Partial Isomorphism", Proxy a -> Property
forall a.
(IsList a, Show a, Arbitrary a, Eq a) =>
Proxy a -> Property
isListPartialIsomorphism Proxy a
p)
  , (String
"Length Preservation", Proxy a -> Property
forall a.
(IsList a, Show (Item a), Arbitrary (Item a), Eq a) =>
Proxy a -> Property
isListLengthPreservation Proxy a
p)
  ]

isListPartialIsomorphism :: forall a. (IsList a, Show a, Arbitrary a, Eq a) => Proxy a -> Property
isListPartialIsomorphism :: Proxy a -> Property
isListPartialIsomorphism Proxy a
_ = Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> a)
-> String
-> (a -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
False (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(a
a :: a) -> [String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a])
  String
"fromList (toList a)"
  (\a
a -> [Item a] -> a
forall l. IsList l => [Item l] -> l
fromList (a -> [Item a]
forall l. IsList l => l -> [Item l]
toList a
a))
  String
"a"
  (\a
a -> a
a)

isListLengthPreservation :: forall a. (IsList a, Show (Item a), Arbitrary (Item a), Eq a) => Proxy a -> Property
isListLengthPreservation :: Proxy a -> Property
isListLengthPreservation Proxy a
_ = ([Item a] -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property (([Item a] -> Bool) -> Property) -> ([Item a] -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \([Item a]
xs :: [Item a]) ->
  ([Item a] -> a
forall l. IsList l => [Item l] -> l
fromList [Item a]
xs :: a) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [Item a] -> a
forall l. IsList l => Int -> [Item l] -> l
fromListN ([Item a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Item a]
xs) [Item a]
xs

foldrProp :: (IsList c, Item c ~ a, Arbitrary c, Show c, Show a, CoArbitrary a, Function a)
  => Proxy a -- ^ input element type
  -> (forall b. (a -> b -> b) -> b -> c -> b) -- ^ foldr function
  -> Property
foldrProp :: Proxy a -> (forall b. (a -> b -> b) -> b -> c -> b) -> Property
foldrProp Proxy a
_ forall b. (a -> b -> b) -> b -> c -> b
f = (c -> Integer -> Fun (a, Integer) Integer -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Integer -> Fun (a, Integer) Integer -> Property)
 -> Property)
-> (c -> Integer -> Fun (a, Integer) Integer -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \c
c (Integer
b0 :: Integer) Fun (a, Integer) Integer
func ->
  let g :: a -> Integer -> Integer
g = Fun (a, Integer) Integer -> a -> Integer -> Integer
forall a b c. Fun (a, b) c -> a -> b -> c
applyFun2 Fun (a, Integer) Integer
func in
  (a -> Integer -> Integer) -> Integer -> [a] -> Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr a -> Integer -> Integer
g Integer
b0 (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c) Integer -> Integer -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a -> Integer -> Integer) -> Integer -> c -> Integer
forall b. (a -> b -> b) -> b -> c -> b
f a -> Integer -> Integer
g Integer
b0 c
c
  
foldlProp :: (IsList c, Item c ~ a, Arbitrary c, Show c, Show a, CoArbitrary a, Function a)
  => Proxy a -- ^ input element type
  -> (forall b. (b -> a -> b) -> b -> c -> b) -- ^ foldl function
  -> Property
foldlProp :: Proxy a -> (forall b. (b -> a -> b) -> b -> c -> b) -> Property
foldlProp Proxy a
_ forall b. (b -> a -> b) -> b -> c -> b
f = (c -> Integer -> Fun (Integer, a) Integer -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Integer -> Fun (Integer, a) Integer -> Property)
 -> Property)
-> (c -> Integer -> Fun (Integer, a) Integer -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \c
c (Integer
b0 :: Integer) Fun (Integer, a) Integer
func ->
  let g :: Integer -> a -> Integer
g = Fun (Integer, a) Integer -> Integer -> a -> Integer
forall a b c. Fun (a, b) c -> a -> b -> c
applyFun2 Fun (Integer, a) Integer
func in
  (Integer -> a -> Integer) -> Integer -> [a] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl Integer -> a -> Integer
g Integer
b0 (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c) Integer -> Integer -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Integer -> a -> Integer) -> Integer -> c -> Integer
forall b. (b -> a -> b) -> b -> c -> b
f Integer -> a -> Integer
g Integer
b0 c
c

foldlMProp :: (IsList c, Item c ~ a, Arbitrary c, Show c, Show a, CoArbitrary a, Function a)
  => Proxy a -- ^ input element type
  -> (forall s b. (b -> a -> ST s b) -> b -> c -> ST s b) -- ^ monadic foldl function
  -> Property
foldlMProp :: Proxy a
-> (forall s b. (b -> a -> ST s b) -> b -> c -> ST s b) -> Property
foldlMProp Proxy a
_ forall s b. (b -> a -> ST s b) -> b -> c -> ST s b
f = (c -> Integer -> Fun (Integer, Item c) Integer -> Property)
-> Property
forall prop. Testable prop => prop -> Property
property ((c -> Integer -> Fun (Integer, Item c) Integer -> Property)
 -> Property)
-> (c -> Integer -> Fun (Integer, Item c) Integer -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \c
c (Integer
b0 :: Integer) Fun (Integer, Item c) Integer
func ->
  (forall s. ST s Integer) -> Integer
forall a. (forall s. ST s a) -> a
runST ((Integer -> Item c -> ST s Integer)
-> Integer -> [Item c] -> ST s Integer
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (Fun (Integer, Item c) Integer -> Integer -> Item c -> ST s Integer
forall a b c s. Fun (a, b) c -> a -> b -> ST s c
stApplyFun2 Fun (Integer, Item c) Integer
func) Integer
b0 (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c)) Integer -> Integer -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (forall s. ST s Integer) -> Integer
forall a. (forall s. ST s a) -> a
runST ((Integer -> a -> ST s Integer) -> Integer -> c -> ST s Integer
forall s b. (b -> a -> ST s b) -> b -> c -> ST s b
f (Fun (Integer, a) Integer -> Integer -> a -> ST s Integer
forall a b c s. Fun (a, b) c -> a -> b -> ST s c
stApplyFun2 Fun (Integer, a) Integer
Fun (Integer, Item c) Integer
func) Integer
b0 c
c)

mapProp :: (IsList c, IsList d, Eq d, Show d, Show b, Item c ~ a, Item d ~ b, Arbitrary c, Arbitrary b, Show c, Show a, CoArbitrary a, Function a)
  => Proxy a -- ^ input element type
  -> Proxy b -- ^ output element type
  -> ((a -> b) -> c -> d) -- ^ map function
  -> Property
mapProp :: Proxy a -> Proxy b -> ((a -> b) -> c -> d) -> Property
mapProp Proxy a
_ Proxy b
_ (a -> b) -> c -> d
f = (c -> Fun a b -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Fun a b -> Property) -> Property)
-> (c -> Fun a b -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \c
c Fun a b
func ->
  [Item d] -> d
forall l. IsList l => [Item l] -> l
fromList ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Fun a b -> a -> b
forall a b. Fun a b -> a -> b
applyFun Fun a b
func) (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c)) d -> d -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a -> b) -> c -> d
f (Fun a b -> a -> b
forall a b. Fun a b -> a -> b
applyFun Fun a b
func) c
c

imapProp :: (IsList c, IsList d, Eq d, Show d, Show b, Item c ~ a, Item d ~ b, Arbitrary c, Arbitrary b, Show c, Show a, CoArbitrary a, Function a)
  => Proxy a -- ^ input element type
  -> Proxy b -- ^ output element type
  -> ((Int -> a -> b) -> c -> d) -- ^ indexed map function
  -> Property
imapProp :: Proxy a -> Proxy b -> ((Int -> a -> b) -> c -> d) -> Property
imapProp Proxy a
_ Proxy b
_ (Int -> a -> b) -> c -> d
f = (c -> Fun (Int, a) b -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Fun (Int, a) b -> Property) -> Property)
-> (c -> Fun (Int, a) b -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \c
c Fun (Int, a) b
func ->
  [Item d] -> d
forall l. IsList l => [Item l] -> l
fromList ((Int -> a -> b) -> [a] -> [b]
forall a b. (Int -> a -> b) -> [a] -> [b]
imapList (Fun (Int, a) b -> Int -> a -> b
forall a b c. Fun (a, b) c -> a -> b -> c
applyFun2 Fun (Int, a) b
func) (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c)) d -> d -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Int -> a -> b) -> c -> d
f (Fun (Int, a) b -> Int -> a -> b
forall a b c. Fun (a, b) c -> a -> b -> c
applyFun2 Fun (Int, a) b
func) c
c

imapMProp :: (IsList c, IsList d, Eq d, Show d, Show b, Item c ~ a, Item d ~ b, Arbitrary c, Arbitrary b, Show c, Show a, CoArbitrary a, Function a)
  => Proxy a -- ^ input element type
  -> Proxy b -- ^ output element type
  -> (forall s. (Int -> a -> ST s b) -> c -> ST s d) -- ^ monadic indexed map function
  -> Property
imapMProp :: Proxy a
-> Proxy b
-> (forall s. (Int -> a -> ST s b) -> c -> ST s d)
-> Property
imapMProp Proxy a
_ Proxy b
_ forall s. (Int -> a -> ST s b) -> c -> ST s d
f = (c -> Fun (Int, Item c) b -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Fun (Int, Item c) b -> Property) -> Property)
-> (c -> Fun (Int, Item c) b -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \c
c Fun (Int, Item c) b
func ->
  [Item d] -> d
forall l. IsList l => [Item l] -> l
fromList ((forall s. ST s [Item d]) -> [Item d]
forall a. (forall s. ST s a) -> a
runST ((Int -> Item c -> ST s (Item d)) -> [Item c] -> ST s [Item d]
forall a s b. (Int -> a -> ST s b) -> [a] -> ST s [b]
imapMList (Fun (Int, Item c) (Item d) -> Int -> Item c -> ST s (Item d)
forall a b c s. Fun (a, b) c -> a -> b -> ST s c
stApplyFun2 Fun (Int, Item c) b
Fun (Int, Item c) (Item d)
func) (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c))) d -> d -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (forall s. ST s d) -> d
forall a. (forall s. ST s a) -> a
runST ((Int -> a -> ST s b) -> c -> ST s d
forall s. (Int -> a -> ST s b) -> c -> ST s d
f (Fun (Int, a) b -> Int -> a -> ST s b
forall a b c s. Fun (a, b) c -> a -> b -> ST s c
stApplyFun2 Fun (Int, a) b
Fun (Int, Item c) b
func) c
c)

traverseProp :: (IsList c, IsList d, Eq d, Show d, Show b, Item c ~ a, Item d ~ b, Arbitrary c, Arbitrary b, Show c, Show a, CoArbitrary a, Function a)
  => Proxy a -- ^ input element type
  -> Proxy b -- ^ output element type
  -> (forall s. (a -> ST s b) -> c -> ST s d) -- ^ traverse function
  -> Property
traverseProp :: Proxy a
-> Proxy b -> (forall s. (a -> ST s b) -> c -> ST s d) -> Property
traverseProp Proxy a
_ Proxy b
_ forall s. (a -> ST s b) -> c -> ST s d
f = (c -> Fun (Item c) b -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Fun (Item c) b -> Property) -> Property)
-> (c -> Fun (Item c) b -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \c
c Fun (Item c) b
func ->
  [Item d] -> d
forall l. IsList l => [Item l] -> l
fromList ((forall s. ST s [Item d]) -> [Item d]
forall a. (forall s. ST s a) -> a
runST ((Item c -> ST s (Item d)) -> [Item c] -> ST s [Item d]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Item d -> ST s (Item d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Item d -> ST s (Item d))
-> (Item c -> Item d) -> Item c -> ST s (Item d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fun (Item c) (Item d) -> Item c -> Item d
forall a b. Fun a b -> a -> b
applyFun Fun (Item c) b
Fun (Item c) (Item d)
func) (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c))) d -> d -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (forall s. ST s d) -> d
forall a. (forall s. ST s a) -> a
runST ((a -> ST s b) -> c -> ST s d
forall s. (a -> ST s b) -> c -> ST s d
f (b -> ST s b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ST s b) -> (a -> b) -> a -> ST s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fun a b -> a -> b
forall a b. Fun a b -> a -> b
applyFun Fun a b
Fun (Item c) b
func) c
c)

-- | Property for the @generate@ function, which builds a container
--   of a given length by applying a function to each index.
generateProp :: (Item c ~ a, Eq c, Show c, IsList c, Arbitrary a, Show a)
  => Proxy a -- ^ input element type
  -> (Int -> (Int -> a) -> c) -- generate function
  -> Property
generateProp :: Proxy a -> (Int -> (Int -> a) -> c) -> Property
generateProp Proxy a
_ Int -> (Int -> a) -> c
f = (NonNegative Int -> Fun Int a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((NonNegative Int -> Fun Int a -> Property) -> Property)
-> (NonNegative Int -> Fun Int a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(NonNegative Int
len) Fun Int a
func ->
  [Item c] -> c
forall l. IsList l => [Item l] -> l
fromList (Int -> (Int -> a) -> [a]
forall a. Int -> (Int -> a) -> [a]
generateList Int
len (Fun Int a -> Int -> a
forall a b. Fun a b -> a -> b
applyFun Fun Int a
func)) c -> c -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int -> (Int -> a) -> c
f Int
len (Fun Int a -> Int -> a
forall a b. Fun a b -> a -> b
applyFun Fun Int a
func)

generateMProp :: (Item c ~ a, Eq c, Show c, IsList c, Arbitrary a, Show a)
  => Proxy a -- ^ input element type
  -> (forall s. Int -> (Int -> ST s a) -> ST s c) -- monadic generate function
  -> Property
generateMProp :: Proxy a -> (forall s. Int -> (Int -> ST s a) -> ST s c) -> Property
generateMProp Proxy a
_ forall s. Int -> (Int -> ST s a) -> ST s c
f = (NonNegative Int -> Fun Int a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((NonNegative Int -> Fun Int a -> Property) -> Property)
-> (NonNegative Int -> Fun Int a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(NonNegative Int
len) Fun Int a
func ->
  [Item c] -> c
forall l. IsList l => [Item l] -> l
fromList ((forall s. ST s [Item c]) -> [Item c]
forall a. (forall s. ST s a) -> a
runST (Int -> (Int -> ST s (Item c)) -> ST s [Item c]
forall s a. Int -> (Int -> ST s a) -> ST s [a]
stGenerateList Int
len (Fun Int (Item c) -> Int -> ST s (Item c)
forall a b s. Fun a b -> a -> ST s b
stApplyFun Fun Int a
Fun Int (Item c)
func))) c -> c -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (forall s. ST s c) -> c
forall a. (forall s. ST s a) -> a
runST (Int -> (Int -> ST s a) -> ST s c
forall s. Int -> (Int -> ST s a) -> ST s c
f Int
len (Fun Int a -> Int -> ST s a
forall a b s. Fun a b -> a -> ST s b
stApplyFun Fun Int a
func))

replicateProp :: (Item c ~ a, Eq c, Show c, IsList c, Arbitrary a, Show a)
  => Proxy a -- ^ input element type
  -> (Int -> a -> c) -- replicate function
  -> Property
replicateProp :: Proxy a -> (Int -> a -> c) -> Property
replicateProp Proxy a
_ Int -> a -> c
f = (NonNegative Int -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((NonNegative Int -> a -> Property) -> Property)
-> (NonNegative Int -> a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(NonNegative Int
len) a
a ->
  [Item c] -> c
forall l. IsList l => [Item l] -> l
fromList (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
len a
a) c -> c -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int -> a -> c
f Int
len a
a

replicateMProp :: (Item c ~ a, Eq c, Show c, IsList c, Arbitrary a, Show a)
  => Proxy a -- ^ input element type
  -> (forall s. Int -> ST s a -> ST s c) -- replicate function
  -> Property
replicateMProp :: Proxy a -> (forall s. Int -> ST s a -> ST s c) -> Property
replicateMProp Proxy a
_ forall s. Int -> ST s a -> ST s c
f = (NonNegative Int -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((NonNegative Int -> a -> Property) -> Property)
-> (NonNegative Int -> a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(NonNegative Int
len) a
a ->
  [Item c] -> c
forall l. IsList l => [Item l] -> l
fromList ((forall s. ST s [Item c]) -> [Item c]
forall a. (forall s. ST s a) -> a
runST (Int -> ST s (Item c) -> ST s [Item c]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len (Item c -> ST s (Item c)
forall (m :: * -> *) a. Monad m => a -> m a
return a
Item c
a))) c -> c -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (forall s. ST s c) -> c
forall a. (forall s. ST s a) -> a
runST (Int -> ST s a -> ST s c
forall s. Int -> ST s a -> ST s c
f Int
len (a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a))

-- | Property for the @filter@ function, which keeps elements for which
-- the predicate holds true.
filterProp :: (IsList c, Item c ~ a, Arbitrary c, Show c, Show a, Eq c, CoArbitrary a, Function a)
  => Proxy a -- ^ element type
  -> ((a -> Bool) -> c -> c) -- ^ map function
  -> Property
filterProp :: Proxy a -> ((a -> Bool) -> c -> c) -> Property
filterProp Proxy a
_ (a -> Bool) -> c -> c
f = (c -> Fun a Bool -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Fun a Bool -> Property) -> Property)
-> (c -> Fun a Bool -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \c
c Fun a Bool
func ->
  [Item c] -> c
forall l. IsList l => [Item l] -> l
fromList ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Fun a Bool -> a -> Bool
forall a b. Fun a b -> a -> b
applyFun Fun a Bool
func) (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c)) c -> c -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a -> Bool) -> c -> c
f (Fun a Bool -> a -> Bool
forall a b. Fun a b -> a -> b
applyFun Fun a Bool
func) c
c

-- | Property for the @filterM@ function, which keeps elements for which
-- the predicate holds true in an applicative context.
filterMProp :: (IsList c, Item c ~ a, Arbitrary c, Show c, Show a, Eq c, CoArbitrary a, Function a)
  => Proxy a -- ^ element type
  -> (forall s. (a -> ST s Bool) -> c -> ST s c) -- ^ traverse function
  -> Property
filterMProp :: Proxy a -> (forall s. (a -> ST s Bool) -> c -> ST s c) -> Property
filterMProp Proxy a
_ forall s. (a -> ST s Bool) -> c -> ST s c
f = (c -> Fun (Item c) Bool -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Fun (Item c) Bool -> Property) -> Property)
-> (c -> Fun (Item c) Bool -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \c
c Fun (Item c) Bool
func ->
  [Item c] -> c
forall l. IsList l => [Item l] -> l
fromList ((forall s. ST s [Item c]) -> [Item c]
forall a. (forall s. ST s a) -> a
runST ((Item c -> ST s Bool) -> [Item c] -> ST s [Item c]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ST s Bool) -> (Item c -> Bool) -> Item c -> ST s Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fun (Item c) Bool -> Item c -> Bool
forall a b. Fun a b -> a -> b
applyFun Fun (Item c) Bool
func) (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c))) c -> c -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (forall s. ST s c) -> c
forall a. (forall s. ST s a) -> a
runST ((a -> ST s Bool) -> c -> ST s c
forall s. (a -> ST s Bool) -> c -> ST s c
f (Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ST s Bool) -> (a -> Bool) -> a -> ST s Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fun a Bool -> a -> Bool
forall a b. Fun a b -> a -> b
applyFun Fun a Bool
Fun (Item c) Bool
func) c
c)

-- | Property for the @mapMaybe@ function, which keeps elements for which
-- the predicate holds true.
mapMaybeProp :: (IsList c, Item c ~ a, Item d ~ b, Eq d, IsList d, Arbitrary b, Show d, Show b, Arbitrary c, Show c, Show a, Eq c, CoArbitrary a, Function a)
  => Proxy a -- ^ input element type
  -> Proxy b -- ^ output element type
  -> ((a -> Maybe b) -> c -> d) -- ^ map function
  -> Property
mapMaybeProp :: Proxy a -> Proxy b -> ((a -> Maybe b) -> c -> d) -> Property
mapMaybeProp Proxy a
_ Proxy b
_ (a -> Maybe b) -> c -> d
f = (c -> Fun a (Maybe b) -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Fun a (Maybe b) -> Property) -> Property)
-> (c -> Fun a (Maybe b) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \c
c Fun a (Maybe b)
func ->
  [Item d] -> d
forall l. IsList l => [Item l] -> l
fromList ((a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Fun a (Maybe b) -> a -> Maybe b
forall a b. Fun a b -> a -> b
applyFun Fun a (Maybe b)
func) (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c)) d -> d -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a -> Maybe b) -> c -> d
f (Fun a (Maybe b) -> a -> Maybe b
forall a b. Fun a b -> a -> b
applyFun Fun a (Maybe b)
func) c
c

mapMaybeMProp :: (IsList c, IsList d, Eq d, Show d, Show b, Item c ~ a, Item d ~ b, Arbitrary c, Arbitrary b, Show c, Show a, CoArbitrary a, Function a)
  => Proxy a -- ^ input element type
  -> Proxy b -- ^ output element type
  -> (forall s. (a -> ST s (Maybe b)) -> c -> ST s d) -- ^ traverse function
  -> Property
mapMaybeMProp :: Proxy a
-> Proxy b
-> (forall s. (a -> ST s (Maybe b)) -> c -> ST s d)
-> Property
mapMaybeMProp Proxy a
_ Proxy b
_ forall s. (a -> ST s (Maybe b)) -> c -> ST s d
f = (c -> Fun (Item c) (Maybe b) -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((c -> Fun (Item c) (Maybe b) -> Property) -> Property)
-> (c -> Fun (Item c) (Maybe b) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \c
c Fun (Item c) (Maybe b)
func ->
  [Item d] -> d
forall l. IsList l => [Item l] -> l
fromList ((forall s. ST s [Item d]) -> [Item d]
forall a. (forall s. ST s a) -> a
runST ((Item c -> ST s (Maybe (Item d))) -> [Item c] -> ST s [Item d]
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeMList (Maybe (Item d) -> ST s (Maybe (Item d))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Item d) -> ST s (Maybe (Item d)))
-> (Item c -> Maybe (Item d)) -> Item c -> ST s (Maybe (Item d))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fun (Item c) (Maybe (Item d)) -> Item c -> Maybe (Item d)
forall a b. Fun a b -> a -> b
applyFun Fun (Item c) (Maybe b)
Fun (Item c) (Maybe (Item d))
func) (c -> [Item c]
forall l. IsList l => l -> [Item l]
toList c
c))) d -> d -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (forall s. ST s d) -> d
forall a. (forall s. ST s a) -> a
runST ((a -> ST s (Maybe b)) -> c -> ST s d
forall s. (a -> ST s (Maybe b)) -> c -> ST s d
f (Maybe b -> ST s (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> ST s (Maybe b))
-> (a -> Maybe b) -> a -> ST s (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fun a (Maybe b) -> a -> Maybe b
forall a b. Fun a b -> a -> b
applyFun Fun a (Maybe b)
Fun (Item c) (Maybe b)
func) c
c)

imapList :: (Int -> a -> b) -> [a] -> [b]
imapList :: (Int -> a -> b) -> [a] -> [b]
imapList Int -> a -> b
f [a]
xs = ((Int, a) -> b) -> [(Int, a)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> a -> b) -> (Int, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> a -> b
f) ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int]
forall a. Enum a => a -> [a]
enumFrom Int
0) [a]
xs)

imapMList :: (Int -> a -> ST s b) -> [a] -> ST s [b]
imapMList :: (Int -> a -> ST s b) -> [a] -> ST s [b]
imapMList Int -> a -> ST s b
f = Int -> [a] -> ST s [b]
go Int
0 where
  go :: Int -> [a] -> ST s [b]
go !Int
_ [] = [b] -> ST s [b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  go !Int
ix (a
x : [a]
xs) = (b -> [b] -> [b]) -> ST s b -> ST s [b] -> ST s [b]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Int -> a -> ST s b
f Int
ix a
x) (Int -> [a] -> ST s [b]
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs)

mapMaybeMList :: Applicative f => (a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeMList :: (a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeMList a -> f (Maybe b)
f = ([Maybe b] -> [b]) -> f [Maybe b] -> f [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe b] -> [b]
forall a. [Maybe a] -> [a]
catMaybes (f [Maybe b] -> f [b]) -> ([a] -> f [Maybe b]) -> [a] -> f [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f (Maybe b)) -> [a] -> f [Maybe b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f (Maybe b)
f

generateList :: Int -> (Int -> a) -> [a]
generateList :: Int -> (Int -> a) -> [a]
generateList Int
len Int -> a
f = Int -> [a]
go Int
0 where
  go :: Int -> [a]
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
    then Int -> a
f Int
ix a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    else []

stGenerateList :: Int -> (Int -> ST s a) -> ST s [a]
stGenerateList :: Int -> (Int -> ST s a) -> ST s [a]
stGenerateList Int
len Int -> ST s a
f = Int -> ST s [a]
go Int
0 where
  go :: Int -> ST s [a]
go !Int
ix = if Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
    then (a -> [a] -> [a]) -> ST s a -> ST s [a] -> ST s [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Int -> ST s a
f Int
ix) (Int -> ST s [a]
go (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    else [a] -> ST s [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

stApplyFun :: Fun a b -> a -> ST s b
stApplyFun :: Fun a b -> a -> ST s b
stApplyFun Fun a b
f a
a = b -> ST s b
forall (m :: * -> *) a. Monad m => a -> m a
return (Fun a b -> a -> b
forall a b. Fun a b -> a -> b
applyFun Fun a b
f a
a)

stApplyFun2 :: Fun (a,b) c -> a -> b -> ST s c
stApplyFun2 :: Fun (a, b) c -> a -> b -> ST s c
stApplyFun2 Fun (a, b) c
f a
a b
b = c -> ST s c
forall (m :: * -> *) a. Monad m => a -> m a
return (Fun (a, b) c -> a -> b -> c
forall a b c. Fun (a, b) c -> a -> b -> c
applyFun2 Fun (a, b) c
f a
a b
b)

#if !MIN_VERSION_QuickCheck(2,10,0)
applyFun :: Fun a b -> (a -> b)
applyFun = apply

applyFun2 :: Fun (a, b) c -> (a -> b -> c)
applyFun2 = curry . apply
#endif
#endif