1 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE QuasiQuotes #-}
4 {-# LANGUAGE TemplateHaskell #-}
5 {-# LANGUAGE TypeFamilies #-}
7 -- | (At least) two different XML types have a notion of teams:
8 -- "TSN.XML.Odds" and "TSN.XML.JFile". And in fact those two types
9 -- agree on the team id, abbreviation, and name -- at least for the
10 -- database representation.
12 -- This module contains a data type for the common database
20 -- * WARNING: these are private but exported to silence warnings
25 import Database.Groundhog () -- Required for some String instance
26 import Database.Groundhog.Core ( PersistEntity(..) )
27 import Database.Groundhog.TH (
33 import Xml ( Child(..), Db(..) )
38 -- | The database representation of a team. The 'team_id' is a
39 -- 'String' field because some teams do in fact have ids like
40 -- \"B52\". The pointless \"team_\" prefix is left on the 'team_id'
41 -- field because otherwise the auto-generated column name would
42 -- conflict with the default \"id\" primary key.
46 team_id :: String, -- ^ Some of them contain characters
47 abbreviation :: Maybe String, -- ^ Some teams don't have abbreviations,
48 -- or at least, some sample jfilexml
49 -- don't have them for some teams.
50 name :: Maybe String -- ^ Some teams don't even have names!
57 -- | A wrapper around 'Team' that lets us distinguish between home and
58 -- away teams. See also 'HTeam'. \"V\" (visiting) was chosen instead
59 -- of \"A\" (away) simply because \"vteam\" looks better than
60 -- \"ateam\". This is purely for type-safety.
62 newtype VTeam = VTeam { vteam :: Team } deriving (Eq, Show)
65 -- | A wrapper around 'Team' that lets us distinguish between home and
66 -- away teams. See also 'VTeam'. This is purely for type-safety.
68 newtype HTeam = HTeam { hteam :: Team } deriving (Eq, Show)
73 -- Generate the Groundhog code for 'Team'.
74 mkPersist defaultCodegenConfig [groundhog|
87 -- | A further refinement of 'FromXmlFk'. These types need not only a
88 -- foreign key to a parent in order to make the XML -> DB
89 -- conversion, but also two foreign keys to away/home teams (as
90 -- represented in "TSN.Team").
92 class (Child a, ToDb a) => FromXmlFkTeams a where
93 -- | The function that produces a @Db a@ out of a parent foreign
94 -- key, two team foreign keys, and an @a@. The parameter order makes
95 -- it easier to map this function over a bunch of things.
96 from_xml_fk_teams :: DefaultKey (Parent a)
97 -> DefaultKey Team -- ^ The away team FK
98 -> DefaultKey Team -- ^ The home team FK