module Properties (tests) where

import Boilerplater
import Utilities

import qualified Data.Vector.IVector as V
import qualified Data.Vector
import qualified Data.Vector.Unboxed
import qualified Data.Vector.Fusion.Stream as S

import Test.QuickCheck

import Test.Framework
import Test.Framework.Providers.QuickCheck

import Text.Show.Functions ()
import Data.List           (foldl', foldl1', unfoldr, find, findIndex)

#define COMMON_CONTEXT(a, v) \
 VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v)

#define VANILLA_CONTEXT(a, v) \
  Eq a,     Show a,     Arbitrary a,     Model a a

#define VECTOR_CONTEXT(a, v) \
  Eq (v a), Show (v a), Arbitrary (v a), Model (v a) [a], V.IVector v a


-- TODO: implement Vector equivalents of list functions for some of the commented out properties

-- TODO: test and implement some of these other Prelude functions:
--  mapM *
--  mapM_ *
--  sequence
--  sequence_
--  sum *
--  product *
--  scanl *
--  scanl1 *
--  scanr *
--  scanr1 *
--  lookup *
--  lines
--  words
--  unlines
--  unwords
-- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.
-- Ones with *s are the most plausible candidates.

-- TODO: add tests for the other extra functions
-- IVector exports still needing tests:
--  copy,
--  slice,
--  (//), update, bpermute,
--  prescanl, prescanl',
--  new,
--  unsafeSlice, unsafeIndex,
--  vlength, vnew

-- TODO: test non-IVector stuff?

testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
testSanity _ = [
        testProperty "fromList.toList == id" prop_fromList_toList,
        testProperty "toList.fromList == id" prop_toList_fromList,
        testProperty "unstream.stream == id" prop_unstream_stream,
        testProperty "stream.unstream == id" prop_stream_unstream
    ]
  where
    prop_fromList_toList (v :: v a)        = (V.fromList . V.toList)                        v == v
    prop_toList_fromList (l :: [a])        = ((V.toList :: v a -> [a]) . V.fromList)        l == l
    prop_unstream_stream (v :: v a)        = (V.unstream . V.stream)                        v == v
    prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s

testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
testPolymorphicFunctions _ = $(testProperties [
        'prop_eq, 'prop_length, 'prop_null, 'prop_reverse,
        'prop_append, 'prop_concatMap,
        'prop_empty, 'prop_cons,
        'prop_head, 'prop_tail, 'prop_init, 'prop_last,
        'prop_drop, 'prop_dropWhile, 'prop_take, 'prop_takeWhile,
        'prop_filter, 'prop_map, 'prop_replicate,
        'prop_zipWith, 'prop_zipWith3,
        'prop_elem, 'prop_notElem,
        'prop_foldr, 'prop_foldl, 'prop_foldr1, 'prop_foldl1,
        'prop_foldl', 'prop_foldl1',
        'prop_find, 'prop_findIndex,
        'prop_unfoldr,
        'prop_singleton, 'prop_snoc
    ])
  where
    -- Prelude
    prop_eq           = ((==) :: v a -> v a -> Bool)                  `eq2` (==)
    prop_length       = (V.length :: v a -> Int)                      `eq1` length
    prop_null         = (V.null :: v a -> Bool)                       `eq1` null
    prop_reverse      = (V.reverse :: v a -> v a)                     `eq1` reverse
    prop_append       = ((V.++) :: v a -> v a -> v a)                 `eq2` (++)
    prop_concatMap    = (V.concatMap :: (a -> v a) -> v a -> v a)     `eq2` concatMap
    prop_empty        = (V.empty :: v a)                              `eq0` []
    prop_cons         = (V.cons :: a -> v a -> v a)                   `eq2` (:)
    --prop_index        = compare (V.!) to (!!)
    prop_head         = (V.head :: v a -> a)                          `eqNotNull1` head
    prop_tail         = (V.tail :: v a -> v a)                        `eqNotNull1` tail
    prop_init         = (V.init :: v a -> v a)                        `eqNotNull1` init
    prop_last         = (V.last :: v a -> a)                          `eqNotNull1` last
    prop_drop         = (V.drop :: Int -> v a -> v a)                 `eq2` drop
    prop_dropWhile    = (V.dropWhile :: (a -> Bool) -> v a -> v a)    `eq2` dropWhile
    prop_take         = (V.take :: Int -> v a -> v a)                 `eq2` take
    prop_takeWhile    = (V.takeWhile :: (a -> Bool) -> v a -> v a)    `eq2` takeWhile
    prop_filter       = (V.filter :: (a -> Bool) -> v a -> v a)       `eq2` filter
    prop_map          = (V.map :: (a -> a) -> v a -> v a)             `eq2` map
    prop_replicate    = (V.replicate :: Int -> a -> v a)              `eq2` replicate
    prop_zipWith      = (V.zipWith :: (a -> a -> a) -> v a -> v a -> v a) `eq3` zipWith
    prop_zipWith3     = (V.zipWith3 :: (a -> a -> a -> a) -> v a -> v a -> v a -> v a) `eq4` zipWith3
    --prop_span         = (V.span :: (a -> Bool) -> v a -> (v a, v a))  `eq2` span
    --prop_break        = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break
    --prop_splitAt      = (V.splitAt :: Int -> v a -> (v a, v a))       `eq2` splitAt
    prop_elem         = (V.elem :: a -> v a -> Bool)                  `eq2` elem
    prop_notElem      = (V.notElem :: a -> v a -> Bool)               `eq2` notElem
    prop_foldr        = (V.foldr :: (a -> a -> a) -> a -> v a -> a)   `eq3` foldr
    prop_foldl        = (V.foldl :: (a -> a -> a) -> a -> v a -> a)   `eq3` foldl
    prop_foldr1       = (V.foldr1 :: (a -> a -> a) -> v a -> a)       `eqNotNull2` foldr1
    prop_foldl1       = (V.foldl1 :: (a -> a -> a) -> v a -> a)       `eqNotNull2` foldl1
    --prop_all          = (V.all :: (a -> Bool) -> v a -> Bool)         `eq2` all
    --prop_any          = (V.any :: (a -> Bool) -> v a -> Bool)         `eq2` any

    -- Data.List
    prop_foldl'       = (V.foldl' :: (a -> a -> a) -> a -> v a -> a)     `eq3` foldl'
    prop_foldl1'      = (V.foldl1' :: (a -> a -> a) -> v a -> a)         `eqNotNull2` foldl1'
    prop_find         = (V.find :: (a -> Bool) -> v a -> Maybe a)        `eq2` find
    prop_findIndex    = (V.findIndex :: (a -> Bool) -> v a -> Maybe Int) `eq2` findIndex
    --prop_findIndices  = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)
    --prop_isPrefixOf   = V.isPrefixOf  `eq2` (isPrefixOf  :: v a -> v a -> Bool)
    --prop_elemIndex    = V.elemIndex   `eq2` (elemIndex   :: a -> v a -> Maybe Int)
    --prop_elemIndices  = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)
    --
    --prop_mapAccumL  = eq3
    --    (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B   -> (X, B))
    --    (  mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
    -- 
    --prop_mapAccumR  = eq3
    --    (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B   -> (X, B))
    --    (  mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))

    -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This
    -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.
    limitUnfolds f (theirs, ours) | ours >= 0
                                  , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
                                  | otherwise                       = Nothing
    prop_unfoldr      = ((\n f a -> V.unfoldr (limitUnfolds f) (a, n)) :: Int -> ((Int, Int) -> Maybe (a, (Int, Int))) -> (Int, Int) -> v a)
                        `eq3` (\n f a -> unfoldr (limitUnfolds f) (a, n))

    -- Extras
    singleton x = [x]
    prop_singleton = (V.singleton :: a -> v a) `eq1` singleton
    
    snoc xs x = xs ++ [x]
    prop_snoc = (V.snoc :: v a -> a -> v a) `eq2` snoc

