Hackercup basketball game

BasketballGame.hs

-- Competitions
import Data.Competition

-- List operations
import Data.List

------------------------
-- Type Instance
------------------------

data Player = Player { name :: String, shoot, height :: Int }

instance Eq Player where
  p1 == p2 = (shoot p1 == shoot p2) && (height p1) == (height p2)
instance Ord Player where
  p1 < p2   = if (shoot p1) == (shoot p2) then (height p1) < (height p2) else (shoot p1) < (shoot p2)

instance Show Player where
  show p    = name p

instance Read Player where
  readsPrec _ r = [(Player { name=nm, shoot=s, height=h }, unwords re)]
    where
      (nm:ss:sh:re) = words r
      s = read ss
      h = read sh

data BasketballGame = BasketballGame { players :: [Player], minutes, tmsz :: Int } deriving (Show)

instance Read BasketballGame where
  readsPrec _ s = [readsGame s]

instance Solveable BasketballGame PlayersOnCourt where
  solve g = solveGame g

data PlayersOnCourt = PlayersOnCourt [Player]

instance Show PlayersOnCourt where
  show (PlayersOnCourt a) = intercalate " " (map show a)

------------------------
-- Solve
------------------------

solveGame :: BasketballGame -> PlayersOnCourt
solveGame p = PlayersOnCourt (am ++ bm)
  where
    m = minutes p
    ts = tmsz p
    ps = sort (players p)
    (a, b) = teams ps
    (at, bt) = (reverseAt ts a, reverseAt ts b)
    (am, bm) = (modSlice m ts at, modSlice m ts bt)

-- Slice from a `mod` (length xs) for length b wrapping around xs
modSlice :: Int -> Int -> [a] -> [a]
modSlice a b xs = take b $ drop (a `mod` length xs) (xs ++ xs)

reverseAt :: Int -> [a] -> [a]
reverseAt i xs = (reverse pre) ++ post
  where (pre, post) = splitAt i xs

teams :: [Player] -> ([Player], [Player])
teams ps = (everyOther ps, everyOther $ tail ps)

everyOther :: [a] -> [a]
everyOther xs = unfoldr helper xs
  where
    helper [] = Nothing
    helper [x] = Just (x, [])
    helper (x:_:xss) = Just (x, xss)

------------------------
-- Parser
------------------------

readsGame :: String -> (BasketballGame, String)
readsGame s = (BasketballGame { players = players, minutes = m, tmsz = p }, final)
  where
    ([n,m,p], rest) = readsN 3 s
    (players, final) = readsN n rest
------------------------
-- Main
------------------------

main :: IO [(BasketballGame, PlayersOnCourt)]
main = runCompetition

Competition.hs

module Data.Competition (
  Solveable(..), runCompetition,

  readsN
) where

-- getArgs
import System.Environment

------------------------
-- Type Classes
------------------------

-- Solveable denotes any type that represents a solveable problem
class (Show a) => Solveable p a where
  solve :: p -> a

------------------------
-- Helpers
------------------------

readsN :: Read a => Int -> String -> ([a], String)
readsN n s = fst $ foldr readsNHelper (([], s), True) [1..n]

readsNHelper :: Read a => Int -> (([a],String),Bool) -> (([a],String),Bool)
readsNHelper _ (pair, False) = (pair, False)
readsNHelper _ ((xs, r), True) = case readsPrec 1 r of
  [] -> ((xs, r), False)
  [(x, t)] -> ((x:xs, t), True)

------------------------
-- Main and IO
------------------------

runCompetition :: (Solveable p a, Read p, Show p) => IO [(p, a)]
runCompetition = do
  [inputFn, outputFn] <- getArgs
  problems <- fmap readAll $ readFile inputFn
  answers <- return $ map solve problems
  writeOutput outputFn answers
  return $ zip problems answers

readAll :: Read a => String -> [a]
readAll s = fst $ readsN n probs
  where
    ([n], probs) = readsN 1 s


writeOutput :: Show a => String -> [a] -> IO ()
writeOutput outputFn ans = do
  output <- return $ (unlines . caseify) ans
  putStr output
  --writeFile outputFn output

------------------------
-- Helpers
------------------------

caseify :: Show a => [a] -> [String]
caseify as = map (\(i,a) -> "Case #" ++ (show i) ++ ": " ++ (show a)) (zip [1..] as)

dropProblemCount :: String -> String
dropProblemCount = (unlines . tail . lines)