X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=88d1cfa9898f4b5477ca703376cd0a7d65a508b5;hb=d02bef0d005f364d552a66f5c6798b2874213dbb;hp=648ddae40a22a708d5b0edf8971bb031faae03a7;hpb=a0853ebe00e630b7d50f97949d4dd45c602bd454;p=dead%2Fhtsn-import.git diff --git a/src/Main.hs b/src/Main.hs index 648ddae..88d1cfa 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -48,6 +48,7 @@ import TSN.DbImport ( DbImport(..), ImportResult(..) ) import qualified TSN.XML.AutoRacingSchedule as AutoRacingSchedule ( dtd, pickle_message ) +import qualified TSN.XML.GameInfo as GameInfo ( dtds, parse_xml ) import qualified TSN.XML.Heartbeat as Heartbeat ( dtd, verify ) import qualified TSN.XML.Injuries as Injuries ( dtd, pickle_message ) import qualified TSN.XML.InjuriesDetail as InjuriesDetail ( @@ -56,6 +57,7 @@ import qualified TSN.XML.InjuriesDetail as InjuriesDetail ( import qualified TSN.XML.News as News ( dtd, pickle_message ) import qualified TSN.XML.Odds as Odds ( dtd, pickle_message ) import qualified TSN.XML.Scores as Scores ( dtd, pickle_message ) +import qualified TSN.XML.SportInfo as SportInfo ( dtds, parse_xml ) import qualified TSN.XML.Weather as Weather ( dtd, pickle_message ) import Xml ( DtdName(..), parse_opts ) @@ -163,6 +165,7 @@ import_file cfg path = 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 @@ -184,10 +187,27 @@ import_file cfg path = do let m = unpickleDoc Scores.pickle_message xml maybe (return $ ImportFailed errmsg) migrate_and_import m + -- SportInfo and GameInfo appear least in the guards | dtd == Weather.dtd = do let m = unpickleDoc Weather.pickle_message xml maybe (return $ ImportFailed errmsg) migrate_and_import m + | dtd `elem` GameInfo.dtds = do + let either_m = GameInfo.parse_xml dtd xml + case either_m of + -- This might give us a slightly better error + -- message than the default 'errmsg'. + Left err -> return $ ImportFailed err + Right m -> migrate_and_import m + + | dtd `elem` SportInfo.dtds = do + let either_m = SportInfo.parse_xml dtd xml + case either_m of + -- This might give us a slightly better error + -- message than the default 'errmsg'. + Left err -> return $ ImportFailed err + Right m -> migrate_and_import m + | otherwise = do let infomsg = "Unrecognized DTD in " ++ path ++ ": " ++ dtd ++ "."