news_tests,
-- * WARNING: these are private but exported to silence warnings
News_LocationConstructor(..),
- News_NewsTeamConstructor(..),
- NewsConstructor(..),
- NewsTeamConstructor(..) )
+ News_TeamConstructor(..),
+ NewsConstructor(..) )
where
-- System imports.
import Database.Groundhog.Generic ( runDbConn )
import Database.Groundhog.Sqlite ( withSqliteConn )
import Database.Groundhog.TH (
- defaultCodegenConfig,
groundhog,
mkPersist )
import Test.Tasty ( TestTree, testGroup )
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(..),
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,
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
--
-- | 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
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)
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.
- 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
-- 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.
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
projects / dead / htsn-import.git / commitdiff
