dbus-hslogger 0.1.0.1 → 0.1.1.0

raw patch · 2 files changed

+89/−17 lines, 2 filesdep +containersdep ~dbusdep ~hsloggerdep ~optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependency ranges changed: dbus, hslogger, optparse-applicative

API changes (from Hackage documentation)

Files

• dbus-hslogger.cabal +10/−9
• src/System/Log/DBus/Server.hs +79/−8

@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack------ hash: d10ade94173aa22bc569628b2b342aadba89e35c4b5bcd8eeef077de9db3b2e7  name:           dbus-hslogger-version:        0.1.0.1+version:        0.1.1.0 synopsis:       Expose a dbus server to control hslogger description:    Please see the README on Github at <https://github.com/IvanMalison/dbus-hslogger#readme> category:       System@@ -17,7 +17,6 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10 extra-source-files:     README.md @@ -35,8 +34,9 @@       src   build-depends:       base >=4.7 && <5+    , containers >=0.5 && <1     , dbus >=1.0.1 && <2-    , hslogger+    , hslogger >=1.2 && <2   default-language: Haskell2010  executable dbus-hslogger-client@@ -48,8 +48,9 @@   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.7 && <5-    , dbus >=1.0.0 && <2.0.0+    , containers >=0.5 && <1+    , dbus >=1.0.0 && <2     , dbus-hslogger-    , hslogger-    , optparse-applicative+    , hslogger >=1.2 && <2+    , optparse-applicative >=0.14 && <1   default-language: Haskell2010

@@ -1,6 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module System.Log.DBus.Server where +import           Data.IORef+import           Data.Map (Map)+import qualified Data.Map as Map import           DBus import           DBus.Client import qualified DBus.Introspection as I@@ -10,16 +13,54 @@ maybeToEither :: b -> Maybe a -> Either b a maybeToEither = flip maybe Right . Left -setLogLevelFromPriorityString :: String -> String -> IO (Either Reply ())-setLogLevelFromPriorityString logPrefix levelString =-  let maybePriority = readMaybe levelString-      getMaybeResult = sequenceA $ setLogLevel logPrefix <$> maybePriority-  in maybeToEither (ReplyError errorInvalidParameters []) <$> getMaybeResult+-- | An opaque handle for the log server, which tracks loggers whose levels+-- have been explicitly set.+newtype LogServer = LogServer (IORef (Map String Priority)) -setLogLevel :: String -> Priority -> IO ()-setLogLevel logPrefix level =+-- | Create a new 'LogServer'.+newLogServer :: IO LogServer+newLogServer = LogServer <$> newIORef Map.empty++setLogLevelTracked :: LogServer -> String -> Priority -> IO ()+setLogLevelTracked (LogServer ref) logPrefix level = do   getLogger logPrefix >>= saveGlobalLogger . setLevel level+  modifyIORef' ref (Map.insert logPrefix level) +setLogLevelFromPriorityStringTracked+  :: LogServer -> String -> String -> IO (Either Reply ())+setLogLevelFromPriorityStringTracked server logPrefix levelString =+  case readMaybe levelString of+    Just level -> Right <$> setLogLevelTracked server logPrefix level+    Nothing -> return $ Left (ReplyError errorInvalidParameters [])++-- | Get the log level of a specific logger. Returns the level as a string,+-- or an empty string if no level has been explicitly set on that logger.+getLogLevel :: String -> IO String+getLogLevel logPrefix = do+  logger <- getLogger logPrefix+  return $ maybe "" show (getLevel logger)++-- | Get all loggers whose levels have been explicitly set via 'SetLogLevel',+-- as a map from logger name to level string.+getConfiguredLogLevels :: LogServer -> IO (Map String String)+getConfiguredLogLevels (LogServer ref) =+  Map.map show <$> readIORef ref++-- | Build the D-Bus interface with tracking and introspection methods.+logInterfaceWithServer :: LogServer -> Interface+logInterfaceWithServer server = defaultInterface+  { interfaceName = "org.taffybar.LogServer"+  , interfaceMethods =+      [ autoMethod "SetLogLevel"+          (setLogLevelFromPriorityStringTracked server)+      , autoMethod "GetLogLevel" getLogLevel+      , autoMethod "GetConfiguredLogLevels"+          (getConfiguredLogLevels server)+      ]+  }++-- | The original interface with only 'SetLogLevel'. Kept for backward+-- compatibility. logInterface :: Interface logInterface = defaultInterface   { interfaceName = "org.taffybar.LogServer"@@ -29,9 +70,39 @@ logPath :: ObjectPath logPath = "/org/taffybar/LogServer" +-- | Start the log server with tracking and introspection. Returns a+-- 'LogServer' handle that can be used to register additional loggers.+startLogServerWithTracking :: Client -> IO LogServer+startLogServerWithTracking client = do+  server <- newLogServer+  export client logPath (logInterfaceWithServer server)+  return server++-- | Start the log server (original API, no tracking). startLogServer :: Client -> IO () startLogServer client =   export client logPath logInterface +-- | Introspection interface including all methods (SetLogLevel, GetLogLevel,+-- GetConfiguredLogLevels). Suitable for TH client generation. logIntrospectionInterface :: I.Interface-logIntrospectionInterface = buildIntrospectionInterface logInterface+logIntrospectionInterface = buildIntrospectionInterface $+  defaultInterface+    { interfaceName = "org.taffybar.LogServer"+    , interfaceMethods =+        [ autoMethod "SetLogLevel" setLogLevelFromPriorityString+        , autoMethod "GetLogLevel" getLogLevel+        , autoMethod "GetConfiguredLogLevels"+            (return Map.empty :: IO (Map String String))+        ]+    }++setLogLevelFromPriorityString :: String -> String -> IO (Either Reply ())+setLogLevelFromPriorityString logPrefix levelString =+  let maybePriority = readMaybe levelString+      getMaybeResult = sequenceA $ setLogLevel logPrefix <$> maybePriority+  in maybeToEither (ReplyError errorInvalidParameters []) <$> getMaybeResult++setLogLevel :: String -> Priority -> IO ()+setLogLevel logPrefix level =+  getLogger logPrefix >>= saveGlobalLogger . setLevel level