{-# LANGUAGE LambdaCase       #-}
{-# LANGUAGE TypeApplications #-}

import           Control.Monad                  (replicateM)
import qualified Data.IORef                     as IOR
import           Data.List                      (elemIndex)
import           Data.Maybe                     (fromJust)
import qualified System.Random.Shuffle          as RS
import           Test.Hspec
import           Test.Hspec.QuickCheck
import qualified Test.QuickCheck                as QC

import           Algorithms.Random.Shuffle.Pure

main :: IO ()
main = hspec $ do
  describe "shuffle" $
    let gen = do
          xs <- (++)
            <$> (map QC.getPrintableString <$> replicateM 2 QC.arbitrary)
            <*> (map QC.getPrintableString . QC.getNonEmpty <$> QC.arbitrary)
          let len = length xs
          is <- mapM (\i -> QC.choose (0, i)) [len - 2, len - 3 .. 0]
          return (xs, is)
     in
      prop "behaves as a monadic version of System.Random.Shuffle.shuffle" $ QC.forAll gen $ \(xs, is) -> do
        ior <- IOR.newIORef is
        let getRandR = const $ mkGen ior
        shuffle getRandR xs `shouldReturn` RS.shuffle xs is

  describe "sampleOne" $ do
    it "returns Nothing given an empty list" $
      sampleOne undefined "" `shouldReturn` Nothing

    prop "returns the only element given a singleton list" $ \x ->
      sampleOne undefined [x :: Char] `shouldReturn` Just x

    let gen = do
          len <- (+ 2) <$> QC.arbitrarySizedNatural
          let xs = take len ['0' ..]
          -- Indices list containing a zero somewhere
          -- NOTE: Why the length is two shorter than xs:
          --   - Minus one: Supplied by prepending by "(0 :)"
          --   - Minus one: getRandR is not actually called when picking the first element. See below.
          is <- (0 :) <$> QC.vectorOf (len - 2) (QC.arbitrarySizedNatural @Int)
          return (xs, is)
     in
      prop "returns the element at the last index where the generator returns 0." $ QC.forAll gen $ \(xs, is) -> do
        ior <- IOR.newIORef is
        let getRandR = const $ mkGen ior

            -- NOTE: Because getRandR is not called when picking the first element,
            --       The actual index is shifted by one.
            expected = xs !! (fromJust (elemRIndex 0 is) + 1)

        sampleOne getRandR xs `shouldReturn` Just expected


mkGen :: IOR.IORef [Int] -> IO Int
mkGen ior =
  IOR.atomicModifyIORef' ior $
    \case
      [] -> error "No more elements!"
      (i : is) -> (is, i)


elemRIndex :: Eq a => a -> [a] -> Maybe Int
elemRIndex x xs = abs . subtract (length xs - 1) <$> elemIndex x (reverse xs)