{-# LANGUAGE TypeOperators, FlexibleContexts #-}

{- |
    Module      :  Test.SDP.Index
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (requires non-portable modules)
    
    @Test.SDP.Index@ provides basic test suite for 'Index' class.
-}
module Test.SDP.Index
(
  -- * Shape test
  TestShape, shapeTest,
  
  -- * Index test
  TestIndex, indexTest,
  
  -- ** Particular tests
  basicIndexTest, inBoundsTest, rangeTest, prevTest, nextTest, dumbSizeTest
)
where

import SDP.Index

default ()

--------------------------------------------------------------------------------

-- | 'TestShape' is service type synonym for more comfortable quickCheck using.
type TestShape s = s -> Bool

{- |
  @'shapeTest' r sh@ is default 'Shape' test, where @r@ is expected rank for
  this shape type. Note that 'shapeTest' also checks @'rank' 'undefined'@ case,
  to make sure 'rank' is correct.
-}
shapeTest :: (Shape s, Eq s, Eq (DimInit s), Eq (DimLast s)) => Int -> s -> Bool
shapeTest :: Int -> s -> Bool
shapeTest Int
r s
sh' = let (DimInit s
s, DimLast s
sh) = s -> (DimInit s, DimLast s)
forall i. Shape i => i -> (DimInit i, DimLast i)
unconsDim s
sh' in [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
  [
    Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== s -> Int
forall i. Shape i => i -> Int
rank (s
forall a. HasCallStack => a
undefined s -> s -> s
forall a. a -> a -> a
`asTypeOf` s
sh'),
    Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== s -> Int
forall i. Shape i => i -> Int
rank s
sh',
    
    DimInit s -> DimLast s -> s
forall i. Shape i => DimInit i -> DimLast i -> i
consDim DimInit s
s DimLast s
sh s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
sh',
    s -> DimLast s
forall i. Shape i => i -> DimLast i
lastDim s
sh' DimLast s -> DimLast s -> Bool
forall a. Eq a => a -> a -> Bool
== DimLast s
sh,
    s -> DimInit s
forall i. Shape i => i -> DimInit i
initDim s
sh' DimInit s -> DimInit s -> Bool
forall a. Eq a => a -> a -> Bool
== DimInit s
s
  ]

--------------------------------------------------------------------------------

-- | TestIndex is service type synonym for more comfortable quickCheck using.
type TestIndex i = (i, i) -> i -> Bool

lim :: Int
lim :: Int
lim =  Int
65536

{- |
  'rangeTest' checks relations of 'inRange', 'isOverflow', 'isUnderflow' and
  'isEmpty'.
-}
rangeTest :: (Index i) => (i, i) -> i -> Bool
rangeTest :: (i, i) -> i -> Bool
rangeTest (i, i)
bnds i
i = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
  [
    Bool -> Bool
not ((i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange (i, i)
bnds i
i Bool -> Bool -> Bool
&& (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
isUnderflow (i, i)
bnds i
i),
    Bool -> Bool
not ((i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange (i, i)
bnds i
i Bool -> Bool -> Bool
&& (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
isOverflow  (i, i)
bnds i
i),
    Bool -> Bool
not ((i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange (i, i)
bnds i
i Bool -> Bool -> Bool
&& (i, i) -> Bool
forall i. Index i => (i, i) -> Bool
isEmpty     (i, i)
bnds),
    
    Bool -> Bool
not ((i, i) -> Bool
forall i. Index i => (i, i) -> Bool
isEmpty (i, i)
bnds)  Bool -> Bool -> Bool
|| (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
isOverflow  (i, i)
bnds i
i,
    Bool -> Bool
not ((i, i) -> Bool
forall i. Index i => (i, i) -> Bool
isEmpty (i, i)
bnds)  Bool -> Bool -> Bool
|| (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
isUnderflow (i, i)
bnds i
i
  ]

-- | 'prevTest' checks relations of 'prev' and 'range'.
prevTest :: (Index i) => (i, i) -> Bool
prevTest :: (i, i) -> Bool
prevTest (i, i)
bnds =
  let test :: [Bool]
test = Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
lim ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (i -> i -> Bool) -> [i] -> [i] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith i -> i -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range (i, i)
bnds) ([i] -> [i]
forall a. [a] -> [a]
tail ([i] -> [i]) -> [i] -> [i]
forall a b. (a -> b) -> a -> b
$ (i, i) -> i -> i
forall i. Index i => (i, i) -> i -> i
prev (i, i)
bnds (i -> i) -> [i] -> [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range (i, i)
bnds)
  in  (i, i) -> Bool
forall i. Index i => (i, i) -> Bool
isEmpty (i, i)
bnds Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
test

-- | 'nextTest' checks relations of 'next' and 'range'.
nextTest :: (Index i) => (i, i) -> Bool
nextTest :: (i, i) -> Bool
nextTest (i, i)
bnds =
  let test :: [Bool]
test = Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
lim ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (i -> i -> Bool) -> [i] -> [i] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith i -> i -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range (i, i)
bnds) ([i] -> [i]
forall a. [a] -> [a]
tail ([i] -> [i]) -> [i] -> [i]
forall a b. (a -> b) -> a -> b
$ (i, i) -> i -> i
forall i. Index i => (i, i) -> i -> i
prev (i, i)
bnds (i -> i) -> [i] -> [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range (i, i)
bnds)
  in  (i, i) -> Bool
forall i. Index i => (i, i) -> Bool
isEmpty (i, i)
bnds Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
test

-- | 'inBoundsTest' checks relations of 'inBounds' and other range functions.
inBoundsTest :: (Index i) => (i, i) -> i -> Bool
inBoundsTest :: (i, i) -> i -> Bool
inBoundsTest (i, i)
bnds i
i = case (i, i) -> i -> InBounds
forall i. Index i => (i, i) -> i -> InBounds
inBounds (i, i)
bnds i
i of
  InBounds
ER -> (i, i) -> Bool
forall i. Index i => (i, i) -> Bool
isEmpty     (i, i)
bnds
  InBounds
IN -> (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inRange     (i, i)
bnds i
i
  InBounds
OR -> (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
isOverflow  (i, i)
bnds i
i
  InBounds
UR -> (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
isUnderflow (i, i)
bnds i
i

{- |
  'dumbSizeTest' is O(n) (may be very long) test, that checks relation of range
  'size' and 'range' length.
-}
dumbSizeTest :: (Index i) => (i, i) -> Bool
dumbSizeTest :: (i, i) -> Bool
dumbSizeTest (i, i)
bnds = [i] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((i, i) -> [i]
forall i. Index i => (i, i) -> [i]
range (i, i)
bnds) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (i, i) -> Int
forall i. Index i => (i, i) -> Int
size (i, i)
bnds

-- | 'basicIndexTest' checks relations of 'rank', 'size' and 'sizes'.
basicIndexTest :: (Index i) => (i, i) -> i -> Bool
basicIndexTest :: (i, i) -> i -> Bool
basicIndexTest bnds :: (i, i)
bnds@(i
l, i
u) i
i = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
  [
    i -> Int
forall i. Shape i => i -> Int
rank i
u Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== i -> Int
forall i. Shape i => i -> Int
rank i
i,
    i -> Int
forall i. Shape i => i -> Int
rank i
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== i -> Int
forall i. Shape i => i -> Int
rank i
i,
    
    [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length  ((i, i) -> [Int]
forall i. Index i => (i, i) -> [Int]
sizes (i, i)
bnds) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== i -> Int
forall i. Shape i => i -> Int
rank i
i,
    [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ((i, i) -> [Int]
forall i. Index i => (i, i) -> [Int]
sizes (i, i)
bnds) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (i, i) -> Int
forall i. Index i => (i, i) -> Int
size (i, i)
bnds
  ]

{- |
  'indexTest' is complex test, that includes all other tests.
  May crash with very big numbers (Word64, Integer) because the tested functions
  are limited by size of type Int.
  In practice, structures of such sizes would take more memory than the address
  space of computers can accommodate.
-}
indexTest :: (Index i) => (i, i) -> i -> Bool
indexTest :: (i, i) -> i -> Bool
indexTest (i, i)
bnds i
i = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
  [
    (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
basicIndexTest (i, i)
bnds i
i,
    (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
inBoundsTest   (i, i)
bnds i
i,
    (i, i) -> i -> Bool
forall i. Index i => (i, i) -> i -> Bool
rangeTest      (i, i)
bnds i
i,
    (i, i) -> Bool
forall i. Index i => (i, i) -> Bool
prevTest       (i, i)
bnds,
    (i, i) -> Bool
forall i. Index i => (i, i) -> Bool
nextTest       (i, i)
bnds
  ]