From: Michael Orlitzky Date: Fri, 4 Jul 2014 05:56:42 +0000 (-0400) Subject: Finish the documentation for ScheduleChanges. X-Git-Tag: 0.0.6~45 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=2dd1ab7a375b55632f6c8165dce97a2df3cc1907;p=dead%2Fhtsn-import.git Finish the documentation for ScheduleChanges. Finalize the schema for ScheduleChanges. Add the Schedule_Changes_XML schema diagram. Remove pointless "team_" prefix from two Team fields. Update Odds/JFile for the Team changes. --- diff --git a/doc/dbschema/Schedule_Changes_XML.png b/doc/dbschema/Schedule_Changes_XML.png new file mode 100644 index 0000000..1cec34e Binary files /dev/null and b/doc/dbschema/Schedule_Changes_XML.png differ diff --git a/src/TSN/Team.hs b/src/TSN/Team.hs index 910c671..36d58ca 100644 --- a/src/TSN/Team.hs +++ b/src/TSN/Team.hs @@ -28,15 +28,17 @@ import Database.Groundhog.TH ( -- | The database representation of a team. The 'team_id' is a -- 'String' field because some teams do in fact have ids like --- \"B52\". +-- \"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 - team_abbreviation :: Maybe String, -- ^ Some teams don't have abbreviations, - -- or at least, some sample jfilexml - -- don't have them for some teams. - team_name :: Maybe String -- ^ Some teams don't even have names! + 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) diff --git a/src/TSN/XML/JFile.hs b/src/TSN/XML/JFile.hs index d2ac6f4..fa37e7c 100644 --- a/src/TSN/XML/JFile.hs +++ b/src/TSN/XML/JFile.hs @@ -174,8 +174,8 @@ instance FromXml JFileGameAwayTeamXml where from_xml JFileGameAwayTeamXml{..} = Team { team_id = away_team_id, - team_abbreviation = away_team_abbreviation, - team_name = away_team_name } + abbreviation = away_team_abbreviation, + name = away_team_name } -- | Allow us to import JFileGameAwayTeamXml directly. instance XmlImport JFileGameAwayTeamXml @@ -204,8 +204,8 @@ instance FromXml JFileGameHomeTeamXml where from_xml JFileGameHomeTeamXml{..} = Team { team_id = home_team_id, - team_abbreviation = home_team_abbreviation, - team_name = home_team_name } + abbreviation = home_team_abbreviation, + name = home_team_name } -- | Allow us to import JFileGameHomeTeamXml directly. instance XmlImport JFileGameHomeTeamXml diff --git a/src/TSN/XML/Odds.hs b/src/TSN/XML/Odds.hs index 2ad2d93..0e84ce6 100644 --- a/src/TSN/XML/Odds.hs +++ b/src/TSN/XML/Odds.hs @@ -187,8 +187,8 @@ instance FromXml OddsGameHomeTeamXml where from_xml OddsGameHomeTeamXml{..} = Team { team_id = xml_home_team_id, - team_abbreviation = Just xml_home_team_abbr, - team_name = Just xml_home_team_name } + abbreviation = Just xml_home_team_abbr, + name = Just xml_home_team_name } -- | This allows us to insert the XML representation -- 'OddsGameHomeTeamXml' directly. diff --git a/src/TSN/XML/ScheduleChanges.hs b/src/TSN/XML/ScheduleChanges.hs index b3d134e..5f0eff2 100644 --- a/src/TSN/XML/ScheduleChanges.hs +++ b/src/TSN/XML/ScheduleChanges.hs @@ -18,8 +18,7 @@ module TSN.XML.ScheduleChanges ( schedule_changes_tests, -- * WARNING: these are private but exported to silence warnings ScheduleChangesConstructor(..), - ScheduleChangesListingConstructor(..), - ScheduleChangesListing_TeamConstructor(..) ) + ScheduleChangesListingConstructor(..) ) where -- System imports. @@ -29,7 +28,6 @@ import Data.Tuple.Curry ( uncurryN ) import Database.Groundhog ( countAll, deleteAll, - insert, insert_, migrate, runMigration, @@ -59,7 +57,7 @@ import Text.XML.HXT.Core ( import TSN.Codegen ( tsn_codegen_config ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) -import TSN.Picklers ( xp_date_padded, xp_time, xp_time_stamp ) +import TSN.Picklers ( xp_date_padded, xp_tba_time, xp_time_stamp ) import TSN.Team ( Team(..) ) import TSN.XmlImport ( XmlImport(..) ) import Xml ( @@ -71,7 +69,8 @@ import Xml ( --- | The DTD to which this module corresponds. Used to invoke dbimport. +-- | The DTD to which this module corresponds. Used to invoke +-- 'dbimport'. -- dtd :: String dtd = "Schedule_Changes_XML.dtd" @@ -161,7 +160,7 @@ instance XmlImport Message data ScheduleChangesListingStatus = ScheduleChangesListingStatus { db_status_numeral :: Int, - db_status :: Maybe String } + db_status :: Maybe String } -- Yes, they can be empty. deriving (Eq, Show) @@ -170,8 +169,7 @@ data ScheduleChangesListingStatus = -- to the database, we drop the intermediate \ -- leaving the listing keyed to the 'ScheduleChanges' itself. -- --- The home/away teams reuse the 'Team' representation and are --- connected via 'ScheduleChangesListing_Team'. +-- The home/away teams reuse the 'Team' representation. -- -- The sport name (sc_sport) is pulled out of the containing -- \ and embedded into the listings themselves. @@ -179,11 +177,13 @@ data ScheduleChangesListingStatus = data ScheduleChangesListing = ScheduleChangesListing { db_schedule_changes_id :: DefaultKey ScheduleChanges, + db_away_team_id :: DefaultKey Team, + db_home_team_id ::DefaultKey Team, db_type :: String, db_sc_sport :: String, db_schedule_id :: Int, db_game_time :: UTCTime, - db_location :: String, + db_location :: Maybe String, db_vscore :: Int, db_hscore :: Int, db_listing_status :: ScheduleChangesListingStatus, @@ -198,8 +198,8 @@ data ScheduleChangesListingXml = xml_type :: String, xml_schedule_id :: Int, xml_game_date :: UTCTime, - xml_game_time :: UTCTime, - xml_location :: String, + xml_game_time :: Maybe UTCTime, + xml_location :: Maybe String, xml_away_team :: ScheduleChangesListingAwayTeamXml, xml_home_team :: ScheduleChangesListingHomeTeamXml, xml_vscore :: Int, @@ -218,17 +218,25 @@ instance ToDb ScheduleChangesListingXml where -- | We don't make 'ScheduleChangesListingXml' an instance of --- 'FromXmlFk' or 'XmlImportFk' because it needs some additional --- information, namely the sport name from its containing --- \. +-- 'FromXmlFkTeams' because it needs some additional information, +-- namely the sport name from its containing \. +-- But essentially we'll need to do the same thing as +-- 'from_xml_fk_teams'. This function accomplishes the same thing, +-- with the addition of the sport that's passed in. +-- +-- The parameter order is for convenience later (see dbimport). -- from_xml_fk_sport :: (DefaultKey ScheduleChanges) - -> String + -> String -- ^ The sport from our containing schedule change + -> (DefaultKey Team) -- ^ Away team FK + -> (DefaultKey Team) -- ^ Home team FK -> ScheduleChangesListingXml -> ScheduleChangesListing -from_xml_fk_sport fk sport ScheduleChangesListingXml{..} = +from_xml_fk_sport fk sport fk_away fk_home ScheduleChangesListingXml{..} = ScheduleChangesListing { db_schedule_changes_id = fk, + db_away_team_id = fk_away, + db_home_team_id = fk_home, db_type = xml_type, db_sc_sport = sport, db_schedule_id = xml_schedule_id, @@ -238,25 +246,14 @@ from_xml_fk_sport fk sport ScheduleChangesListingXml{..} = db_hscore = xml_hscore, db_listing_status = xml_listing_status, db_notes = xml_notes } - where -- | Make the database \"game time\" from the XML -- date/time. Simply take the day part from one and the time -- from the other. -- - make_game_time d t = UTCTime (utctDay d) (utctDayTime t) - - - --- * ScheduleChangesListing_Team + make_game_time d Nothing = d + make_game_time d (Just t) = UTCTime (utctDay d) (utctDayTime t) --- | Database mapping between listings and their home/away teams. --- -data ScheduleChangesListing_Team = - ScheduleChangesListing_Team { - sclt_schedule_changes_listings_id :: DefaultKey ScheduleChangesListing, - sclt_away_team_id :: DefaultKey Team, - sclt_home_team_id :: DefaultKey Team } -- * ScheduleChangesListingAwayTeamXml / ScheduleChangesListingHomeTeamXml @@ -265,30 +262,33 @@ data ScheduleChangesListing_Team = -- team. Its corresponding database representation (along with that -- of the home team) is a "TSN.Team", but their XML representations -- are different. +-- data ScheduleChangesListingAwayTeamXml = ScheduleChangesListingAwayTeamXml { away_team_id :: String, - away_team_name :: String } + away_team_name :: Maybe String } deriving (Eq, Show) + instance ToDb ScheduleChangesListingAwayTeamXml where -- | The database analogue of an 'ScheduleChangesListingAwayTeamXml' is -- a 'Team'. -- type Db ScheduleChangesListingAwayTeamXml = Team + instance FromXml ScheduleChangesListingAwayTeamXml where -- | To convert a 'ScheduleChangesListingAwayTeamXml' to a 'Team', - -- we set the non-existent abbreviation to \"Nothing\" and wrap - -- the always-present name field in \"Just\". + -- we set the non-existent abbreviation to \"Nothing\". -- from_xml ScheduleChangesListingAwayTeamXml{..} = Team { team_id = away_team_id, - team_abbreviation = Nothing, - team_name = Just away_team_name } + abbreviation = Nothing, + name = away_team_name } -- | Allow us to import ScheduleChangesListingAwayTeamXml directly. +-- instance XmlImport ScheduleChangesListingAwayTeamXml @@ -300,27 +300,30 @@ instance XmlImport ScheduleChangesListingAwayTeamXml data ScheduleChangesListingHomeTeamXml = ScheduleChangesListingHomeTeamXml { home_team_id :: String, - home_team_name :: String } + home_team_name :: Maybe String } deriving (Eq, Show) + instance ToDb ScheduleChangesListingHomeTeamXml where -- | The database analogue of an 'ScheduleChangesListingHomeTeamXml' -- is a 'Team'. -- type Db ScheduleChangesListingHomeTeamXml = Team + instance FromXml ScheduleChangesListingHomeTeamXml where -- | To convert a 'ScheduleChangesListingHomeTeamXml' to a 'Team', - -- we set the non-existent abbreviation to \"Nothing\" and wrap - -- the always-present name field in \"Just\". + -- we set the non-existent abbreviation to \"Nothing\". -- from_xml ScheduleChangesListingHomeTeamXml{..} = Team { team_id = home_team_id, - team_abbreviation = Nothing, - team_name = Just home_team_name } + abbreviation = Nothing, + name = home_team_name } + -- | Allow us to import ScheduleChangesListingHomeTeamXml directly. +-- instance XmlImport ScheduleChangesListingHomeTeamXml @@ -334,7 +337,6 @@ instance DbImport Message where migrate (undefined :: Team) migrate (undefined :: ScheduleChanges) migrate (undefined :: ScheduleChangesListing) - migrate (undefined :: ScheduleChangesListing_Team) dbimport m = do -- Insert the top-level message @@ -343,25 +345,20 @@ instance DbImport Message where -- Now loop through the message's schedule changes forM_ (xml_schedule_changes m) $ \sc -> do -- Construct the function that will turn an XML listing into a DB one. + -- This is only partially applied without the away/home team IDs. let listing_xml_to_db = from_xml_fk_sport msg_id (xml_sc_sport sc) -- Now loop through the listings so that we can handle the teams -- one listing at a time. forM_ (xml_sc_listings sc) $ \listing -> do - let db_listing = listing_xml_to_db listing - listing_id <- insert db_listing - away_team_id <- insert_xml_or_select (xml_away_team listing) home_team_id <- insert_xml_or_select (xml_home_team listing) - -- Insert a record into schedule_changes_listings__teams - -- mapping the home/away teams to this game. Use the full - -- record syntax because the types would let us mix up the - -- home/away teams. - insert_ ScheduleChangesListing_Team { - sclt_schedule_changes_listings_id = listing_id, - sclt_away_team_id = away_team_id, - sclt_home_team_id = home_team_id } + -- Finish constructing the xml -> db function. + let listing_xml_to_db' = listing_xml_to_db away_team_id home_team_id + let db_listing = listing_xml_to_db' listing + + insert_ db_listing return ImportSucceeded @@ -377,7 +374,7 @@ mkPersist tsn_codegen_config [groundhog| # Prevent multiple imports of the same message. fields: [db_xml_file_id] - +# Note: we drop the "sc" prefix from the db_sc_sport field. - entity: ScheduleChangesListing dbName: schedule_changes_listings constructors: @@ -386,6 +383,18 @@ mkPersist tsn_codegen_config [groundhog| - name: db_schedule_changes_id reference: onDelete: cascade + - name: db_away_team_id + reference: + onDelete: cascade + - name: db_home_team_id + reference: + onDelete: cascade + - name: db_sc_sport + dbName: sport + - name: db_listing_status + embeddedType: + - {name: status_numeral, dbName: status_numeral} + - {name: status, dbName: status} - embedded: ScheduleChangesListingStatus fields: @@ -394,21 +403,6 @@ mkPersist tsn_codegen_config [groundhog| - name: db_status dbName: status - -- entity: ScheduleChangesListing_Team - dbName: schedule_changes_listings__teams - constructors: - - name: ScheduleChangesListing_Team - fields: - - name: sclt_schedule_changes_listings_id - reference: - onDelete: cascade - - name: sclt_away_team_id - reference: - onDelete: cascade - - name: sclt_home_team_id - reference: - onDelete: cascade |] @@ -417,29 +411,36 @@ mkPersist tsn_codegen_config [groundhog| -- * Pickling -- +-- | An (un)pickler for the \ elements. +-- pickle_away_team :: PU ScheduleChangesListingAwayTeamXml pickle_away_team = xpElem "Away_Team" $ xpWrap (from_tuple, to_tuple) $ xpPair (xpAttr "AT_ID" xpText) - xpText + (xpOption xpText) where from_tuple = uncurry ScheduleChangesListingAwayTeamXml to_tuple t = (away_team_id t, away_team_name t) + +-- | An (un)pickler for the \ elements. +-- pickle_home_team :: PU ScheduleChangesListingHomeTeamXml pickle_home_team = xpElem "Home_Team" $ xpWrap (from_tuple, to_tuple) $ xpPair (xpAttr "HT_ID" xpText) - xpText + (xpOption xpText) where from_tuple = uncurry ScheduleChangesListingHomeTeamXml to_tuple t = (home_team_id t, home_team_name t) +-- | An (un)pickler for the \ elements. +-- pickle_status :: PU ScheduleChangesListingStatus pickle_status = xpElem "status" $ @@ -452,6 +453,8 @@ pickle_status = db_status s) +-- | An (un)pickler for the \ elements. +-- pickle_listing :: PU ScheduleChangesListingXml pickle_listing = xpElem "SC_Listing" $ @@ -459,8 +462,8 @@ pickle_listing = xp11Tuple (xpAttr "type" xpText) (xpElem "Schedule_ID" xpInt) (xpElem "Game_Date" xp_date_padded) - (xpElem "Game_Time" xp_time) - (xpElem "Location" xpText) + (xpElem "Game_Time" xp_tba_time) + (xpElem "Location" (xpOption xpText)) pickle_away_team pickle_home_team (xpElem "vscore" xpInt) @@ -481,6 +484,9 @@ pickle_listing = xml_listing_status l, xml_notes l) + +-- | An (un)pickler for the \ elements. +-- pickle_schedule_change :: PU ScheduleChangeXml pickle_schedule_change = xpElem "Schedule_Change" $ @@ -566,21 +572,18 @@ test_on_delete_cascade = let a = undefined :: Team let b = undefined :: ScheduleChanges let c = undefined :: ScheduleChangesListing - let d = undefined :: ScheduleChangesListing_Team actual <- withSqliteConn ":memory:" $ runDbConn $ do runMigration silentMigrationLogger $ do migrate a migrate b migrate c - migrate d _ <- dbimport results deleteAll b count_a <- countAll a count_b <- countAll b count_c <- countAll c - count_d <- countAll d - return $ sum [count_a, count_b, count_c, count_d] + return $ sum [count_a, count_b, count_c] let expected = 12 -- There are 16 team elements, but 4 are dupes, -- so 12 unique teams should be left over. actual @?= expected