    {-# LANGUAGE CPP #-}
    module Test.Hspec.Core.Shuffle (
      shuffleForest
    #ifdef TEST
    , shuffle
    , mkArray
    #endif
    ) where

    import           Prelude ()
    import           Test.Hspec.Core.Compat
    import           Test.Hspec.Core.Tree

    import           System.Random
    import           Control.Monad.ST
    import           Data.STRef
    import           Data.Array.ST

    shuffleForest :: STRef st StdGen -> [Tree c a] -> ST st [Tree c a]
    shuffleForest :: forall st c a. STRef st StdGen -> [Tree c a] -> ST st [Tree c a]
    shuffleForest STRef st StdGen
    ref [Tree c a]
    xs = (STRef st StdGen -> [Tree c a] -> ST st [Tree c a]
    forall st a. STRef st StdGen -> [a] -> ST st [a]
    shuffle STRef st StdGen
    ref [Tree c a]
    xs ST st [Tree c a]
    -> ([Tree c a] -> ST st [Tree c a]) -> ST st [Tree c a]
    forall a b. ST st a -> (a -> ST st b) -> ST st b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Tree c a -> ST st (Tree c a)) -> [Tree c a] -> ST st [Tree c a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (STRef st StdGen -> Tree c a -> ST st (Tree c a)
    forall st c a. STRef st StdGen -> Tree c a -> ST st (Tree c a)
    shuffleTree STRef st StdGen
    ref))

    shuffleTree :: STRef st StdGen -> Tree c a -> ST st (Tree c a)
    shuffleTree :: forall st c a. STRef st StdGen -> Tree c a -> ST st (Tree c a)
    shuffleTree STRef st StdGen
    ref Tree c a
    t = case Tree c a
    t of
      Node String
    d [Tree c a]
    xs -> String -> [Tree c a] -> Tree c a
    forall c a. String -> [Tree c a] -> Tree c a
    Node String
    d ([Tree c a] -> Tree c a) -> ST st [Tree c a] -> ST st (Tree c a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> STRef st StdGen -> [Tree c a] -> ST st [Tree c a]
    forall st c a. STRef st StdGen -> [Tree c a] -> ST st [Tree c a]
    shuffleForest STRef st StdGen
    ref [Tree c a]
    xs
      NodeWithCleanup Maybe (String, Location)
    loc c
    c [Tree c a]
    xs -> Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
    forall c a. Maybe (String, Location) -> c -> [Tree c a] -> Tree c a
    NodeWithCleanup Maybe (String, Location)
    loc c
    c ([Tree c a] -> Tree c a) -> ST st [Tree c a] -> ST st (Tree c a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> STRef st StdGen -> [Tree c a] -> ST st [Tree c a]
    forall st c a. STRef st StdGen -> [Tree c a] -> ST st [Tree c a]
    shuffleForest STRef st StdGen
    ref [Tree c a]
    xs
      Leaf {} -> Tree c a -> ST st (Tree c a)
    forall a. a -> ST st a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Tree c a
    t

    shuffle :: STRef st StdGen -> [a] -> ST st [a]
    shuffle :: forall st a. STRef st StdGen -> [a] -> ST st [a]
    shuffle STRef st StdGen
    ref [a]
    xs = do
      arr <- [a] -> ST st (STArray st Int a)
    forall a st. [a] -> ST st (STArray st Int a)
    mkArray [a]
    xs
      bounds@(_, n) <- getBounds arr
      forM (range bounds) $ \ Int
    i -> do
        j <- (Int, Int) -> ST st Int
    forall {b}. Random b => (b, b) -> ST st b
    randomIndex (Int
    i, Int
    n)
        vi <- readArray arr i
        vj <- readArray arr j
        writeArray arr j vi
        return vj
      where
        randomIndex :: (b, b) -> ST st b
    randomIndex (b, b)
    bounds = do
          (a, gen) <- (b, b) -> StdGen -> (b, StdGen)
    forall g. RandomGen g => (b, b) -> g -> (b, g)
    forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
    randomR (b, b)
    bounds (StdGen -> (b, StdGen)) -> ST st StdGen -> ST st (b, StdGen)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> STRef st StdGen -> ST st StdGen
    forall s a. STRef s a -> ST s a
    readSTRef STRef st StdGen
    ref
          writeSTRef ref gen
          return a

    mkArray :: [a] -> ST st (STArray st Int a)
    mkArray :: forall a st. [a] -> ST st (STArray st Int a)
    mkArray [a]
    xs = (Int, Int) -> [a] -> ST st (STArray st Int a)
    forall (a :: * -> * -> *) e (m :: * -> *) i.
    (MArray a e m, Ix i) =>
    (i, i) -> [e] -> m (a i e)
    newListArray (Int
    1, [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs) [a]
    xs