From: Michael Orlitzky <michael@orlitzky.com>
Date: Sun, 29 Dec 2013 00:41:07 +0000 (-0500)
Subject: Move Logging, Report, and Terminal into their own library htsn-common and depend... 
X-Git-Tag: 0.0.4~5
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=39a22e11952c31a1f058c1e457be471381eff6fa;p=dead%2Fhtsn.git

Move Logging, Report, and Terminal into their own library htsn-common and depend upon it.
---

diff --git a/htsn.cabal b/htsn.cabal
index 72c22be..09c5c0d 100644
--- a/htsn.cabal
+++ b/htsn.cabal
@@ -203,7 +203,6 @@ description:
 
 executable htsn
   build-depends:
-    ansi-terminal               == 0.6.*,
     base                        == 4.*,
     cmdargs                     >= 0.10.6,
     configurator                == 0.2.*,
@@ -211,12 +210,12 @@ executable htsn
     filepath                    == 1.3.*,
     hdaemonize                  == 0.4.*,
     hslogger                    == 1.2.*,
+    htsn-common                 == 0.0.1,
     hxt                         == 9.3.*,
     MissingH                    == 1.2.*,
     network                     == 2.4.*,
     tasty                       == 0.6.*,
     tasty-hunit                 == 0.4.*,
-    transformers                == 0.3.*,
     unix                        == 2.6.*
 
   main-is:
@@ -230,10 +229,7 @@ executable htsn
     Configuration
     ExitCodes
     FeedHosts
-    Network.Services.TSN.Logging
     OptionalConfiguration
-    Network.Services.TSN.Report
-    Network.Services.TSN.Terminal
     Unix
     Xml
 
@@ -266,7 +262,6 @@ test-suite testsuite
   hs-source-dirs: src test
   main-is: TestSuite.hs
   build-depends:
-    ansi-terminal               == 0.6.*,
     base                        == 4.*,
     cmdargs                     >= 0.10.6,
     configurator                == 0.2.*,
@@ -274,12 +269,12 @@ test-suite testsuite
     filepath                    == 1.3.*,
     hdaemonize                  == 0.4.*,
     hslogger                    == 1.2.*,
+    htsn-common                 == 0.0.1,
     hxt                         == 9.3.*,
     MissingH                    == 1.2.*,
     network                     == 2.4.*,
     tasty                       == 0.6.*,
     tasty-hunit                 == 0.4.*,
-    transformers                == 0.3.*,
     unix                        == 2.6.*
 
   -- It's not entirely clear to me why I have to reproduce all of this.
diff --git a/makefile b/makefile
index d1b5052..a0d4de7 100644
--- a/makefile
+++ b/makefile
@@ -1,23 +1,24 @@
-BIN = dist/build/htsn/htsn
+PN = htsn
+BIN = dist/build/$(PN)/$(PN)
 TESTSUITE_BIN = dist/build/testsuite/testsuite
 SRCS := $(shell find src/ -type f -name '*.hs')
 TEST_SRCS := $(shell find test/ -type f -name '*.hs')
 
 .PHONY : dist hlint
 
-$(BIN): $(SRCS)
+$(BIN): $(PN).cabal $(SRCS)
 	runghc Setup.hs clean
 	runghc Setup.hs configure --user --prefix=/
 	runghc Setup.hs build
 
-profile: $(SRCS)
+profile: $(PN).cabal $(SRCS)
 	runghc Setup.hs clean
 	runghc Setup.hs configure --user \
                                   --enable-executable-profiling \
                                   --prefix=/
 	runghc Setup.hs build
 
-doc: *.cabal $(SRCS)
+doc: $(PN).cabal $(SRCS)
 	runghc Setup.hs configure --user --prefix=/
 	runghc Setup.hs hscolour --executables
 	runghc Setup.hs haddock --internal    \
@@ -30,7 +31,7 @@ clean:
 	rm -f *.xml
 	rm -rf tmp
 
-$(TESTSUITE_BIN): $(SRCS) $(TEST_SRCS)
+$(TESTSUITE_BIN): $(PN).cabal $(SRCS) $(TEST_SRCS)
 	runghc Setup.hs configure --user --enable-tests --prefix=/
 	runghc Setup.hs build
 
