{-# 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 r sh' = let (s, sh) = unconsDim sh' in and
  [
    r == rank (undefined `asTypeOf` sh'),
    r == rank sh',
    
    consDim s sh == sh',
    lastDim sh' == sh,
    initDim sh' == s
  ]

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

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

lim :: Int
lim =  65536

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

-- | 'prevTest' checks relations of 'prev' and 'range'.
prevTest :: (Index i) => (i, i) -> Bool
prevTest bnds =
  let test = take lim $ zipWith (==) (range bnds) (tail $ prev bnds <$> range bnds)
  in  isEmpty bnds || and test

-- | 'nextTest' checks relations of 'next' and 'range'.
nextTest :: (Index i) => (i, i) -> Bool
nextTest bnds =
  let test = take lim $ zipWith (==) (range bnds) (tail $ prev bnds <$> range bnds)
  in  isEmpty bnds || and test

-- | 'inBoundsTest' checks relations of 'inBounds' and other range functions.
inBoundsTest :: (Index i) => (i, i) -> i -> Bool
inBoundsTest bnds i = case inBounds bnds i of
  ER -> isEmpty     bnds
  IN -> inRange     bnds i
  OR -> isOverflow  bnds i
  UR -> isUnderflow bnds 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 bnds = length (range bnds) == size bnds

-- | 'basicIndexTest' checks relations of 'rank', 'size' and 'sizes'.
basicIndexTest :: (Index i) => (i, i) -> i -> Bool
basicIndexTest bnds@(l, u) i = and
  [
    rank u == rank i,
    rank l == rank i,
    
    length  (sizes bnds) == rank i,
    product (sizes bnds) == size 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 bnds i = and
  [
    basicIndexTest bnds i,
    inBoundsTest   bnds i,
    rangeTest      bnds i,
    prevTest       bnds,
    nextTest       bnds
  ]