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.
91 lines
3.7 KiB
91 lines
3.7 KiB
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
import Data.Aeson as AE
|
|
import Data.Aeson.Types as AET
|
|
import Data.ByteString.Lazy as BL
|
|
import Data.ByteString.Lazy.Char8 as BL8
|
|
import Data.HashMap.Strict as HM
|
|
import Data.Maybe as M
|
|
import Prelude as P
|
|
import Worldcup.Continents
|
|
import Worldcup.Countries
|
|
import Worldcup.Events
|
|
import Worldcup.EventsTeams
|
|
import Worldcup.Games
|
|
import Worldcup.Rounds
|
|
import Worldcup.Teams
|
|
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,
|
|
worldcupCountries :: Countries,
|
|
worldcupContinents :: Continents,
|
|
worldcupTourneys :: Tourneys
|
|
} 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
|
|
|
|
buildWorldcupData :: WorldcupData
|
|
buildWorldcupData = WorldcupData HM.empty HM.empty HM.empty HM.empty
|
|
|
|
main :: IO ()
|
|
main = do
|
|
dataTeams <- BL.readFile "./data/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"
|
|
dataEvents <- BL.readFile "./data/events.json"
|
|
dataRounds <- BL.readFile "./data/rounds.json"
|
|
|
|
let teams = parseTeams (AE.eitherDecode dataTeams)
|
|
let events = parseEvents (AE.eitherDecode dataEvents)
|
|
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)
|
|
|
|
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"
|
|
|