{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

-- | (At least) two different XML types have a notion of teams:
--   "TSN.XML.Odds" and "TSN.XML.JFile". And in fact those two types
--   agree on the team id, abbreviation, and name -- at least for the
--   database representation.
--
--   This module contains a data type for the common database
--   representation.
--
module TSN.Team (
  HTeam(..),
  FromXmlFkTeams(..),
  Team(..),
  VTeam(..),
  -- * WARNING: these are private but exported to silence warnings
  TeamConstructor(..) )
where

-- System imports
import Data.Vector.HFixed ( HVector )
import Database.Groundhog () -- Required for some String instance
import Database.Groundhog.Core ( PersistEntity(..) )
import Database.Groundhog.TH (
  defaultCodegenConfig,
  groundhog,
  mkPersist )
import qualified GHC.Generics as GHC ( Generic )

-- Local imports
import Xml ( Child(..), Db(..) )


-- * Team

-- | The database representation of a team. The 'team_id' is a
--   'String' field because some teams do in fact have ids like
--   \"B52\". The pointless \"team_\" prefix is left on the 'team_id'
--   field because otherwise the auto-generated column name would
--   conflict with the default \"id\" primary key.
--
data Team =
  Team {
    team_id :: String, -- ^ Some of them contain characters
    abbreviation :: Maybe String, -- ^ Some teams don't have abbreviations,
                                  --   or at least, some sample jfilexml
                                  --   don't have them for some teams.
    name :: Maybe String -- ^ Some teams don't even have names!
    }
  deriving (Eq, GHC.Generic, Show)

-- | Needed for 'H.convert'.
--
instance HVector Team

-- * VTeam / HTeam

-- | A wrapper around 'Team' that lets us distinguish between home and
--   away teams. See also 'HTeam'. \"V\" (visiting) was chosen instead
--   of \"A\" (away) simply because \"vteam\" looks better than
--   \"ateam\". This is purely for type-safety.
--
newtype VTeam = VTeam { vteam :: Team } deriving (Eq, Show)


-- | A wrapper around 'Team' that lets us distinguish between home and
--   away teams. See also 'VTeam'. This is purely for type-safety.
--
newtype HTeam = HTeam { hteam :: Team } deriving (Eq, Show)


-- * Database stuff

-- Generate the Groundhog code for 'Team'.
mkPersist defaultCodegenConfig [groundhog|
- entity: Team
  dbName: teams
  constructors:
    - name: Team
      uniques:
        - name: unique_team
          type: constraint
          fields: [team_id]
|]



-- | A further refinement of 'FromXmlFk'. These types need not only a
--   foreign key to a parent in order to make the XML -> DB
--   conversion, but also two foreign keys to away/home teams (as
--   represented in "TSN.Team").
--
class (Child a, ToDb a) => FromXmlFkTeams a where
  -- | The function that produces a @Db a@ out of a parent foreign
  -- key, two team foreign keys, and an @a@. The parameter order makes
  -- it easier to map this function over a bunch of things.
  from_xml_fk_teams :: DefaultKey (Parent a)
                    -> DefaultKey Team -- ^ The away team FK
                    -> DefaultKey Team -- ^ The home team FK
                    -> a
                    -> Db a