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