From: Michael Orlitzky Date: Sat, 25 Oct 2014 16:31:39 +0000 (-0400) Subject: Bump to version 0.2.0. X-Git-Tag: 0.2.0^0 X-Git-Url: https://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=commitdiff_plain;h=a7e41a48ee8a9c72f66f2cde0a86b3e49abc423c Bump to version 0.2.0. Remove the NewsTeams and replace them with the common TSN.Teams. Parse the team id attribute in newsxml. Add a database CHANGES file with (manual) migration information. Update the newsxml dbschema diagram. --- diff --git a/doc/CHANGES.database b/doc/CHANGES.database new file mode 100644 index 0000000..75d9d9b --- /dev/null +++ b/doc/CHANGES.database @@ -0,0 +1,16 @@ +Any database changes requiring manual intervention will be mentioned +here. These should always be accompanied by a medium-version bump. + +0.1.3 -> 0.2.0 +-------------- + +The newsxml teams now have an "id" attribute, which means that we can +link each news entry to the common "teams" table rather than using a +custom "news_teams". + +The migration will work automatically, creating a news__teams join +table, but the two old tables will still be left behind: news_teams +and news__news_teams. These can safely be deleted: + + DROP TABLE news_teams; + DROP TABLE news__news_teams; diff --git a/doc/dbschema/newsxml.png b/doc/dbschema/newsxml.png index 76401ae..398a420 100644 Binary files a/doc/dbschema/newsxml.png and b/doc/dbschema/newsxml.png differ diff --git a/htsn-import.cabal b/htsn-import.cabal index 1e9b870..4a89446 100644 --- a/htsn-import.cabal +++ b/htsn-import.cabal @@ -1,5 +1,5 @@ name: htsn-import -version: 0.1.3 +version: 0.2.0 cabal-version: >= 1.8 author: Michael Orlitzky maintainer: Michael Orlitzky @@ -11,6 +11,7 @@ extra-source-files: doc/dbschema/*.png doc/htsn-importrc.example doc/man1/htsn-import.1 + doc/CHANGES.database doc/README.development doc/TODO makefile diff --git a/src/TSN/XML/News.hs b/src/TSN/XML/News.hs index f401d41..0207593 100644 --- a/src/TSN/XML/News.hs +++ b/src/TSN/XML/News.hs @@ -17,9 +17,8 @@ module TSN.XML.News ( news_tests, -- * WARNING: these are private but exported to silence warnings News_LocationConstructor(..), - News_NewsTeamConstructor(..), - NewsConstructor(..), - NewsTeamConstructor(..) ) + News_TeamConstructor(..), + NewsConstructor(..) ) where -- System imports. @@ -39,7 +38,6 @@ import Database.Groundhog.Core ( DefaultKey ) import Database.Groundhog.Generic ( runDbConn ) import Database.Groundhog.Sqlite ( withSqliteConn ) import Database.Groundhog.TH ( - defaultCodegenConfig, groundhog, mkPersist ) import Test.Tasty ( TestTree, testGroup ) @@ -72,8 +70,9 @@ import TSN.Codegen ( tsn_db_field_namer ) -- Used in a test import TSN.Database ( insert_or_select ) import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate ) -import TSN.Picklers ( xp_time_stamp ) import TSN.Location ( Location(..), pickle_location ) +import TSN.Picklers ( xp_time_stamp ) +import TSN.Team ( Team(..) ) import TSN.XmlImport ( XmlImport(..) ) import Xml ( FromXml(..), @@ -118,7 +117,7 @@ data Message = xml_category :: String, xml_sport :: String, xml_url :: Maybe String, - xml_teams :: [NewsTeam], + xml_teams :: [NewsTeamXml], xml_locations :: [Location], xml_sms :: Maybe String, xml_editor :: Maybe String, @@ -173,32 +172,43 @@ instance FromXml Message where instance XmlImport Message --- * NewsTeam +-- * NewsTeamXml --- | The database/XML type for teams as they show up in the news. We --- can't reuse the representation from "TSN.Team" because they --- require a team id. We wouldn't want to make the team ID optional --- and then insert a team with no id, only to find the same team --- later with an id and be unable to update the record. (We could --- add the update logic, but it would be more trouble than it's --- worth.) +-- | The XML type for teams as they show up in the news. We can't +-- reuse the representation from "TSN.Team" because our name doesn't +-- appear optional and we have no abbreviation. -- -data NewsTeam = - NewsTeam { team_name :: String } +data NewsTeamXml = + NewsTeamXml { xml_team_id :: String, + xml_team_name :: String } deriving (Eq, Show) +instance ToDb NewsTeamXml where + -- | The database representation of 'NewsTeamXml' is 'Team'. + type Db NewsTeamXml = Team + +-- | Convert the XML representation 'NewsTeamXml' to the database +-- representation 'Team'. +-- +instance FromXml NewsTeamXml where + from_xml NewsTeamXml{..} = + Team { team_id = xml_team_id, + abbreviation = Nothing, + name = Just xml_team_name } +-- | Allow us to import 'NewsTeamXml' directly. +-- +instance XmlImport NewsTeamXml --- * News_NewsTeam --- | Mapping between News records and NewsTeam records in the --- database. We don't name the fields because we don't use the names --- explicitly; that means we have to give them nice database names --- via groundhog. +-- * News_Team + +-- | Mapping between News records and Team records in the database. We +-- don't name the fields because we don't use the names explicitly; +-- that means we have to give them nice database names via +-- groundhog. -- -data News_NewsTeam = News_NewsTeam - (DefaultKey News) - (DefaultKey NewsTeam) +data News_Team = News_Team (DefaultKey News) (DefaultKey Team) -- * News_Location @@ -248,7 +258,7 @@ has_only_single_sms xmltree = -- -- | Define 'dbmigrate' and 'dbimport' for 'Message's. The import is --- slightly non-generic because of our 'News_NewsTeam' and +-- slightly non-generic because of our 'News_Team' and -- 'News_Location' join tables. -- instance DbImport Message where @@ -256,23 +266,23 @@ instance DbImport Message where run_dbmigrate $ do migrate (undefined :: Location) migrate (undefined :: News) - migrate (undefined :: NewsTeam) - migrate (undefined :: News_NewsTeam) + migrate (undefined :: Team) + migrate (undefined :: News_Team) migrate (undefined :: News_Location) dbimport message = do -- Insert the message and acquire its primary key (unique ID) news_id <- insert_xml message - -- Now insert the teams. We use insert_or_select because we know - -- that most teams will already exist, and we want to get back the - -- id for the existing team when there's a collision. - nt_ids <- mapM insert_or_select (xml_teams message) + -- Now insert the teams. We use insert_xml_or_select because we + -- know that most teams will already exist, and we want to get + -- back the id for the existing team when there's a collision. + team_ids <- mapM insert_xml_or_select (xml_teams message) -- Now that the teams have been inserted, create - -- news__news_team records mapping beween the two. - let news_news_teams = map (News_NewsTeam news_id) nt_ids - mapM_ insert_ news_news_teams + -- news__team records mapping beween the two. + let news_teams = map (News_Team news_id) team_ids + mapM_ insert_ news_teams -- Do all of that over again for the Locations. loc_ids <- mapM insert_or_select (xml_locations message) @@ -282,21 +292,6 @@ instance DbImport Message where return ImportSucceeded --- These types don't have special XML representations or field name --- collisions so we use the defaultCodegenConfig and give their --- fields nice simple names. -mkPersist defaultCodegenConfig [groundhog| -- entity: NewsTeam - dbName: news_teams - constructors: - - name: NewsTeam - uniques: - - name: unique_news_teams - type: constraint - fields: [team_name] - -|] - -- These types have fields with e.g. db_ and xml_ prefixes, so we -- use our own codegen to peel those off before naming the columns. @@ -322,17 +317,17 @@ mkPersist tsn_codegen_config [groundhog| - name: db_event_id dbName: event_id -- entity: News_NewsTeam - dbName: news__news_teams +- entity: News_Team + dbName: news__teams constructors: - - name: News_NewsTeam + - name: News_Team fields: - - name: news_NewsTeam0 # Default created by mkNormalFieldName + - name: news_Team0 # Default created by mkNormalFieldName dbName: news_id reference: onDelete: cascade - - name: news_NewsTeam1 # Default created by mkNormalFieldName - dbName: news_teams_id + - name: news_Team1 # Default created by mkNormalFieldName + dbName: teams_id reference: onDelete: cascade @@ -356,18 +351,20 @@ mkPersist tsn_codegen_config [groundhog| -- XML Picklers -- --- | Convert a 'NewsTeam' to/from XML. +-- | Convert a 'NewsTeamXml' to/from XML. -- -pickle_news_team :: PU NewsTeam +pickle_news_team :: PU NewsTeamXml pickle_news_team = xpElem "team" $ - xpWrap (from_string, to_string) xpText + xpWrap (from_pair, to_pair) $ + xpPair (xpAttr "id" xpText) + xpText -- team name where - to_string :: NewsTeam -> String - to_string = team_name + from_pair :: (String, String) -> NewsTeamXml + from_pair = uncurry NewsTeamXml - from_string :: String -> NewsTeam - from_string = NewsTeam + to_pair :: NewsTeamXml -> (String, String) + to_pair (NewsTeamXml x y) = (x,y) -- | Convert a 'MsgId' to/from XML. @@ -539,8 +536,8 @@ test_on_delete_cascade = testGroup "cascading delete tests" news <- unsafe_unpickle path pickle_message let a = undefined :: Location let b = undefined :: News - let c = undefined :: NewsTeam - let d = undefined :: News_NewsTeam + let c = undefined :: Team + let d = undefined :: News_Team let e = undefined :: News_Location actual <- withSqliteConn ":memory:" $ runDbConn $ do runMigration silentMigrationLogger $ do