{-# LANGUAGE TypeFamilies #-}
-- | Parse TSN XML for the DTD \"weatherxml.dtd\". Each document
--- contains a bunch of forecasts, which each contain one league, and
--- that league contains a bunch of listings.
+-- contains a bunch of forecasts, which each contain zero or more
+-- leagues, which in turn (each) contain a bunch of listings.
--
module TSN.XML.Weather (
dtd,
import Database.Groundhog (
countAll,
deleteAll,
+ insert_,
migrate,
runMigration,
silentMigrationLogger )
xml_weather :: String }
deriving (Eq, Show)
--- | Database representation of a weather forecast listing.
+
+-- | Database representation of a weather forecast listing. The
+-- 'db_league_name' field should come from the containing \<league\>
+-- element which is not stored in the database.
--
data WeatherForecastListing =
WeatherForecastListing {
db_weather_forecasts_id :: DefaultKey WeatherForecast,
+ db_league_name :: Maybe String,
db_teams :: String,
db_weather :: String }
--- | The database analogue of a 'WeatherForecastListingXml' is
--- 'WeatherForecastListing'.
+-- | We don't make 'WeatherForecastListingXml' an instance of
+-- 'FromXmlFk' because it needs some additional information, namely
+-- the league name from its containing \<league\> element.
--
-instance ToDb WeatherForecastListingXml where
- type Db WeatherForecastListingXml = WeatherForecastListing
-
-
-instance Child WeatherForecastListingXml where
- -- | Each 'WeatherForecastListingXml' is contained in a
- -- 'WeatherForecast'.
- --
- type Parent WeatherForecastListingXml = WeatherForecast
-
-
--- | This is needed to define the 'XmlImportFk' instance for
--- 'WeatherForecastListing'.
+-- When supplied with a forecast id and a league name, this will
+-- turn an XML listing into a database one.
--
-instance FromXmlFk WeatherForecastListingXml where
- from_xml_fk fk WeatherForecastListingXml{..} =
+from_xml_fk_league :: DefaultKey WeatherForecast
+ -> (Maybe String)
+ -> WeatherForecastListingXml
+ -> WeatherForecastListing
+from_xml_fk_league fk ln WeatherForecastListingXml{..} =
WeatherForecastListing {
db_weather_forecasts_id = fk,
+ db_league_name = ln,
db_teams = xml_teams,
db_weather = xml_weather }
--- | This allows us to insert the XML representation
--- 'WeatherForecastListingXml' directly.
---
-instance XmlImportFk WeatherForecastListingXml
-
-- * WeatherLeague
-- | XML representation of a league, as they appear in the weather
-- documents. There is no associated database representation because
-- the league element really adds no information besides its own
--- (usually empty) name. Since there's exactly one league per
--- forecast, we just store the league_name in the database
--- representation of a forecast.
+-- (usually empty) name. The leagues contain listings, so we
+-- associate the league name with each listing instead.
--
data WeatherLeague =
WeatherLeague {
- league_name :: Maybe String,
- listings :: [WeatherForecastListingXml] }
+ league_name :: Maybe String,
+ listings :: [WeatherForecastListingXml] }
deriving (Eq, Show)
data WeatherForecast =
WeatherForecast {
db_weather_id :: DefaultKey Weather,
- db_game_date :: UTCTime,
- db_league_name :: Maybe String }
+ db_game_date :: UTCTime }
+
--- | XML representation of a weather forecast. It would have been
--- cleaner to omit the 'WeatherLeague' middleman, but having it
--- simplifies parsing.
+-- | XML representation of a weather forecast.
--
data WeatherForecastXml =
WeatherForecastXml {
xml_game_date :: UTCTime,
- xml_league :: WeatherLeague }
+ xml_leagues :: [WeatherLeague] }
deriving (Eq, Show)
+
instance ToDb WeatherForecastXml where
-- | The database representation of a 'WeatherForecastXml' is a
-- 'WeatherForecast'.
instance FromXmlFk WeatherForecastXml where
-- | To convert a 'WeatherForecastXml' into a 'WeatherForecast', we
- -- replace the 'WeatherLeague' with its name.
+ -- just copy everything verbatim.
--
from_xml_fk fk WeatherForecastXml{..} =
WeatherForecast {
db_weather_id = fk,
- db_game_date = xml_game_date,
- db_league_name = (league_name xml_league) }
+ db_game_date = xml_game_date }
-- | This allows us to call 'insert_xml' on an 'WeatherForecastXml'
migrate (undefined :: WeatherForecastListing)
dbimport m = do
- -- The weather database schema has a nice linear structure. First
- -- we insert the top-level weather record.
+ -- First we insert the top-level weather record.
weather_id <- insert_xml m
-- Next insert all of the forecasts, one at a time.
forM_ (xml_forecasts m) $ \forecast -> do
forecast_id <- insert_xml_fk weather_id forecast
- -- Insert all of this forecast's listings.
- mapM_ (insert_xml_fk_ forecast_id) (listings $ xml_league forecast)
+ -- With the forecast id in hand, loop through this forecast's
+ -- leagues...
+ forM_ (xml_leagues forecast) $ \league -> do
+ -- Construct the function that converts an XML listing to a
+ -- database one.
+ let todb = from_xml_fk_league forecast_id (league_name league)
+
+ -- Now use it to convert all of the XML listings.
+ let db_listings = map todb (listings league)
+
+ -- And finally, insert those DB listings.
+ mapM_ insert_ db_listings
return ImportSucceeded
xpWrap (from_pair, to_pair) $
xpPair
(xpAttr "gamedate" xp_gamedate)
- pickle_league
+ (xpList pickle_league)
where
from_pair = uncurry WeatherForecastXml
to_pair WeatherForecastXml{..} = (xml_game_date,
- xml_league)
+ xml_leagues)
projects / dead / htsn-import.git / commitdiff