src/TSN/Team.hs

   1 {-# LANGUAGE DeriveGeneric #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE GADTs #-}
   4 {-# LANGUAGE QuasiQuotes #-}
   5 {-# LANGUAGE TemplateHaskell #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7
   8 -- | (At least) two different XML types have a notion of teams:
   9 --   "TSN.XML.Odds" and "TSN.XML.JFile". And in fact those two types
  10 --   agree on the team id, abbreviation, and name -- at least for the
  11 --   database representation.
  12 --
  13 --   This module contains a data type for the common database
  14 --   representation.
  15 --
  16 module TSN.Team (
  17   HTeam(..),
  18   FromXmlFkTeams(..),
  19   Team(..),
  20   VTeam(..),
  21   -- * WARNING: these are private but exported to silence warnings
  22   TeamConstructor(..) )
  23 where
  24
  25 -- System imports
  26 import Database.Groundhog () -- Required for some String instance
  27 import Database.Groundhog.Core ( PersistEntity(..) )
  28 import Database.Groundhog.TH (
  29   defaultCodegenConfig,
  30   groundhog,
  31   mkPersist )
  32 import qualified GHC.Generics as GHC ( Generic )
  33
  34 -- Local imports
  35 import Generics ( Generic(..) )
  36 import Xml ( Child(..), Db(..) )
  37
  38
  39 -- * Team
  40
  41 -- | The database representation of a team. The 'team_id' is a
  42 --   'String' field because some teams do in fact have ids like
  43 --   \"B52\". The pointless \"team_\" prefix is left on the 'team_id'
  44 --   field because otherwise the auto-generated column name would
  45 --   conflict with the default \"id\" primary key.
  46 --
  47 data Team =
  48   Team {
  49     team_id :: String, -- ^ Some of them contain characters
  50     abbreviation :: Maybe String, -- ^ Some teams don't have abbreviations,
  51                                   --   or at least, some sample jfilexml
  52                                   --   don't have them for some teams.
  53     name :: Maybe String -- ^ Some teams don't even have names!
  54     }
  55   deriving (Eq, GHC.Generic, Show)
  56
  57 -- | Needed for 'Generics.to_tuple'.
  58 --
  59 instance Generic Team
  60
  61 -- * VTeam / HTeam
  62
  63 -- | A wrapper around 'Team' that lets us distinguish between home and
  64 --   away teams. See also 'HTeam'. \"V\" (visiting) was chosen instead
  65 --   of \"A\" (away) simply because \"vteam\" looks better than
  66 --   \"ateam\". This is purely for type-safety.
  67 --
  68 newtype VTeam = VTeam { vteam :: Team } deriving (Eq, Show)
  69
  70
  71 -- | A wrapper around 'Team' that lets us distinguish between home and
  72 --   away teams. See also 'VTeam'. This is purely for type-safety.
  73 --
  74 newtype HTeam = HTeam { hteam :: Team } deriving (Eq, Show)
  75
  76
  77 -- * Database stuff
  78
  79 -- Generate the Groundhog code for 'Team'.
  80 mkPersist defaultCodegenConfig [groundhog|
  81 - entity: Team
  82   dbName: teams
  83   constructors:
  84     - name: Team
  85       uniques:
  86         - name: unique_team
  87           type: constraint
  88           fields: [team_id]
  89 |]
  90
  91
  92
  93 -- | A further refinement of 'FromXmlFk'. These types need not only a
  94 --   foreign key to a parent in order to make the XML -> DB
  95 --   conversion, but also two foreign keys to away/home teams (as
  96 --   represented in "TSN.Team").
  97 --
  98 class (Child a, ToDb a) => FromXmlFkTeams a where
  99   -- | The function that produces a @Db a@ out of a parent foreign
 100   -- key, two team foreign keys, and an @a@. The parameter order makes
 101   -- it easier to map this function over a bunch of things.
 102   from_xml_fk_teams :: DefaultKey (Parent a)
 103                     -> DefaultKey Team -- ^ The away team FK
 104                     -> DefaultKey Team -- ^ The home team FK
 105                     -> a
 106                     -> Db a