{-# 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(..), Team(..), VTeam(..), -- * WARNING: these are private but exported to silence warnings TeamConstructor(..) ) where -- System imports import Database.Groundhog () -- Required for some String instance import Database.Groundhog.TH ( defaultCodegenConfig, groundhog, mkPersist ) -- * 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, Show) -- * 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] |]