- -- | Takes a 'Doctype', 'XmlTree' pair and uses the 'Doctype' to
- -- determine which function to call on the 'XmlTree'.
- import_with_dtd :: (String, XmlTree) -> IO (Maybe Int)
- import_with_dtd (dtd,xml) =
- -- We need NoMonomorphismRestriction here.
- if backend cfg == Postgres
- then withPostgresqlConn cs $ runDbConn $ importer xml
- else withSqliteConn cs $ runDbConn $ importer xml
- where
- -- | Pull the real connection String out of the configuration.
- cs :: String
- cs = get_connection_string $ connection_string cfg
+ -- | Takes a ('DtdName', 'XmlTree') pair and uses the 'DtdName'
+ -- to determine which function to call on the 'XmlTree'.
+ import_with_dtd :: (DtdName, XmlTree) -> IO ImportResult
+ import_with_dtd (DtdName dtd,xml)
+ -- We special-case the heartbeat so it doesn't have to run in
+ -- the database monad.
+ | dtd == Heartbeat.dtd = Heartbeat.verify xml
+ | otherwise =
+ -- We need NoMonomorphismRestriction here.
+ if backend cfg == Postgres
+ then withPostgresqlConn cs $ runDbConn importer
+ else withSqliteConn cs $ runDbConn importer
+ where
+ -- | Pull the real connection String out of the configuration.
+ --
+ cs :: String
+ cs = get_connection_string $ connection_string cfg
+
+ -- | Convenience; we use this everywhere below in 'importer'.
+ --
+ migrate_and_import m = dbmigrate m >> dbimport m
+
+ importer
+ | dtd == AutoRacingResults.dtd = do
+ let m = unpickleDoc AutoRacingResults.pickle_message xml
+ maybe (return $ ImportFailed errmsg) migrate_and_import m
+
+ | dtd == AutoRacingSchedule.dtd = do
+ let m = unpickleDoc AutoRacingSchedule.pickle_message xml
+ maybe (return $ ImportFailed errmsg) migrate_and_import m
+
+ -- GameInfo and SportInfo appear least in the guards
+ | dtd == Injuries.dtd = do
+ let m = unpickleDoc Injuries.pickle_message xml
+ maybe (return $ ImportFailed errmsg) migrate_and_import m
+
+ | dtd == InjuriesDetail.dtd = do
+ let m = unpickleDoc InjuriesDetail.pickle_message xml
+ maybe (return $ ImportFailed errmsg) migrate_and_import m
+