From da61a6744550e974688d46b23b11f1a842e4da2e Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sat, 28 Dec 2013 18:50:11 -0500 Subject: [PATCH] Move the TSN namespace (Xml.hs and FeedHosts.hs) into the top level. Move the report_foo functions into their own module. Get the process name automatically in init_logging. --- htsn.cabal | 7 +++-- makefile | 2 +- src/Configuration.hs | 2 +- src/{TSN => }/FeedHosts.hs | 2 +- src/Logging.hs | 5 ++- src/Main.hs | 59 ++++++------------------------------ src/OptionalConfiguration.hs | 2 +- src/Report.hs | 57 ++++++++++++++++++++++++++++++++++ src/{TSN => }/Xml.hs | 2 +- test/TestSuite.hs | 2 +- 10 files changed, 80 insertions(+), 60 deletions(-) rename src/{TSN => }/FeedHosts.hs (98%) create mode 100644 src/Report.hs rename src/{TSN => }/Xml.hs (99%) diff --git a/htsn.cabal b/htsn.cabal index 2d3e676..a25b7e9 100644 --- a/htsn.cabal +++ b/htsn.cabal @@ -1,5 +1,5 @@ name: htsn -version: 0.0.3 +version: 0.0.4 cabal-version: >= 1.8 author: Michael Orlitzky maintainer: Michael Orlitzky @@ -229,12 +229,13 @@ executable htsn CommandLine Configuration ExitCodes + FeedHosts Logging OptionalConfiguration + Report Terminal - TSN.FeedHosts - TSN.Xml Unix + Xml ghc-options: -Wall diff --git a/makefile b/makefile index b31b678..45ed838 100644 --- a/makefile +++ b/makefile @@ -3,7 +3,7 @@ TESTSUITE_BIN = dist/build/testsuite/testsuite .PHONY : dist hlint -$(BIN): src/*.hs src/TSN/*.hs +$(BIN): src/*.hs runghc Setup.hs clean runghc Setup.hs configure --user --prefix=/ runghc Setup.hs build diff --git a/src/Configuration.hs b/src/Configuration.hs index 10e01bc..49213c3 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -13,7 +13,7 @@ import System.Log ( Priority( INFO ) ) import qualified OptionalConfiguration as OC ( OptionalConfiguration(..), merge_maybes ) -import TSN.FeedHosts (FeedHosts(..)) +import FeedHosts (FeedHosts(..)) -- | The main configuration data type. This will be passed to most of -- the important functions once it has been created. diff --git a/src/TSN/FeedHosts.hs b/src/FeedHosts.hs similarity index 98% rename from src/TSN/FeedHosts.hs rename to src/FeedHosts.hs index 81f57aa..b3fcc48 100644 --- a/src/TSN/FeedHosts.hs +++ b/src/FeedHosts.hs @@ -8,7 +8,7 @@ -- instance is specific to TSN, even though otherwise it's just a -- list of strings. -- -module TSN.FeedHosts +module FeedHosts where -- DC is needed only for the DCT.Configured instance of String. diff --git a/src/Logging.hs b/src/Logging.hs index ede739a..63101c6 100644 --- a/src/Logging.hs +++ b/src/Logging.hs @@ -7,6 +7,7 @@ module Logging ( where import Control.Monad ( when ) +import System.Environment ( getProgName ) import System.Log.Formatter ( simpleLogFormatter ) import System.Log.Handler ( setFormatter ) import System.Log.Handler.Simple ( GenericHandler, fileHandler ) @@ -67,7 +68,9 @@ init_logging log_file log_level syslog = do sl_handler' <- openlog rootLoggerName [] USER sl_level -- Syslog should output the date by itself. - let sl_formatter = simpleLogFormatter "htsn[$pid] $prio: $msg" + program_name <- getProgName + let sl_formatter = simpleLogFormatter $ + program_name ++ "[$pid] $prio: $msg" let sl_handler = setFormatter sl_handler' sl_formatter updateGlobalLogger rootLoggerName (addHandler sl_handler) diff --git a/src/Main.hs b/src/Main.hs index 2b0b5b9..ece44a8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 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 Report ( + report_debug, + report_info, + report_warning, + report_error ) +import 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. diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index 3b663d0..33ca3d9 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -34,9 +34,9 @@ import System.FilePath ( () ) import System.IO.Error ( catchIOError ) import System.Log ( Priority(..) ) +import FeedHosts ( FeedHosts(..) ) import Logging ( log_error ) -- Can't import report_error from Main import Terminal ( display_error ) -- 'cause of circular imports. -import TSN.FeedHosts ( FeedHosts(..) ) -- Derive standalone instances of Data and Typeable for Priority. This diff --git a/src/Report.hs b/src/Report.hs new file mode 100644 index 0000000..925a018 --- /dev/null +++ b/src/Report.hs @@ -0,0 +1,57 @@ +-- | Convenience functions for reporting (display and/or logging) +-- status messages. +-- +module Report ( + report_debug, + report_error, + report_info, + report_warning ) +where + +import Logging ( + log_debug, + log_error, + log_info, + log_warning ) +import Terminal ( + display_debug, + display_error, + display_info, + display_warning ) + + +-- | 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 diff --git a/src/TSN/Xml.hs b/src/Xml.hs similarity index 99% rename from src/TSN/Xml.hs rename to src/Xml.hs index ebc4fb7..7f82a7d 100644 --- a/src/TSN/Xml.hs +++ b/src/Xml.hs @@ -1,7 +1,7 @@ -- | Minimal XML functionality needed to parse each document's -- XML_File_ID. -- -module TSN.Xml ( +module Xml ( parse_xmlfid, xml_tests ) where diff --git a/test/TestSuite.hs b/test/TestSuite.hs index f5d6d3c..668f019 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -1,6 +1,6 @@ import Test.Tasty ( TestTree, defaultMain ) -import TSN.Xml ( xml_tests ) +import Xml ( xml_tests ) tests :: TestTree tests = xml_tests -- 2.43.2