StateCombine.hs

#!/usr/bin/env stack
-- stack --resolver=lts-11.14 script

import qualified Data.List as LS
import Data.IntMap
import Control.Monad.State

type Card = Int
type Deck = [Card]
type PlayerS = IntMap [Card]
data Table = Table
  { deck    :: Deck
  , players :: PlayerS
  } deriving(Show)

drawFromDeck :: State Deck Card
drawFromDeck = state $ \(c:cs) -> (c, cs)

addToHand :: Int -> Card -> State PlayerS ()
addToHand i c = modify $ \ps -> insert i (c:ps!i) ps

focus :: (s -> t) -> (t -> s -> s) -> State t a -> State s a
focus get set ma = state $ \s ->
  let (a, t) = runState ma (get s)
  in  (a, set t s)

deckE :: Deck -> Table -> Table
deckE d tbl = tbl { deck = d }
playersE :: PlayerS -> Table -> Table
playersE p tbl = tbl { players = p }

focusDeck :: State Deck a -> State Table a
focusDeck = focus deck deckE
focusPlayers :: State PlayerS a -> State Table a
focusPlayers = focus players playersE

drawCard :: Int -> State Table ()
drawCard i = focusDeck drawFromDeck >>= focusPlayers . addToHand i

main :: IO ()
main = print $ runState (drawCard 1) $
       Table [1..3] (fromList [(1,[]),(2,[])])