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 +1/−2
- src/System/Log/Caster.hs +38/−2
- test/CasterTest.hs +22/−1
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+