X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=6a0380091a65d60f342b86bdb65190e4d024bce5;hb=ce9fabd584f2e8844b8b1ede9b29bb573e2033f7;hp=ed28f919b7e349e782b8e62e4cacc7f2ecfa120c;hpb=53c5550fee7f8a39a7906545978f15876a06fbd1;p=dead%2Fhtsn-import.git diff --git a/src/Main.hs b/src/Main.hs index ed28f91..6a03800 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -28,7 +28,9 @@ import Text.XML.HXT.Core ( getText, hasName, readDocument, - runX ) + runX, + unpickleDoc, + xpickle) import Backend ( Backend(..) ) import CommandLine ( get_args ) @@ -43,10 +45,10 @@ import Network.Services.TSN.Report ( report_error ) import TSN.DbImport ( DbImport(..), ImportResult(..) ) import qualified TSN.XML.Heartbeat as Heartbeat ( verify ) -import qualified TSN.XML.Injuries as Injuries ( Listing ) -import qualified TSN.XML.InjuriesDetail as InjuriesDetail ( PlayerListing ) -import qualified TSN.XML.News as News ( News ) -import qualified TSN.XML.Odds as Odds ( Odds ) +import qualified TSN.XML.Injuries as Injuries ( Message ) +import qualified TSN.XML.InjuriesDetail as InjuriesDetail ( Message ) +import qualified TSN.XML.News as News ( Message ) +--import qualified TSN.XML.Odds as Odds ( Odds ) import Xml ( DtdName(..), parse_opts ) @@ -68,32 +70,30 @@ import_file :: Configuration -- ^ A configuration object needed for the -> FilePath -- ^ The path of the XML file to import. - -> IO (Maybe Int) -- ^ If we processed the file, Just the number - -- of records imported. Otherwise, Nothing. + -> IO Bool -- ^ True if we processed the file, False otherwise. import_file cfg path = do results <- parse_and_import `catch` exception_handler case results of [] -> do -- One of the arrows returned "nothing." report_error $ "Unable to determine DTD for file " ++ path ++ "." - return Nothing + return False (ImportFailed errmsg:_) -> do report_error errmsg - return Nothing + return False (ImportSkipped infomsg:_) -> do -- We processed the message but didn't import anything. Return -- "success" so that the XML file is deleted. report_info infomsg - return $ Just 0 - (ImportSucceeded count:_) -> do - report_info $ "Successfully imported " ++ (show count) ++ - " records from " ++ path ++ "." - return $ Just count + return True + (ImportSucceeded:_) -> do + report_info $ "Successfully imported " ++ path ++ "." + return True (ImportUnsupported infomsg:_) -> do -- For now we return "success" for these too, since we know we don't -- support a bunch of DTDs and we want them to get deleted. report_info infomsg - return $ Just 0 + return True where -- | This will catch *any* exception, even the ones thrown by -- Haskell's 'error' (which should never occur under normal @@ -135,29 +135,39 @@ import_file cfg path = do -- We special-case the heartbeat so it doesn't have to run in -- the database monad. | dtd == "Heartbeat.dtd" = Heartbeat.verify xml - | otherwise = + | otherwise = do -- We need NoMonomorphismRestriction here. if backend cfg == Postgres - then withPostgresqlConn cs $ runDbConn $ importer xml - else withSqliteConn cs $ runDbConn $ importer xml + 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 == "injuriesxml.dtd" = - dbimport (undefined :: Injuries.Listing) + | dtd == "injuriesxml.dtd" = do + let m = unpickleDoc xpickle xml :: Maybe Injuries.Message + let errmsg = "Could not unpickle injuriesxml." + maybe (return $ ImportFailed errmsg) migrate_and_import m + + | dtd == "Injuries_Detail_XML.dtd" = do + let m = unpickleDoc xpickle xml :: Maybe InjuriesDetail.Message + let errmsg = "Could not unpickle Injuries_Detail_XML." + maybe (return $ ImportFailed errmsg) migrate_and_import m - | dtd == "Injuries_Detail_XML.dtd" = - dbimport (undefined :: InjuriesDetail.PlayerListing) - | dtd == "newsxml.dtd" = - dbimport (undefined :: News.News) + | dtd == "newsxml.dtd" = do + let m = unpickleDoc xpickle xml :: Maybe News.Message + let errmsg = "Could not unpickle newsxml." + maybe (return $ ImportFailed errmsg) migrate_and_import m - | dtd == "Odds_XML.dtd" = undefined + -- | dtd == "Odds_XML.dtd" = undefined - | otherwise = \_ -> do -- Dummy arg simplifies the other cases. + | otherwise = do let infomsg = "Unrecognized DTD in " ++ path ++ ": " ++ dtd ++ "." return $ ImportUnsupported infomsg @@ -197,10 +207,10 @@ main = do -- Zip the results with the files list to find out which ones can be -- deleted. let result_pairs = zip (OC.xml_files opt_config) results - let victims = [ (p,c) | (p, Just c) <- result_pairs ] - let imported_count = sum $ map snd victims - report_info $ "Imported " ++ (show imported_count) ++ " records total." - mapM_ ((kill True) . fst) victims + let victims = [ p | (p, True) <- result_pairs ] + let imported_count = length victims + report_info $ "Imported " ++ (show imported_count) ++ " document(s) total." + mapM_ (kill True) victims where -- | Wrap these two actions into one function so that we don't