MONAAAADS.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where


type Inventory = (Game, Int)
type UserRank = (User, (Game, Int))



unwrapPair :: Monad m => (a, m b) -> m (a, b)
unwrapPair (a, mb) = do b <- mb
                        return (a, b)


updateWith :: (Eq a, Eq b) => [(a, b)] -> (b -> Maybe b) -> a -> [(a, b)]
updateWith set update key =
    case lookup key set of
      Just b -> replace set
                        (unwrapPair (key, update b))
                        (fromMaybe 0 $ elemIndex (key, b) set)
      Nothing -> set
  where replace :: [a] -> Maybe a -> Int -> [a]
        replace [] _ _ = []
        replace (_:xs) (Just val) 0 = val:xs
        replace (_:xs) Nothing 0 = xs
        replace (x:xs) val i = x : (replace xs val $ i - 1)

allocateGames :: [Game] -> [UserRank] -> [(User, Game)]
allocateGames games rank = snd
                         . runWriter
                         . runStateT (allocateGamesImpl rank)
                         $ buildQuotas games

allocateGamesImpl :: [UserRank] -> StateT [Inventory] (Writer [(User, Game)]) ()
allocateGamesImpl [] = return ()
allocateGamesImpl ((user, (game, _)):ranks) =
    do tell [(user, game)]
       inventory' <- get
       put $ updateWith inventory' (\i -> if i <= 0 
                                          then Nothing 
                                          else Just $ i - 1) game
       allocateGamesImpl $ filter ((/= user) . fst) ranks


main :: IO ()
main =
    do games <- csvToGames <$> readFile "games.csv"
       ranked <- getRanked <$> readFile "ranked.csv"

       let rankings = showTrace $ allocateGames games ranked

       mapM_ (
           mapM_ (
               \(u, g) -> putStrLn . show $ (username u, gameName g))) rankings