Move logChannel to package logging-hslogger

logging-hslogger/src/Logging/HsLogger.hs

@@ -17,3 +17,32 @@ hsLoggerSink m = HsLogger.logM channel level $(format "{linfo} - {message}")
       INFO  -> HsLogger.INFO
       WARN  -> HsLogger.WARNING
       ERROR -> HsLogger.ERROR
+
+logChannel :: LogRecord -> String
+logChannel m = $(format "{package}.{module_}")
+  where
+    loc = logLocation m
+    package = stripVersion $ locationPackage loc
+    module_ = locationModule loc
+
+-- | Strip version string from given package name.
+--
+-- The package name @main@ is returned verbatim.  If the package name is not
+-- @main@, we assume that there is always a version string, delimited with a
+-- @\'-\'@ from the package name.  Behavior is unspecified for package names
+-- that are neither @main@ nor have a version string.
+--
+-- Examples:
+--
+-- >>> stripVersion "main"
+-- "main"
+--
+-- >>> stripVersion "foo-0.0.0"
+-- "foo"
+--
+-- >>> stripVersion "foo-bar-0.0.0"
+-- "foo-bar"
+stripVersion :: String -> String
+stripVersion p = case p of
+  "main" -> p
+  _ -> reverse $ tail $ dropWhile (/= '-') $ reverse p

logging.cabal

@@ -17,5 +17,3 @@ library
     , format
   exposed-modules:
       Logging
-  other-modules:
-      Util

src/Logging.hs

@@ -5,15 +5,25 @@ module Logging (
 , logInfo
 , logWarn
 , logError
+
 , LogRecord
-, logChannel
 , logLevel
 , logMessage
 , logLocation
-, formatLocation
+
 , LogLevel (..)
+
+, Location
+, locationFilename
+, locationPackage
+, locationModule
+, locationLine
+, locationColumn
+, formatLocation
+
 , setLogSink
 , defaultLogSink
+
 , error
 , undefined
 ) where
@@ -31,12 +41,6 @@ import           Data.IORef
 import           Foreign (unsafePerformIO)
 
 import           Text.Format (formatS, format)
-import           Util (stripVersion)
-
--- | Compatibility function for old LogRecord format
-logChannel :: LogRecord -> String
-logChannel m = let loc = logLocation m in
-  (stripVersion $ locationPackage loc) ++ "." ++ locationModule loc
 
 data LogLevel = TRACE | DEBUG | INFO | WARN | ERROR
   deriving (Eq, Show)

test/run.sh

@@ -2,5 +2,4 @@
 
 cd "`dirname $0`"
 
-runhaskell -i../src Main.hs $*
 runhaskell -i../src Spec.hs $*