Configuration and Concept

trace-dispatcher/src/Cardano/Logging.hs

@@ -2,8 +2,8 @@ module Cardano.Logging (
     module X
   ) where
 
-import           Cardano.Logging.Configuration as X
+import           Cardano.Logging.Types as X
 import           Cardano.Logging.Trace as X
+import           Cardano.Logging.Configuration as X
 import           Cardano.Logging.Tracer.EKG as X
 import           Cardano.Logging.Tracer.Katip as X
-import           Cardano.Logging.Types as X

trace-dispatcher/src/Cardano/Logging/Configuration.hs

@@ -31,7 +31,7 @@ filterPrivacyFromConfig = withConfig getPrivacy filterTraceByPrivacy
 -- | Take a selector function, and a function from trace to trace with
 --   this selector to make a trace transformer with a config value
 withConfig :: (MonadIO m, Eq b) =>
-     (TraceConfig -> Context -> b)
+     (TraceConfig -> Namespace -> b)
   -> (Maybe b -> Trace m a -> Trace m a)
   -> Trace m a
   -> m (Trace m a)
@@ -86,7 +86,7 @@ withConfig extract needsConfigFunc tr = do
                             ++ show (lcContext lc)
 
 -- | If no severity can be found in the config, it is set to Warning
-getSeverity :: TraceConfig -> Context -> SeverityF
+getSeverity :: TraceConfig -> Namespace -> SeverityF
 getSeverity config context =
     fromMaybe WarningF (getOption severitySelector config context)
   where
@@ -95,7 +95,7 @@ getSeverity config context =
     severitySelector _              = Nothing
 
 -- | If no privacy can be found in the config, it is set to Public
-getPrivacy :: TraceConfig -> Context -> Privacy
+getPrivacy :: TraceConfig -> Namespace -> Privacy
 getPrivacy config context =
   fromMaybe Public (getOption privacySelector config context)
   where
@@ -104,7 +104,7 @@ getPrivacy config context =
     privacySelector _             = Nothing
 
 -- | Searches in the config to find an option
-getOption :: (ConfigOption -> Maybe a) -> TraceConfig -> Context -> Maybe a
+getOption :: (ConfigOption -> Maybe a) -> TraceConfig -> Namespace -> Maybe a
 getOption sel config [] =
   case Map.lookup [] (tcOptions config) of
     Nothing -> Nothing

trace-dispatcher/src/Cardano/Logging/Trace.hs

@@ -23,14 +23,9 @@ import           Cardano.Logging.Types
 traceWith :: Monad m => Trace m a -> a -> m ()
 traceWith tr a = T.traceWith tr (emptyLoggingContext, Right a)
 
-configureTracers :: Monad m => TraceConfig -> [Trace m a] -> m ()
-configureTracers config tracers = do
-    mapM_ (configureTrace Reset) tracers
-    mapM_ (configureTrace (Config config)) tracers
-    mapM_ (configureTrace Optimize) tracers
-  where
-    configureTrace :: Monad m => TraceControl -> Trace m a -> m ()
-    configureTrace c tr = T.traceWith tr (emptyLoggingContext, Left c)
+-- | Convenience function for naming a message when tracing
+traceNamed :: Monad m => Trace m a -> Text -> a -> m ()
+traceNamed tr n = traceWith (appendName n tr)
 
 --- | Don't process further if the result of the selector function
 ---   is False.
@@ -51,14 +46,13 @@ filterTraceBySeverity :: (Monad m) =>
   -> Trace m a
 filterTraceBySeverity (Just minSeverity) = filterTrace $
     \(c, e) -> case lcSeverity c of
-                        Just s  -> fromEnum s >= fromEnum minSeverity
-                        Nothing -> True
+                  Just s  -> fromEnum s >= fromEnum minSeverity
+                  Nothing -> True
 filterTraceBySeverity Nothing = id
 
-
 -- | Appends a name to the context.
--- E.g. appendName "out" $ appendName "middle" $ appendName "in" tracer
--- give the result: `in.middle.out`.
+-- E.g. appendName "specific" $ appendName "middle" $ appendName "general" tracer
+-- give the result: `general.middle.specific`.
 appendName :: Monad m => Text -> Trace m a -> Trace m a
 appendName name = T.contramap
   (\ (lc,e) -> (lc {lcContext = name : lcContext lc}, e))
@@ -97,10 +91,33 @@ setPrivacy p = T.contramap
                     then (lc,v)
                     else (lc {lcPrivacy = Just p}, v))
 
+-- | Sets severities for the messages in this trace based on the selector function
+withPrivacy :: Monad m => (a -> Privacy) -> Trace m a -> Trace m a
+withPrivacy fs = T.contramap $
+    \case
+      (lc, Right e) -> if isJust (lcPrivacy lc)
+                          then (lc, Right e)
+                          else (lc {lcPrivacy = Just (fs e)}, Right e)
+      (lc, Left  c) -> (lc, Left c)
+
+-- | Sets detail level for the messages in this trace
+setDetails :: Monad m => DetailLevel -> Trace m a -> Trace m a
+setDetails p = T.contramap
+  (\ (lc,v) -> if isJust (lcDetails lc)
+                    then (lc,v)
+                    else (lc {lcDetails = Just p}, v))
+
+-- | Sets severities for the messages in this trace based on the selector function
+withDetails :: Monad m => (a -> DetailLevel) -> Trace m a -> Trace m a
+withDetails fs = T.contramap $
+    \case
+      (lc, Right e) -> if isJust (lcDetails lc)
+                          then (lc, Right e)
+                          else (lc {lcDetails = Just (fs e)}, Right e)
+      (lc, Left  c) -> (lc, Left c)
 
 -- | Folds the cata function with acc over a.
 -- Uses an IORef to store the state
