Google Code Jam/Train Timetable

import Data.List data City = A | B deriving (Eq,Ord,Show) data Time = Time {time :: Int} deriving (Ord,Eq) instance Show Time where show (Time x) = show (x `div` 60) ++ ":" ++ show (x `mod` 60) data TLoc = TLoc {at :: Time , pos :: City} deriving (Ord,Show,Eq) data Train = Train {started :: City , doing ::TLoc} deriving (Eq,Show) data Tratta = Tratta { from :: TLoc, to :: TLoc} deriving (Ord,Eq) ready :: Tratta -> Train -> Bool ready (Tratta from _) (Train _ doing) = pos from == pos doing && at doing <= at from busy :: [Train] -> Tratta -> [Train] busy ts x = case find (ready x) ts of Nothing -> Train (pos . from $ x) (to x) : ts Just t -> Train (started t) (to x) : delete t ts trains :: [Tratta] -> [Train] trains = foldl' busy [] type Versus = (City,City) parseTratta :: Int -> Versus -> String -> Tratta parseTratta ta (a,b) x = let [t1,t2] = map toMinute . words $ x toMinute (h1:h2:':':m1:[m2]) = read [h1,h2] * 60 + read [m1,m2] in Tratta (TLoc (Time t1) a) (TLoc (Time $ t2 + ta) b) parseCase [] = Nothing parseCase (ta:m:xs) = let [t1,t2] = map read . words $ m (das,xs') = splitAt t1 xs (dbs,xs'') = splitAt t2 xs' pta = parseTratta (read ta) in Just (sort $ map (pta (A,B)) das ++ map (pta (B,A)) dbs,xs'') parseCases :: String -> [[Tratta]] parseCases x = let (n:ts) = lines x in take (read n) . unfoldr parseCase $ ts main = do ts <- parseCases `fmap` getContents flip mapM_ (zip [1..] ts) $ \(i,ns) -> do putStr $ "Case #" ++ show i ++ ": " let (as,bs) = partition ((==A). started) $ trains ns putStrLn $ (show (length as) ++ " " ++ show (length bs))