{-# LANGUAGE BangPatterns #-}

import Debug.Trace
import Control.Monad (forM_)
import Data.Function (on)
import Data.List (sortBy, unfoldr, maximumBy)
import System.Random (RandomGen, randoms, getStdGen, split)
import Data.HashSet (HashSet, fromList, member)
import qualified Data.HashMap.Strict as M

data Player = Player { name :: String
                     , rank :: Int
                     , matchLimit :: Int
                     } deriving (Show, Eq)

players :: [Player]
-- players = [ Player "orbekk" (-1) 4
--           , Player "ltsang" (-4) 4
--           , Player "sebh" 2 4
--           , Player "fringd" (-1) 4
--           , Player "sheyrax" (-2) 2
--           ]

players = [Player "orbekk"	(-1)	4
          , Player "sebh"	2	4
          , Player "ltsang"	(-4)	4
          , Player "fringd"	(-1)	4
          , Player "tysonjh"	(-14)	4
          , Player "shreyax"	(-2)	4
          , Player "bensley"	(-16)	4
          , Player "taosong"	1	4
          , Player "jtnapoli" (-17)	4
          , Player "woojlee"	(-7)	4
          , Player "binfu"	4	4
          , Player "wschudy"	(-13)	3
          , Player "hoffstaetter" (-17)	4
          , Player "wwall"	(-2)	3]


score :: M.HashMap String Player -> [(String, String)] -> [(String, String)]
    -> Int
score players history [] = 0
score players history ((p1, p2):ms) =
  rankScore + recencyScore + score players history ms
    where rankScore = 100 - 10 * (abs (getRank p1 - getRank p2))
          getRank p = rank (players M.! p)
          recencyScore = -10 * length (filter (==(p1, p2)) history)

shuffle :: (RandomGen g) => g -> [a] -> [a]
shuffle g xs = map snd $ sortBy (compare `on` fst) (zip rs xs)
  where rs = randoms g :: [Int]

matchOnce :: [String] -> [String] -> [(String, String)]
matchOnce (p:ps) (q:qs)
  | p == q    = matchOnce (p:ps) qs
  | otherwise = (p', q') : matchOnce (filter (/=q) ps) (filter (/=p) qs)
      where p' = min p q
            q' = max p q
matchOnce _ _ = []

subtractMatches :: [(String, String)] -> [Player] -> [Player]
subtractMatches matches players = fmap subtractMatch players
  where matchPlayers :: HashSet String
        matchPlayers = fromList (map fst matches ++ map snd matches)
        subtractMatch p
            | (name p) `member` matchPlayers =
                  p { matchLimit = matchLimit p - 1 }
            | otherwise = p

matchPlayers :: (RandomGen g) => g -> [Player] -> [(String, String)]
matchPlayers _ [] = []
matchPlayers _ [p] = []
matchPlayers g players = matches ++ matchPlayers g3 nextPlayers
  where matches = matchOnce (shuffle g1 playerNames) (shuffle g2 playerNames)
        playerNames = fmap name players
        (g', g1) = split g
        (g2, g3) = split g'
        nextPlayers =
            filter ((>0) . matchLimit) (subtractMatches matches players)

iterativeMatchPlayers :: (RandomGen g) => g -> [Player] -> [[(String, String)]]
iterativeMatchPlayers g players = unfoldr f (g, players)
  where f (g, players) = Just (matchPlayers g1 players, (g2, players))
                           where (g1, g2) = split g

main = do
  let n = 100000
  g <- getStdGen
  let playerMap = M.fromList (map (\p -> (name p, p)) players)
  let matchups = take n $ iterativeMatchPlayers g players
  let matchup = maximumBy (compare `on` score playerMap []) matchups
  forM_ matchup $ \(p, q) ->
    putStrLn $ p ++ " vs. " ++ q
  putStrLn $ "Score: " ++ show (score playerMap [] matchup)