dbus-hslogger 0.1.1.0 → 0.1.1.1
raw patch · 6 files changed
+93/−66 lines, 6 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +10/−0
- Setup.hs +1/−0
- app/Main.hs +30/−24
- dbus-hslogger.cabal +6/−5
- src/System/Log/DBus/Client.hs +4/−2
- src/System/Log/DBus/Server.hs +42/−35
+ ChangeLog.md view
@@ -0,0 +1,10 @@+# Changelog for dbus-hslogger++## 0.1.1.1 - 2026-05-13++- Update package metadata for the taffybar monorepo release.+- Clean up compiler warnings in the client executable.++## 0.1.1.0++- Previous Hackage release.
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
app/Main.hs view
@@ -1,49 +1,55 @@ {-# LANGUAGE OverloadedStrings #-}+ module Main where import Control.Monad import DBus import DBus.Client-import Data.Semigroup ((<>)) import Options.Applicative import System.Log.DBus.Client levelP :: Parser String levelP = strOption- ( long "level"- <> short 'l'- <> help "The level to which to set the log"- <> metavar "LEVEL"- <> value "INFO"- )+ ( long "level"+ <> short 'l'+ <> help "The level to which to set the log"+ <> metavar "LEVEL"+ <> value "INFO"+ ) prefixP :: Parser String prefixP = strOption- ( long "prefix"- <> short 'p'- <> help "The log prefix whose level will be set"- <> metavar "PREFIX"- <> value "System.Taffybar"- )+ ( long "prefix"+ <> short 'p'+ <> help "The log prefix whose level will be set"+ <> metavar "PREFIX"+ <> value "System.Taffybar"+ ) busNameP :: Parser BusName-busNameP = busName_ <$>- strOption- ( long "bus-name"- <> short 'b'- <> help "The bus name to which the message should be sent"- <> value "org.taffybar.Bar"- )+busNameP =+ busName_+ <$> strOption+ ( long "bus-name"+ <> short 'b'+ <> help "The bus name to which the message should be sent"+ <> value "org.taffybar.Bar"+ ) doSetLogLevel :: Client -> Parser (IO (Either MethodError ())) doSetLogLevel client = setLogLevel client <$> busNameP <*> prefixP <*> levelP +main :: IO () main = do client <- connectSession- res <- join $ execParser $- info (doSetLogLevel client <**> helper)- ( fullDesc- <> progDesc "Set the log level of a running process")+ res <-+ join $+ execParser $+ info+ (doSetLogLevel client <**> helper)+ ( fullDesc+ <> progDesc "Set the log level of a running process"+ ) print res
dbus-hslogger.cabal view
@@ -5,12 +5,12 @@ -- see: https://github.com/sol/hpack name: dbus-hslogger-version: 0.1.1.0+version: 0.1.1.1 synopsis: Expose a dbus server to control hslogger-description: Please see the README on Github at <https://github.com/IvanMalison/dbus-hslogger#readme>+description: Please see the README on Github at <https://github.com/taffybar/dbus-hslogger#readme> category: System-homepage: https://github.com/IvanMalison/dbus-hslogger#readme-bug-reports: https://github.com/IvanMalison/dbus-hslogger/issues+homepage: https://github.com/taffybar/dbus-hslogger#readme+bug-reports: https://github.com/taffybar/dbus-hslogger/issues author: Ivan Malison maintainer: IvanMalison@gmail.com copyright: Ivan Malison@@ -19,10 +19,11 @@ build-type: Simple extra-source-files: README.md+ ChangeLog.md source-repository head type: git- location: https://github.com/IvanMalison/dbus-hslogger+ location: https://github.com/taffybar/dbus-hslogger library exposed-modules:
src/System/Log/DBus/Client.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE TemplateHaskell #-}+ module System.Log.DBus.Client where import DBus.Generation import System.Log.DBus.Server -generateClient defaultGenerationParams { genObjectPath = Just logPath }- logIntrospectionInterface+generateClient+ defaultGenerationParams {genObjectPath = Just logPath}+ logIntrospectionInterface
src/System/Log/DBus/Server.hs view
@@ -1,14 +1,15 @@ {-# 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 DBus+import DBus.Client import qualified DBus.Introspection as I-import System.Log.Logger-import Text.Read+import Data.IORef+import Data.Map (Map)+import qualified Data.Map as Map+import System.Log.Logger+import Text.Read maybeToEither :: b -> Maybe a -> Either b a maybeToEither = flip maybe Right . Left@@ -26,8 +27,8 @@ getLogger logPrefix >>= saveGlobalLogger . setLevel level modifyIORef' ref (Map.insert logPrefix level) -setLogLevelFromPriorityStringTracked- :: LogServer -> String -> String -> IO (Either Reply ())+setLogLevelFromPriorityStringTracked ::+ LogServer -> String -> String -> IO (Either Reply ()) setLogLevelFromPriorityStringTracked server logPrefix levelString = case readMaybe levelString of Just level -> Right <$> setLogLevelTracked server logPrefix level@@ -48,24 +49,28 @@ -- | 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)- ]- }+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"- , interfaceMethods = [ autoMethod "SetLogLevel" setLogLevelFromPriorityString ]- }+logInterface =+ defaultInterface+ { interfaceName = "org.taffybar.LogServer",+ interfaceMethods = [autoMethod "SetLogLevel" setLogLevelFromPriorityString]+ } logPath :: ObjectPath logPath = "/org/taffybar/LogServer"@@ -86,22 +91,24 @@ -- | Introspection interface including all methods (SetLogLevel, GetLogLevel, -- GetConfiguredLogLevels). Suitable for TH client generation. logIntrospectionInterface :: I.Interface-logIntrospectionInterface = buildIntrospectionInterface $- defaultInterface- { interfaceName = "org.taffybar.LogServer"- , interfaceMethods =- [ autoMethod "SetLogLevel" setLogLevelFromPriorityString- , autoMethod "GetLogLevel" getLogLevel- , autoMethod "GetConfiguredLogLevels"- (return Map.empty :: IO (Map String String))- ]- }+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+ getMaybeResult = traverse (setLogLevel logPrefix) maybePriority+ in maybeToEither (ReplyError errorInvalidParameters []) <$> getMaybeResult setLogLevel :: String -> Priority -> IO () setLogLevel logPrefix level =