status-notifier-item 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+79/−31 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/StatusNotifier/Host/Service.hs +75/−25
• src/StatusNotifier/Util.hs +1/−1
• src/StatusNotifier/Watcher/Service.hs +0/−1
• status-notifier-item.cabal +3/−4

@@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}  module StatusNotifier.Host.Service where @@ -12,22 +13,29 @@ import           Control.Monad.Except import           DBus import           DBus.Client+import           DBus.Generation+import           DBus.Internal.Types import qualified DBus.Internal.Message as M+import qualified DBus.TH as DTH import qualified Data.ByteString as BS+import           Data.Coerce import           Data.Either import           Data.Int import qualified Data.Map.Strict as Map import           Data.Maybe import           Data.String+import           Data.Unique import           Data.Word import           System.Log.Logger import           Text.Printf -import qualified StatusNotifier.Item.Constants as I import qualified StatusNotifier.Item.Client as I+import qualified StatusNotifier.Item.Constants as I import           StatusNotifier.Util import qualified StatusNotifier.Watcher.Client as W+import qualified StatusNotifier.Watcher.Constants as W import qualified StatusNotifier.Watcher.Signals as W+import qualified StatusNotifier.Watcher.Service as W  statusNotifierHostString :: String statusNotifierHostString = "StatusNotifierHost"@@ -44,20 +52,22 @@   | TitleUpdated   | TooltipUpdated deriving (Eq, Show) +type UpdateHandler = UpdateType -> ItemInfo -> IO ()+ data Params = Params   { dbusClient :: Maybe Client   , uniqueIdentifier :: String   , namespace :: String-  , handleUpdate :: UpdateType -> ItemInfo -> IO ()-  , hostLogger :: Logger+  , startWatcher :: Bool   } +hostLogger = logM "StatusNotifier.Host.Service"+ defaultParams = Params   { dbusClient = Nothing   , uniqueIdentifier = ""   , namespace = "org.kde"-  , handleUpdate = \_ _ -> return ()-  , hostLogger = makeDefaultLogger "StatusNotifier.Watcher.Service"+  , startWatcher = False   }  data ItemInfo = ItemInfo@@ -91,28 +101,48 @@                          , itemServicePath = path                          } = fn name path -build :: Params -> IO (IO RequestNameReply)+data Host = Host+  { itemInfoMap :: IO (Map.Map BusName ItemInfo)+  , addUpdateHandler :: UpdateHandler -> IO Unique+  , removeUpdateHandler :: Unique -> IO ()+  }++build :: Params -> IO (Maybe Host) build Params { dbusClient = mclient              , namespace = namespaceString              , uniqueIdentifier = uniqueID-             , handleUpdate = updateHandler-             , hostLogger = logger+             , startWatcher = shouldStartWatcher              } = do   client <- maybe connectSession return mclient   itemInfoMapVar <- newMVar Map.empty+  updateHandlersVar <- newMVar ([] :: [(Unique, UpdateHandler)])   let busName = getBusName namespaceString uniqueID -      logError = logL logger ERROR+      logError = hostLogger ERROR       logErrorWithMessage message error = logError message >> logError (show error)-      logInfo = logL logger INFO+      logInfo = hostLogger INFO       logErrorAndThen andThen e = logError (show e) >> andThen -      doUpdate utype uinfo =-        logInfo (printf "Sending update (iconPixmaps suppressed): %s %s"+      doUpdateForHandler utype uinfo (unique, handler) = do+        logInfo (printf "Sending update (iconPixmaps suppressed): %s %s, for handler %s"                           (show utype)-                          (show $ uinfo { iconPixmaps = [] })) >>-        void (forkIO (updateHandler utype uinfo))+                          (show $ uinfo { iconPixmaps = [] })+                          (show $ hashUnique unique))+        forkIO $ handler utype uinfo +      doUpdate utype uinfo =+        readMVar updateHandlersVar >>= mapM_ (doUpdateForHandler utype uinfo)++      addHandler handler = do+        unique <- newUnique+        modifyMVar_ updateHandlersVar (return . ((unique, handler):))+        let doUpdateForInfo info = doUpdateForHandler ItemAdded info (unique, handler)+        readMVar itemInfoMapVar >>= mapM_ doUpdateForInfo+        return unique++      removeHandler unique =+        modifyMVar_ updateHandlersVar (return . filter ((/= unique) . fst))+       getPixmaps a1 a2 a3 = fmap convertPixmapsToHostByteOrder <$>                             I.getIconPixmap a1 a2 a3 @@ -148,7 +178,7 @@       registerWithPairs =         mapM (uncurry clientSignalRegister)         where logUnableToCallSignal signal =-                logL logger ERROR $ printf "Unable to call handler with %s" $+                hostLogger ERROR $ printf "Unable to call handler with %s" $                      show signal               clientSignalRegister signalRegisterFn handler =                 signalRegisterFn client matchAny handler logUnableToCallSignal@@ -210,7 +240,7 @@         , (I.registerForNewTitle, handleNewTitle)         ] -      initializeItemInfoMap = modifyMVar_ itemInfoMapVar $ \itemInfoMap -> do+      initializeItemInfoMap = modifyMVar itemInfoMapVar $ \itemInfoMap -> do         -- All initialization is done inside this modifyMvar to avoid race         -- conditions with the itemInfoMapVar.         clientSignalHandlers <- registerWithPairs clientRegistrationPairs@@ -224,23 +254,43 @@                 releaseName client (fromString busName)                 return ()             logErrorAndShutdown error =-              logError (show error) >> shutdownHost >> return Map.empty+              logError (show error) >> shutdownHost >> return (Map.empty, False)             finishInitialization serviceNames = do               itemInfos <- createAll serviceNames-              mapM_ (doUpdate ItemAdded) itemInfos               let newMap = Map.fromList $ map (itemServiceName &&& id) itemInfos                   -- Extra paranoia about the map                   resultMap = if Map.null itemInfoMap                               then newMap                               else Map.union itemInfoMap newMap               W.registerStatusNotifierHost client busName >>=-               either logErrorAndShutdown (const $ return resultMap)+               either logErrorAndShutdown (const $ return (resultMap, True))         W.getRegisteredStatusNotifierItems client >>=          either logErrorAndShutdown finishInitialization -      startup =-        do-          nameRequestResult <- requestName client (fromString busName) []-          when (nameRequestResult == NamePrimaryOwner) initializeItemInfoMap-          return nameRequestResult-  return startup+      startWatcherIfNeeded = do+        let watcherName = maybe "" coerce $ genBusName W.watcherClientGenerationParams+            startWatcher = do+              (_, doIt) <- W.buildWatcher W.defaultWatcherParams+              doIt+        res <- DTH.getNameOwner client watcherName+        case res of+          Right _ -> return ()+          Left _ -> void $ forkIO $ void startWatcher++  when shouldStartWatcher startWatcherIfNeeded+  nameRequestResult <- requestName client (fromString busName) []+  if nameRequestResult == NamePrimaryOwner+  then do+    initializationSuccess <- initializeItemInfoMap+    return $ if initializationSuccess+    then+      Just Host+      { itemInfoMap = readMVar itemInfoMapVar+      , addUpdateHandler = addHandler+      , removeUpdateHandler = removeHandler+      }+    else Nothing+  else do+    logErrorWithMessage "Failed to obtain desired service name" nameRequestResult+    return Nothing+

@@ -52,7 +52,7 @@ {-# NOINLINE makeDefaultLogger #-} makeDefaultLogger :: String -> Logger makeDefaultLogger name =-  setLevel INFO $ unsafePerformIO $ getLogger name+  unsafePerformIO $ getLogger name  logErrorWithDefault ::   Show a => Logger -> b -> String -> Either a b -> IO b

@@ -27,7 +27,6 @@ import           System.Log.Logger import           Text.Printf - buildWatcher WatcherParams                { watcherNamespace = interfaceNamespace                , watcherLogger = logger

@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.27.0.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: 5031b8852f36b00720f0e3a9da94253f14e1732c28f671b766c2a75be1926610+-- hash: 18a8456ecc7341693bf5762b5d6e0f6ff33dcb66895d73081d52ddb31b8a731c  name:           status-notifier-item-version:        0.1.0.0+version:        0.2.0.0 synopsis:       A wrapper over the StatusNotifierItem/libappindicator dbus specification description:    Please see the README on Github at <https://github.com/IvanMalison/status-notifier-item#readme> category:       Desktop@@ -18,7 +18,6 @@ license-file:   LICENSE build-type:     Simple cabal-version:  >= 1.10- extra-source-files:     ChangeLog.md     README.md