core-program 0.3.4.0 → 0.3.4.1

raw patch · 4 files changed

+30/−19 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• core-program.cabal +1/−1
• lib/Core/Program/Context.hs +7/−14
• lib/Core/Program/Execute.hs +14/−2
• lib/Core/Program/Logging.hs +8/−2

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

@@ -25,7 +25,6 @@     handleTelemetryChoice,     Exporter (..),     Forwarder (..),-    emptyForwarder,     None (..),     isNone,     configure,@@ -35,7 +34,7 @@     getContext,     fmapContext,     subProgram,-    Boom(..),+    Boom (..), ) where  import Chrono.TimeStamp (TimeStamp, getCurrentTimeNanoseconds)@@ -135,12 +134,6 @@     { telemetryHandlerFrom :: [Datum] -> IO ()     } -emptyForwarder :: Forwarder-emptyForwarder =-    Forwarder-        { telemetryHandlerFrom = \_ -> pure ()-        }- {- | Internal context for a running program. You access this via actions in the 'Program' monad. The principal item here is the user-supplied top-level@@ -185,7 +178,7 @@       outputChannelFrom :: TQueue (Maybe Rope)     , telemetryChannelFrom :: TQueue (Maybe Datum)     , -- machinery for telemetry-      telemetryForwarderFrom :: Forwarder+      telemetryForwarderFrom :: Maybe Forwarder     , currentDatumFrom :: MVar Datum     , applicationDataFrom :: MVar τ     }@@ -373,7 +366,7 @@             , verbosityLevelFrom = level -- will be filled in handleVerbosityLevel             , outputChannelFrom = out             , telemetryChannelFrom = tel-            , telemetryForwarderFrom = emptyForwarder+            , telemetryForwarderFrom = Nothing             , currentDatumFrom = v             , applicationDataFrom = u             }@@ -459,7 +452,7 @@         result <- lookupEnv var         return $ case result of             Just value -> insertKeyValue name (Value value) acc-            Nothing -> acc+            Nothing -> insertKeyValue name Empty acc  handleVerbosityLevel :: Context τ -> IO (MVar Verbosity) handleVerbosityLevel context = do@@ -515,7 +508,7 @@                 -- and return it                 pure                     context-                        { telemetryForwarderFrom = forwarder+                        { telemetryForwarderFrom = Just forwarder                         }   where     lookupExporter :: Rope -> [Exporter] -> Maybe Exporter@@ -525,10 +518,10 @@             False -> lookupExporter target exporters             True -> Just exporter -{-|+{- | A utility exception for those occasions when you just need to go "boom". -} data Boom = Boom-  deriving Show+    deriving (Show)  instance Exception Boom

@@ -365,8 +365,20 @@ -- the technique used   by **io-streams** to just pass along a stream of Maybes, -- with Nothing signalling end-of-stream is exactly good enough for our needs. ---processTelemetryMessages :: Forwarder -> MVar Verbosity -> TQueue (Maybe Rope) -> TQueue (Maybe Datum) -> IO ()-processTelemetryMessages processor v out tel = do+processTelemetryMessages :: Maybe Forwarder -> MVar Verbosity -> TQueue (Maybe Rope) -> TQueue (Maybe Datum) -> IO ()+processTelemetryMessages Nothing _ _ tel = do+    ignoreForever tel+  where+    ignoreForever queue = do+        possibleItem <- atomically $ do+            readTQueue queue -- blocks+        case possibleItem of+            -- time to shutdown+            Nothing -> pure ()+            -- otherwise igonore+            Just _ -> do+                ignoreForever queue+processTelemetryMessages (Just processor) v out tel = do     Safe.catch         (loopForever action v out tel)         (collapseHandler "telemetry processing collapsed")

@@ -140,7 +140,6 @@     debug,     debugS,     debugR,-     -- internal     internal,     isEvent,@@ -163,6 +162,7 @@ import Core.Text.Colour import Core.Text.Rope import Core.Text.Utilities+import Data.Maybe (isJust)  data Message = Message TimeStamp Severity Rope (Maybe Rope) @@ -456,12 +456,18 @@             !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     context <- ask     liftIO $ do         level <- readMVar (verbosityLevelFrom context)-        when (isDebug level) $ do++        when ((isDebug level) && (isTelemetry context)) $ do             now <- getCurrentTimeNanoseconds             !value' <- evaluate value             putMessage context (Message now SeverityInternal (label <> value') Nothing)