From: Michael Orlitzky <michael@orlitzky.com>
Date: Sun, 29 Dec 2013 07:16:52 +0000 (-0500)
Subject: Make it really import the XML files from the command line.
X-Git-Tag: 0.0.1~150
X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhtsn-import.git;a=commitdiff_plain;h=ce611b60b9c42e176b215453f0d0f862d2d5d0fd

Make it really import the XML files from the command line.
Jump through a bunch of hoops to get proper status messages (and error reporting) from the arrow composition.
---

diff --git a/src/Main.hs b/src/Main.hs
index 9151a8e..e94d21b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -16,6 +16,7 @@ import Data.Maybe ( isNothing )
 import Data.Monoid ( (<>) )
 import System.Console.CmdArgs ( def )
 import System.Exit ( exitWith, ExitCode (ExitFailure) )
+import System.IO.Error ( catchIOError )
 import Text.XML.HXT.Core (
   ArrowXml,
   IOStateArrow,
@@ -82,26 +83,30 @@ import_generic :: (XmlPickler a, PersistEntity b)
                => b          -- ^ Dummy Listing instance needed for 'migrate'
                -> (a -> [b]) -- ^ listings getter
                -> XmlTree
-               -> IO ()
+               -> IO (Maybe Int) -- ^ Return the number of records inserted.
 import_generic dummy g xml =
   withSqliteConn "foo.sqlite3" $ runDbConn $ do
     runMigration defaultMigrationLogger $ do
       migrate dummy
     let root_element = unpickleDoc xpickle xml
     case root_element of
-      Nothing -> let msg = "Could not unpickle document in import_generic."
-                 in liftIO $ report_error msg
-      Just elt  -> mapM_ (\l -> insert l) (g elt)
+      Nothing -> do
+        let msg = "Could not unpickle document in import_generic."
+        liftIO $ report_error msg
+        return Nothing
+      Just elt  -> do
+        ids <- mapM (\l -> insert l) (g elt)
+        return $ Just (length ids)
 
 -- | Import TSN.Injuries from an 'XmlTree'.
-import_injuries :: XmlTree -> IO ()
+import_injuries :: XmlTree -> IO (Maybe Int)
 import_injuries =
   import_generic
     (undefined :: Injuries.Listing)
     Injuries.listings
 
 -- | Import TSN.InjuriesDetail from an 'XmlTree'.
-import_injuries_detail :: XmlTree -> IO ()
+import_injuries_detail :: XmlTree -> IO (Maybe Int)
 import_injuries_detail =
   import_generic
     (undefined :: InjuriesDetail.PlayerListing)
@@ -109,12 +114,24 @@ import_injuries_detail =
 
 import_file :: FilePath -> IO ()
 import_file path = do
-  report_info $ "Attempting to import " ++ path ++ "."
-  results <- runX $ readA >>> (doctypeA &&& returnA) >>> (arr import_with_dtd)
+  results <- catchIOError
+               parse_and_import
+               (\e -> do
+                  report_error (show e)
+                  report_error $ "Failed to import file " ++ path ++ "."
+                  -- Return a nonempty list so we don't claim incorrectly that
+                  -- we couldn't parse the DTD.
+                  return [ Nothing ] )
+
   case results of
+    -- If results' is empty, one of the arrows return "nothing."
     []    -> report_error $ "Unable to determine DTD for file " ++ path ++ "."
-    (r:_) -> r -- Need to do something with the result or it gets GCed?
-               -- We do only expect one result fortunately.
+    (r:_) ->
+      case r of
+        Nothing -> return ()
+        Just cnt -> report_info $ "Successfully imported " ++
+                                  (show cnt) ++
+                                  " records from " ++ path ++ "."
   where
     -- | An arrow that reads a document into an 'XmlTree'.
     readA :: IOStateArrow s a XmlTree
@@ -125,15 +142,28 @@ import_file path = do
     doctypeA :: ArrowXml a => a XmlTree String
     doctypeA = getAttrl >>> hasName "doctype-SYSTEM" /> getText
 
+    -- | Combine the arrows above as well as the function below
+    --   (arrowized with 'arr') into an IO action that does everything
+    --   (parses and then runs the import on what was parsed).
+    --
+    --   The result of runX has type IO [IO (Maybe Int)]. We thus use
+    --   bind (>>=) and sequence to combine all of the IOs into one
+    --   big one outside of the list.
+    parse_and_import :: IO [Maybe Int]
+    parse_and_import =
+      (runX $ readA >>> (doctypeA &&& returnA) >>> (arr import_with_dtd))
+      >>=
+      sequence
+
     -- | Takes a 'Doctype', 'XmlTree' pair and uses the 'Doctype' to
     --   determine which function to call on the 'XmlTree'.
-    import_with_dtd :: (String, XmlTree) -> IO ()
+    import_with_dtd :: (String, XmlTree) -> IO (Maybe Int)
     import_with_dtd (dtd,xml)
       | dtd == "injuriesxml.dtd" = import_injuries xml
       | dtd == "Injuries_Detail_XML.dtd" = import_injuries_detail xml
-      | otherwise = report_info $
-                      "Unrecognized DTD in " ++ path ++ ": " ++ dtd ++ "."
-
+      | otherwise = do
+          report_info $ "Unrecognized DTD in " ++ path ++ ": " ++ dtd ++ "."
+          return Nothing
 
 main :: IO ()
 main = do
@@ -163,5 +193,6 @@ main = do
     report_error "No connection string supplied."
     exitWith (ExitFailure exit_no_connection_string)
 
-
-  return ()
+  -- We don't do this in parallel (for now?) to keep the error
+  -- messages nice and linear.
+  mapM_ import_file (OC.xml_files opt_config)