testTuplyFunctions:: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT((a, a), v), VECTOR_CONTEXT((a, a, a), v)) => v a -> [Test]
testTuplyFunctions _ = $(testProperties ['prop_zip, 'prop_zip3, 'prop_unzip, 'prop_unzip3])
  where
    prop_zip          = (V.zip :: v a -> v a -> v (a, a))             `eq2` zip
    prop_zip3         = (V.zip3 :: v a -> v a -> v a -> v (a, a, a))  `eq3` zip3
    prop_unzip        = (V.unzip :: v (a, a) -> (v a, v a))           `eq1` unzip
    prop_unzip3       = (V.unzip3 :: v (a, a, a) -> (v a, v a, v a))  `eq1` unzip3

testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]
testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum])
  where
    prop_compare      = (compare :: v a -> v a -> Ordering) `eq2` compare
    prop_maximum      = (V.maximum :: v a -> a)             `eqNotNull1` maximum
    prop_minimum      = (V.minimum :: v a -> a)             `eqNotNull1` minimum

testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a) => v a -> [Test]
testEnumFunctions _ = $(testProperties ['prop_enumFromTo, 'prop_enumFromThenTo])
  where
    prop_enumFromTo     =                                        (V.enumFromTo :: a -> a -> v a)          `eq2` enumFromTo
    prop_enumFromThenTo = \i j n -> fromEnum i < fromEnum j ==> ((V.enumFromThenTo :: a -> a -> a -> v a) `eq3` enumFromThenTo) i j n

testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test]
testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])
  where
    prop_and          = (V.and :: v Bool -> Bool) `eq1` and
    prop_or           = (V.or :: v Bool -> Bool)  `eq1` or

testNumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Num a) => v a -> [Test]
testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product])
  where
    prop_sum          = (V.sum :: v a -> a)     `eq1` sum
    prop_product      = (V.product :: v a -> a) `eq1` product

testNestedVectorFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]
testNestedVectorFunctions _ = $(testProperties [])
  where
    -- Prelude
    --prop_concat       = (V.concat :: [v a] -> v a)                    `eq1` concat
    
    -- Data.List
    --prop_transpose    = V.transpose   `eq1` (transpose   :: [v a] -> [v a])
    --prop_group        = V.group       `eq1` (group       :: v a -> [v a])
    --prop_inits        = V.inits       `eq1` (inits       :: v a -> [v a])
    --prop_tails        = V.tails       `eq1` (tails       :: v a -> [v a])


testGeneralBoxedVector dummy = concatMap ($ dummy) [
        testSanity,
        testPolymorphicFunctions,
        testOrdFunctions,
        testEnumFunctions,
        testTuplyFunctions,
        testNestedVectorFunctions
    ]

testBoolBoxedVector dummy = testGeneralBoxedVector dummy ++ testBoolFunctions dummy
testNumericBoxedVector dummy = testGeneralBoxedVector dummy ++ testNumFunctions dummy

testGeneralUnboxedVector dummy = concatMap ($ dummy) [
        testSanity,
        testPolymorphicFunctions,
        testOrdFunctions,
        testEnumFunctions
    ]

testBoolUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testBoolFunctions dummy
testNumericUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testNumFunctions dummy

tests = [
        testGroup "Data.Vector.Vector (Bool)"           (testBoolBoxedVector      (undefined :: Data.Vector.Vector Bool)),
        testGroup "Data.Vector.Vector (Int)"            (testNumericBoxedVector   (undefined :: Data.Vector.Vector Int)),
        testGroup "Data.Vector.Unboxed.Vector (Bool)"   (testBoolUnboxedVector    (undefined :: Data.Vector.Unboxed.Vector Bool)),
        testGroup "Data.Vector.Unboxed.Vector (Int)"    (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)),
        testGroup "Data.Vector.Unboxed.Vector (Float)"  (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float)),
        testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double))
    ]