-- * Tests
news_tests,
-- * WARNING: these are private but exported to silence warnings
- News_NewsLocationConstructor(..),
+ News_LocationConstructor(..),
News_NewsTeamConstructor(..),
NewsConstructor(..),
- NewsLocationConstructor(..),
NewsTeamConstructor(..) )
where
import TSN.Database ( insert_or_select )
import TSN.DbImport ( DbImport(..), ImportResult(..), run_dbmigrate )
import TSN.Picklers ( xp_time_stamp )
+import TSN.Location ( Location(..) )
import TSN.XmlImport ( XmlImport(..) )
import Xml (
FromXml(..),
xml_sport :: String,
xml_url :: Maybe String,
xml_teams :: [NewsTeam],
- xml_locations :: [NewsLocation],
+ xml_locations :: [NewsLocationXml],
xml_sms :: String,
xml_editor :: Maybe String,
xml_text :: Maybe String, -- Text and continue seem to show up in pairs,
-- * NewsTeam
--- | The database type for teams as they show up in the news.
+-- | 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.)
--
data NewsTeam =
NewsTeam { team_name :: String }
(DefaultKey NewsTeam)
--- * NewsLocation
+-- * NewsLocationXml
--- | The database type for locations as they show up in the news.
+-- | The XML type for locations as they show up in the news. The
+-- associated database type comes from "TSN.Location".
--
-data NewsLocation =
- NewsLocation {
- city :: Maybe String,
- state :: Maybe String,
- country :: String }
+data NewsLocationXml =
+ NewsLocationXml {
+ xml_city :: Maybe String,
+ xml_state :: Maybe String,
+ xml_country :: String }
deriving (Eq, Show)
--- * News_NewsLocation
+instance ToDb NewsLocationXml where
+ -- | The database analogue of a NewsLocationXml is a Location.
+ type Db NewsLocationXml = Location
--- | Mapping between News records and NewsLocation records in the
+
+instance FromXml NewsLocationXml where
+ -- | To convert from the XML representation to the database one, we
+ -- don't have to do anything. Just copy the fields.
+ --
+ from_xml NewsLocationXml{..} =
+ Location xml_city xml_state xml_country
+
+
+-- | Allow us to import the XML representation directly into the
+-- database, without having to perform the conversion manually first.
+--
+instance XmlImport NewsLocationXml
+
+
+-- * News_Location
+
+-- | Mapping between 'News' records and 'Location' 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_NewsLocation = News_NewsLocation
- (DefaultKey News)
- (DefaultKey NewsLocation)
+data News_Location = News_Location
+ (DefaultKey News)
+ (DefaultKey Location)
-- | Define 'dbmigrate' and 'dbimport' for 'Message's. The import is
-- slightly non-generic because of our 'News_NewsTeam' and
--- 'News_NewsLocation' join tables.
+-- 'News_Location' join tables.
--
instance DbImport Message where
dbmigrate _ =
run_dbmigrate $ do
+ migrate (undefined :: Location)
migrate (undefined :: News)
migrate (undefined :: NewsTeam)
migrate (undefined :: News_NewsTeam)
- migrate (undefined :: NewsLocation)
- migrate (undefined :: News_NewsLocation)
+ migrate (undefined :: News_Location)
dbimport message = do
-- Insert the message and acquire its primary key (unique ID)
news_id <- insert_xml message
- -- And insert each one into its own table. 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.
+ -- 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 that the teams have been inserted, create
let news_news_teams = map (News_NewsTeam news_id) nt_ids
mapM_ insert_ news_news_teams
- -- Do all of that over again for the NewsLocations.
- loc_ids <- mapM insert_or_select (xml_locations message)
- let news_news_locations = map (News_NewsLocation news_id) loc_ids
+ -- Do all of that over again for the Locations.
+ loc_ids <- mapM insert_xml_or_select (xml_locations message)
+ let news_news_locations = map (News_Location news_id) loc_ids
mapM_ insert_ news_news_locations
return ImportSucceeded
type: constraint
fields: [team_name]
-- entity: NewsLocation
- dbName: news_locations
- constructors:
- - name: NewsLocation
- uniques:
- - name: unique_news_location
- type: constraint
- fields: [city, state, country]
-
|]
reference:
onDelete: cascade
-- entity: News_NewsLocation
- dbName: news__news_locations
+- entity: News_Location
+ dbName: news__locations
constructors:
- - name: News_NewsLocation
+ - name: News_Location
fields:
- - name: news_NewsLocation0 # Default created by mkNormalFieldName
+ - name: news_Location0 # Default created by mkNormalFieldName
dbName: news_id
reference:
onDelete: cascade
- - name: news_NewsLocation1 # Default created by mkNormalFieldName
- dbName: news_locations_id
+ - name: news_Location1 # Default created by mkNormalFieldName
+ dbName: locations_id
reference:
onDelete: cascade
|]
to_tuple m = (db_msg_id m, db_event_id m)
--- | Convert a 'NewsLocation' to/from XML.
+-- | Convert a 'NewsLocationXml' to/from XML.
--
-pickle_location :: PU NewsLocation
+pickle_location :: PU NewsLocationXml
pickle_location =
xpElem "location" $
xpWrap (from_tuple, to_tuple) $
(xpElem "country" xpText)
where
from_tuple =
- uncurryN NewsLocation
- to_tuple l = (city l, state l, country l)
+ uncurryN NewsLocationXml
+ to_tuple l = (xml_city l, xml_state l, xml_country l)
-- | Convert a 'Message' to/from XML.
where
check desc path expected = testCase desc $ do
news <- unsafe_unpickle path pickle_message
- let a = undefined :: News
- let b = undefined :: NewsTeam
- let c = undefined :: News_NewsTeam
- let d = undefined :: NewsLocation
- let e = undefined :: News_NewsLocation
+ let a = undefined :: Location
+ let b = undefined :: News
+ let c = undefined :: NewsTeam
+ let d = undefined :: News_NewsTeam
+ let e = undefined :: News_Location
actual <- withSqliteConn ":memory:" $ runDbConn $ do
runMigration silentMigrationLogger $ do
migrate a
migrate d
migrate e
_ <- dbimport news
- deleteAll a
+ deleteAll b
count_a <- countAll a
count_b <- countAll b
count_c <- countAll c
projects / dead / htsn-import.git / commitdiff
