From 41ddeb6fc974fee85a1a08e994088224e0757189 Mon Sep 17 00:00:00 2001 From: Ben Burlingham Date: Fri, 21 Oct 2016 19:45:43 -0700 Subject: [PATCH] Tourney structure complete. --- Worldcup/Events.hs | 19 +++------ Worldcup/EventsTeams.hs | 10 +++-- Worldcup/Games.hs | 53 +++++++++++++++--------- Worldcup/Tourneys.hs | 45 +++++++++++++++++++++ worldcup.hs | 89 ++++++++++++++++++----------------------- 5 files changed, 129 insertions(+), 87 deletions(-) create mode 100644 Worldcup/Tourneys.hs diff --git a/Worldcup/Events.hs b/Worldcup/Events.hs index 6bb9b23..ecbfe91 100644 --- a/Worldcup/Events.hs +++ b/Worldcup/Events.hs @@ -1,15 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Worldcup.Events (Events, Event(..), parseEvents, lookupEvent) where +module Worldcup.Events (Event(..), parseEvents) where import Data.Aeson -import Data.Aeson.Types as AET -import Data.HashMap.Strict as HM -import Data.Maybe as M -import Prelude as P - -type Events = HashMap Int Event +import Data.Aeson.Types as AET +import Prelude as P data Event = Event { eventId :: Int, @@ -21,12 +17,9 @@ instance FromJSON Event where eventName <- o .: "key" return Event{..} -lookupEvent :: Int -> Events -> Event -lookupEvent _id es = M.fromMaybe (Event 999 "DNE") (HM.lookup _id es) - -parseEvents :: Either String [Value] -> Events +parseEvents :: Either String [Value] -> [Event] parseEvents (Left x) = error x -parseEvents (Right xs) = P.foldl reduce HM.empty xs where +parseEvents (Right xs) = P.foldl reduce [] xs where reduce acc x = case (parseEither parseJSON x :: Either String Event) of (Left s) -> error s - (Right v) -> HM.insert (eventId v) v acc + (Right v) -> v : acc diff --git a/Worldcup/EventsTeams.hs b/Worldcup/EventsTeams.hs index 7349b33..03d56e5 100644 --- a/Worldcup/EventsTeams.hs +++ b/Worldcup/EventsTeams.hs @@ -8,16 +8,18 @@ import Data.Aeson.Types import Prelude as P data EventTeam = EventTeam { - eventTeamId :: Int } deriving (Show) + eventsTeamsEventId :: Int, + eventsTeamsTeamId :: Int } deriving (Show) instance FromJSON EventTeam where parseJSON = withObject "team" $ \o -> do - eventTeamId <- o .: "team_id" + eventsTeamsEventId <- o .: "event_id" + eventsTeamsTeamId <- o .: "team_id" return EventTeam{..} -parseEventsTeams :: Either String [Value] -> [Int] +parseEventsTeams :: Either String [Value] -> [EventTeam] parseEventsTeams (Left x) = error x parseEventsTeams (Right xs) = P.foldl reduce [] xs where reduce acc x = case (parseEither parseJSON x :: Either String EventTeam) of (Left s) -> error s - (Right v) -> eventTeamId v : acc + (Right v) -> v : acc diff --git a/Worldcup/Games.hs b/Worldcup/Games.hs index 1c15764..ee5c2c5 100644 --- a/Worldcup/Games.hs +++ b/Worldcup/Games.hs @@ -7,29 +7,42 @@ import Data.Aeson import Data.Aeson.Types data Game = Game { - playAt :: String, - roundId :: Int, - team1Id :: Int, - team2Id :: Int, - score1 :: Value, - score2 :: Value, - score1et :: Value, - score2et :: Value, - score1p :: Value, - score2p :: Value } deriving (Show) + gamePlayAt :: String, + gameRoundId :: Int, + gameTeam1Id :: Int, + gameTeam2Id :: Int, + gameScore1 :: Value, + gameScore2 :: Value, + gameScore1et :: Value, + gameScore2et :: Value, + gameScore1p :: Value, + gameScore2p :: Value } deriving (Show) + +instance ToJSON Game where + toJSON Game{..} = object [ + "ts" .= gamePlayAt, + "rId" .= gameRoundId, + "t1" .= gameTeam1Id, + "t2" .= gameTeam2Id, + "s1" .= gameScore1, + "se1" .= gameScore1et, + "sp1" .= gameScore1p, + "s2" .= gameScore2, + "se2" .= gameScore2et, + "sp2" .= gameScore2p ] instance FromJSON Game where parseJSON = withObject "game" $ \o -> do - roundId <- o .: "round_id" - team1Id <- o .: "team1_id" - team2Id <- o .: "team2_id" - playAt <- o .: "play_at" - score1 <- o .: "score1" - score2 <- o .: "score2" - score1et <- o .: "score1et" - score2et <- o .: "score2et" - score1p <- o .: "score1p" - score2p <- o .: "score2p" + gameRoundId <- o .: "round_id" + gameTeam1Id <- o .: "team1_id" + gameTeam2Id <- o .: "team2_id" + gamePlayAt <- o .: "play_at" + gameScore1 <- o .: "score1" + gameScore2 <- o .: "score2" + gameScore1et <- o .: "score1et" + gameScore2et <- o .: "score2et" + gameScore1p <- o .: "score1p" + gameScore2p <- o .: "score2p" return Game{..} parseGames :: Either String [Value] -> [Game] diff --git a/Worldcup/Tourneys.hs b/Worldcup/Tourneys.hs new file mode 100644 index 0000000..5322415 --- /dev/null +++ b/Worldcup/Tourneys.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Worldcup.Tourneys (Tourneys, Tourney(..), buildTourneys) where + +import Data.Aeson +import Data.Aeson.Types as AET +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) diff --git a/worldcup.hs b/worldcup.hs index 7085a6d..001345b 100644 --- a/worldcup.hs +++ b/worldcup.hs @@ -15,20 +15,18 @@ import Worldcup.EventsTeams import Worldcup.Games import Worldcup.Rounds import Worldcup.Teams - ------ Data constructors ----- -data FinalResult = FinalResult { - resultId :: Int, - resultCountry :: String, - resultContinent :: String, - resultGoals :: Int -} deriving (Show) - -instance ToJSON FinalResult where - toJSON FinalResult{..} = - object [ "id" .= resultId, "ct" .= resultCountry, "cn" .= resultContinent, "g" .= resultGoals ] - ----- +import Worldcup.Tourneys + +-- data FinalResult = FinalResult { +-- resultId :: Int, +-- resultCountry :: String, +-- resultContinent :: String, +-- resultGoals :: Int +-- } deriving (Show) +-- +-- instance ToJSON FinalResult where +-- toJSON FinalResult{..} = +-- object [ "id" .= resultId, "ct" .= resultCountry, "cn" .= resultContinent, "g" .= resultGoals ] data WorldcupData = WorldcupData { worldcupTeams :: Teams, @@ -37,40 +35,32 @@ data WorldcupData = WorldcupData { worldcupTourneys :: Tourneys } deriving (Show) -type Tourneys = HashMap String Tourney - -data Tourney = Tourney { - tourneyGames :: [Game], - tourneyTeams :: [Int] } deriving (Show) - ----- - parseInt :: Value -> Int parseInt Null = 0 parseInt x = read $ BL8.unpack $ encode x :: Int -countryFromTeamId :: Int -> Teams -> Countries -> Country -countryFromTeamId _id hmT = lookupCountry a where - a = teamCountryId $ lookupTeam _id hmT - -continentFromTeamId :: Int -> Teams -> Countries -> Continents -> Continent -continentFromTeamId _id hmT hmC = lookupContinent (countryContinentId b) where - a = teamCountryId $ lookupTeam _id hmT - b = lookupCountry a hmC - -goalsFromTeamId :: Int -> [Game] -> Int -goalsFromTeamId _id = P.foldl reducer 0 where - reducer acc x - | team1Id x == _id = acc + parseInt (score1 x) + parseInt (score1et x) + parseInt (score1p x) - | team2Id x == _id = acc + parseInt (score2 x) + parseInt (score2et x) + parseInt (score2p x) - | otherwise = acc - -buildFinalResult :: [Int] -> Teams -> Countries -> Continents -> [Game] -> [FinalResult] -buildFinalResult ets hmT hmC hmN gs = P.foldl reducer [] ets where - reducer acc x = FinalResult x (getCountryName x) (getContinentName x) (goalCount x) : acc - getCountryName x = countryName (countryFromTeamId x hmT hmC) - getContinentName x = continentName (continentFromTeamId x hmT hmC hmN) - goalCount x = goalsFromTeamId x gs +-- countryFromTeamId :: Int -> Teams -> Countries -> Country +-- countryFromTeamId _id hmT = lookupCountry a where +-- a = teamCountryId $ lookupTeam _id hmT +-- +-- continentFromTeamId :: Int -> Teams -> Countries -> Continents -> Continent +-- continentFromTeamId _id hmT hmC = lookupContinent (countryContinentId b) where +-- a = teamCountryId $ lookupTeam _id hmT +-- b = lookupCountry a hmC +-- +-- goalsFromTeamId :: Int -> [Game] -> Int +-- goalsFromTeamId _id = P.foldl reducer 0 where +-- reducer acc x +-- | team1Id x == _id = acc + parseInt (score1 x) + parseInt (score1et x) + parseInt (score1p x) +-- | team2Id x == _id = acc + parseInt (score2 x) + parseInt (score2et x) + parseInt (score2p x) +-- | otherwise = acc +-- +-- buildFinalResult :: [Int] -> Teams -> Countries -> Continents -> [Game] -> [FinalResult] +-- buildFinalResult ets hmT hmC hmN gs = P.foldl reducer [] ets where +-- reducer acc x = FinalResult x (getCountryName x) (getContinentName x) (goalCount x) : acc +-- getCountryName x = countryName (countryFromTeamId x hmT hmC) +-- getContinentName x = continentName (continentFromTeamId x hmT hmC hmN) +-- goalCount x = goalsFromTeamId x gs buildWorldcupData :: WorldcupData buildWorldcupData = WorldcupData HM.empty HM.empty HM.empty HM.empty @@ -78,7 +68,7 @@ buildWorldcupData = WorldcupData HM.empty HM.empty HM.empty HM.empty main :: IO () main = do dataTeams <- BL.readFile "./data/teams.json" - dataEventTeams <- BL.readFile "./data/events_teams.json" + dataEventsTeams <- BL.readFile "./data/events_teams.json" dataCountries <- BL.readFile "./data/countries.json" dataContinents <- BL.readFile "./data/continents.json" dataGames <- BL.readFile "./data/games.json" @@ -87,16 +77,15 @@ main = do let teams = parseTeams (AE.eitherDecode dataTeams) let events = parseEvents (AE.eitherDecode dataEvents) - let eventteams = parseEventsTeams (AE.eitherDecode dataEventTeams) + let eventsteams = parseEventsTeams (AE.eitherDecode dataEventsTeams) let games = parseGames (AE.eitherDecode dataGames) let countries = parseCountries (AE.eitherDecode dataCountries) let continents = parseContinents (AE.eitherDecode dataContinents) let rounds = parseRounds (AE.eitherDecode dataRounds) - print events - - -- let encoded = encode $ buildFinalResult eventteams teams countries continents games - -- BL8.putStrLn encoded + let encoded = encode $ buildTourneys rounds eventsteams games events + BL8.putStrLn encoded -- P.putStrLn $ show (P.length eventteams) ++ " teams found." -- BL8.putStrLn "Writing teams.json" -- BL8.writeFile "teams.json" encoded + print "DONE"