diff --git a/src/Network/Services/TSN/Logging.hs b/src/Network/Services/TSN/Logging.hs
deleted file mode 100644
index a20a897..0000000
--- a/src/Network/Services/TSN/Logging.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-module Network.Services.TSN.Logging (
-  init_logging,
-  log_debug,
-  log_error,
-  log_info,
-  log_warning )
-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 )
-import System.Log.Handler.Syslog (
-  Facility ( USER ),
-  openlog )
-import System.Log.Logger (
-  Priority ( INFO ),
-  addHandler,
-  debugM,
-  errorM,
-  infoM,
-  rootLoggerName,
-  setHandlers,
-  setLevel,
-  updateGlobalLogger,
-  warningM )
-
-
--- | Log a message at the DEBUG level.
-log_debug :: String -> IO ()
-log_debug = debugM rootLoggerName
-
--- | Log a message at the ERROR level.
-log_error :: String -> IO ()
-log_error = errorM rootLoggerName
-
--- | Log a message at the INFO level.
-log_info :: String -> IO ()
-log_info = infoM rootLoggerName
-
--- | Log a message at the WARNING level.
-log_warning :: String -> IO ()
-log_warning = warningM rootLoggerName
-
-
--- | Set up the logging. All logs are handled by the global "root"
---   logger provided by HSLogger. We remove all of its handlers so
---   that it does nothing; then we conditionally add back two handlers
---   -- one for syslog, and one for a normal file -- dependent upon
---   the 'syslog' and 'log_file' configuration items.
---
---   Why don't we take a Configuration as an argument? Because it
---   would create circular imports!
-init_logging :: Maybe FilePath -> Priority -> Bool -> IO ()
-init_logging log_file log_level syslog = do
-  -- First set the global log level and clear the default handler.
-  let no_handlers = [] :: [GenericHandler a]
-  updateGlobalLogger rootLoggerName (setLevel log_level .
-                                              setHandlers no_handlers)
-
-  when syslog $ do
-    let min_level = INFO
-    let sl_level = if log_level < min_level then min_level else log_level
-
-    -- The syslog handle gets its own level which will cowardly refuse
-    -- to log all debug info (i.e. the entire feed) to syslog.
-    sl_handler' <- openlog rootLoggerName [] USER sl_level
-
-    -- Syslog should output the date by itself.
-    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)
-
-  case log_file of
-    Nothing -> return ()
-    Just lf -> do
-      lf_handler' <- fileHandler lf log_level
-      let lf_formatter = simpleLogFormatter "$time: htsn[$pid] $prio: $msg"
-      let lf_handler = setFormatter lf_handler' lf_formatter
-      updateGlobalLogger rootLoggerName (addHandler lf_handler)
diff --git a/src/Network/Services/TSN/Report.hs b/src/Network/Services/TSN/Report.hs
deleted file mode 100644
index 2423352..0000000
--- a/src/Network/Services/TSN/Report.hs
+++ /dev/null
@@ -1,57 +0,0 @@
--- | Convenience functions for reporting (display and/or logging)
---   status messages.
---
-module Network.Services.TSN.Report (
-  report_debug,
-  report_error,
-  report_info,
-  report_warning )
-where
-
-import Network.Services.TSN.Logging (
-  log_debug,
-  log_error,
-  log_info,
-  log_warning )
-import Network.Services.TSN.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/Network/Services/TSN/Terminal.hs b/src/Network/Services/TSN/Terminal.hs
deleted file mode 100644
index e24d23c..0000000
--- a/src/Network/Services/TSN/Terminal.hs
+++ /dev/null
@@ -1,79 +0,0 @@
-module Network.Services.TSN.Terminal (
-  display_debug,
-  display_error,
-  display_info,
-  display_sent,
-  display_warning )
-where
-
-import Control.Monad.IO.Class (MonadIO(..))
-import System.Console.ANSI (
-  SGR( SetColor ),
-  Color(..),
-  ColorIntensity( Vivid ),
-  ConsoleLayer( Foreground ),
-  hSetSGR )
-import System.IO ( Handle, hPutStr, stderr, stdout )
-
--- | Perform a computation (anything in MonadIO) with the given
---   graphics mode(s) enabled. Revert to the previous graphics mode
---   after the computation has finished.
-with_sgr :: (MonadIO m) => Handle -> [SGR] -> m a -> m a
-with_sgr h sgrs computation = do
-  liftIO $ hSetSGR h sgrs
-  x <- computation
-  liftIO $ hSetSGR h []
-  return x
-
--- | Perform a computation (anything in MonadIO) with the output set
---   to a certain color. Reset to the default color after the
---   computation has finished.
-with_color :: (MonadIO m) => Handle -> Color -> m a -> m a
-with_color h color =
-  with_sgr h [SetColor Foreground Vivid color]
-
-
--- | Write the given String to a handle in color. The funnyCaps are
---   for synergy with putstrLn and friends.
---
-hPutStrColor :: Handle -> Color -> String -> IO ()
-hPutStrColor h c = with_color h c . hPutStr h
-
-
--- | Write the given line to a handle in color. The funnyCaps are for
---   synergy with putstrLn and friends.
---
-hPutStrColorLn :: Handle -> Color -> String -> IO ()
-hPutStrColorLn h c s = hPutStrColor h c (s ++ "\n")
-
-
--- | Display text sent to the feed on the console. Don't automatically
---   append a newline.
---
-display_sent :: String -> IO ()
-display_sent = hPutStrColor stdout Green
-
-
--- | Display debug text on the console. Don't automatically append a
---   newline in case the raw text is needed for, uh, debugging.
---
-display_debug :: String -> IO ()
-display_debug = putStr
-
-
--- | Display an informational message on the console.
---
-display_info :: String -> IO ()
-display_info = hPutStrColorLn stdout Cyan
-
-
--- | Display a warning on the console. Uses stderr instead of stdout.
---
-display_warning :: String -> IO ()
-display_warning = hPutStrColorLn stderr Yellow
-
-
--- | Display an error on the console. Uses stderr instead of stdout.
---
-display_error :: String -> IO ()
-display_error = hPutStrColorLn stderr Red