diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -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. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/dbus-hslogger.cabal b/dbus-hslogger.cabal --- a/dbus-hslogger.cabal +++ b/dbus-hslogger.cabal @@ -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 +description: Please see the README on Github at 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: diff --git a/src/System/Log/DBus/Client.hs b/src/System/Log/DBus/Client.hs --- a/src/System/Log/DBus/Client.hs +++ b/src/System/Log/DBus/Client.hs @@ -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 diff --git a/src/System/Log/DBus/Server.hs b/src/System/Log/DBus/Server.hs --- a/src/System/Log/DBus/Server.hs +++ b/src/System/Log/DBus/Server.hs @@ -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 =