{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
module Data.Array.Comfort.Shape.Test (tests) where

import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Shape.Utility (isRight)

import Control.Applicative (pure)
import Data.Tuple.HT (mapSnd)

import qualified Test.QuickCheck as QC


inBounds :: (Shape.Indexed sh) => sh -> Bool
inBounds :: sh -> Bool
inBounds sh
sh  =  (Index sh -> Bool) -> [Index sh] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (sh -> Index sh -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
Shape.inBounds sh
sh) ([Index sh] -> Bool) -> [Index sh] -> Bool
forall a b. (a -> b) -> a -> b
$ sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh


forAllIndices ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix, QC.Testable prop) =>
   sh -> (ix -> prop) -> QC.Property
forAllIndices :: sh -> (ix -> prop) -> Property
forAllIndices sh
sh ix -> prop
f =
   let ixs :: [Index sh]
ixs = sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh
   in Bool -> Bool
not ([ix] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ix]
[Index sh]
ixs)  Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
QC.==>  Gen ix -> (ix -> prop) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll ([ix] -> Gen ix
forall a. [a] -> Gen a
QC.elements [ix]
[Index sh]
ixs) ix -> prop
f

-- ToDo: we need to check for indices outside of bounds, too
inBoundsOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
inBoundsOffset :: sh -> Property
inBoundsOffset sh
sh =
   sh -> (ix -> Bool) -> Property
forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh ((ix -> Bool) -> Property) -> (ix -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      sh -> Index sh -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
Shape.inBounds sh
sh ix
Index sh
ix Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==
      Either String Int -> Bool
forall a b. Either a b -> Bool
isRight (Result Checked Int -> Either String Int
forall a. Result Checked a -> Either String a
Shape.getChecked (sh -> Index sh -> Result Checked Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
Shape.unifiedOffset sh
sh ix
Index sh
ix))

inBoundsSizeOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
inBoundsSizeOffset :: sh -> Property
inBoundsSizeOffset sh
sh =
   sh -> (ix -> Bool) -> Property
forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh ((ix -> Bool) -> Property) -> (ix -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      sh -> Index sh -> Bool
forall sh. Indexed sh => sh -> Index sh -> Bool
Shape.inBounds sh
sh ix
Index sh
ix Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==
      Either String Int -> Bool
forall a b. Either a b -> Bool
isRight (Result Checked Int -> Either String Int
forall a. Result Checked a -> Either String a
Shape.getChecked ((Int, ix -> Result Checked Int) -> ix -> Result Checked Int
forall a b. (a, b) -> b
snd (sh -> (Int, Index sh -> Result Checked Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
Shape.unifiedSizeOffset sh
sh) ix
ix))

sizeOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
sizeOffset :: sh -> Property
sizeOffset sh
sh =
   sh -> (ix -> Bool) -> Property
forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh ((ix -> Bool) -> Property) -> (ix -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      ((ix -> Int) -> Int) -> (Int, ix -> Int) -> (Int, Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((ix -> Int) -> ix -> Int
forall a b. (a -> b) -> a -> b
$ix
ix) (sh -> (Int, Index sh -> Int)
forall sh. Indexed sh => sh -> (Int, Index sh -> Int)
Shape.sizeOffset sh
sh)
      (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
==
      (sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh, sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
sh ix
Index sh
ix)

uncheckedSizeOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
uncheckedSizeOffset :: sh -> Property
uncheckedSizeOffset sh
sh =
   sh -> (ix -> Bool) -> Property
forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh ((ix -> Bool) -> Property) -> (ix -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      ((ix -> Int) -> Int) -> (Int, ix -> Int) -> (Int, Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((ix -> Int) -> ix -> Int
forall a b. (a -> b) -> a -> b
$ix
ix) (sh -> (Int, Index sh -> Int)
forall sh. Indexed sh => sh -> (Int, Index sh -> Int)
Shape.uncheckedSizeOffset sh
sh) (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
==
         (sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh, sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset sh
sh ix
Index sh
ix)

unifiedSizeOffsetA ::
   (Shape.Checking check, Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) =>
   Shape.CheckSingleton check -> sh -> QC.Property
unifiedSizeOffsetA :: CheckSingleton check -> sh -> Property
unifiedSizeOffsetA CheckSingleton check
check sh
sh =
   sh -> (ix -> Bool) -> Property
forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh ((ix -> Bool) -> Property) -> (ix -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      ((ix -> Result check Int) -> Result check Int)
-> (Int, ix -> Result check Int) -> (Int, Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((ix -> Result check Int) -> ix -> Result check Int
forall a b. (a -> b) -> a -> b
$ix
ix) (sh -> (Int, Index sh -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
Shape.unifiedSizeOffset sh
sh) (Int, Result check Int) -> (Int, Result check Int) -> Bool
forall a. Eq a => a -> a -> Bool
==
         (sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh, CheckSingleton check -> Result check Int -> Result check Int
forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check (Result check Int -> Result check Int)
-> Result check Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ sh -> Index sh -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
Shape.unifiedOffset sh
sh ix
Index sh
ix)

unifiedSizeOffsetB ::
   (Shape.Checking check, Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) =>
   Shape.CheckSingleton check -> sh -> QC.Property
unifiedSizeOffsetB :: CheckSingleton check -> sh -> Property
unifiedSizeOffsetB CheckSingleton check
check sh
sh =
   sh -> (ix -> Bool) -> Property
forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh ((ix -> Bool) -> Property) -> (ix -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      (((ix -> Result check Int) -> Result check Int)
-> (Int, ix -> Result check Int) -> (Int, Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (CheckSingleton check -> Result check Int -> Result check Int
forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check (Result check Int -> Result check Int)
-> ((ix -> Result check Int) -> Result check Int)
-> (ix -> Result check Int)
-> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ix -> Result check Int) -> ix -> Result check Int
forall a b. (a -> b) -> a -> b
$ix
ix)) ((Int, ix -> Result check Int) -> (Int, Result check Int))
-> (Int, ix -> Result check Int) -> (Int, Result check Int)
forall a b. (a -> b) -> a -> b
$ sh -> (Int, Index sh -> Result check Int)
forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
Shape.unifiedSizeOffset sh
sh)
      (Int, Result check Int) -> (Int, Result check Int) -> Bool
forall a. Eq a => a -> a -> Bool
==
      case CheckSingleton check
check of
         CheckSingleton check
Shape.Checked ->
            ((ix -> Int) -> Result check Int)
-> (Int, ix -> Int) -> (Int, Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Result check Int)
-> ((ix -> Int) -> Int) -> (ix -> Int) -> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ix -> Int) -> ix -> Int
forall a b. (a -> b) -> a -> b
$ix
ix)) (sh -> (Int, Index sh -> Int)
forall sh. Indexed sh => sh -> (Int, Index sh -> Int)
Shape.sizeOffset sh
sh)
         CheckSingleton check
Shape.Unchecked ->
            ((ix -> Int) -> Result check Int)
-> (Int, ix -> Int) -> (Int, Result check Int)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Result check Int)
-> ((ix -> Int) -> Int) -> (ix -> Int) -> Result check Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ix -> Int) -> ix -> Int
forall a b. (a -> b) -> a -> b
$ix
ix)) (sh -> (Int, Index sh -> Int)
forall sh. Indexed sh => sh -> (Int, Index sh -> Int)
Shape.uncheckedSizeOffset sh
sh)

uncheckedOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
uncheckedOffset :: sh -> Property
uncheckedOffset sh
sh =
   sh -> (ix -> Bool) -> Property
forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh ((ix -> Bool) -> Property) -> (ix -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
sh ix
Index sh
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset sh
sh ix
Index sh
ix

unifiedOffset ::
   (Shape.Checking check, Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) =>
   Shape.CheckSingleton check -> sh -> QC.Property
unifiedOffset :: CheckSingleton check -> sh -> Property
unifiedOffset CheckSingleton check
check sh
sh =
   sh -> (ix -> Bool) -> Property
forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh ((ix -> Bool) -> Property) -> (ix -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      CheckSingleton check -> Result check Int -> Result check Int
forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check (sh -> Index sh -> Result check Int
forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
Shape.unifiedOffset sh
sh ix
Index sh
ix) Result check Int -> Result check Int -> Bool
forall a. Eq a => a -> a -> Bool
==
      case CheckSingleton check
check of
         CheckSingleton check
Shape.Checked -> Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
sh ix
Index sh
ix
         CheckSingleton check
Shape.Unchecked -> Int -> Result check Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Result check Int) -> Int -> Result check Int
forall a b. (a -> b) -> a -> b
$ sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset sh
sh ix
Index sh
ix

lengthIndices :: (Shape.Indexed sh) => sh -> Bool
lengthIndices :: sh -> Bool
lengthIndices sh
sh  =  [Index sh] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh

indexOffsets :: (Shape.Indexed sh) => sh -> Bool
indexOffsets :: sh -> Bool
indexOffsets sh
sh =
   (Index sh -> Int) -> [Index sh] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (sh -> Index sh -> Int
forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
sh) (sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh) [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh) [Int
0..]

invIndices :: (Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) => sh -> Bool
invIndices :: sh -> Bool
invIndices sh
sh =
   sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh [ix] -> [ix] -> Bool
forall a. Eq a => a -> a -> Bool
==
   (Int -> ix) -> [Int] -> [ix]
forall a b. (a -> b) -> [a] -> [b]
map (sh -> Int -> Index sh
forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.indexFromOffset sh
sh) (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh) [Int
0..])

uncheckedInvIndices ::
   (Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) => sh -> Bool
uncheckedInvIndices :: sh -> Bool
uncheckedInvIndices sh
sh =
   sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh [ix] -> [ix] -> Bool
forall a. Eq a => a -> a -> Bool
==
   (Int -> ix) -> [Int] -> [ix]
forall a b. (a -> b) -> [a] -> [b]
map (sh -> Int -> Index sh
forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.uncheckedIndexFromOffset sh
sh) (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh) [Int
0..])

unifiedInvIndicesA ::
   (Shape.Checking check, Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) =>
   Shape.CheckSingleton check -> sh -> Bool
unifiedInvIndicesA :: CheckSingleton check -> sh -> Bool
unifiedInvIndicesA CheckSingleton check
check sh
sh =
   (ix -> Result check ix) -> [ix] -> [Result check ix]
forall a b. (a -> b) -> [a] -> [b]
map ix -> Result check ix
forall (f :: * -> *) a. Applicative f => a -> f a
pure (sh -> [Index sh]
forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh) [Result check ix] -> [Result check ix] -> Bool
forall a. Eq a => a -> a -> Bool
==
   (Int -> Result check ix) -> [Int] -> [Result check ix]
forall a b. (a -> b) -> [a] -> [b]
map (CheckSingleton check -> Result check ix -> Result check ix
forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check (Result check ix -> Result check ix)
-> (Int -> Result check ix) -> Int -> Result check ix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sh -> Int -> Result check (Index sh)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
Shape.unifiedIndexFromOffset sh
sh)
      (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh) [Int
0..])

unifiedInvIndicesB ::
   (Shape.Checking check, Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) =>
   Shape.CheckSingleton check -> sh -> QC.Property
unifiedInvIndicesB :: CheckSingleton check -> sh -> Property
unifiedInvIndicesB CheckSingleton check
check sh
sh =
   let n :: Int
n = sh -> Int
forall sh. C sh => sh -> Int
Shape.size sh
sh in Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
QC.==>
   Gen Int -> (Int -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) ((Int -> Bool) -> Property) -> (Int -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
k ->
   CheckSingleton check -> Result check ix -> Result check ix
forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check (sh -> Int -> Result check (Index sh)
forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
Shape.unifiedIndexFromOffset sh
sh Int
k) Result check ix -> Result check ix -> Bool
forall a. Eq a => a -> a -> Bool
==
   case CheckSingleton check
check of
      CheckSingleton check
Shape.Checked -> ix -> Result check ix
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ix -> Result check ix) -> ix -> Result check ix
forall a b. (a -> b) -> a -> b
$ sh -> Int -> Index sh
forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.indexFromOffset sh
sh Int
k
      CheckSingleton check
Shape.Unchecked -> ix -> Result check ix
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ix -> Result check ix) -> ix -> Result check ix
forall a b. (a -> b) -> a -> b
$ sh -> Int -> Index sh
forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.uncheckedIndexFromOffset sh
sh Int
k


unifiedTests ::
   (Shape.Checking check,
    Shape.InvIndexed sh, Show sh, Shape.Index sh ~ ix, Eq ix, Show ix) =>
   Shape.CheckSingleton check -> QC.Gen sh -> [(String, QC.Property)]
unifiedTests :: CheckSingleton check -> Gen sh -> [(String, Property)]
unifiedTests CheckSingleton check
check Gen sh
gen =
   (String
"unifiedSizeOffsetA", Gen sh -> (sh -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (CheckSingleton check -> sh -> Property
forall check sh ix.
(Checking check, Indexed sh, Index sh ~ ix, Show ix) =>
CheckSingleton check -> sh -> Property
unifiedSizeOffsetA CheckSingleton check
check)) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"unifiedSizeOffsetB", Gen sh -> (sh -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (CheckSingleton check -> sh -> Property
forall check sh ix.
(Checking check, Indexed sh, Index sh ~ ix, Show ix) =>
CheckSingleton check -> sh -> Property
unifiedSizeOffsetB CheckSingleton check
check)) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"unifiedOffset", Gen sh -> (sh -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (CheckSingleton check -> sh -> Property
forall check sh ix.
(Checking check, Indexed sh, Index sh ~ ix, Show ix) =>
CheckSingleton check -> sh -> Property
unifiedOffset CheckSingleton check
check)) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"unifiedInvIndicesA", Gen sh -> (sh -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (CheckSingleton check -> sh -> Bool
forall check sh ix.
(Checking check, InvIndexed sh, Index sh ~ ix, Eq ix) =>
CheckSingleton check -> sh -> Bool
unifiedInvIndicesA CheckSingleton check
check)) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"unifiedInvIndicesB", Gen sh -> (sh -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (CheckSingleton check -> sh -> Property
forall check sh ix.
(Checking check, InvIndexed sh, Index sh ~ ix, Eq ix) =>
CheckSingleton check -> sh -> Property
unifiedInvIndicesB CheckSingleton check
check)) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   []

-- cf. Test.Utility
prefix :: String -> [(String, test)] -> [(String, test)]
prefix :: String -> [(String, test)] -> [(String, test)]
prefix String
msg =
   ((String, test) -> (String, test))
-> [(String, test)] -> [(String, test)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
str,test
test) -> (String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str, test
test))

tests ::
   (Shape.InvIndexed sh, Show sh, Shape.Index sh ~ ix, Eq ix, Show ix) =>
   QC.Gen sh -> [(String, QC.Property)]
tests :: Gen sh -> [(String, Property)]
tests Gen sh
gen =
   (String
"inBounds", Gen sh -> (sh -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Bool
forall sh. Indexed sh => sh -> Bool
inBounds) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"inBoundsOffset", Gen sh -> (sh -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Property
forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
inBoundsOffset) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"inBoundsSizeOffset", Gen sh -> (sh -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Property
forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
inBoundsSizeOffset) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"sizeOffset", Gen sh -> (sh -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Property
forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
sizeOffset) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"uncheckedSizeOffset", Gen sh -> (sh -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Property
forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
uncheckedSizeOffset) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"uncheckedOffset", Gen sh -> (sh -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Property
forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
uncheckedOffset) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"lengthIndices", Gen sh -> (sh -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Bool
forall sh. Indexed sh => sh -> Bool
lengthIndices) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"indexOffsets", Gen sh -> (sh -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Bool
forall sh. Indexed sh => sh -> Bool
indexOffsets) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"invIndices", Gen sh -> (sh -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Bool
forall sh ix. (InvIndexed sh, Index sh ~ ix, Eq ix) => sh -> Bool
invIndices) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   (String
"uncheckedInvIndices", Gen sh -> (sh -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen sh -> Bool
forall sh ix. (InvIndexed sh, Index sh ~ ix, Eq ix) => sh -> Bool
uncheckedInvIndices) (String, Property) -> [(String, Property)] -> [(String, Property)]
forall a. a -> [a] -> [a]
:
   String -> [(String, Property)] -> [(String, Property)]
forall test. String -> [(String, test)] -> [(String, test)]
prefix String
"Checked" (CheckSingleton Checked -> Gen sh -> [(String, Property)]
forall check sh ix.
(Checking check, InvIndexed sh, Show sh, Index sh ~ ix, Eq ix,
 Show ix) =>
CheckSingleton check -> Gen sh -> [(String, Property)]
unifiedTests CheckSingleton Checked
Shape.Checked Gen sh
gen) [(String, Property)]
-> [(String, Property)] -> [(String, Property)]
forall a. [a] -> [a] -> [a]
++
   String -> [(String, Property)] -> [(String, Property)]
forall test. String -> [(String, test)] -> [(String, test)]
prefix String
"Unchecked" (CheckSingleton Unchecked -> Gen sh -> [(String, Property)]
forall check sh ix.
(Checking check, InvIndexed sh, Show sh, Index sh ~ ix, Eq ix,
 Show ix) =>
CheckSingleton check -> Gen sh -> [(String, Property)]
unifiedTests CheckSingleton Unchecked
Shape.Unchecked Gen sh
gen) [(String, Property)]
-> [(String, Property)] -> [(String, Property)]
forall a. [a] -> [a] -> [a]
++
   []