packages feed

caster 0.0.1.0 → 0.0.2.0

raw patch · 3 files changed

+61/−5 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ System.Log.Caster: terminalFormatter :: Formatter
+ System.Log.Caster: terminalListener :: Listener

Files

caster.cabal view
@@ -1,5 +1,5 @@ name:                caster-version:             0.0.1.0+version:             0.0.2.0 synopsis:            Multicast, thread-safe, and fast logger. description:         Please see the README on GitHub at <https://github.com/kirisaki/caster#readme> homepage:            https://github.com/kirisaki/caster#readme@@ -20,7 +20,6 @@  library   exposed-modules: System.Log.Caster-  -- other-extensions:   build-depends:       base >= 4.10                      , bytestring >= 0.10.8.2                      , fast-builder >= 0.1.0.0
src/System/Log/Caster.hs view
@@ -22,10 +22,12 @@   -- * Listeners   , stdoutListener   , stdoutListenerWith+  , terminalListener   , handleListener   , handleListenerFlush   -- * Formatter   , defaultFormatter+  , terminalFormatter   -- * Log levels   , LogLevel(..)   , logAs@@ -174,12 +176,45 @@ stdoutListener :: Listener stdoutListener = stdoutListenerWith defaultFormatter +-- | Terminal listener. Log levels are colored.+terminalListener :: Listener+terminalListener = stdoutListenerWith terminalFormatter  -- | Default log formatter. defaultFormatter :: Formatter defaultFormatter (LogMsg lev ut str) =   formatTime ut <> " - [" <> logLevelToBuilder lev <> "] " <> str <> "\n" +-- | Formatter for term.+--   It provides colored logs.+terminalFormatter :: Formatter+terminalFormatter = terminalFormatterWith+                    "\ESC[32m"+                    "\ESC[36m"+                    "\ESC[4m\ESC[36m"+                    "\ESC[4m\ESC[33m"+                    "\ESC[4m\ESC[31m"+                    "\ESC[1m\ESC[31m"+                    "\ESC[1m\ESC[35m"+                    "\ESC[5m\ESC[35m"++-- | Formatter with specified colors for log levels.+--   Parameters are just @FB.Builder@, so you can decorate as you like with ansi escaping.+terminalFormatterWith :: FB.Builder -> FB.Builder -> FB.Builder -> FB.Builder -> FB.Builder -> FB.Builder -> FB.Builder -> FB.Builder -> Formatter+terminalFormatterWith fDebug fInfo fNotice fWarn fError fCritical fAlert fEmergency (LogMsg lev ut str) =+  formatTime ut <> " - " <> fmt <>  "[" <> logLevelToBuilder lev <> "]\ESC[0m " <> str <> "\n"+  where+    fmt = case lev of+      LogDebug     -> fDebug+      LogInfo      -> fInfo+      LogNotice    -> fNotice+      LogWarn      -> fWarn+      LogError     -> fError+      LogCritical  -> fCritical+      LogAlert     -> fAlert+      LogEmergency -> fEmergency++ logLevelToBuilder :: LogLevel -> FB.Builder logLevelToBuilder = \case   LogDebug -> "DEBUG"@@ -189,13 +224,14 @@   LogError -> "ERROR"   LogCritical -> "CRITICAL"   LogAlert -> "ALERT"-  LogEmergency -> "EMERGEBCY"+  LogEmergency -> "EMERGENCY" + {-# NOINLINE formatTime #-} formatTime :: UnixTime -> FB.Builder formatTime ut =   let-    ut' = FB.byteString . unsafePerformIO $ formatUnixTime "%Y-%m-d %T" ut+    ut' = FB.byteString . unsafePerformIO $ formatUnixTime "%Y-%m-%d %T" ut     utMilli = FB.string7 . tail . show $ utMicroSeconds ut `div` 1000 + 1000   in     ut' <> "." <> utMilli
test/CasterTest.hs view
@@ -22,6 +22,9 @@ import           System.Directory import           System.IO +logLevels :: [LogLevel]+logLevels = [LogDebug, LogInfo, LogNotice, LogWarn, LogError, LogCritical, LogAlert, LogEmergency]+ prop_toBuilder_String :: String -> Bool prop_toBuilder_String str = (LT.unpack . LTE.decodeUtf8 . FB.toLazyByteString $ toBuilder str) == str @@ -48,7 +51,7 @@ prop_concat str0 str1 = (LT.unpack . LTE.decodeUtf8 . FB.toLazyByteString $ str0 <:> str1) == str0 <> str1  instance Arbitrary LogLevel where-  arbitrary = elements [LogDebug, LogInfo, LogNotice, LogWarn, LogError, LogCritical, LogAlert, LogEmergency]+  arbitrary = elements logLevels  prop_broadcastLog :: [(LogLevel, String)] -> Property prop_broadcastLog msgs = monadicIO $ do@@ -90,3 +93,21 @@     pure res    QCM.assert result++unit_stdout :: IO ()+unit_stdout = testListenrWith stdoutListener++unit_terminal :: IO ()+unit_terminal = testListenrWith terminalListener++testListenrWith :: Listener -> IO ()+testListenrWith l = do+  chan <- newLogChan+  lq <- newLogQueue+  thread0 <- forkIO $ relayLog chan LogDebug l+  threadb <- forkIO $ broadcastLog lq chan+  forM_ logLevels (\l -> logAs lq l "nyaan")+  threadDelay 100000+  killThread thread0+  killThread threadb+