Skip to content
Browse files

Move logChannel to package logging-hslogger

  • Loading branch information...
1 parent 36c75ed commit 0450e3f8df231db5babf995cd06d2085797c0276 @sol committed Jan 2, 2012
Showing with 41 additions and 42 deletions.
  1. +29 −0 logging-hslogger/src/Logging/HsLogger.hs
  2. +0 −2 logging.cabal
  3. +12 −8 src/Logging.hs
  4. +0 −23 src/Util.hs
  5. +0 −8 test/Main.hs
  6. +0 −1 test/run.sh
View
29 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
View
2 logging.cabal
@@ -17,5 +17,3 @@ library
, format
exposed-modules:
Logging
- other-modules:
- Util
View
20 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)
View
23 src/Util.hs
@@ -1,23 +0,0 @@
-module Util where
-
--- | 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
View
8 test/Main.hs
@@ -1,8 +0,0 @@
-module Main (main) where
-
-import Test.Framework (defaultMain)
-import Test.Framework.Providers.DocTest
-
-main = do
- doctests <- docTest ["Util"] ["-i../src"]
- defaultMain [doctests]
View
1 test/run.sh
@@ -2,5 +2,4 @@
cd "`dirname $0`"
-runhaskell -i../src Main.hs $*
runhaskell -i../src Spec.hs $*

0 comments on commit 0450e3f

Please sign in to comment.
Something went wrong with that request. Please try again.