{-# LANGUAGE TemplateHaskell #-}

import Control.Lens
import Control.Lens.TH
import Data.List
import System.Random.Stateful
import Control.Monad.State

-- fake shuffle because System.Random version on this playground
-- does not seem to have this yet
uniformShuffleListM :: StatefulGen g m => [a] -> g -> m [a]
uniformShuffleListM xs gen = pure xs

data Card = Card { _val :: Int } deriving (Read, Show, Eq)
$(makeLenses ''Card)

type Deck = [Card]
type Hand = [Card]
type Discard = [Card]

data Player = Player
     { _deck :: Deck
     , _hand :: Hand
     , _discard :: Discard
     } deriving (Read, Show, Eq)
$(makeLenses ''Player)

type PlayerId = Int

data Game = Game
     { _players :: [Player]
     , _playerId :: PlayerId
     } deriving (Read, Show, Eq)
$(makeLenses ''Game)

type GameState a = (StatefulGen g m) => StateT Game (m g) a

makeDeck :: Deck
makeDeck = [Card x | x <- [1..100]]

newPlayer :: (StatefulGen g m) => g -> m Player
newPlayer gen = do
  d <- uniformShuffleListM makeDeck gen
  -- start with three cards in hand
  let player = Player (drop 3 d) (take 4 d) []
  pure player

makeGame :: (StatefulGen g m) => g -> m Game
makeGame gen = do
  p1 <- newPlayer gen
  p2 <- newPlayer gen
  pid <- uniformRM (0, 1) gen
  pure $ Game [p1, p2] pid

getPlayer :: PlayerId -> GameState Player
getPlayer playerId = do
  state <- get
  pure $ (state ^. players) !! playerId

modifyPlayer :: PlayerId -> (Player -> Player) -> GameState ()
modifyPlayer playerId func = modify $ over (players . element playerId) func

-- shuffle discards into the deck
shuffleDiscards :: PlayerId -> GameState ()
shuffleDiscards playerId = do
  gen <- lift get
  player <- getPlayer playerId
  let newdeck = (player ^. deck) ++ (player ^. discard)
  shuffledDeck <- uniformShuffleListM newdeck gen
  pure $ modifyPlayer playerId $ over deck (\_ -> shuffledDeck) . over discard (\_ -> [])

-- draw a card from the deck, shuffling if necessary.
drawFromDeck :: PlayerId -> GameState ()
drawFromDeck playerId = do
  player <- getPlayer playerId
  let dsize = length $ player ^. deck
  if dsize > 0
    then
      pure $ draw
    else do
      shuffleDiscards playerId
      pure $ draw
  where
    draw = do
      player <- getPlayer playerId
      let drawnCards = take 1 (player ^. deck)
      modifyPlayer playerId $ over deck (drop 1) . over hand ((++) drawnCards)

runGame :: GameState ()
runGame = do
  drawFromDeck 0 gen
  drawFromDeck 1 gen

makeAndRunGame :: (StatefulGen g m) => g -> m Game
makeAndRunGame gen = do
  startState <- makeGame gen
  (_, newState) <- runStateT runGame startState
  pure newState

main :: IO ()
main = do
  let seed = 12345
  let gen = mkStdGen 12345
  let (finalState, finalGen) = runStateGen gen makeAndRunGame
  print finalState