module Control.Monad.Random.Extras
(
shuffle
, shuffleSeq
, choiceExtract
, choiceExtractSeq
, choice
, choiceSeq
)
where
import Control.Monad (MonadPlus, liftM)
import Control.Monad.Loops (unfoldrM')
import Control.Monad.Random (MonadRandom, getRandomR)
import qualified Data.Sequence as Seq
import Data.Sequence ((><), ViewL((:<)))
extract :: [a] -> Int -> Maybe (a, [a])
extract s i | null r = Nothing
| otherwise = Just (b, a ++ c)
where (a, r) = splitAt i s
(b : c) = r
extractSeq :: Seq.Seq a -> Int -> Maybe (a, Seq.Seq a)
extractSeq s i | Seq.null r = Nothing
| otherwise = Just (b, a >< c)
where (a, r) = Seq.splitAt i s
(b :< c) = Seq.viewl r
shuffle :: (MonadRandom m) => [a] -> m [a]
shuffle = shuffleSeq . Seq.fromList
shuffleSeq :: (MonadRandom m, MonadPlus f) => Seq.Seq a -> m (f a)
shuffleSeq = unfoldrM' choiceExtractSeq
choiceExtract :: (MonadRandom m) => [a] -> m (Maybe (a, [a]))
choiceExtract [] = return Nothing
choiceExtract xs = extract xs `liftM` getRandomR (0, length xs 1)
choiceExtractSeq :: (MonadRandom m) => Seq.Seq a -> m (Maybe (a, Seq.Seq a))
choiceExtractSeq s | Seq.null s = return Nothing
| otherwise = extractSeq s `liftM` getRandomR (0, Seq.length s 1)
choice :: (MonadRandom m) => [a] -> m a
choice [] = error "Control.Monad.Random.Extras.choice: empty list"
choice xs = (xs !!) `liftM` getRandomR (0, length xs 1)
choiceSeq :: (MonadRandom m) => Seq.Seq a -> m a
choiceSeq s | Seq.null s = error "Control.Monad.Random.Extras.choiceSeq: empty sequence"
| otherwise = Seq.index s `liftM` getRandomR (0, Seq.length s 1)