{-# OPTIONS_GHC -fno-warn-orphans #-}
-- QuickCheck properties for Data.FingerTree

module Main where

import Data.RationalList

import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck
import Test.QuickCheck.Poly

import Data.Foldable (toList)
import qualified Data.List as List
import Prelude hiding (
    map, repeat, cycle, iterate, filter, any, all,
    take, drop, splitAt, zip, zipWith, unzip)

main :: IO ()
main = defaultMainWithOpts properties runner_opts
  where
    runner_opts = mempty { ropt_test_options = Just test_opts }
    test_opts = mempty {
          topt_maximum_generated_tests = Just 500
        , topt_maximum_unsuitable_generated_tests = Just 500
        }

properties :: [Test]
properties =
    [ testProperty "iterate" prop_iterate
    , testProperty "components" prop_components
    , testProperty "minimal prefix" prop_minimal_prefix
    , testProperty "fromList-toList" prop_fromList_toList
    , testProperty "zip" prop_zip
    , testProperty "zipWith (,)" prop_zipWith_comma
    , testProperty "take-drop" prop_take_drop
    , testProperty "take-length" prop_take_length
    , testProperty "splitAt" prop_splitAt
    , testProperty "finite" prop_finite
    , testProperty "elementAt" prop_elementAt
    , testProperty "foldMapTake" prop_foldMapTake
    ]

prop_iterate :: Int -> Int -> Bool
prop_iterate m n =
    iterate f 1 == fromList [1..nf] <> cycle [nf+1..nf+nr]
  where
    nf = abs m
    nr = abs n + 1
    f k
      | k == nf+nr = nf+1
      | otherwise = k+1

prop_components :: RationalList A -> Bool
prop_components xs =
    xs == fromList (prefix xs) <> cycle (repetend xs)

prop_minimal_prefix :: RationalList A -> Bool
prop_minimal_prefix xs =
    null fr || null re || last fr /= last re
  where
    fr = prefix xs
    re = repetend xs

prop_fromList_toList :: [A] -> Bool
prop_fromList_toList xs =
    xs == toList (fromList xs)

prop_zip :: RationalList A -> RationalList B -> Bool
prop_zip xs ys =
    unzip (zip xs ys) == if finite xs || finite ys
        then let (xs', ys') = List.unzip (List.zip (toList xs) (toList ys))
             in (fromList xs', fromList ys')
        else (xs, ys)

prop_zipWith_comma :: RationalList A -> RationalList B -> Bool
prop_zipWith_comma xs ys =
    zipWith (,) xs ys == zip xs ys

prop_splitAt :: Int -> RationalList A -> Bool
prop_splitAt i xs =
    splitAt i xs == (take i xs, drop i xs)

prop_take_drop :: Int -> RationalList A -> Bool
prop_take_drop i xs =
    xs == fromList (take i xs) <> drop i xs

prop_take_length :: Int -> RationalList A -> Bool
prop_take_length i xs =
    List.length (take i xs) == if finite xs then min len (length xs) else len
  where
    len = max i 0

prop_finite :: [A] -> [A] -> Bool
prop_finite xs ys =
    finite (fromList xs <> cycle ys) == null ys

prop_elementAt :: Int -> RationalList A -> Bool
prop_elementAt i xs =
    elementAt ix xs == if finite xs && ix >= length xs then Nothing
        else Just (toList xs!!ix)
  where
    ix = abs i

prop_foldMapTake :: Int -> RationalList A -> Bool
prop_foldMapTake i xs =
    foldMapTake (:[]) ix xs == List.take ix (toList xs)
  where
    ix = abs i

------------------------------------------------------------------------
-- QuickCheck
------------------------------------------------------------------------

instance (Arbitrary a, Eq a) => Arbitrary (RationalList a) where
    arbitrary = (<>) <$> (fromList <$> arbitrary) <*> (cycle <$> arbitrary)