module T3.Server.Lobby where

import Control.Monad
import Control.Monad.Random
import Control.Monad.Conc.ClassTmp
import Control.Concurrent.STM (TVar, STM, readTVar, writeTVar)
import System.Random
import Data.Maybe
import T3.Match

type Lobby m = [(UserName, StartCallback m)]

addUserToLobby :: MonadConc m => TVar (Lobby m) -> UserName -> StartCallback m -> m Bool
addUserToLobby lobby un cb = atomically $ do
  lob <- readTVar lobby
  let shouldAdd = isNothing (lookup un lob)
  when shouldAdd $ writeTVar lobby ((un, cb) : lob)
  return shouldAdd

userPairFromLobby :: (MonadConc m, MonadRandom m) => TVar (Lobby m) -> m (Maybe ((UserName, StartCallback m), (UserName, StartCallback m)))
userPairFromLobby lobby = do
  a <- getRandom
  b <- getRandom
  atomically $ do
    lob <- readTVar lobby
    let len = length lob
    if len < 2 then return Nothing else grabEm lob (mod a len) (mod b (len - 1))
  where
    grabEm lob i j = do
      let (x, lob') = grab lob i
      let (y, lob'') = grab lob' j
      writeTVar lobby lob''
      return $ Just (x, y)
    grab :: [a] -> Int -> (a, [a])
    grab xs idx = (xs !! idx, take idx xs ++ drop (idx + 1) xs)