core-program 0.4.5.3 → 0.4.6.1

raw patch · 4 files changed

+21/−15 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• core-program.cabal +1/−1
• lib/Core/Program/Context.hs +3/−0
• lib/Core/Program/Execute.hs +3/−3
• lib/Core/Program/Logging.hs +14/−11

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           core-program-version:        0.4.5.3+version:        0.4.6.1 synopsis:       Opinionated Haskell Interoperability description:    A library to help build command-line programs, both tools and                 longer-running daemons.

@@ -233,6 +233,8 @@     | -- | @since 0.2.12       Verbose     | Debug+    | -- | @since 0.4.6+      Internal     deriving (Show)  {- |@@ -491,6 +493,7 @@      in case debug of             Just value -> case value of                 Empty -> Right Debug+                Value "internal" -> Right Internal                 Value _ -> Left (ExitFailure 2)             Nothing -> case verbose of                 Just value -> case value of

@@ -438,7 +438,7 @@      reportStatus start num = do         level <- readMVar v-        when (isDebug level) $ do+        when (isInternal level) $ do             now <- getCurrentTimeNanoseconds             let desc = case num of                     1 -> "1 event"@@ -449,7 +449,7 @@                         now                         True                         SeverityInternal-                        ("telemetry: sent " <> desc)+                        ("Sent " <> desc)             atomically $ do                 writeTQueue out (Just message) @@ -463,7 +463,7 @@                         now                         True                         SeverityWarn-                        ("sending telemetry failed (Exception: " <> intoRope (show e) <> "); Restarting exporter.")+                        ("Sending telemetry failed (Exception: " <> intoRope (show e) <> "); Restarting exporter.")             atomically $ do                 writeTQueue out (Just message) 

@@ -144,6 +144,7 @@     internal,     isEvent,     isDebug,+    isInternal, ) where  import Chrono.TimeStamp (TimeStamp (..), getCurrentTimeNanoseconds)@@ -162,7 +163,6 @@ import Core.Text.Colour import Core.Text.Rope import Core.Text.Utilities-import Data.Maybe (isJust)  data Message = Message TimeStamp Severity Rope (Maybe Rope) @@ -401,13 +401,22 @@     Output -> False     Verbose -> True     Debug -> True+    Internal -> True  isDebug :: Verbosity -> Bool isDebug level = case level of     Output -> False     Verbose -> False     Debug -> True+    Internal -> True +isInternal :: Verbosity -> Bool+isInternal level = case level of+    Output -> False+    Verbose -> False+    Debug -> False+    Internal -> True+ {- | Output a debugging message formed from a label and a value. This is like 'event' above but for the (rather common) case of needing to inspect or record@@ -467,18 +476,12 @@             !value' <- evaluate value             putMessage context (Message now SeverityDebug label (Just value')) -isTelemetry :: Context t -> Bool-isTelemetry context =-    let forwarder = telemetryForwarderFrom context-     in isJust forwarder--internal :: Rope -> Rope -> Program τ ()-internal label value = do+internal :: Rope -> Program τ ()+internal label = do     context <- ask     liftIO $ do         level <- readMVar (verbosityLevelFrom context) -        when ((isDebug level) && (isTelemetry context)) $ do+        when (isInternal level) $ do             now <- getCurrentTimeNanoseconds-            !value' <- evaluate value-            putMessage context (Message now SeverityInternal (label <> value') Nothing)+            putMessage context (Message now SeverityInternal label Nothing)