You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
44 lines
1.5 KiB
44 lines
1.5 KiB
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
module Worldcup.Tourneys (Tourneys, Tourney(..), buildTourneys) where
|
|
|
|
import Data.Aeson
|
|
import Data.HashMap.Strict as HM
|
|
import Prelude as P
|
|
import Worldcup.Events
|
|
import Worldcup.EventsTeams
|
|
import Worldcup.Games
|
|
import Worldcup.Rounds
|
|
|
|
type Tourneys = HashMap String Tourney
|
|
|
|
data Tourney = Tourney {
|
|
tourneyGames :: [Game],
|
|
tourneyTeams :: [Int] } deriving (Show)
|
|
|
|
instance ToJSON Tourney where
|
|
toJSON Tourney{..} = object [ "games" .= tourneyGames, "teams" .= tourneyTeams ]
|
|
|
|
roundIsInEvent :: Int -> Int -> Rounds -> Bool
|
|
roundIsInEvent eid rid rs = roundEventId getRound == eid where
|
|
getRound = lookupRound rid rs
|
|
|
|
teamIdsFromEventId :: Int -> [EventTeam] -> [Int]
|
|
teamIdsFromEventId eid = foldl reducer [] where
|
|
reducer acc x
|
|
| eventsTeamsEventId x == eid = eventsTeamsTeamId x : acc
|
|
| otherwise = acc
|
|
|
|
gamesFromEventId :: Int -> Rounds -> [Game] -> [Game]
|
|
gamesFromEventId eid rs = foldl reducer [] where
|
|
reducer acc x
|
|
| roundIsInEvent eid (gameRoundId x) rs = x : acc
|
|
| otherwise = acc
|
|
|
|
buildTourneys :: Rounds -> [EventTeam] -> [Game] -> [Event] -> Tourneys
|
|
buildTourneys rs ets gs = foldl reducer HM.empty where
|
|
reducer acc x = HM.insert (getEvent x) (Tourney (getGames x) (getTeams x)) acc
|
|
getGames x = gamesFromEventId (eventId x) rs gs
|
|
getTeams x = teamIdsFromEventId (eventId x) ets
|
|
getEvent x = drop 6 (eventName x)
|
|
|