StableShuffle.hs

StableShuffle.hs

{-# LANGUAGE PartialTypeSignatures #-}
module StableShuffle where

import           Control.Monad
import           Control.Monad.Random.Class
import           Data.List
import qualified Data.Map.Strict as M
import           Data.Maybe
import           Data.Ord
import           System.Random.Shuffle

data Stability a = Stable a | Instable a

shuffleWithStability :: MonadRandom m => [Stability a] -> m [a]
shuffleWithStability ordered = do
  shuffled <- shuffleM ordered
  pure
    (mergeWithStability stables shuffled)
  where
    stables =
      mapMaybe
        (\e ->
           case e of
             Stable a -> Just a
             _ -> Nothing)
        ordered

mergeWithStability :: [a] -> [Stability a] -> [a]
mergeWithStability stables0 shuffled =
  snd
    (mapAccumL
       (\stables element ->
          case (element, stables) of
            (Instable a, _) -> (stables, a)
            (Stable{}, s:stables') -> (stables', s)
            (Stable a, []) -> ([], a))
       stables0
       shuffled)