{-# LANGUAGE OverloadedStrings #-}
module Data.Tournament (
    Tournament(..),
    TournamentRank(..),
    TournamentType(..),
    ScoringMethod(..)
) where

import Data.Dates (DateTime(..), parseDate)
import Data.Text (Text, pack, unpack, append)
import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), object, (.=), (.:))
import Data.Aeson.Types (typeMismatch)

import Control.Applicative (Applicative(..), (<$>), (<*>))

import Data.ID(ID(..))
import Data.Location (Location)


data TournamentRank = Local | Districtal | Regional | National | International deriving (Eq, Show, Ord)
data TournamentType = Individual | Pairs | Teams deriving (Eq, Show)
data ScoringMethod  = TopScore | IMP | Patton deriving (Eq, Show)

data Tournament = Tournament {
    _id             :: ID Tournament,
    date            :: DateTime,
    name            :: Text,
    location        :: Location,
    tournamentType  :: TournamentType,
    scoring         :: ScoringMethod,
    rank            :: TournamentRank,
    fee             :: Integer
}

instance ToJSON TournamentRank where
    toJSON Local = String "L"
    toJSON Districtal = String "D"
    toJSON Regional = String "R"
    toJSON National = String "N"
    toJSON International = String "I"

instance FromJSON TournamentRank where
    parseJSON (String "L") = pure Local
    parseJSON (String "D") = pure Districtal
    parseJSON (String "R") = pure Regional
    parseJSON (String "N") = pure National
    parseJSON (String "I") = pure International
    parseJSON v = typeMismatch "TournamentRank" v


instance ToJSON TournamentType where
    toJSON Individual = String "individual"
    toJSON Pairs = String "pairs"
    toJSON Teams = String "teams"

instance FromJSON TournamentType where
    parseJSON (String "individual") = pure Individual
    parseJSON (String "pairs") = pure Pairs
    parseJSON (String "teams") = pure Teams
    parseJSON v = typeMismatch "TournamentType" v


instance ToJSON ScoringMethod where
    toJSON TopScore = String "MAX"
    toJSON IMP = String "IMP"
    toJSON Patton = String "PAT"

instance FromJSON ScoringMethod where
    parseJSON (String "MAX") = pure TopScore
    parseJSON (String "IMP") = pure IMP
    parseJSON (String "PAT") = pure Patton
    parseJSON v = typeMismatch "ScoringMethod" v


instance ToJSON DateTime where
    toJSON d = String $ asText year d `append` "/" `append` asText month d
                                      `append` "/" `append` asText day d

instance FromJSON DateTime where
    parseJSON (Object o) = DateTime <$> o .: "year"
                                    <*> o .: "month"
                                    <*> o .: "day"
                                    <*> pure 0 <*> pure 0 <*> pure 0
    parseJSON txt@(String str) = case parseDate epoch (unpack str) of
                                Right d -> pure d
                                Left err -> typeMismatch (show err) txt
    parseJSON v = typeMismatch "Date" v


instance ToJSON Tournament where
    toJSON tournament = object [
            "id"        .= (toJSON $ _id tournament),
            "date"      .= (toJSON $ date tournament),
            "name"      .= (toJSON $ name tournament),
            "location"  .= (toJSON $ location tournament),
            "type"      .= (toJSON $ tournamentType tournament),
            "scoring"   .= (toJSON $ scoring tournament),
            "rank"      .= (toJSON $ rank tournament),
            "fee"       .= (toJSON $ fee tournament)
        ]

instance FromJSON Tournament where
    parseJSON (Object o) = Tournament <$> o .: "id"
                                      <*> o .: "date"
                                      <*> o .: "name"
                                      <*> o .: "location"
                                      <*> o .: "type"
                                      <*> o .: "scoring"
                                      <*> o .: "rank"
                                      <*> o .: "fee"
    parseJSON val = typeMismatch "Tournament" val

asText :: (Show b) => (a -> b) -> a -> Text
asText transform = pack . show . transform

epoch :: DateTime
epoch = DateTime 1970 1 1 0 0 0
