Tourney structure complete.

master
Ben Burlingham 9 years ago
parent 5b7ad80303
commit 41ddeb6fc9
  1. 19
      Worldcup/Events.hs
  2. 10
      Worldcup/EventsTeams.hs
  3. 53
      Worldcup/Games.hs
  4. 45
      Worldcup/Tourneys.hs
  5. 89
      worldcup.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

@ -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

@ -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]

@ -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)

@ -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"

Loading…
Cancel
Save