{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Game.Tournament
-- Copyright   :  (c) Eirik Albrigtsen 2012
-- License     :  MIT
-- Maintainer  :  Eirik <clux> Albrigtsen
-- Stability   :  unstable
--
-- Tournament construction and maintenance including competition based structures and helpers.
--
-- This library is intended to be imported qualified as it exports functions that clash with
-- Prelude.
--
-- > import Game.Tournament as T
--
-- The Tournament structure contain a Map of 'GameId' -> 'Game' for its internal
-- representation and the 'GameId' keys are the location in the Tournament.
--
-- Duel tournaments are based on the theory from <http://clux.org/entries/view/2407>.
-- By using the seeding definitions listed there, there is almost only one way to
-- generate a tournament, and the ambivalence appears only in Double elimination.
--
-- We have additionally chosen that brackets should converge by having the losers bracket move upwards.
-- This is not necessary, but improves the visual layout when presented in a standard way.
--
-- FFA tournaments use a collection of sensible assumptions on how to
-- optimally split n people into s groups while minimizing the sum of seeds difference
-- between groups for fairness. At the end of each round, groups are recalculated from the scores
-- of the winners, and new groups are created for the next round.

-- TODO: This structure is meant to encapsulate this structure to ensure internal consistency,
-- but hopefully in such a way it can be safely serialized to DBs.
-----------------------------------------------------------------------------

module Game.Tournament (
   -- * Building Block A: Duel helpers
     seeds
   , duelExpected

   -- * Building Block B: Group helpers
   , groups
   , robin

   -- * Tournament Types
   , GameId(..)
   , Elimination(..)
   , Bracket(..)
   , Rules(..)
   , Results -- type synonym
   , results

   , Result  -- no constructor, but accessors:
   , player
   , placement
   , wins
   , total

   , Size

   , Tournament -- no constructor
   , Score

   , GroupSize
   , Advancers

   --, Game(..)
   --, Player

   --, Games

   -- * Tournament Interface
   , tournament
   , score
   , count
   , scorable
   , keys

   -- -* Match Inspection
   --, scores
   --, winner
   --, loser

   , testcase
) where

import Prelude hiding (round)
import Numeric (showIntAtBase, readInt)
import Data.Char (intToDigit, digitToInt)
import Data.List (sort, sortBy, group, groupBy, genericTake, zipWith4)
import Data.Ord (comparing)
import Data.Function (on)
import Data.Bits (shiftL)
import Data.Maybe (fromJust, isJust, fromMaybe)
import qualified Data.Map.Lazy as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Control.Arrow ((&&&), second)
import Control.Monad (when)
import Control.Monad.State (State, get, put, modify, execState, gets)
--import System.IO.Unsafe (unsafePerformIO) -- while developing

-- -----------------------------------------------------------------------------
-- TODO should somehow ensure 0 < i <= 2^(p-1) in the next fn

-- | Power of a tournament.
-- It's defined as 2^num_players rounded up to nearest power of 2.
--type Power = Int

--type GameNumber = Int
-- TODO: use int synonyms more liberally?


-- | Computes both the upper and lower player seeds for a duel elimiation match.
-- The first argument is the power of the tournament:
--
-- p :: 2^num_players rounding up to nearest power of 2
--
-- The second parameter is the game number i (in round one).
--
-- The pair (p,i) must obey
--
-- >p > 0 && 0 < i <= 2^(p-1).
seeds :: Int -> Int -> (Int, Int)
seeds p i
  | p > 0, i > 0, i <= 2^(p-1) = (1 - lastSeed + 2^p, lastSeed)
  | otherwise = error "seeds called outside well defined power game region"
  where
    lastSeed = let (k, r) = ((floor . logBase 2 . fromIntegral) i, i - 2^k) in
      case r of
        0 -> 2^(p-k)
        _ -> 2^(p-k-1) + nr `shiftL` (p - length bstr) where
          bstr = reverse $ showIntAtBase 2 intToDigit (i - 2*r) ""
          nr = fst $ head $ readInt 2 (`elem` "01") digitToInt bstr


-- | Check if the 3 criteria for perfect seeding holds for the current
-- power and seed pair arguments.
-- This can be used to make a measure of how good the seeding was in retrospect
duelExpected :: Integral a => a -> (a, a) -> Bool
duelExpected p (a, b) = odd a && even b && a + b == 1 + 2^p

-- -----------------------------------------------------------------------------
-- Group helpers
--type Group = [Int]

-- | Splits a numer of players into groups of as close to equal seeding sum
-- as possible. When groupsize is even and s | n, the seed sum is constant.
-- Fixes the number of groups as ceil $ n / s, but will reduce s when all groups not full.
groups :: Int -> Int -> [[Int]]
groups 0 _ = []
groups s n = map (sort . filter (<=n) . makeGroup) [1..ngrps] where
  ngrps = ceiling $ fromIntegral n / fromIntegral s

  -- find largest 0<gs<=s s.t. even distribution => at least one full group, i.e. gs*ngrps - n < ngrps
  gs = until ((< ngrps + n) . (*ngrps)) (subtract 1) s

  modl = ngrps*gs -- modl may be bigger than n, e.e. groups 4 10 has a 12 model
  npairs = ngrps * (gs `div` 2)
  pairs = zip [1..npairs] [modl, modl-1..]
  leftovers = [npairs+1, npairs+2 .. modl-npairs] -- [1..modl] \\ e in pairs
  makeGroup i = leftover ++ concatMap (\(x,y) -> [x,y]) gpairs where
    gpairs = filter ((`elem` [i, i+ngrps .. i+npairs]) . fst) pairs
    leftover = take 1 . drop (i-1) $ leftovers

-- | Round robin schedules a list of n players and returns
-- a list of rounds (where a round is a list of pairs). Uses
-- http://en.wikipedia.org/wiki/Round-robin_tournament#Scheduling_algorithm
robin :: Integral a => a -> [[(a,a)]]
robin n = map (filter notDummy . toPairs) rounds where
  n' = if odd n then n+1 else n
  m = n' `div` 2 -- matches per round
  permute (x:xs@(_:_)) = x : last xs : init xs
  permute xs = xs -- not necessary, wont be called on length 1/2 lists
  rounds = genericTake (n'-1) $ iterate permute [1..n']
  notDummy (x,y) = all (<=n) [x,y]
  toPairs x =  genericTake m $ zip x (reverse x)

-- -----------------------------------------------------------------------------
-- Duel elimination

-- | The location of a game is written as to simulate the classical shorthand WBR2,
-- but includes additionally the game number for complete positional uniqueness.
--
-- A 'Single' elimination final will have the unique identifier
--
-- > let wbf = GameId WB p 1
--
-- where 'p == count t WB'.
data GameId = GameId {
  bracket :: Bracket
, round   :: Int
, game    :: Int
} deriving (Show, Eq, Ord)

-- | Duel Tournament option.
--
-- 'Single' elimation is a standard power of 2 tournament tree,
-- wheras 'Double' elimination grants each loser a second chance in the lower bracket.
data Elimination = Single | Double deriving (Show, Eq, Ord)

-- | The bracket location of a game.
--
-- For 'Duel' 'Single' or 'FFA', most matches exist in  the winners bracket ('WB')
-- , with the exception of the bronze final and possible crossover matches.
--
-- 'Duel' 'Double' or 'FFA' with crossovers will have extra matches in the loser bracket ('LB').
data Bracket = WB | LB deriving (Show, Eq, Ord)

-- | Players and Results zip to the correct association list.
-- 'scores' will obtain this ordered association list safely.
data Game = Game {
  players :: [Player]
, result  :: Maybe [Score]
} deriving (Show, Eq)

type Games = Map GameId Game

-- | 'score' clarification types.
type Position = Int
type Score = Int
type Player = Int
type Seed = Int

-- | Record of each player's accomplishments in the current tournament.
data Result = Result {
  -- | Player associated with the record.
  player    :: Int
  -- | Placement of the player associated with this record.
, placement :: Int
  -- | Number of games the player associated with this record won.
, wins      :: Int
  -- | Sum of scores for the games the associated player played.
, total     :: Int
} deriving (Show)

-- | Results in descending order of placement.
--
-- Only constructed by 'score' once the last game was played.
type Results = [Result]

type GroupSize = Int
type Advancers = Int

data Rules = FFA GroupSize Advancers | Duel Elimination
type Size = Int

data Tournament = Tourney {
  size      :: Size
, crossover :: Bool
, rules     :: Rules
, games     :: Games
, results   :: Maybe Results
}

-- Internal helpers
gameZip :: Game -> [(Player, Score)]
gameZip m = zip (players m) (fromJust (result m))
gameSort :: [(Player, Score)] -> [(Player, Score)]
gameSort = reverse . sortBy (comparing snd)

-- | Sorted player identifier list by scores.
--
-- If this is called on an unscored match a (finite) list zeroes is returned.
-- This is consistent with the internal representation of placeholders in Matches.
scores :: Game -> [Player]
scores g@(Game pls msc)
  | Just _ <- msc = map fst . gameSort . gameZip $ g
  | otherwise = replicate (length pls) 0

-- | The first and last elements from scores.
winner, loser :: Game -> Player
winner = head . scores
loser = last . scores

-- Duel specific helper
pow :: Int -> Int
pow = ceiling . logBase 2 . fromIntegral


-- | Count the number of rounds in a given bracket in a Tournament.
-- TODO: rename to length once it has been less awkwardly moved into an internal part
count :: Tournament -> Bracket -> Int
count Tourney { rules = Duel Single, size = np } br = if br == WB then pow np else 0 -- 1 with bronze
count Tourney { rules = Duel Double, size = np } br = (if br == WB then 1 else 2) * pow np
count Tourney { rules = FFA _ _, games = ms } WB = round . fst . Map.findMax $ ms
count Tourney { rules = FFA _ _} LB = 0

-- Scoring and construction helper
woScores :: [Player] -> Maybe [Score]
woScores ps
  | 0 `notElem` ps && -1 `elem` ps = Just $ map (\x -> if x == -1 then 0 else 1) ps
  | otherwise = Nothing

-- | Get the list of all GameIds in a Tournament.
-- This list is also ordered by GameId's Ord, and in fact,
-- if the corresponding games were scored in this order, the tournament would finish,
-- and scorable would only return False for a few special walkover games.
-- TODO: if introducing crossovers, this would not be true for LB crossovers
-- => need to place them in WB in an 'interim round'
keys :: Tournament -> [GameId]
keys = Map.keys . games

-- | Create match shells for an FFA elimination tournament.
-- Result comes pre-filled in with either top advancers or advancers `intersect` seedList.
-- This means what the player numbers represent is only fixed per round.
-- TODO: Either String Tournament as return for intelligent error handling
tournament :: Rules -> Size -> Tournament
tournament rs@(FFA gs adv) np
  -- Enforce >2 players, >2 players per match, and >1 group needed.
  -- Not technically limiting, but: gs 2 <=> duel and 1 group <=> best of one.
  | np <= 2 = error "Need >2 players for an FFA elimination"
  | gs <= 2 = error "Need >2 players per match for an FFA elimination"
  | np <= gs = error "Need >1 group for an FFA elimination"
  | adv >= gs = error "Need to eliminate at least one player a match in FFA elimination"
  | adv <= 0 = error "Need >0 players to advance per match in a FFA elimination"
  | otherwise =
    --TODO: allow crossover matches when there are gaps intelligently..
    let minsize = minimum . map length
        hideSeeds = map $ map $ const 0
        nextGroup g = hideSeeds . groups gs $ leftover where
          -- force zero non-eliminating matches unless only 1 left
          advm = max 1 $ adv - (gs - minsize g)
          leftover = length g * advm

        playoffs = takeWhile ((>1) . length) . iterate nextGroup . groups gs $ np
        final = nextGroup $ last playoffs
        grps = playoffs ++ [final]

        -- finally convert raw group lists to matches
        makeRound grp r = zipWith makeMatch grp [1..] where
          makeMatch g i = (GameId WB r i, Game g Nothing)

        ms = Map.fromList . concat $ zipWith makeRound grps [1..]
    in Tourney { size = np, rules = rs, games = ms, results = Nothing, crossover = False }


-- | Create match shells for an elimination tournament
-- hangles walkovers and leaves the tournament in a stable initial state
tournament rs@(Duel e) np
  -- Enforce minimum 4 players for a tournament. It is possible to extend to 2 and 3, but:
  -- 3p uses a 4p model with one WO => == RRobin in Double, == Unfair in Single
  -- 2p Single == 1 best of 1 match, 2p Double == 1 best of 3 match
  -- and grand final rules fail when LB final is R1 (p=1) as GF is then 2*p-1 == 1 ↯
  | np < 4 = error "Need >=4 competitors for an elimination tournament"
  | otherwise = Tourney { size = np, rules = rs, games = ms, results = Nothing, crossover = True} where
    p = pow np

    -- complete WBR1 by filling in -1 as WO markers for missing (np'-np) players
    markWO (x, y) = map (\a -> if a <= np then a else -1) [x,y]
    makeWbR1 i = (l, Game pl (woScores pl)) where
      l = GameId WB 1 i
      pl = markWO $ seeds p i

    -- make WBR2 and LBR1 shells by using the paired WBR1 results to propagate winners/WO markers
    propagateWbR1 br ((_, m1), (l2, m2)) = (l, Game pl (woScores pl)) where
      (l, pl)
        | br == WB = (GameId WB 2 g, map winner [m1, m2])
        | br == LB = (GameId LB 1 g, map loser [m1, m2])
      g = game l2 `div` 2

    -- make LBR2 shells by using LBR1 results to propagate WO markers if 2x
    makeLbR2 (l1, m1) = (l, Game pl Nothing) where
      l = GameId LB 2 $ game l1
      plw = winner m1
      pl = if odd (game l1) then [0, plw] else [plw, 0]

    -- construct (possibly) non-empty rounds
    wbr1 = map makeWbR1 [1..2^(p-1)]
    wbr1pairs = take (2^(p-2))
      $ filter (even . game . fst . snd) $ zip wbr1 (tail wbr1)
    wbr2 = map (propagateWbR1 WB) wbr1pairs
    lbr1 = map (propagateWbR1 LB) wbr1pairs
    lbr2 = map makeLbR2 lbr1

    -- construct (definitely) empty rounds
    wbRest = concatMap makeRound [3..p] where
      makeRound r = map (GameId WB r) [1..2^(p-r)]
      --bfm = MID LB (R 1) (G 1) -- bronze final here, exception

    lbRest = map gfms [2*p-1, 2*p] ++ concatMap makeRound [3..2*p-2] where
      makeRound r = map (GameId LB r) [1..(2^) $ p - 1 - (r+1) `div` 2]
      gfms r = GameId LB r 1

    toMap = Map.fromSet (const (Game [0,0] Nothing)) . Set.fromList

    -- finally, union the mappified brackets
    wb = Map.union (toMap wbRest) $ Map.fromList $ wbr1 ++ wbr2
    lb = Map.union (toMap lbRest) $ Map.fromList $ lbr1 ++ lbr2
    ms = if e == Single then wb else wb `Map.union` lb


-- | Helper to create the tie-correct Player -> Position association list.
-- Requires a Round -> Position function to do the heavy lifting where possible,
-- the final Game and Maybe bronzefinal to not take out
-- the list of games prefiltered away non-final bracket and final games.
-- result zips with Player == [1..]
placementSort :: Game -> Maybe Game -> (Int -> Position) -> Games -> [Position]
placementSort fg bf toPlacement = map snd . sortBy (comparing fst)
  . prependTop 1 (Just fg)
  . prependTop (((+1) . length . players) fg) bf
  . excludeTop
  . map (second toPlacement . (fst . head &&& foldr (max . snd) 1))
  . groupBy ((==) `on` fst)
  . sortBy (comparing fst)
  . Map.foldrWithKey rfold []
  where
    pls = if isJust bf then concatMap players [fg, fromJust bf] else players fg
    rfold (GameId _ r _) m acc = (++ acc) . map (id &&& const r) $ players m

    prependTop :: Int -> Maybe Game -> [(Position, Player)] -> [(Position, Player)]
    prependTop strt g
      | isJust g = (++) . flip zip [strt..] . map fst . gameSort . gameZip . fromJust $ g
      | otherwise = id
    excludeTop :: [(Position, Player)] -> [(Position, Player)]
    excludeTop = filter ((`notElem` pls) . fst)

-- zips with Player == [1..]
sumScores :: Games -> [Score]
sumScores = map (foldr ((+) . snd) 0)
  . groupBy ((==) `on` fst)
  . sortBy (comparing fst)
  . Map.foldr ((++) . gameZip) []

-- zips with Player == [1..]
getWins :: Int -> Games -> [Int]
getWins np = map (subtract 1 . length) -- started out with one of each so we can count zeroes
  . group . sort
  . Map.foldr ((:) . winner) [1..np]

zipResults :: [Int] -> [Int] -> [Int] -> [Result]
zipResults a b = sortBy (comparing placement) . zipWith4 Result [1..] a b

makeResults :: Tournament -> Games -> Maybe Results
makeResults (Tourney {rules = Duel e, size = np}) ms
  | e == Single
  , Just wbf@(Game _ (Just _)) <- Map.lookup (GameId WB p 1) ms -- final played
  -- bf lookup here if included!
  = Just . scorify $ wbf

  | e == Double
  , Just gf1@(Game _ (Just gf1sc)) <- Map.lookup (GameId LB (2*p-1) 1) ms -- gf1 played
  , Just gf2@(Game _ gf2sc) <- Map.lookup (GameId LB (2*p) 1) ms  -- gf2 maybe played
  , isJust gf2sc || maximum gf1sc == head gf1sc -- gf2 played || gf1 conclusive
  = Just . scorify $ if isJust gf2sc then gf2 else gf1

  | otherwise = Nothing

  where
    p = pow np
    maxRnd = if e == Single then p else 2*p-1

    -- maps (last bracket's) maxround to the tie-placement
    toPlacement :: Elimination -> Int -> Position
    toPlacement Double maxlbr = if metric <= 4 then metric else 2^(k+1) + 1 + oddExtra where
      metric = 2*p + 1 - maxlbr
      r = metric - 4
      k = (r+1) `div` 2
      oddExtra = if odd r then 0 else 2^k
    toPlacement Single maxr = if metric <= 1 then metric else 2^r + 1 where
      metric = p+1 - maxr
      r = metric - 1

    scorify :: Game -> Results
    scorify f = zipResults placements (getWins np ms) (sumScores msnwo) where
      -- all pipelines start with this. 0 should not exist, -1 => winner got further
      -- scores not Just => should not have gotten this far by guard in score fn
      msnwo = Map.filter (all (>0) . players) ms

      placements = placementSort f Nothing (toPlacement e)
        . Map.filterWithKey lastBracketNotFinal $ msnwo

      lastBracketNotFinal k _ = round k < maxRnd && lastBracket (bracket k)
      lastBracket br = (e == Single && br == WB) || (e == Double && br == LB)


makeResults (Tourney {rules = FFA _ _, size = np}) ms
  | (GameId _ maxRnd _, f@(Game _ (Just _))) <- Map.findMax ms
  = Just $ scorify maxRnd f

  | otherwise = Nothing
  where
    -- rsizes :: [(RoundNr, NumPlayers)] lookup helper for toPlacement
    rsizes = map (fst . head &&& foldr ((+) . snd) 0)
      . groupBy ((==) `on` fst)
      . sortBy (comparing fst)
      . Map.foldrWithKey rsizerf [] $ ms
      where
        rsizerf gid g acc = (round gid, (length . players) g) : acc

    -- maps a player's maxround to the tie-placement (called for r < maxRnd)
    -- simplistic :: 1 + number of people who got through to next round
    toPlacement :: Int -> Position
    toPlacement maxrp = (1+) . fromJust . lookup (maxrp + 1) $ rsizes

    scorify :: Int -> Game -> Results
    scorify maxRnd f = zipResults placements (getWins np ms) (sumScores ms) where
      -- NB: WO markers or placeholders should NOT exist when scorify called!

      -- placements using common helper, having prefiltered final game(round)
      placements = placementSort f Nothing toPlacement
        . Map.filterWithKey (\k _ -> round k < maxRnd) $ ms


playersReady :: GameId -> Tournament -> Maybe [Player]
playersReady gid t
  | Just (Game pls _) <- Map.lookup gid $ games t
  , all (>0) pls
  = Just pls
  | otherwise = Nothing

-- | Check if a GameId exists and is ready to be scored through 'score'.
scorable :: GameId -> Tournament -> Bool
scorable gid = isJust . playersReady gid

-- | Checks if a GameId is 'scorable' and it will not propagate to an already scored Game.
-- Guarding Tournament updates with this ensures it is never in an inconsistent state.
-- TODO: really needs access to mRight, mDown (if duel) to ensure they exist
-- TODO: if FFA only allow scoring if NO matches in the next round have been scored
safeScorable :: GameId -> Tournament -> Bool
safeScorable = undefined

-- | Score a match in a tournament and propagate winners/losers.
-- If match is not 'scorable', the Tournament will pass through unchanged.
--
-- For a Duel tournament, winners (and losers if Double) are propagated immediately,
-- wheras FFA tournaments calculate winners at the end of the round (when all games played).
--
-- There is no limitation on re-scoring old games, so care must be taken to not update too far
-- back ones and leaving the tournament in an inconsistent state. When scoring games more than one
-- round behind the corresponding active round, the locations to which these propagate must
-- be updated manually.
--
-- To prevent yourself from never scoring older matches, only score games for which
-- 'safeScorable' returns True. Though this has not been implemented yet.
--
-- > gid = (GameId WB 2 1)
-- > tUpdated = if safeScorable gid then score gid [1,0] t else t
--
-- TODO: strictify this function
-- TODO: better to do a scoreSafe? // call this scoreUnsafe
score :: GameId -> [Score] -> Tournament -> Tournament
score gid sc trn@(Tourney { rules = r, size = np, games = ms })
  | Duel e <- r
  , Just pls <- playersReady gid trn
  , length sc == 2
  = let msUpd = execState (scoreDuel (pow np) e gid sc pls) ms
        rsUpd = makeResults trn msUpd
    in trn { games = msUpd, results = rsUpd }

  | FFA s adv <- r
  , Just pls <- playersReady gid trn
  , length sc == length pls
  = let msUpd = execState (scoreFFA s adv gid sc pls) ms
        rsUpd = makeResults trn msUpd
    in trn { games = msUpd, results = rsUpd }

  -- somewhat less ideally, if length sc /= length pls this now also fails silently even if socable passes
  | otherwise = trn


scoreFFA :: GroupSize -> Advancers -> GameId -> [Score] -> [Player] -> State Games ()
scoreFFA gs adv gid@(GameId _ r _) scrs pls = do
  -- 1. score given game
  let m = Game pls $ Just scrs
  modify $ Map.adjust (const m) gid

  -- 2. if end of round, fill in next round
  currRnd <- gets $ Map.elems . Map.filterWithKey (const . (==r) . round)
  when (all (isJust . result) currRnd) $ do
    -- find the number of players we need in next round
    numNext <- gets $ Map.foldr ((+) . length . players) 0
                    . Map.filterWithKey (const . (==r+1) . round)
    -- recreate next round by using last round results as new seeding
    -- update next round by overwriting duplicate keys in next round
    modify $ flip (Map.unionWith (flip const)) $ makeRnd currRnd numNext
    return ()

  where
    -- make round (r+1) from the games in round r and the top n to take
    makeRnd :: [Game] -> Size -> Games
    makeRnd gms = Map.fromList . nextGames . grpMap (seedAssoc False gms) . groups gs

    -- This sorts all players by overall scores (to help pick best crossover candidates)
    -- Or, if !takeAll, sort normally by only including the advancers from each game.
    seedAssoc :: Bool -> [Game] -> [(Seed, Player)]
    seedAssoc takeAll rnd
      | takeAll   = seedify . concatMap gameZip $ rnd
      | otherwise = seedify . concatMap (take (rndAdv rnd) . gameSort . gameZip) $ rnd
        where
          -- Find out how many to keep from each round before sorting overall
          rndAdv :: [Game] -> Advancers
          rndAdv = max 1 . (adv - gs +) . minimum . map (length . players)

          seedify :: [(Player, Score)] -> [(Seed, Player)]
          seedify = zip [1..] . map fst . gameSort

    grpMap :: [(Seed, Player)] -> [[Seed]] -> [[Player]]
    grpMap assoc = map . map $ fromJust . flip lookup assoc

    nextGames :: [[Player]] -> [(GameId, Game)]
    nextGames = zipWith (\i g -> (GameId WB (r+1) i, Game g Nothing)) [1..]

scoreDuel :: Int -> Elimination -> GameId -> [Score] -> [Player] -> State Games (Maybe Game)
scoreDuel p e gid scrs pls = do
  -- 1. score given game
  let m = Game pls $ Just scrs
  modify $ Map.adjust (const m) gid

  -- 2. move winner right
  let nprog = mRight True p gid
  nres <- playerInsert nprog $ winner m

  -- 3. move loser to down if we were in winners
  let dprog = mDown p gid
  dres <- playerInsert dprog $ loser m

  -- 4. check if loser needs WO from LBR1
  let dprog2 = woCheck p dprog dres
  uncurry playerInsert $ fromMaybe (Nothing, 0) dprog2

  -- 5. check if winner needs WO from LBR2
  let nprog2 = woCheck p nprog nres
  uncurry playerInsert $ fromMaybe (Nothing, 0) nprog2

  return Nothing
  where
    -- insert player x into list index idx of mid's players, and woScore it
    -- progress result determines location and must be passed in as fst arg
    playerInsert :: Maybe (GameId, Position) -> Player -> State Games (Maybe Game)
    playerInsert Nothing _ = return Nothing
    playerInsert (Just (gid, idx)) x = do
      tmap <- get
      let (updated, tupd) = Map.updateLookupWithKey updFn gid tmap
      put tupd
      return updated
        where updFn _ (Game plsi _) = Just $ Game plsm (woScores plsm) where
                plsm = if idx == 0 then [x, last plsi] else [head plsi, x]

    -- given tourney power, progress results, and insert results, of previous
    -- if it was woScored in playerInsert, produce new (progress, winner) pair
    woCheck :: Player
            -> Maybe (GameId, Position)
            -> Maybe Game
            -> Maybe (Maybe (GameId, Position), Player)
    woCheck p (Just (gid, _)) (Just mg)
      | w <- winner mg, w > 0 = Just (mRight False p gid, w)
      | otherwise = Nothing
    woCheck _ _ _ = Nothing

    -- right progress fn: winner moves right to (GameId, Position)
    mRight :: Bool -> Int -> GameId -> Maybe (GameId, Position)
    mRight gf2Check p (GameId br r g)
      | r < 1 || g < 1 = error "bad GameId"
      -- Nothing if last Game. NB: WB ends 1 round faster depending on e
      | r >= 2*p || (br == WB && (r > p || (e == Single && r == p))) = Nothing
      | br == LB  = Just (GameId LB (r+1) ghalf, pos)   -- standard LB progression
      | r == 2*p-1 && br == LB && gf2Check && maximum scrs == head scrs = Nothing
      | r == p    = Just (GameId LB (2*p-1) ghalf, 0)   -- WB winner -> GF1 path
      | otherwise = Just (GameId WB (r+1) ghalf, pos)   -- standard WB progression
        where
          ghalf = if br == LB && odd r then g else (g+1) `div` 2
          pos
            | br == WB = if odd g then 0 else 1         -- WB maintains standard alignment
            | r == 2*p-2 = 1                            -- LB final winner => bottom of GF
            | r == 2*p-1 = 0                            -- GF(1) winnner moves to the top [semantic]
            | r > 1 && odd r = 1                        -- winner usually takes the bottom position
            | r == 1 = if odd g then 1 else 0           -- first rounds sometimes goto bottom
            | otherwise = if odd g then 0 else 1        -- normal progression only in even rounds + R1
            -- by placing winner on bottom consistently in odd rounds the bracket moves upward each new refill
            -- the GF(1) and LB final are special cases that give opposite results to the advanced rule above

    -- down progress fn : loser moves down to (GameId, Position)
    mDown :: Int -> GameId -> Maybe (GameId, Position)
    mDown p (GameId br r g)
      | e == Single = Nothing
      -- or case for bf: | e == Single && r == p-1 = Just (MID LB (R 1) (G 1), if odd g then 0 else 1)
      | r == 2*p-1 = Just (GameId LB (2*p) 1, 1) -- GF(1) loser moves to the bottom
      | br == LB || r > p = Nothing
      | r == 1    = Just (GameId LB 1 ghalf, pos)     -- WBR1 -> r=1 g/2 (LBR1 only gets input from WB)
      | otherwise = Just (GameId LB ((r-1)*2) g, pos) -- WBRr -> 2x as late per round in WB
        where
          ghalf = (g+1) `div` 2
          -- drop on top >R2, and <=2 for odd g to match bracket movement
          pos = if r > 2 || odd g then 0 else 1


-- testing stuff
upd :: [Score] -> GameId -> State Tournament ()
upd sc id = do
  t <- get
  put $ score id sc t
  return ()

manipDuel :: [GameId] -> State Tournament ()
manipDuel = mapM_ (upd [1,0])

manipFFA :: State Tournament ()
manipFFA = do
  upd [1,2,3,4] $ GameId WB 1 1
  upd [5,3,2,1] $ GameId WB 1 2
  upd [2,4,2,1] $ GameId WB 1 3
  upd [6,3,2,1] $ GameId WB 1 4

  upd [1,2,3,4] $ GameId WB 2 1

testor :: Tournament -> IO ()
testor Tourney { games = ms, results = rs } = do
  mapM_ print $ Map.assocs ms
  maybe (print "no results") (mapM_ print) rs

testcase :: IO ()
testcase = do
  let t = tournament (Duel Double) 8
  testor $ execState (manipDuel (keys t)) t

  --let t = tournament (FFA 4 1) 16
  --testor $ execState manipFFA t


-- | Checks if a Tournament is valid
{-
PERHAPS BETTER:
WB: always has np (rounded to nearest power) - 1 matches -- i.e. np = 2^p some p > 1
LB: always has 2*[num_wb_matches - 2^(p-1) + 1] -- i.e. minus the first round's matches but plus two finals
tournamentValid :: Tournament -> Bool
tournamentValid t =
  let (wb, lb) = partition ((== WB) . brac . locId) r
      roundRightWb k = rightSize && uniquePlayers where
        rightSize = 2^(p-k) == length $ filter ((== k) . rnd . locId) wb
        uniquePlayers =
      rountRightLb k = rightSize && uniquePlayers where
        rightSize = 2^(p - 1 - (k+1) `div` 2) == length $ filter ((== k) . rnd . locId) lb

  in all $ map roundRightWb [1..2^p]
-}