src/TSN/Team.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE GADTs #-}
   3 {-# LANGUAGE QuasiQuotes #-}
   4 {-# LANGUAGE TemplateHaskell #-}
   5 {-# LANGUAGE TypeFamilies #-}
   6
   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.
  11 --
  12 --   This module contains a data type for the common database
  13 --   representation.
  14 --
  15 module TSN.Team (
  16   HTeam(..),
  17   Team(..),
  18   VTeam(..),
  19   -- * WARNING: these are private but exported to silence warnings
  20   TeamConstructor(..) )
  21 where
  22
  23 -- System imports
  24 import Database.Groundhog () -- Required for some String instance
  25 import Database.Groundhog.TH (
  26   defaultCodegenConfig,
  27   groundhog,
  28   mkPersist )
  29
  30
  31 -- * Team
  32
  33 -- | The database representation of a team. The 'team_id' is a
  34 --   'String' field because some teams do in fact have ids like
  35 --   \"B52\". The pointless \"team_\" prefix is left on the 'team_id'
  36 --   field because otherwise the auto-generated column name would
  37 --   conflict with the default \"id\" primary key.
  38 --
  39 data Team =
  40   Team {
  41     team_id :: String, -- ^ Some of them contain characters
  42     abbreviation :: Maybe String, -- ^ Some teams don't have abbreviations,
  43                                   --   or at least, some sample jfilexml
  44                                   --   don't have them for some teams.
  45     name :: Maybe String -- ^ Some teams don't even have names!
  46     }
  47   deriving (Eq, Show)
  48
  49
  50 -- * VTeam / HTeam
  51
  52 -- | A wrapper around 'Team' that lets us distinguish between home and
  53 --   away teams. See also 'HTeam'. \"V\" (visiting) was chosen instead
  54 --   of \"A\" (away) simply because \"vteam\" looks better than
  55 --   \"ateam\". This is purely for type-safety.
  56 --
  57 newtype VTeam = VTeam { vteam :: Team } deriving (Eq, Show)
  58
  59
  60 -- | A wrapper around 'Team' that lets us distinguish between home and
  61 --   away teams. See also 'VTeam'. This is purely for type-safety.
  62 --
  63 newtype HTeam = HTeam { hteam :: Team } deriving (Eq, Show)
  64
  65
  66 -- * Database stuff
  67
  68 -- Generate the Groundhog code for 'Team'.
  69 mkPersist defaultCodegenConfig [groundhog|
  70 - entity: Team
  71   dbName: teams
  72   constructors:
  73     - name: Team
  74       uniques:
  75         - name: unique_team
  76           type: constraint
  77           fields: [team_id]
  78 |]