simple-log 0.8.5 → 0.9.0

raw patch · 5 files changed

+34/−22 lines, 5 filesdep ~hformat

Dependency ranges changed: hformat

Files

• simple-log.cabal +2/−2
• src/System/Log/Simple.hs +3/−3
• src/System/Log/Simple/Base.hs +10/−2
• src/System/Log/Simple/Stream.hs +12/−1
• src/System/Log/Simple/Text.hs +7/−14

@@ -1,5 +1,5 @@ Name:                 simple-log
-Version:              0.8.5
+Version:              0.9.0
 Synopsis:             Simple log for Haskell
 Description:          Log library for Haskell
 License:              BSD3
@@ -28,7 +28,7 @@     directory >= 1.2 && < 1.4,
     exceptions >= 0.8 && < 0.9,
     filepath >= 1.4 && < 1.5,
-    hformat == 0.2.*,
+    hformat == 0.3.*,
     microlens == 0.4.*,
     microlens-platform == 0.3.*,
     mmorph == 1.0.*,

@@ -85,13 +85,13 @@ import System.Log.Simple.Chan
 
 globalLog ∷ Log
-globalLog = unsafePerformIO $ newLog defCfg [handler text console]
+globalLog = unsafePerformIO $ newLog defCfg [handler text coloredConsole]
 
-runGlobalLog ∷ (MonadIO m, MonadMask m) ⇒ LogT m a → m a
+runGlobalLog ∷ LogT m a → m a
 runGlobalLog = withLog globalLog
 
 runConsoleLog ∷ (MonadIO m, MonadMask m) ⇒ LogConfig → LogT m a → m a
-runConsoleLog cfg = runLog cfg [handler text console]
+runConsoleLog cfg = runLog cfg [handler text coloredConsole]
 
 runLogChan ∷ (MonadIO m, MonadMask m) ⇒ (Chan w → LogHandler) → LogConfig → LogT m a → m (a, [w])
 runLogChan c cfg act = do

@@ -49,6 +49,14 @@ instance Default Level where
 	def = Trace
 
+instance Formattable Level where
+	formattable Trace _ = "TRACE" `withFlags` ["gray"]
+	formattable Debug _ = "DEBUG" `withFlags` ["yellow"]
+	formattable Info _ = "INFO" `withFlags` ["blue"]
+	formattable Warning _ = "WARN" `withFlags` ["darkyellow"]
+	formattable Error _ = "ERROR" `withFlags` ["red"]
+	formattable Fatal _ = "FATAL" `withFlags` ["bg=red"]
+
 -- | Component — each one have separate log scopes and can have different politics
 -- Child component's root politics inherits its parent root politics
 -- Component name parts stored in reverse order
@@ -57,7 +65,7 @@ instance Show Component where
 	show = T.unpack ∘ T.intercalate "." ∘ reverse ∘ componentPath
 
-instance FormatBuild Component
+instance Formattable Component
 
 instance Read Component where
 	readsPrec _ = return ∘ flip (,) "" ∘ Component ∘ reverse ∘ splitBy '.' ∘ T.pack
@@ -78,7 +86,7 @@ instance Show Scope where
 	show = T.unpack ∘ T.intercalate "/" ∘ reverse ∘ scopePath
 
-instance FormatBuild Scope
+instance Formattable Scope
 
 instance Read Scope where
 	readsPrec _ = return ∘ flip (,) "" ∘ Scope ∘ reverse ∘ splitBy '/' ∘ T.pack

@@ -1,5 +1,6 @@ module System.Log.Simple.Stream (
-	stream, console
+	stream, console,
+	coloredStream, coloredConsole
 	) where
 
 import Control.Monad.IO.Class
@@ -7,6 +8,8 @@ import qualified Data.Text.IO as T
 import System.Log.Simple.Base
 import System.IO
+import Text.Format (Formatted)
+import Text.Format.Colored
 
 stream ∷ Handle → Consumer Text
 stream h = do
@@ -15,3 +18,11 @@ 
 console ∷ Consumer Text
 console = stream stderr
+
+coloredStream ∷ Handle → Consumer Formatted
+coloredStream h = do
+	liftIO $ hSetEncoding h utf8
+	return $ \f → hColored h f >> hFlush h
+
+coloredConsole ∷ Consumer Formatted
+coloredConsole = coloredStream stderr

@@ -3,7 +3,6 @@ 	textFmt, text, shortText, msgOnly
 	) where
 
-import Data.Text (Text)
 import Data.Time
 import Text.Format
 
@@ -13,27 +12,21 @@ defaultTimeFormat ∷ String
 defaultTimeFormat = "%_Y-%m-%d %T %z"
 
-textFmt ∷ String → String → Converter Text
+textFmt ∷ FormatResult r ⇒ String → String → Converter r
 textFmt tmFmt msgFmt (Message tm l comp scope msg) = format msgFmt ~~ args where
 	args = [
 		"time" ~% formatTime defaultTimeLocale tmFmt tm,
-		"level" ~% toStr l,
+		"level" ~% l,
 		"component" ~% comp,
 		"scope" ~% scope,
 		"message" ~% msg]
-	toStr Trace = "TRACE"
-	toStr Debug = "DEBUG"
-	toStr Info = "INFO"
-	toStr Warning = "WARN"
-	toStr Error = "ERROR"
-	toStr Fatal = "FATAL"
 
 -- | Text log converter with default time format
-text ∷ Converter Text
-text = textFmt defaultTimeFormat "{time}\t{level}\t{component}:{scope}> {message}"
+text ∷ FormatResult r ⇒ Converter r
+text = textFmt defaultTimeFormat "{time:cyan}\t{level}\t{component:magenta}:{scope:green}> {message}"
 
-shortText ∷ Converter Text
-shortText = textFmt defaultTimeFormat "{level}\t{component}: {message}"
+shortText ∷ FormatResult r ⇒ Converter r
+shortText = textFmt defaultTimeFormat "{level}\t{component:magenta}: {message}"
 
-msgOnly ∷ Converter Text
+msgOnly ∷ FormatResult r ⇒ Converter r
 msgOnly = textFmt defaultTimeFormat "{message}"