Round Robin tournament Scheduler

roundRobinTournament.hs

-- round robin based scheduler based on Chris Okasaki's stack Overflow answer

-- the algorithm is as follows assuming you have 6 teams
--  arange them as (clockwise) 
--
--  | 0, 1, 2 | now keep 0 fixed and rotate as such | 0, 5, 1 |
--  | 5, 4, 3 |                                     | 4, 3, 2 |
-- leading to games (0,4), (5,3) and (1,2)
-- rotate again with 0 fixed and you get | 0, 4, 5 | 
--                                       | 3, 2, 1 |
-- which results in (0,3), (4,2), and (5,1)
-- and do this for n-1 (from the start, and in this case n=6 ) times 
--
-- the rotations are modelled as list rotations [1,2,3,4,5] -> [5,1,2,3,4] 
-- the rotations can also be done as [1,2,3,4,5] -> [2,3,4,5,1] (I've done it as such)
-- either way you should get the same answer 


type Game = (Maybe Int, Maybe Int)
type Games = [Game]

gamePrint :: Game -> String
gamePrint (Just a,Just b)    = " Game : " ++ show a ++" Vs "++ show b
gamePrint (Just a, Nothing)  = " No game for "++ show a ++ " this week."
gamePrint (Nothing ,Just a)  = " No game for "++ show a ++ " this week."


-- utilities

rotate :: [a] -> [a]
rotate [] = []
rotate (x:xs) = xs ++ [x]


listOfRotations :: [a] -> Int -> [[a]]
listOfRotations x 2 = [rotate x]
listOfRotations x n = y:(listOfRotations y (n-1))
  where y = rotate x 

makeMatches :: ([a],[a]) -> [(a,a)]
makeMatches (x,y) = zip x $ reverse y

-- Round robin

roundRobinPre :: [a] -> [[a]]
roundRobinPre list@(x:xs) = map ([x]++) . listOfRotations xs $ length list

evenOutList :: [Int] -> [Maybe Int]
evenOutList list = if (even $ length list)
                      then map Just list
                      else (map Just list) ++ [Nothing]


roundRobin :: [Int] -> [Games]
roundRobin list = map mappedFunction $ roundRobinPre . evenOutList $ list
  where mappedFunction list = makeMatches . splitAt (div (length list) 2) $ list
        

-- interaction with the cold cruel real world

printFunction :: Int -> Games -> IO ()
printFunction x y = do
                      putStrLn $ " Week : " ++ (show x)
                      putStrLn "--------------------"
                      mapM_ (print.gamePrint) y
                      putStrLn "\n\n"

main :: IO ()
main = do
  putStrLn " Enter number of Teams : "
  numberOfTeams <- getLine
  let teamNumbers = read numberOfTeams :: Int
      scheduledMatches =  roundRobin $ take teamNumbers [1..]
      roundRobinResults = zip [1..] scheduledMatches
  mapM_ (\(x,y) -> printFunction x y ) roundRobinResults