-
 foldTraceM
   :: forall a acc m . MonadIO m
   => (acc -> a -> acc)
@@ -124,13 +141,13 @@ foldTraceM cata initial tr = do
 
 -- | Folds the monadic cata function with acc over a.
 -- Uses an IORef to store the state
-foldTraceM'
+foldMTraceM
   :: forall a acc m . MonadIO m
   => (acc -> a -> m acc)
   -> acc
   -> Trace m (Folding a acc)
   -> m (Trace m a)
-foldTraceM' cata initial tr = do
+foldMTraceM cata initial tr = do
   ref <- liftIO (newIORef initial)
   let trr = mkTracer ref
   pure (T.arrow trr)
@@ -157,3 +174,13 @@ routingTrace rf rc = T.arrow $ T.emit $
     \case
       (lc, Right x) -> T.traceWith (rf x) (lc, Right x)
       (lc, Left  c) -> T.traceWith rc     (lc, Left  c)
+
+
+configureTracers :: Monad m => TraceConfig -> [Trace m a] -> m ()
+configureTracers config tracers = do
+    mapM_ (configureTrace Reset) tracers
+    mapM_ (configureTrace (Config config)) tracers
+    mapM_ (configureTrace Optimize) tracers
+  where
+    configureTrace :: Monad m => TraceControl -> Trace m a -> m ()
+    configureTrace c tr = T.traceWith tr (emptyLoggingContext, Left c)

trace-dispatcher/src/Cardano/Logging/Tracer/Katip.hs

@@ -22,7 +22,7 @@ import           Katip.Core (ScribeHandle (..), WorkerMessage (..),
 import           Katip.Scribes.Handle (ioLogEnv)
 import           System.IO (stdout)
 
-import           Cardano.Logging.Types
+import           Cardano.Logging.Types hiding(Namespace)
 
 stdoutObjectKatipTracer :: (MonadIO m, LogItem a) => m (Trace m a)
 stdoutObjectKatipTracer = do

trace-dispatcher/src/Cardano/Logging/Types.hs

@@ -4,36 +4,33 @@
 module Cardano.Logging.Types where
 
 import           Control.Tracer
+import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Data.Text (Text)
 import           Katip (LogEnv, Severity, ToObject)
 
-type Context = [Text]
+type Namespace = [Text]
+type Selector  = [Text]
 
 -- | Configurable tracer which carries a context while tracing
 type Trace m a = Tracer m (LoggingContext, Either TraceControl a)
 
 data LoggingContext = LoggingContext {
-    lcContext  :: Context
-  , lcSeverity :: Maybe Severity
-  , lcPrivacy  :: Maybe Privacy
+    lcContext     :: Namespace
+  , lcSeverity    :: Maybe Severity
+  , lcPrivacy     :: Maybe Privacy
+  , lcDetails     :: Maybe DetailLevel
 }
 
-emptyLoggingContext :: LoggingContext
-emptyLoggingContext = LoggingContext [] Nothing Nothing
-
-data LoggingContextKatip = LoggingContextKatip {
-    lk       :: LoggingContext
-  , lkLogEnv :: LogEnv
-}
+data Form = HumanF | MachineF
 
 -- | Formerly known as verbosity
-data DetailLevel =
-      DBrief
-    | DRegular
-    | DDetailed
+data DetailLevel = DBrief | DRegular | DDetailed
     deriving (Show, Eq, Ord, Bounded, Enum)
 
+emptyLoggingContext :: LoggingContext
+emptyLoggingContext = LoggingContext [] Nothing Nothing Nothing
+
 data Privacy =
       Confidential -- confidential information - handle with care
     | Public       -- can be public.
@@ -59,7 +56,7 @@ data ConfigOption =
     -- | Severity level (default is WarningF)
     CoSeverity SeverityF
     -- | Detail level (Default is DRegular)
-  | CoDetailLevel DetailLevel
+  | CoDetail DetailLevel
     -- | Privacy level (Default is Public)
   | CoPrivacy Privacy
     -- | Defined in messages per second (Defaul is 10)
@@ -69,7 +66,7 @@ data TraceConfig = TraceConfig {
     tcName :: Text
 
      -- | Options specific to a certain namespace
-  , tcOptions :: Map.Map Context [ConfigOption]
+  , tcOptions :: Map.Map Namespace [ConfigOption]
 
   --  Forwarder:
      -- Can their only be one forwarder? Use one of:
@@ -104,3 +101,8 @@ data TraceControl =
     Reset
   | Config TraceConfig
   | Optimize
+
+data LoggingContextKatip = LoggingContextKatip {
+    lk       :: LoggingContext
+  , lkLogEnv :: LogEnv
+}