Reorder init_logging arguments to match htsn-common.

[dead/htsn.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index 02b42ff09b2f5b58b3357147d03a5679e43f606b..38dd2e5ad5e8af5c4336c667507a6a87b74c0ccd 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -5,7 +5,7 @@ module Main
 where
 
 import Control.Concurrent ( threadDelay )
-import Control.Exception.Base ( bracket )
+import Control.Exception ( bracket, throw )
 import Control.Monad ( when )
 import Data.List ( isPrefixOf )
 import Data.Maybe ( isNothing )
@@ -37,61 +37,20 @@ import ExitCodes (
   exit_no_password,
   exit_no_username,
   exit_pidfile_exists )
-import Logging (
-  init_logging,
-  log_debug,
-  log_error,
-  log_info,
-  log_warning )
+import FeedHosts ( FeedHosts(..) )
+import Network.Services.TSN.Logging ( init_logging )
 import qualified OptionalConfiguration as OC (
   OptionalConfiguration(..),
   from_rc )
-import Terminal (
-  display_debug,
-  display_error,
-  display_info,
-  display_sent,
-  display_warning )
-import TSN.FeedHosts ( FeedHosts(..) )
-import TSN.Xml ( parse_xmlfid )
+import Network.Services.TSN.Report (
+  report_debug,
+  report_info,
+  report_warning,
+  report_error )
+import Network.Services.TSN.Terminal ( display_sent )
+import Xml ( parse_xmlfid )
 import Unix ( full_daemonize )
 
--- | Display and log debug information. WARNING! This does not
---   automatically append a newline. The output is displayed/logged
---   as-is, for, you know, debug purposes.
-report_debug :: String -> IO ()
-report_debug s = do
-  display_debug s
-  log_debug s
-
-
--- | Display and log an error condition. This will prefix the error
---   with "ERROR: " when displaying (but not logging) it so that it
---   stands out.
---
-report_error :: String -> IO ()
-report_error s = do
-  display_error $ "ERROR: " ++ s
-  log_error s
-
-
--- | Display and log an informational (status) message.
---
-report_info :: String -> IO ()
-report_info s = do
-  display_info s
-  log_info s
-
-
--- | Display and log a warning. This will prefix the warning with
---   "WARNING: " when displaying (but not logging) it so that it
---   stands out.
---
-report_warning :: String -> IO ()
-report_warning s = do
-  display_warning $ "WARNING: " ++ s
-  log_warning s
-
 
 -- | Receive a single line of text from a Handle, and send it to the
 --   debug log.
@@ -198,6 +157,7 @@ log_in cfg h = do
     else do
       send_cred h (password cfg)
       _ <- recv_line h -- "The Sports Network"
+      report_info $ "Logged in as " ++ (username cfg) ++ "."
       return ()
   where
     username_prompt = "Username: "
@@ -296,7 +256,7 @@ main = do
   -- 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)
+  init_logging (log_level cfg) (log_file cfg) (syslog cfg)
 
   -- Check the optional config for missing required options. This is
   -- necessary because if the user specifies an empty list of
@@ -336,7 +296,7 @@ main = do
 
   -- If we were asked to daemonize, do that; otherwise just run the thing.
   if (daemonize cfg)
-  then full_daemonize cfg run_program
+  then try_daemonize cfg run_program
   else run_program
 
   where
@@ -353,3 +313,16 @@ main = do
       catchIOError (connect_and_parse cfg host) (report_error . show)
       thread_sleep 5 -- Wait 5s before attempting to reconnect.
       round_robin cfg $ (feed_host_idx + 1) `mod` (length hosts)
+
+
+    -- | A exception handler around full_daemonize. If full_daemonize
+    --   doesn't work, we report the error and crash. This is fine; we
+    --   only need the program to be resilient once it actually starts.
+    --
+    try_daemonize :: Configuration -> IO () -> IO ()
+    try_daemonize cfg program =
+      catchIOError
+        (full_daemonize cfg program)
+        (\e -> do
+          report_error (show e)
+          throw e)