tsn_codegen_config,
tsn_db_field_namer )
import TSN.DbImport ( DbImport(..), ImportResult(..) )
-import Xml ( ToFromXml(..), pickle_unpickle, unpickleable )
+import TSN.XmlImport ( XmlImport(..) )
+import Xml ( FromXml(..), pickle_unpickle, unpickleable )
xml_casino_line :: Maybe Float }
deriving (Eq, Show)
+
-- | The casinos should have their own table, but the lines don't
-- belong in that table. (There should be another table joining the
-- casinos and the thing the lines are for together.)
data OddsCasino =
OddsCasino {
- db_casino_client_id :: Int,
- db_casino_name :: String }
+ casino_client_id :: Int,
+ casino_name :: String }
deriving (Eq, Show)
-instance ToFromXml OddsCasino where
- type Xml OddsCasino = OddsCasinoXml
- type Container OddsCasino = () -- It has one, but we don't use it.
-
- -- Use a record wildcard here so GHC doesn't complain that we never
- -- used our named fields.
- to_xml (OddsCasino {..}) =
- OddsCasinoXml
- db_casino_client_id
- db_casino_name
- def
+instance FromXml OddsCasinoXml where
+ type Db OddsCasinoXml = OddsCasino
-- We don't need the key argument (from_xml_fk) since the XML type
-- contains more information in this case.
- from_xml OddsCasinoXml{..} =
- OddsCasino
- xml_casino_client_id
- xml_casino_name
-
-data OddsHomeTeam =
- OddsHomeTeam {
- home_team_id :: Int,
- home_rotation_number :: Int,
- home_abbr :: String,
- home_team_name :: String,
- home_casinos :: [OddsCasinoXml] }
+ from_xml OddsCasinoXml{..} = OddsCasino
+ xml_casino_client_id
+ xml_casino_name
+
+instance XmlImport OddsCasinoXml
+
+
+data OddsHomeTeamXml =
+ OddsHomeTeamXml {
+ xml_home_team_id :: Int,
+ xml_home_rotation_number :: Int,
+ xml_home_abbr :: String,
+ xml_home_team_name :: String,
+ xml_home_casinos :: [OddsCasinoXml] }
+ deriving (Eq, Show)
+
+instance FromXml OddsHomeTeamXml where
+ type Db OddsHomeTeamXml = OddsTeam
+ from_xml OddsHomeTeamXml{..} = OddsTeam
+ xml_home_team_id
+ xml_home_abbr
+ xml_home_team_name
+
+instance XmlImport OddsHomeTeamXml where
+
+
+data OddsTeam =
+ OddsTeam {
+ db_team_id :: Int,
+ db_abbr :: String,
+ db_team_name :: String }
deriving (Eq, Show)
-data OddsAwayTeam =
- OddsAwayTeam {
- away_team_id :: Int,
- away_rotation_number :: Int,
- away_abbr :: String,
- away_team_name :: String,
- away_casinos :: [OddsCasinoXml] }
+data OddsAwayTeamXml =
+ OddsAwayTeamXml {
+ xml_away_team_id :: Int,
+ xml_away_rotation_number :: Int,
+ xml_away_abbr :: String,
+ xml_away_team_name :: String,
+ xml_away_casinos :: [OddsCasinoXml] }
deriving (Eq, Show)
+instance FromXml OddsAwayTeamXml where
+ type Db OddsAwayTeamXml = OddsTeam
+ from_xml OddsAwayTeamXml{..} = OddsTeam
+ xml_away_team_id
+ xml_away_abbr
+ xml_away_team_name
+
+instance XmlImport OddsAwayTeamXml where
+
-- | Can't use a newtype with Groundhog.
data OddsOverUnder =
OddsOverUnder [OddsCasinoXml]
data OddsGame =
OddsGame {
- game_id :: Int,
- game_date :: String, -- TODO
- game_time :: String, -- TODO
- game_away_team :: OddsAwayTeam,
- game_home_team :: OddsHomeTeam,
- game_over_under :: OddsOverUnder }
+ db_game_id :: Int,
+ db_game_date :: String, -- TODO
+ db_game_time :: String, -- TODO
+ db_game_away_team_id :: DefaultKey OddsTeam,
+ db_game_away_team_rotation_number :: Int,
+ db_game_home_team_id :: DefaultKey OddsTeam,
+ db_game_home_team_rotation_number :: Int }
+deriving instance Eq OddsGame
+deriving instance Show OddsGame
+
+data OddsGameXml =
+ OddsGameXml {
+ xml_game_id :: Int,
+ xml_game_date :: String, -- TODO
+ xml_game_time :: String, -- TODO
+ xml_game_away_team :: OddsAwayTeamXml,
+ xml_game_home_team :: OddsHomeTeamXml,
+ xml_game_over_under :: OddsOverUnder }
deriving (Eq, Show)
data Odds =
data OddsGameWithNotes =
OddsGameWithNotes {
notes :: [String],
- game :: OddsGame }
+ game :: OddsGameXml }
deriving (Eq, Show)
-- | The XML representation of Odds.
-- | Pseudo-field that lets us get the 'OddsGame's out of
-- 'xml_games_with_notes'.
-xml_games :: Message -> [OddsGame]
+xml_games :: Message -> [OddsGameXml]
xml_games m = map game (xml_games_with_notes m)
-instance ToFromXml Odds where
- type Xml Odds = Message
- type Container Odds = ()
-
- -- Use record wildcards to avoid unused field warnings.
- to_xml (Odds {..}) =
- Message
- def
- def
- def
- db_sport
- db_title
- db_line_time
- def
- def
+instance FromXml Message where
+ type Db Message = Odds
-- We don't need the key argument (from_xml_fk) since the XML type
-- contains more information in this case.
from_xml (Message _ _ _ d e f _ _) =
Odds d e f
+instance XmlImport Message
+
+instance DbImport Message where
+ dbmigrate _= undefined
+ dbimport = undefined
pickle_game_with_notes :: PU OddsGameWithNotes
pickle_game_with_notes =
xpickle = pickle_casino
-pickle_home_team :: PU OddsHomeTeam
+pickle_home_team :: PU OddsHomeTeamXml
pickle_home_team =
xpElem "HomeTeam" $
xpWrap (from_tuple, to_tuple) $
(xpElem "HomeTeamName" xpText)
(xpList pickle_casino)
where
- from_tuple = uncurryN OddsHomeTeam
+ from_tuple = uncurryN OddsHomeTeamXml
-- Use record wildcards to avoid unused field warnings.
- to_tuple OddsHomeTeam{..} = (home_team_id,
- home_rotation_number,
- home_abbr,
- home_team_name,
- home_casinos)
+ to_tuple OddsHomeTeamXml{..} = (xml_home_team_id,
+ xml_home_rotation_number,
+ xml_home_abbr,
+ xml_home_team_name,
+ xml_home_casinos)
-instance XmlPickler OddsHomeTeam where
+instance XmlPickler OddsHomeTeamXml where
xpickle = pickle_home_team
-pickle_away_team :: PU OddsAwayTeam
+pickle_away_team :: PU OddsAwayTeamXml
pickle_away_team =
xpElem "AwayTeam" $
xpWrap (from_tuple, to_tuple) $
(xpElem "AwayTeamName" xpText)
(xpList pickle_casino)
where
- from_tuple = uncurryN OddsAwayTeam
+ from_tuple = uncurryN OddsAwayTeamXml
-- Use record wildcards to avoid unused field warnings.
- to_tuple OddsAwayTeam{..} = (away_team_id,
- away_rotation_number,
- away_abbr,
- away_team_name,
- away_casinos)
+ to_tuple OddsAwayTeamXml{..} = (xml_away_team_id,
+ xml_away_rotation_number,
+ xml_away_abbr,
+ xml_away_team_name,
+ xml_away_casinos)
-instance XmlPickler OddsAwayTeam where
+instance XmlPickler OddsAwayTeamXml where
xpickle = pickle_away_team
xpickle = pickle_over_under
-pickle_game :: PU OddsGame
+pickle_game :: PU OddsGameXml
pickle_game =
xpElem "Game" $
xpWrap (from_tuple, to_tuple) $
pickle_home_team
pickle_over_under
where
- from_tuple = uncurryN OddsGame
+ from_tuple = uncurryN OddsGameXml
-- Use record wildcards to avoid unused field warnings.
- to_tuple OddsGame{..} = (game_id,
- game_date,
- game_time,
- game_away_team,
- game_home_team,
- game_over_under)
-
-instance XmlPickler OddsGame where
+ to_tuple OddsGameXml{..} = (xml_game_id,
+ xml_game_date,
+ xml_game_time,
+ xml_game_away_team,
+ xml_game_home_team,
+ xml_game_over_under)
+
+instance XmlPickler OddsGameXml where
xpickle = pickle_game
(xpElem "sport" xpText)
(xpElem "Title" xpText)
(xpElem "Line_Time" xpText)
- (xpList $ pickle_game_with_notes)
+ (xpList pickle_game_with_notes)
(xpElem "time_stamp" xpText)
where
from_tuple = uncurryN Message
+-- * Groundhog database schema.
+mkPersist tsn_codegen_config [groundhog|
+- entity: Odds
+
+- entity: OddsCasino
+ dbName: odds_casinos
+ constructors:
+ - name: OddsCasino
+ uniques:
+ - name: unique_odds_casino
+ type: constraint
+ fields: [casino_client_id]
+
+- entity: OddsTeam
+ dbName: odds_teams
+ constructors:
+ - name: OddsTeam
+ uniques:
+ - name: unique_odds_team
+ type: constraint
+ fields: [db_team_id]
+
+
+- entity: OddsGame
+ dbName: odds_games
+ constructors:
+ - name: OddsGame
+ uniques:
+ - name: unique_odds_game
+ type: constraint
+ fields: [db_game_id]
+|]
+
-- * Tasty Tests
odds_tests :: TestTree
projects / dead / htsn-import.git / commitdiff