{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Test.Vector.ShuffleSpec
    ( spec
    ) where

import Prelude

import Data.List.NonEmpty
    ( NonEmpty (..) )
import Test.Hspec
    ( Spec, describe, it )
import Test.QuickCheck
    ( Arbitrary (..)
    , Confidence (..)
    , NonEmptyList (..)
    , Positive (..)
    , PrintableString (..)
    , Property
    , Testable
    , arbitrary
    , checkCoverageWith
    , cover
    , genericShrink
    , label
    , vectorOf
    , (==>)
    )
import Test.QuickCheck.Monadic
    ( assert, monadicIO, monitor, pick, run )
import Test.Vector.Shuffle
    ( mkSeed, shuffle, shuffleNonEmpty, shuffleWith )

import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T

spec :: Spec
spec = do
    describe "shuffle" $ do
        it "every list can be shuffled, ultimately" $
            check prop_shuffleCanShuffle
        it "shuffle is non-deterministic" $
            check prop_shuffleNotDeterministic
        it "sort (shuffle xs) == sort xs" $
            check prop_shufflePreserveElements

    describe "shuffleNonEmpty" $ do
        it "every non-empty list can be shuffled, ultimately" $
            check prop_shuffleNonEmptyCanShuffle
        it "shuffleNonEmpty is non-deterministic" $
            check prop_shuffleNonEmptyNotDeterministic
        it "sort (shuffleNonEmpty xs) == sort xs" $
            check prop_shuffleNonEmptyPreserveElements

    describe "shuffleWith / mkSeed" $ do
        it "shuffling with the same seed is deterministic" $
            check prop_shuffleWithDeterministic
        it "different seed means different shuffles" $
            check prop_shuffleDifferentSeed

  where
    check :: forall p. Testable p => p -> Property
    check = checkCoverageWith lowerConfidence

    lowerConfidence :: Confidence
    lowerConfidence = Confidence (10^(6 :: Integer)) 0.75

--------------------------------------------------------------------------------
-- Properties
--------------------------------------------------------------------------------

prop_shuffleCanShuffle
    :: NonEmptyList Int
    -> Property
prop_shuffleCanShuffle (NonEmpty xs) = monadicIO $ run $ do
    xs' <- shuffle xs
    return $ cover 90 (xs /= xs') "shuffled" ()

prop_shuffleNonEmptyCanShuffle
    :: NonEmpty Int
    -> Property
prop_shuffleNonEmptyCanShuffle xs = monadicIO $ run $ do
    xs' <- shuffleNonEmpty xs
    return $ cover 90 (xs /= xs') "shuffled" ()

prop_shuffleNotDeterministic
    :: NonEmptyList Int
    -> Property
prop_shuffleNotDeterministic (NonEmpty xs) = monadicIO $ run $ do
    xs1 <- shuffle xs
    xs2 <- shuffle xs
    return $ cover 90 (xs1 /= xs2) "not deterministic" ()

prop_shuffleNonEmptyNotDeterministic
    :: NonEmpty Int
    -> Property
prop_shuffleNonEmptyNotDeterministic xs = monadicIO $ run $ do
    xs1 <- shuffleNonEmpty xs
    xs2 <- shuffleNonEmpty xs
    return $ cover 90 (xs1 /= xs2) "not deterministic" ()

prop_shufflePreserveElements
    :: [Int]
    -> Property
prop_shufflePreserveElements xs = monadicIO $ run $ do
    xs' <- shuffle xs
    return $ cover 90 (not $ null xs) "non-empty" (L.sort xs == L.sort xs')

prop_shuffleNonEmptyPreserveElements
    :: NonEmpty Int
    -> Property
prop_shuffleNonEmptyPreserveElements xs = monadicIO $ run $ do
    xs' <- shuffleNonEmpty xs
    return $ cover 90 (not $ null xs) "non-empty" (NE.sort xs == NE.sort xs')

-- ∀(g :: RandomGen).
-- ∀(es :: [a]).
--
-- shuffleWith g es == shuffleWith g es
prop_shuffleWithDeterministic
    :: PrintableString
    -> NonEmptyList Int
    -> Property
prop_shuffleWithDeterministic (PrintableString seed) (NonEmpty xs) =
    monadicIO $ do
        ys0 <- run $ shuffleWith (mkSeed $ T.pack seed) xs
        ys1 <- run $ shuffleWith (mkSeed $ T.pack seed) xs
        monitor $ cover 90 (length xs > 1) "non singleton"
        assert (ys0 == ys1)

-- ∀(x0 : Text, x1 : Text). g0 = mkSeed x0, g1 = mkSeed x1
-- ∃(Δ: Int).
-- ∀(es :: [a]).
--
-- g0 ≠g1, length es > Δ⇒ shuffleWith g0 es ≠shuffleWith g1 es
prop_shuffleDifferentSeed
    :: (PrintableString, PrintableString)
    -> Positive Int
    -> Property
prop_shuffleDifferentSeed (x0, x1) (Positive len) = do
    x0 /= x1 ==> monadicIO $ do
        let g0 = mkSeed $ T.pack $ getPrintableString x0
        let g1 = mkSeed $ T.pack $ getPrintableString x1
        es <- pick $ vectorOf len (arbitrary @Int)
        ys0 <- run $ shuffleWith g0 es
        ys1 <- run $ shuffleWith g1 es
        monitor $ label (prettyLen es)
        monitor $ cover 90 (ys0 /= ys1) "different"
  where
    prettyLen :: [a] -> String
    prettyLen xs = case length xs of
        n | n <= 1 -> "singleton"
        n | n <= 10 -> "small list"
        _ -> "big list"

instance Arbitrary a => Arbitrary (NonEmpty a) where
    arbitrary = (:|) <$> arbitrary <*> arbitrary
    shrink = genericShrink