X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=9151a8ef06112a1b966b30938a34ca82aa22dd63;hb=9d278c8b8eeff1a1317f2c3b0f7fdf5fb759ffb3;hp=11cbfae1305c7d446eca0b00168a0c3cc14431f3;hpb=5726138127d880a12421a78b37a178e061c46efe;p=dead%2Fhtsn-import.git

diff --git a/src/Main.hs b/src/Main.hs
index 11cbfae..9151a8e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,6 +2,8 @@ module Main
 where
 
 import Control.Arrow ( (&&&), arr, returnA )
+import Control.Monad ( when )
+import Control.Monad.IO.Class ( liftIO )
 import Database.Groundhog.Core ( PersistEntity )
 import Database.Groundhog.Sqlite (
   defaultMigrationLogger,
@@ -10,6 +12,10 @@ import Database.Groundhog.Sqlite (
   runDbConn,
   runMigration,
   withSqliteConn )
+import Data.Maybe ( isNothing )
+import Data.Monoid ( (<>) )
+import System.Console.CmdArgs ( def )
+import System.Exit ( exitWith, ExitCode (ExitFailure) )
 import Text.XML.HXT.Core (
   ArrowXml,
   IOStateArrow,
@@ -31,7 +37,19 @@ import Text.XML.HXT.Core (
   withValidate,
   xpickle,
   yes )
-import System.Environment ( getArgs )
+
+import CommandLine ( get_args )
+import Configuration ( Configuration(..), merge_optional )
+import ExitCodes (
+  exit_no_connection_string,
+  exit_no_xml_files )
+import Network.Services.TSN.Logging ( init_logging )
+import qualified OptionalConfiguration as OC (
+  OptionalConfiguration ( connection_string, xml_files ),
+  from_rc )
+import Network.Services.TSN.Report (
+  report_info,
+  report_error )
 import qualified TSN.Injuries as Injuries (
   Listing,
   Message ( listings ) )
@@ -41,6 +59,7 @@ import qualified TSN.InjuriesDetail as InjuriesDetail (
   PlayerListing )
 
 
+
 -- | A list of options passed to 'readDocument' when we parse an XML
 --   document. We don't validate because the DTDs from TSN are
 --   wrong. As a result, we don't want to keep useless DTDs
@@ -68,10 +87,11 @@ import_generic dummy g xml =
   withSqliteConn "foo.sqlite3" $ runDbConn $ do
     runMigration defaultMigrationLogger $ do
       migrate dummy
-    let msg = unpickleDoc xpickle xml
-    case msg of
-      Nothing -> error "Should unpickle!"
-      Just m  -> mapM_ (\l -> insert l) (g m)
+    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)
 
 -- | Import TSN.Injuries from an 'XmlTree'.
 import_injuries :: XmlTree -> IO ()
@@ -89,9 +109,10 @@ 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)
   case results of
-    []    -> error "ERROR: Unable to determine DOCTYPE."
+    []    -> 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.
   where
@@ -110,10 +131,37 @@ import_file path = do
     import_with_dtd (dtd,xml)
       | dtd == "injuriesxml.dtd" = import_injuries xml
       | dtd == "Injuries_Detail_XML.dtd" = import_injuries_detail xml
-      | otherwise = error "ERROR: Unrecognized DTD."
+      | otherwise = report_info $
+                      "Unrecognized DTD in " ++ path ++ ": " ++ dtd ++ "."
 
 
 main :: IO ()
 main = do
-  args <- getArgs
-  import_file (args !! 0)
+  rc_cfg <- OC.from_rc
+  cmd_cfg <- get_args
+
+  -- Merge the config file options with the command-line ones,
+  -- prefering the command-line ones.
+  let opt_config = rc_cfg <> cmd_cfg
+
+  -- Update a default config with any options that have been set in
+  -- either the config file or on the command-line.  We initialize
+  -- logging before the missing parameter checks below so that we can
+  -- log the errors.
+  let cfg = (def :: Configuration) `merge_optional` opt_config
+  init_logging (log_file cfg) (log_level cfg) (syslog cfg)
+
+  -- Check the optional config for missing required options.
+  when (null $ OC.xml_files opt_config) $ do
+    report_error "No XML files given."
+    exitWith (ExitFailure exit_no_xml_files)
+
+  -- There's a default connection string, namely the empty string, but
+  -- it's not much use to us. So we make sure that we were given
+  -- something explicitly.
+  when (isNothing (OC.connection_string opt_config)) $ do
+    report_error "No connection string supplied."
+    exitWith (ExitFailure exit_no_connection_string)
+
+
+  return ()