Dynamic replacement between Haskell class implementations

Question

I’ve finished quite a bit of writing a poker game, and now I’m trying to demonstrate various implementations of card drawing algorithms that can be swapped every round. I wrote a class that defines instances of two functions of a class and a couple of instances for this class:

class Drawable a where
    initDeck :: IO a
    draw :: a -> IO (ShuffleType, Card)

newtype Deck = Deck [Card]
newtype RandomIndex = RandomIndex Deck
newtype KnuthShuffle = KnuthShuffle Deck

instance Drawable RandomIndex where
    initDeck = return $ coerce fullDeck

    draw x = do
        let cards = coerce x

        randomNum <- getStdRandom $ randomR (0, length cards- 1)

        let (beginning, card:end) = splitAt randomNum cards

        return (IsRandomIndex . coerce $ beginning ++ end, card)

instance Drawable KnuthShuffle where
    initDeck = coerce $ shuffle (length fullDeck - 1) fullDeck
        where shuffle 0 xs = return xs
              shuffle i xs = do
                j <- getStdRandom $ randomR (0, i)
                shuffle (i-1) (swap i j xs)

    draw x = return (IsKnuthShuffle $ coerce deck, card)
        where (card:deck) = coerce x


-- adapted from https://stackoverflow.com/a/30551130/8737306
swap :: Int -> Int -> [a] -> [a]
swap i j xs
    | i == j = xs
    | otherwise = let elemI = xs !! i
                      elemJ = xs !! j
                      left = take j xs
                      middle = take (i - j - 1) (drop (j + 1) xs)
                      right = drop (i + 1) xs
                  in  left ++ [elemI] ++ middle ++ [elemJ] ++ right

Coerce is simply used to conveniently deploy several new types, I use them to prevent callers outside the module from interacting with internal cards and ensure the state of the deck from the moment of the previous call.

midgame. - initDeck , . , RandomIndex KnuthShuffle.

, -

data Game a = Game {
    players :: [Player],
    pots :: [Pot],
    cards :: a
}

dealCard:

dealCard :: (Drawable a) => Game a -> Game a
dealCard game = do
   deck <- initDeck
   (card, newDeck) <- draw deck
   putStrLn $ "You drew the " ++ show card
   cards .= newDeck -- I'm using lenses and stateT

, . :

deck <- initDeck :: IO KnuthShuffle

, , Drawable a, .

:

data ShuffleType = IsKnuthShuffle KnuthShuffle
                 | IsRandomIndex RandomIndex

ShuffleType draw, , . , , .

, , - .

nextRound :: Game -> String -> Game
nextRound game newShuffle = do
    case newShuffle of
        "knuth" -> do
             deck <- initDeck :: IO KnuthShuffle
             cards .= deck
        "randomIndex" -> do
             deck <- initDeck :: IO RandomIndex
             cards .= deck

, , draw .

, , Haskell , , . , - , initKnuth, drawKnuth, initRandomIndex .., .

, .

: @DanielWagner . , :

drawCard :: GameStateT Card
drawCard = do
    s <- get
    shuffle <- lift $ readIORef (s^.shuffleType)

    let oldDeck = s^.cardInfo.deck

    case shuffle of
        Knuth -> do
            let (card, newDeck) = drawKnuth oldDeck
            cardInfo.deck .= IsKnuth newDeck
            cardInfo.tableCards %= (++ [card])
            return card

        RandomIndex -> do
            (card, newDeck) <- lift $ drawRandomIndex oldDeck
            cardInfo.deck .= IsRandomIndex newDeck
            cardInfo.tableCards %= (++ [card])
            return card

, , , , , newDeck if.

Answer 1

, . . , : .

data KnuthShuffle = ...
data RandomIndex  = ...

, , .

data ShuffleType = IsKnuthShuffle KnuthShuffle
                 | IsRandomIndex  RandomIndex

ShuffleType.

initDeckKnuth :: IO KnuthShuffle
initDeckKnuth = ...

initDeckRandom :: IO RandomIndex
initDeckRandom = ...

KnuthShuffle RandomIndex ShuffleType, .

nextRound :: Game -> String -> Game
nextRound game newShuffle = do
    case newShuffle of
        "knuth" -> do
             deck <- IsKnuthShuffle initDeckKnuth
             cards .= deck
        "randomIndex" -> do
             deck <- IsRandomIndex initDeckRandom
             cards .= deck

.

draw :: ShuffleType -> IO (ShuffleType, Card)
draw (IsKnuthShuffle x) = ... -- The KnuthShuffle case here
draw (IsRandomIndex  x) = ... -- The RandomIndex  case here