    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RecordWildCards #-}
    module StatusNotifier.Host.Service where

    import           Control.Applicative
    import           Control.Arrow
    import           Control.Concurrent
    import           Control.Concurrent.MVar
    import           Control.Lens
    import           Control.Lens.Tuple
    import           Control.Monad
    import           Control.Monad.Trans.Class
    import           Control.Monad.Trans.Except
    import           Control.Monad.Trans.Maybe
    import           DBus
    import           DBus.Client
    import           DBus.Generation
    import qualified DBus.Internal.Message as M
    import           DBus.Internal.Types
    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.Typeable
    import           Data.Unique
    import           Data.Word
    import           System.Log.Logger
    import           Text.Printf

    import qualified StatusNotifier.Item.Client 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 :: String
    statusNotifierHostString = String
    "StatusNotifierHost"

    getBusName :: String -> String -> String
    getBusName :: String -> String -> String
    getBusName String
    namespace =
      String -> String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "%s.%s-%s" String
    namespace String
    statusNotifierHostString

    data UpdateType
      = ItemAdded
      | ItemRemoved
      | IconUpdated
      | OverlayIconUpdated
      | StatusUpdated
      | TitleUpdated
      | ToolTipUpdated deriving (UpdateType -> UpdateType -> Bool
    (UpdateType -> UpdateType -> Bool)
    -> (UpdateType -> UpdateType -> Bool) -> Eq UpdateType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UpdateType -> UpdateType -> Bool
    == :: UpdateType -> UpdateType -> Bool
    $c/= :: UpdateType -> UpdateType -> Bool
    /= :: UpdateType -> UpdateType -> Bool
    Eq, Int -> UpdateType -> String -> String
    [UpdateType] -> String -> String
    UpdateType -> String
    (Int -> UpdateType -> String -> String)
    -> (UpdateType -> String)
    -> ([UpdateType] -> String -> String)
    -> Show UpdateType
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> UpdateType -> String -> String
    showsPrec :: Int -> UpdateType -> String -> String
    $cshow :: UpdateType -> String
    show :: UpdateType -> String
    $cshowList :: [UpdateType] -> String -> String
    showList :: [UpdateType] -> String -> String
    Show)

    type UpdateHandler = UpdateType -> ItemInfo -> IO ()

    data Params = Params
      { Params -> Maybe Client
    dbusClient :: Maybe Client
      , Params -> String
    uniqueIdentifier :: String
      , Params -> String
    namespace :: String
      , Params -> Bool
    startWatcher :: Bool
      , Params -> Bool
    matchSenderWhenNameOwnersUnmatched :: Bool
      }

    hostLogger :: Priority -> String -> IO ()
    hostLogger = String -> Priority -> String -> IO ()
    logM String
    "StatusNotifier.Host.Service"

    defaultParams :: Params
    defaultParams = Params
      { dbusClient :: Maybe Client
    dbusClient = Maybe Client
    forall a. Maybe a
    Nothing
      , uniqueIdentifier :: String
    uniqueIdentifier = String
    ""
      , namespace :: String
    namespace = String
    "org.kde"
      , startWatcher :: Bool
    startWatcher = Bool
    False
      , matchSenderWhenNameOwnersUnmatched :: Bool
    matchSenderWhenNameOwnersUnmatched = Bool
    True
      }

    type ImageInfo = [(Int32, Int32, BS.ByteString)]

    data ItemInfo = ItemInfo
      { ItemInfo -> BusName
    itemServiceName :: BusName
      , ItemInfo -> ObjectPath
    itemServicePath :: ObjectPath
      , ItemInfo -> Maybe String
    itemId :: Maybe String
      , ItemInfo -> Maybe String
    itemStatus :: Maybe String
      , ItemInfo -> Maybe String
    itemCategory :: Maybe String
      , ItemInfo -> Maybe (String, ImageInfo, String, String)
    itemToolTip :: Maybe (String, ImageInfo, String, String)
      , ItemInfo -> String
    iconTitle :: String
      , ItemInfo -> String
    iconName :: String
      , ItemInfo -> Maybe String
    overlayIconName :: Maybe String
      , ItemInfo -> Maybe String
    iconThemePath :: Maybe String
      , ItemInfo -> ImageInfo
    iconPixmaps :: ImageInfo
      , ItemInfo -> ImageInfo
    overlayIconPixmaps :: ImageInfo
      , ItemInfo -> Maybe ObjectPath
    menuPath :: Maybe ObjectPath
      , ItemInfo -> Bool
    itemIsMenu :: Bool
      } deriving (ItemInfo -> ItemInfo -> Bool
    (ItemInfo -> ItemInfo -> Bool)
    -> (ItemInfo -> ItemInfo -> Bool) -> Eq ItemInfo
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ItemInfo -> ItemInfo -> Bool
    == :: ItemInfo -> ItemInfo -> Bool
    $c/= :: ItemInfo -> ItemInfo -> Bool
    /= :: ItemInfo -> ItemInfo -> Bool
    Eq, Int -> ItemInfo -> String -> String
    [ItemInfo] -> String -> String
    ItemInfo -> String
    (Int -> ItemInfo -> String -> String)
    -> (ItemInfo -> String)
    -> ([ItemInfo] -> String -> String)
    -> Show ItemInfo
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ItemInfo -> String -> String
    showsPrec :: Int -> ItemInfo -> String -> String
    $cshow :: ItemInfo -> String
    show :: ItemInfo -> String
    $cshowList :: [ItemInfo] -> String -> String
    showList :: [ItemInfo] -> String -> String
    Show)

    supressPixelData :: ItemInfo -> ItemInfo
    supressPixelData ItemInfo
    info =
      ItemInfo
    info { iconPixmaps = map (\(Int32
    w, Int32
    h, ByteString
    _) -> (Int32
    w, Int32
    h, ByteString
    "")) $ iconPixmaps info }

    makeLensesWithLSuffix ''ItemInfo

    convertPixmapsToHostByteOrder ::
      [(Int32, Int32, BS.ByteString)] -> [(Int32, Int32, BS.ByteString)]
    convertPixmapsToHostByteOrder :: ImageInfo -> ImageInfo
    convertPixmapsToHostByteOrder = ((Int32, Int32, ByteString) -> (Int32, Int32, ByteString))
    -> ImageInfo -> ImageInfo
    forall a b. (a -> b) -> [a] -> [b]
    map (((Int32, Int32, ByteString) -> (Int32, Int32, ByteString))
     -> ImageInfo -> ImageInfo)
    -> ((Int32, Int32, ByteString) -> (Int32, Int32, ByteString))
    -> ImageInfo
    -> ImageInfo
    forall a b. (a -> b) -> a -> b
    $ ASetter
      (Int32, Int32, ByteString)
      (Int32, Int32, ByteString)
      ByteString
      ByteString
    -> (ByteString -> ByteString)
    -> (Int32, Int32, ByteString)
    -> (Int32, Int32, ByteString)
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ASetter
      (Int32, Int32, ByteString)
      (Int32, Int32, ByteString)
      ByteString
      ByteString
    forall s t a b. Field3 s t a b => Lens s t a b
    Lens
      (Int32, Int32, ByteString)
      (Int32, Int32, ByteString)
      ByteString
      ByteString
    _3 ByteString -> ByteString
    networkToSystemByteOrder

    callFromInfo :: (BusName -> ObjectPath -> t) -> ItemInfo -> t
    callFromInfo BusName -> ObjectPath -> t
    fn ItemInfo { itemServiceName :: ItemInfo -> BusName
    itemServiceName = BusName
    name
                             , itemServicePath :: ItemInfo -> ObjectPath
    itemServicePath = ObjectPath
    path
                             } = BusName -> ObjectPath -> t
    fn BusName
    name ObjectPath
    path

    data Host = Host
      { Host -> IO (Map BusName ItemInfo)
    itemInfoMap :: IO (Map.Map BusName ItemInfo)
      , Host -> UpdateHandler -> IO Unique
    addUpdateHandler :: UpdateHandler -> IO Unique
      , Host -> Unique -> IO ()
    removeUpdateHandler :: Unique -> IO ()
      , Host -> BusName -> IO ()
    forceUpdate :: BusName -> IO ()
      } deriving Typeable

    build :: Params -> IO (Maybe Host)
    build :: Params -> IO (Maybe Host)
    build Params { dbusClient :: Params -> Maybe Client
    dbusClient = Maybe Client
    mclient
                 , namespace :: Params -> String
    namespace = String
    namespaceString
                 , uniqueIdentifier :: Params -> String
    uniqueIdentifier = String
    uniqueID
                 , startWatcher :: Params -> Bool
    startWatcher = Bool
    shouldStartWatcher
                 , matchSenderWhenNameOwnersUnmatched :: Params -> Bool
    matchSenderWhenNameOwnersUnmatched = Bool
    doMatchUnmatchedSender
                 } = do
      client <- IO Client -> (Client -> IO Client) -> Maybe Client -> IO Client
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO Client
    connectSession Client -> IO Client
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Client
    mclient
      itemInfoMapVar <- newMVar Map.empty
      updateHandlersVar <- newMVar ([] :: [(Unique, UpdateHandler)])
      let busName = String -> String -> String
    getBusName String
    namespaceString String
    uniqueID

          logError = Priority -> String -> IO ()
    hostLogger Priority
    ERROR
          logErrorWithMessage String
    message a
    error = String -> IO ()
    logError String
    message IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> IO ()
    logError (a -> String
    forall a. Show a => a -> String
    show a
    error)

          logInfo = Priority -> String -> IO ()
    hostLogger Priority
    INFO
          logErrorAndThen IO b
    andThen a
    e = String -> IO ()
    logError (a -> String
    forall a. Show a => a -> String
    show a
    e) IO () -> IO b -> IO b
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO b
    andThen

          doUpdateForHandler t
    utype ItemInfo
    uinfo (Unique
    unique, t -> ItemInfo -> IO ()
    handler) = do
            String -> IO ()
    logInfo (String -> String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Sending update (iconPixmaps suppressed): %s %s, for handler %s"
                              (t -> String
    forall a. Show a => a -> String
    show t
    utype)
                              (ItemInfo -> String
    forall a. Show a => a -> String
    show (ItemInfo -> String) -> ItemInfo -> String
    forall a b. (a -> b) -> a -> b
    $ ItemInfo -> ItemInfo
    supressPixelData ItemInfo
    uinfo)
                              (Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ Unique -> Int
    hashUnique Unique
    unique))
            IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ t -> ItemInfo -> IO ()
    handler t
    utype ItemInfo
    uinfo

          doUpdate UpdateType
    utype ItemInfo
    uinfo =
            MVar [(Unique, UpdateHandler)] -> IO [(Unique, UpdateHandler)]
    forall a. MVar a -> IO a
    readMVar MVar [(Unique, UpdateHandler)]
    updateHandlersVar IO [(Unique, UpdateHandler)]
    -> ([(Unique, UpdateHandler)] -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ((Unique, UpdateHandler) -> IO ThreadId)
    -> [(Unique, UpdateHandler)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (UpdateType -> ItemInfo -> (Unique, UpdateHandler) -> IO ThreadId
    forall {t}.
    Show t =>
    t -> ItemInfo -> (Unique, t -> ItemInfo -> IO ()) -> IO ThreadId
    doUpdateForHandler UpdateType
    utype ItemInfo
    uinfo)

          addHandler UpdateHandler
    handler = do
            unique <- IO Unique
    newUnique
            modifyMVar_ updateHandlersVar (return . ((unique, handler):))
            let doUpdateForInfo ItemInfo
    info = UpdateType -> ItemInfo -> (Unique, UpdateHandler) -> IO ThreadId
    forall {t}.
    Show t =>
    t -> ItemInfo -> (Unique, t -> ItemInfo -> IO ()) -> IO ThreadId
    doUpdateForHandler UpdateType
    ItemAdded ItemInfo
    info (Unique
    unique, UpdateHandler
    handler)
            readMVar itemInfoMapVar >>= mapM_ doUpdateForInfo
            return unique

          removeHandler Unique
    unique =
            MVar [(Unique, UpdateHandler)]
    -> ([(Unique, UpdateHandler)] -> IO [(Unique, UpdateHandler)])
    -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar [(Unique, UpdateHandler)]
    updateHandlersVar ([(Unique, UpdateHandler)] -> IO [(Unique, UpdateHandler)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Unique, UpdateHandler)] -> IO [(Unique, UpdateHandler)])
    -> ([(Unique, UpdateHandler)] -> [(Unique, UpdateHandler)])
    -> [(Unique, UpdateHandler)]
    -> IO [(Unique, UpdateHandler)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Unique, UpdateHandler) -> Bool)
    -> [(Unique, UpdateHandler)] -> [(Unique, UpdateHandler)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Unique
    unique) (Unique -> Bool)
    -> ((Unique, UpdateHandler) -> Unique)
    -> (Unique, UpdateHandler)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Unique, UpdateHandler) -> Unique
    forall a b. (a, b) -> a
    fst))

          getPixmaps t -> t -> t -> f (f ImageInfo)
    getter t
    a1 t
    a2 t
    a3 =
            (ImageInfo -> ImageInfo) -> f ImageInfo -> f ImageInfo
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ImageInfo -> ImageInfo
    convertPixmapsToHostByteOrder (f ImageInfo -> f ImageInfo) -> f (f ImageInfo) -> f (f ImageInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> t -> t -> t -> f (f ImageInfo)
    getter t
    a1 t
    a2 t
    a3

          getMaybe t -> t -> t -> f (Either d b)
    fn t
    a t
    b t
    c = (b -> Maybe b) -> Either d b -> Either d (Maybe b)
    forall b c d. (b -> c) -> Either d b -> Either d c
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either d b) (Either d c)
    right b -> Maybe b
    forall a. a -> Maybe a
    Just (Either d b -> Either d (Maybe b))
    -> f (Either d b) -> f (Either d (Maybe b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> t -> t -> t -> f (Either d b)
    fn t
    a t
    b t
    c

          buildItemInfo String
    name = ExceptT MethodError IO ItemInfo -> IO (Either MethodError ItemInfo)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT MethodError IO ItemInfo
     -> IO (Either MethodError ItemInfo))
    -> ExceptT MethodError IO ItemInfo
    -> IO (Either MethodError ItemInfo)
    forall a b. (a -> b) -> a -> b
    $ do
            pathString <- IO (Either MethodError String) -> ExceptT MethodError IO String
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO (Either MethodError String) -> ExceptT MethodError IO String)
    -> IO (Either MethodError String) -> ExceptT MethodError IO String
    forall a b. (a -> b) -> a -> b
    $ Client -> String -> IO (Either MethodError String)
    W.getObjectPathForItemName Client
    client String
    name
            let busName = String -> BusName
    forall a. IsString a => String -> a
    fromString String
    name
                path = String -> ObjectPath
    objectPath_ String
    pathString
                doGetDef a
    def Client -> BusName -> ObjectPath -> m (Either MethodError a)
    fn =
                  m (Either MethodError a) -> ExceptT MethodError m a
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (m (Either MethodError a) -> ExceptT MethodError m a)
    -> m (Either MethodError a) -> ExceptT MethodError m a
    forall a b. (a -> b) -> a -> b
    $ a -> Either MethodError a -> Either MethodError a
    forall b. b -> Either MethodError b -> Either MethodError b
    exemptAll a
    def (Either MethodError a -> Either MethodError a)
    -> m (Either MethodError a) -> m (Either MethodError a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Client -> BusName -> ObjectPath -> m (Either MethodError a)
    fn Client
    client BusName
    busName ObjectPath
    path
                doGet Client -> BusName -> ObjectPath -> m (Either e a)
    fn = m (Either e a) -> ExceptT e m a
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (m (Either e a) -> ExceptT e m a)
    -> m (Either e a) -> ExceptT e m a
    forall a b. (a -> b) -> a -> b
    $ Client -> BusName -> ObjectPath -> m (Either e a)
    fn Client
    client BusName
    busName ObjectPath
    path
            pixmaps <- doGetDef [] $ getPixmaps I.getIconPixmap
            iName <- doGetDef name I.getIconName
            overlayPixmap <- doGetDef [] $ getPixmaps I.getOverlayIconPixmap
            overlayIName <- doGetDef Nothing $ getMaybe I.getOverlayIconName
            themePath <- doGetDef Nothing $ getMaybe I.getIconThemePath
            menu <- doGetDef Nothing $ getMaybe I.getMenu
            title <- doGetDef "" I.getTitle
            tooltip <- doGetDef Nothing $ getMaybe I.getToolTip
            idString <- doGetDef Nothing $ getMaybe I.getId
            status <- doGetDef Nothing $ getMaybe I.getStatus
            category <- doGetDef Nothing $ getMaybe I.getCategory
            itemIsMenu <- doGetDef False I.getItemIsMenu
            return ItemInfo
                     { itemServiceName = busName_ name
                     , itemId = idString
                     , itemStatus = status
                     , itemCategory = category
                     , itemServicePath = path
                     , itemToolTip = tooltip
                     , iconPixmaps = pixmaps
                     , iconThemePath = themePath
                     , iconName = iName
                     , iconTitle = title
                     , menuPath = menu
                     , overlayIconName = overlayIName
                     , overlayIconPixmaps = overlayPixmap
                     , itemIsMenu = itemIsMenu
                     }

          createAll [String]
    serviceNames = do
            (errors, itemInfos) <-
              [Either MethodError ItemInfo] -> ([MethodError], [ItemInfo])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers ([Either MethodError ItemInfo] -> ([MethodError], [ItemInfo]))
    -> IO [Either MethodError ItemInfo]
    -> IO ([MethodError], [ItemInfo])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> IO (Either MethodError ItemInfo))
    -> [String] -> IO [Either MethodError ItemInfo]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM String -> IO (Either MethodError ItemInfo)
    buildItemInfo [String]
    serviceNames
            mapM_ (logErrorWithMessage "Error in item building at startup:") errors
            return itemInfos

          registerWithPairs =
            ((Client -> MatchRule -> b -> (Signal -> IO ()) -> IO b, b)
     -> IO b)
    -> [(Client -> MatchRule -> b -> (Signal -> IO ()) -> IO b, b)]
    -> IO [b]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (((Client -> MatchRule -> b -> (Signal -> IO ()) -> IO b)
     -> b -> IO b)
    -> (Client -> MatchRule -> b -> (Signal -> IO ()) -> IO b, b)
    -> IO b
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (Client -> MatchRule -> b -> (Signal -> IO ()) -> IO b)
    -> b -> IO b
    forall {a} {t} {t}.
    Show a =>
    (Client -> MatchRule -> t -> (a -> IO ()) -> t) -> t -> t
    clientSignalRegister)
            where logUnableToCallSignal :: a -> IO ()
    logUnableToCallSignal a
    signal =
                    Priority -> String -> IO ()
    hostLogger Priority
    ERROR (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Unable to call handler with %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
                         a -> String
    forall a. Show a => a -> String
    show a
    signal
                  clientSignalRegister :: (Client -> MatchRule -> t -> (a -> IO ()) -> t) -> t -> t
    clientSignalRegister Client -> MatchRule -> t -> (a -> IO ()) -> t
    signalRegisterFn t
    handler =
                    Client -> MatchRule -> t -> (a -> IO ()) -> t
    signalRegisterFn Client
    client MatchRule
    matchAny t
    handler a -> IO ()
    forall {a}. Show a => a -> IO ()
    logUnableToCallSignal

          handleItemAdded String
    serviceName =
            MVar (Map BusName ItemInfo)
    -> (Map BusName ItemInfo -> IO (Map BusName ItemInfo)) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar (Map BusName ItemInfo)
    itemInfoMapVar ((Map BusName ItemInfo -> IO (Map BusName ItemInfo)) -> IO ())
    -> (Map BusName ItemInfo -> IO (Map BusName ItemInfo)) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Map BusName ItemInfo
    itemInfoMap ->
              String -> IO (Either MethodError ItemInfo)
    buildItemInfo String
    serviceName IO (Either MethodError ItemInfo)
    -> (Either MethodError ItemInfo -> IO (Map BusName ItemInfo))
    -> IO (Map BusName ItemInfo)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
              (MethodError -> IO (Map BusName ItemInfo))
    -> (ItemInfo -> IO (Map BusName ItemInfo))
    -> Either MethodError ItemInfo
    -> IO (Map BusName ItemInfo)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (IO (Map BusName ItemInfo)
    -> MethodError -> IO (Map BusName ItemInfo)
    forall {a} {b}. Show a => IO b -> a -> IO b
    logErrorAndThen (IO (Map BusName ItemInfo)
     -> MethodError -> IO (Map BusName ItemInfo))
    -> IO (Map BusName ItemInfo)
    -> MethodError
    -> IO (Map BusName ItemInfo)
    forall a b. (a -> b) -> a -> b
    $ Map BusName ItemInfo -> IO (Map BusName ItemInfo)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Map BusName ItemInfo
    itemInfoMap)
                     (Map BusName ItemInfo -> ItemInfo -> IO (Map BusName ItemInfo)
    addItemInfo Map BusName ItemInfo
    itemInfoMap)
              where addItemInfo :: Map BusName ItemInfo -> ItemInfo -> IO (Map BusName ItemInfo)
    addItemInfo Map BusName ItemInfo
    map itemInfo :: ItemInfo
    itemInfo@ItemInfo{Bool
    String
    ImageInfo
    Maybe String
    Maybe (String, ImageInfo, String, String)
    Maybe ObjectPath
    BusName
    ObjectPath
    itemServiceName :: ItemInfo -> BusName
    itemServicePath :: ItemInfo -> ObjectPath
    itemId :: ItemInfo -> Maybe String
    itemStatus :: ItemInfo -> Maybe String
    itemCategory :: ItemInfo -> Maybe String
    itemToolTip :: ItemInfo -> Maybe (String, ImageInfo, String, String)
    iconTitle :: ItemInfo -> String
    iconName :: ItemInfo -> String
    overlayIconName :: ItemInfo -> Maybe String
    iconThemePath :: ItemInfo -> Maybe String
    iconPixmaps :: ItemInfo -> ImageInfo
    overlayIconPixmaps :: ItemInfo -> ImageInfo
    menuPath :: ItemInfo -> Maybe ObjectPath
    itemIsMenu :: ItemInfo -> Bool
    itemServiceName :: BusName
    itemServicePath :: ObjectPath
    itemId :: Maybe String
    itemStatus :: Maybe String
    itemCategory :: Maybe String
    itemToolTip :: Maybe (String, ImageInfo, String, String)
    iconTitle :: String
    iconName :: String
    overlayIconName :: Maybe String
    iconThemePath :: Maybe String
    iconPixmaps :: ImageInfo
    overlayIconPixmaps :: ImageInfo
    menuPath :: Maybe ObjectPath
    itemIsMenu :: Bool
    ..} =
                      if BusName -> Map BusName ItemInfo -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member BusName
    itemServiceName Map BusName ItemInfo
    map
                      then Map BusName ItemInfo -> IO (Map BusName ItemInfo)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Map BusName ItemInfo
    map
                      else UpdateHandler
    doUpdate UpdateType
    ItemAdded ItemInfo
    itemInfo IO () -> IO (Map BusName ItemInfo) -> IO (Map BusName ItemInfo)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                           Map BusName ItemInfo -> IO (Map BusName ItemInfo)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BusName -> ItemInfo -> Map BusName ItemInfo -> Map BusName ItemInfo
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert BusName
    itemServiceName ItemInfo
    itemInfo Map BusName ItemInfo
    map)

          getObjectPathForItemName BusName
    name =
            ObjectPath
    -> (ItemInfo -> ObjectPath) -> Maybe ItemInfo -> ObjectPath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ObjectPath
    I.defaultPath ItemInfo -> ObjectPath
    itemServicePath (Maybe ItemInfo -> ObjectPath)
    -> (Map BusName ItemInfo -> Maybe ItemInfo)
    -> Map BusName ItemInfo
    -> ObjectPath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BusName -> Map BusName ItemInfo -> Maybe ItemInfo
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup BusName
    name (Map BusName ItemInfo -> ObjectPath)
    -> IO (Map BusName ItemInfo) -> IO ObjectPath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            MVar (Map BusName ItemInfo) -> IO (Map BusName ItemInfo)
    forall a. MVar a -> IO a
    readMVar MVar (Map BusName ItemInfo)
    itemInfoMapVar

          handleItemRemoved String
    serviceName =
            MVar (Map BusName ItemInfo)
    -> (Map BusName ItemInfo
        -> IO (Map BusName ItemInfo, Maybe ItemInfo))
    -> IO (Maybe ItemInfo)
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar (Map BusName ItemInfo)
    itemInfoMapVar Map BusName ItemInfo -> IO (Map BusName ItemInfo, Maybe ItemInfo)
    forall {m :: * -> *} {a}.
    Monad m =>
    Map BusName a -> m (Map BusName a, Maybe a)
    doRemove IO (Maybe ItemInfo) -> (Maybe ItemInfo -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
            IO () -> (ItemInfo -> IO ()) -> Maybe ItemInfo -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO ()
    logNonExistentRemoval (UpdateHandler
    doUpdate UpdateType
    ItemRemoved)
            where
              busName :: BusName
    busName = String -> BusName
    busName_ String
    serviceName
              doRemove :: Map BusName a -> m (Map BusName a, Maybe a)
    doRemove Map BusName a
    currentMap =
                (Map BusName a, Maybe a) -> m (Map BusName a, Maybe a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BusName -> Map BusName a -> Map BusName a
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete BusName
    busName Map BusName a
    currentMap, BusName -> Map BusName a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup BusName
    busName Map BusName a
    currentMap)
              logNonExistentRemoval :: IO ()
    logNonExistentRemoval =
                Priority -> String -> IO ()
    hostLogger Priority
    WARNING (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Attempt to remove unknown item %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
                           BusName -> String
    forall a. Show a => a -> String
    show BusName
    busName

          watcherRegistrationPairs =
            [ (Client
    -> MatchRule
    -> (Signal -> String -> IO ())
    -> (Signal -> IO ())
    -> IO SignalHandler
    W.registerForStatusNotifierItemRegistered, (String -> IO ()) -> b -> String -> IO ()
    forall a b. a -> b -> a
    const String -> IO ()
    handleItemAdded)
            , (Client
    -> MatchRule
    -> (Signal -> String -> IO ())
    -> (Signal -> IO ())
    -> IO SignalHandler
    W.registerForStatusNotifierItemUnregistered, (String -> IO ()) -> b -> String -> IO ()
    forall a b. a -> b -> a
    const String -> IO ()
    handleItemRemoved)
            ]

          getSender BusName -> IO ()
    fn s :: Signal
    s@M.Signal { signalSender :: Signal -> Maybe BusName
    M.signalSender = Just BusName
    sender} =
            String -> IO ()
    logInfo (Signal -> String
    forall a. Show a => a -> String
    show Signal
    s) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> BusName -> IO ()
    fn BusName
    sender
          getSender BusName -> IO ()
    _ Signal
    s = String -> IO ()
    logError (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Received signal with no sender: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Signal -> String
    forall a. Show a => a -> String
    show Signal
    s

          runProperty Client -> BusName -> ObjectPath -> IO b
    prop BusName
    serviceName =
            BusName -> IO ObjectPath
    getObjectPathForItemName BusName
    serviceName IO ObjectPath -> (ObjectPath -> IO b) -> IO b
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Client -> BusName -> ObjectPath -> IO b
    prop Client
    client BusName
    serviceName

          logUnknownSender a
    updateType a
    signal =
            Priority -> String -> IO ()
    hostLogger Priority
    WARNING (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                       String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Got signal for update type: %s from unknown sender: %s"
                       (a -> String
    forall a. Show a => a -> String
    show a
    updateType) (a -> String
    forall a. Show a => a -> String
    show a
    signal)

          identifySender M.Signal { signalSender :: Signal -> Maybe BusName
    M.signalSender = Just BusName
    sender
                                  , signalPath :: Signal -> ObjectPath
    M.signalPath = ObjectPath
    senderPath
                                  } = do
            infoMap <- MVar (Map BusName ItemInfo) -> IO (Map BusName ItemInfo)
    forall a. MVar a -> IO a
    readMVar MVar (Map BusName ItemInfo)
    itemInfoMapVar
            let identifySenderBySender = Maybe ItemInfo -> IO (Maybe ItemInfo)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BusName -> Map BusName ItemInfo -> Maybe ItemInfo
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup BusName
    sender Map BusName ItemInfo
    infoMap)
                identifySenderById = (Maybe (Maybe ItemInfo) -> Maybe ItemInfo)
    -> IO (Maybe (Maybe ItemInfo)) -> IO (Maybe ItemInfo)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe (Maybe ItemInfo) -> Maybe ItemInfo
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (Maybe (Maybe ItemInfo)) -> IO (Maybe ItemInfo))
    -> IO (Maybe (Maybe ItemInfo)) -> IO (Maybe ItemInfo)
    forall a b. (a -> b) -> a -> b
    $
                  IO (Either MethodError (Maybe ItemInfo))
    identifySenderById_ IO (Either MethodError (Maybe ItemInfo))
    -> (Either MethodError (Maybe ItemInfo)
        -> IO (Maybe (Maybe ItemInfo)))
    -> IO (Maybe (Maybe ItemInfo))
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Priority -> String -> IO ())
    -> String
    -> Either MethodError (Maybe ItemInfo)
    -> IO (Maybe (Maybe ItemInfo))
    forall a b.
    Show a =>
    (Priority -> String -> IO ())
    -> String -> Either a b -> IO (Maybe b)
    logEitherError Priority -> String -> IO ()
    hostLogger String
    "Failed to identify sender"
                identifySenderById_ = ExceptT MethodError IO (Maybe ItemInfo)
    -> IO (Either MethodError (Maybe ItemInfo))
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT MethodError IO (Maybe ItemInfo)
     -> IO (Either MethodError (Maybe ItemInfo)))
    -> ExceptT MethodError IO (Maybe ItemInfo)
    -> IO (Either MethodError (Maybe ItemInfo))
    forall a b. (a -> b) -> a -> b
    $ do
                  senderId <- IO (Either MethodError String) -> ExceptT MethodError IO String
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (IO (Either MethodError String) -> ExceptT MethodError IO String)
    -> IO (Either MethodError String) -> ExceptT MethodError IO String
    forall a b. (a -> b) -> a -> b
    $ Client -> BusName -> ObjectPath -> IO (Either MethodError String)
    I.getId Client
    client BusName
    sender ObjectPath
    senderPath
                  let matchesSender ItemInfo
    info =
                        if ItemInfo -> Maybe String
    itemId ItemInfo
    info Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just String
    senderId
                        then do
                          senderNameOwner <- Client -> String -> IO (Either MethodError String)
    DTH.getNameOwner Client
    client (BusName -> String
    forall a b. Coercible a b => a -> b
    coerce BusName
    sender)
                          infoNameOwner <- DTH.getNameOwner client (coerce $ itemServiceName info)
                          let warningMsg =
                                String
    "Matched sender id: %s, but name owners do not \
                                \ match: %s %s. Considered match: %s."
                              warningText = String -> String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    warningMsg
                                            (String -> String
    forall a. Show a => a -> String
    show String
    senderId)
                                            (Either MethodError String -> String
    forall a. Show a => a -> String
    show Either MethodError String
    senderNameOwner)
                                            (Either MethodError String -> String
    forall a. Show a => a -> String
    show Either MethodError String
    infoNameOwner)
                          when (senderNameOwner /= infoNameOwner) $
                               hostLogger WARNING warningText
                          return doMatchUnmatchedSender
                        else Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                  lift $ findM matchesSender (Map.elems infoMap)
            identifySenderBySender <||> identifySenderById
            where m (Maybe a)
    a <||> :: m (Maybe a) -> m (Maybe a) -> m (Maybe a)
    <||> m (Maybe a)
    b = MaybeT m a -> m (Maybe a)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT m a -> m (Maybe a)) -> MaybeT m a -> m (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ m (Maybe a) -> MaybeT m a
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT m (Maybe a)
    a MaybeT m a -> MaybeT m a -> MaybeT m a
    forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> m (Maybe a) -> MaybeT m a
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT m (Maybe a)
    b
          identifySender Signal
    _ = Maybe ItemInfo -> IO (Maybe ItemInfo)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ItemInfo
    forall a. Maybe a
    Nothing

          updateItemByLensAndProp (a -> Identity a) -> ItemInfo -> Identity ItemInfo
    lens Client -> BusName -> ObjectPath -> IO (Either MethodError a)
    prop BusName
    busName = ExceptT MethodError IO ItemInfo -> IO (Either MethodError ItemInfo)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT MethodError IO ItemInfo
     -> IO (Either MethodError ItemInfo))
    -> ExceptT MethodError IO ItemInfo
    -> IO (Either MethodError ItemInfo)
    forall a b. (a -> b) -> a -> b
    $ do
            newValue <- IO (Either MethodError a) -> ExceptT MethodError IO a
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT ((Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> BusName -> IO (Either MethodError a)
    forall {b}.
    (Client -> BusName -> ObjectPath -> IO b) -> BusName -> IO b
    runProperty Client -> BusName -> ObjectPath -> IO (Either MethodError a)
    prop BusName
    busName)
            let modify Map BusName ItemInfo
    infoMap =
                  -- This noops when the value is not present
                  let newMap :: Map BusName ItemInfo
    newMap = ASetter (Map BusName ItemInfo) (Map BusName ItemInfo) a a
    -> a -> Map BusName ItemInfo -> Map BusName ItemInfo
    forall s t a b. ASetter s t a b -> b -> s -> t
    set (Index (Map BusName ItemInfo)
    -> Lens'
         (Map BusName ItemInfo) (Maybe (IxValue (Map BusName ItemInfo)))
    forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
    at BusName
    Index (Map BusName ItemInfo)
    busName ((Maybe (IxValue (Map BusName ItemInfo))
      -> Identity (Maybe (IxValue (Map BusName ItemInfo))))
     -> Map BusName ItemInfo -> Identity (Map BusName ItemInfo))
    -> ((a -> Identity a)
        -> Maybe (IxValue (Map BusName ItemInfo))
        -> Identity (Maybe (IxValue (Map BusName ItemInfo))))
    -> ASetter (Map BusName ItemInfo) (Map BusName ItemInfo) a a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IxValue (Map BusName ItemInfo)
     -> Identity (IxValue (Map BusName ItemInfo)))
    -> Maybe (IxValue (Map BusName ItemInfo))
    -> Identity (Maybe (IxValue (Map BusName ItemInfo)))
    forall a b (p :: * -> * -> *) (f :: * -> *).
    (Choice p, Applicative f) =>
    p a (f b) -> p (Maybe a) (f (Maybe b))
    _Just ((IxValue (Map BusName ItemInfo)
      -> Identity (IxValue (Map BusName ItemInfo)))
     -> Maybe (IxValue (Map BusName ItemInfo))
     -> Identity (Maybe (IxValue (Map BusName ItemInfo))))
    -> ((a -> Identity a)
        -> IxValue (Map BusName ItemInfo)
        -> Identity (IxValue (Map BusName ItemInfo)))
    -> (a -> Identity a)
    -> Maybe (IxValue (Map BusName ItemInfo))
    -> Identity (Maybe (IxValue (Map BusName ItemInfo)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Identity a)
    -> IxValue (Map BusName ItemInfo)
    -> Identity (IxValue (Map BusName ItemInfo))
    (a -> Identity a) -> ItemInfo -> Identity ItemInfo
    lens) a
    newValue Map BusName ItemInfo
    infoMap
                  in (Map BusName ItemInfo, Maybe ItemInfo)
    -> m (Map BusName ItemInfo, Maybe ItemInfo)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map BusName ItemInfo
    newMap, BusName -> Map BusName ItemInfo -> Maybe ItemInfo
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup BusName
    busName Map BusName ItemInfo
    newMap)
            ExceptT $ maybeToEither (methodError (Serial 0) errorFailed) <$>
                    modifyMVar itemInfoMapVar modify

          logErrorsHandler (a -> Identity a) -> ItemInfo -> Identity ItemInfo
    lens UpdateType
    updateType Client -> BusName -> ObjectPath -> IO (Either MethodError a)
    prop =
            [BusName -> IO (Either MethodError ItemInfo)]
    -> UpdateType -> Signal -> IO ()
    forall {a}.
    Show a =>
    [BusName -> IO (Either a ItemInfo)]
    -> UpdateType -> Signal -> IO ()
    runUpdaters [((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    forall {a} {a}.
    ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    updateItemByLensAndProp (a -> Identity a) -> ItemInfo -> Identity ItemInfo
    lens Client -> BusName -> ObjectPath -> IO (Either MethodError a)
    prop] UpdateType
    updateType

          -- Run all the provided updaters with the expectation that at least one
          -- will succeed.
          runUpdatersForService [p -> IO (Either a ItemInfo)]
    updaters UpdateType
    updateType p
    serviceName = do
            updateResults <- ((p -> IO (Either a ItemInfo)) -> IO (Either a ItemInfo))
    -> [p -> IO (Either a ItemInfo)] -> IO [Either a ItemInfo]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((p -> IO (Either a ItemInfo)) -> p -> IO (Either a ItemInfo)
    forall a b. (a -> b) -> a -> b
    $ p
    serviceName) [p -> IO (Either a ItemInfo)]
    updaters
            let (failures, updates) = partitionEithers updateResults
                logLevel = if [ItemInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ItemInfo]
    updates then Priority
    ERROR else Priority
    DEBUG
            mapM_ (doUpdate updateType) updates
            when (not $ null failures) $
                 hostLogger logLevel $ printf "Property update failures %s" $
                            show failures

          runUpdaters [BusName -> IO (Either a ItemInfo)]
    updaters UpdateType
    updateType Signal
    signal =
            Signal -> IO (Maybe ItemInfo)
    identifySender Signal
    signal IO (Maybe ItemInfo) -> (Maybe ItemInfo -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO () -> (ItemInfo -> IO ()) -> Maybe ItemInfo -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO ()
    runForAll (BusName -> IO ()
    runUpdateForService (BusName -> IO ()) -> (ItemInfo -> BusName) -> ItemInfo -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ItemInfo -> BusName
    itemServiceName)
            where runUpdateForService :: BusName -> IO ()
    runUpdateForService = [BusName -> IO (Either a ItemInfo)]
    -> UpdateType -> BusName -> IO ()
    forall {a} {p}.
    Show a =>
    [p -> IO (Either a ItemInfo)] -> UpdateType -> p -> IO ()
    runUpdatersForService [BusName -> IO (Either a ItemInfo)]
    updaters UpdateType
    updateType
                  runForAll :: IO ()
    runForAll = UpdateType -> Signal -> IO ()
    forall {a} {a}. (Show a, Show a) => a -> a -> IO ()
    logUnknownSender UpdateType
    updateType Signal
    signal IO () -> IO (Map BusName ItemInfo) -> IO (Map BusName ItemInfo)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                              MVar (Map BusName ItemInfo) -> IO (Map BusName ItemInfo)
    forall a. MVar a -> IO a
    readMVar MVar (Map BusName ItemInfo)
    itemInfoMapVar IO (Map BusName ItemInfo)
    -> (Map BusName ItemInfo -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                              (BusName -> IO ()) -> [BusName] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ BusName -> IO ()
    runUpdateForService ([BusName] -> IO ())
    -> (Map BusName ItemInfo -> [BusName])
    -> Map BusName ItemInfo
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map BusName ItemInfo -> [BusName]
    forall k a. Map k a -> [k]
    Map.keys

          updateIconPixmaps =
            ((ImageInfo -> Identity ImageInfo)
     -> ItemInfo -> Identity ItemInfo)
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    forall {a} {a}.
    ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    updateItemByLensAndProp (ImageInfo -> Identity ImageInfo) -> ItemInfo -> Identity ItemInfo
    Lens' ItemInfo ImageInfo
    iconPixmapsL ((Client
      -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
     -> BusName -> IO (Either MethodError ItemInfo))
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    forall a b. (a -> b) -> a -> b
    $ (Client
     -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
    -> Client
    -> BusName
    -> ObjectPath
    -> IO (Either MethodError ImageInfo)
    forall {f :: * -> *} {f :: * -> *} {t} {t} {t}.
    (Functor f, Functor f) =>
    (t -> t -> t -> f (f ImageInfo)) -> t -> t -> t -> f (f ImageInfo)
    getPixmaps Client
    -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo)
    I.getIconPixmap

          updateIconName =
            ((String -> Identity String) -> ItemInfo -> Identity ItemInfo)
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError String))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    forall {a} {a}.
    ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    updateItemByLensAndProp (String -> Identity String) -> ItemInfo -> Identity ItemInfo
    Lens' ItemInfo String
    iconNameL Client -> BusName -> ObjectPath -> IO (Either MethodError String)
    I.getIconName

          updateIconTheme =
            ((Maybe String -> Identity (Maybe String))
     -> ItemInfo -> Identity ItemInfo)
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    forall {a} {a}.
    ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    updateItemByLensAndProp (Maybe String -> Identity (Maybe String))
    -> ItemInfo -> Identity ItemInfo
    Lens' ItemInfo (Maybe String)
    iconThemePathL Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String))
    getThemePathDefault

          updateFromIconThemeFromSignal Signal
    signal =
            Signal -> IO (Maybe ItemInfo)
    identifySender Signal
    signal IO (Maybe ItemInfo)
    -> (Maybe ItemInfo -> IO (Maybe (Either MethodError ItemInfo)))
    -> IO (Maybe (Either MethodError ItemInfo))
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (ItemInfo -> IO (Either MethodError ItemInfo))
    -> Maybe ItemInfo -> IO (Maybe (Either MethodError ItemInfo))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse (BusName -> IO (Either MethodError ItemInfo)
    updateIconTheme (BusName -> IO (Either MethodError ItemInfo))
    -> (ItemInfo -> BusName)
    -> ItemInfo
    -> IO (Either MethodError ItemInfo)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ItemInfo -> BusName
    itemServiceName)

          handleNewIcon Signal
    signal = do
            -- XXX: This avoids the case where the theme path is updated before the
            -- icon name is updated when both signals are sent simultaneously
            Signal -> IO (Maybe (Either MethodError ItemInfo))
    updateFromIconThemeFromSignal Signal
    signal
            [BusName -> IO (Either MethodError ItemInfo)]
    -> UpdateType -> Signal -> IO ()
    forall {a}.
    Show a =>
    [BusName -> IO (Either a ItemInfo)]
    -> UpdateType -> Signal -> IO ()
    runUpdaters [BusName -> IO (Either MethodError ItemInfo)
    updateIconPixmaps, BusName -> IO (Either MethodError ItemInfo)
    updateIconName]
                        UpdateType
    IconUpdated Signal
    signal

          updateOverlayIconName =
            ((Maybe String -> Identity (Maybe String))
     -> ItemInfo -> Identity ItemInfo)
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    forall {a} {a}.
    ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    updateItemByLensAndProp (Maybe String -> Identity (Maybe String))
    -> ItemInfo -> Identity ItemInfo
    Lens' ItemInfo (Maybe String)
    overlayIconNameL ((Client
      -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
     -> BusName -> IO (Either MethodError ItemInfo))
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    forall a b. (a -> b) -> a -> b
    $
                                    (Client -> BusName -> ObjectPath -> IO (Either MethodError String))
    -> Client
    -> BusName
    -> ObjectPath
    -> IO (Either MethodError (Maybe String))
    forall {f :: * -> *} {t} {t} {t} {d} {b}.
    Functor f =>
    (t -> t -> t -> f (Either d b))
    -> t -> t -> t -> f (Either d (Maybe b))
    getMaybe Client -> BusName -> ObjectPath -> IO (Either MethodError String)
    I.getOverlayIconName

          updateOverlayIconPixmaps =
            ((ImageInfo -> Identity ImageInfo)
     -> ItemInfo -> Identity ItemInfo)
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    forall {a} {a}.
    ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    updateItemByLensAndProp (ImageInfo -> Identity ImageInfo) -> ItemInfo -> Identity ItemInfo
    Lens' ItemInfo ImageInfo
    overlayIconPixmapsL ((Client
      -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
     -> BusName -> IO (Either MethodError ItemInfo))
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
    -> BusName
    -> IO (Either MethodError ItemInfo)
    forall a b. (a -> b) -> a -> b
    $
                                    (Client
     -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
    -> Client
    -> BusName
    -> ObjectPath
    -> IO (Either MethodError ImageInfo)
    forall {f :: * -> *} {f :: * -> *} {t} {t} {t}.
    (Functor f, Functor f) =>
    (t -> t -> t -> f (f ImageInfo)) -> t -> t -> t -> f (f ImageInfo)
    getPixmaps Client
    -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo)
    I.getOverlayIconPixmap

          handleNewOverlayIcon Signal
    signal = do
            Signal -> IO (Maybe (Either MethodError ItemInfo))
    updateFromIconThemeFromSignal Signal
    signal
            [BusName -> IO (Either MethodError ItemInfo)]
    -> UpdateType -> Signal -> IO ()
    forall {a}.
    Show a =>
    [BusName -> IO (Either a ItemInfo)]
    -> UpdateType -> Signal -> IO ()
    runUpdaters [BusName -> IO (Either MethodError ItemInfo)
    updateOverlayIconPixmaps, BusName -> IO (Either MethodError ItemInfo)
    updateOverlayIconName]
                        UpdateType
    OverlayIconUpdated Signal
    signal

          getThemePathDefault Client
    client BusName
    busName ObjectPath
    objectPath =
            (String -> Maybe String)
    -> Either MethodError String -> Either MethodError (Maybe String)
    forall b c d. (b -> c) -> Either d b -> Either d c
    forall (a :: * -> * -> *) b c d.
    ArrowChoice a =>
    a b c -> a (Either d b) (Either d c)
    right String -> Maybe String
    forall a. a -> Maybe a
    Just (Either MethodError String -> Either MethodError (Maybe String))
    -> IO (Either MethodError String)
    -> IO (Either MethodError (Maybe String))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Client -> BusName -> ObjectPath -> IO (Either MethodError String)
    I.getIconThemePath Client
    client BusName
    busName ObjectPath
    objectPath

          handleNewTitle =
            ((String -> Identity String) -> ItemInfo -> Identity ItemInfo)
    -> UpdateType
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError String))
    -> Signal
    -> IO ()
    forall {a} {a}.
    ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> UpdateType
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> Signal
    -> IO ()
    logErrorsHandler (String -> Identity String) -> ItemInfo -> Identity ItemInfo
    Lens' ItemInfo String
    iconTitleL UpdateType
    TitleUpdated Client -> BusName -> ObjectPath -> IO (Either MethodError String)
    I.getTitle

          handleNewTooltip =
            ((Maybe (String, ImageInfo, String, String)
      -> Identity (Maybe (String, ImageInfo, String, String)))
     -> ItemInfo -> Identity ItemInfo)
    -> UpdateType
    -> (Client
        -> BusName
        -> ObjectPath
        -> IO
             (Either MethodError (Maybe (String, ImageInfo, String, String))))
    -> Signal
    -> IO ()
    forall {a} {a}.
    ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> UpdateType
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> Signal
    -> IO ()
    logErrorsHandler (Maybe (String, ImageInfo, String, String)
     -> Identity (Maybe (String, ImageInfo, String, String)))
    -> ItemInfo -> Identity ItemInfo
    Lens' ItemInfo (Maybe (String, ImageInfo, String, String))
    itemToolTipL UpdateType
    ToolTipUpdated ((Client
      -> BusName
      -> ObjectPath
      -> IO
           (Either MethodError (Maybe (String, ImageInfo, String, String))))
     -> Signal -> IO ())
    -> (Client
        -> BusName
        -> ObjectPath
        -> IO
             (Either MethodError (Maybe (String, ImageInfo, String, String))))
    -> Signal
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (Client
     -> BusName
     -> ObjectPath
     -> IO (Either MethodError (String, ImageInfo, String, String)))
    -> Client
    -> BusName
    -> ObjectPath
    -> IO
         (Either MethodError (Maybe (String, ImageInfo, String, String)))
    forall {f :: * -> *} {t} {t} {t} {d} {b}.
    Functor f =>
    (t -> t -> t -> f (Either d b))
    -> t -> t -> t -> f (Either d (Maybe b))
    getMaybe Client
    -> BusName
    -> ObjectPath
    -> IO (Either MethodError (String, ImageInfo, String, String))
    I.getToolTip

          handleNewStatus =
            ((Maybe String -> Identity (Maybe String))
     -> ItemInfo -> Identity ItemInfo)
    -> UpdateType
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
    -> Signal
    -> IO ()
    forall {a} {a}.
    ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
    -> UpdateType
    -> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
    -> Signal
    -> IO ()
    logErrorsHandler (Maybe String -> Identity (Maybe String))
    -> ItemInfo -> Identity ItemInfo
    Lens' ItemInfo (Maybe String)
    itemStatusL UpdateType
    StatusUpdated ((Client
      -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
     -> Signal -> IO ())
    -> (Client
        -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
    -> Signal
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (Client -> BusName -> ObjectPath -> IO (Either MethodError String))
    -> Client
    -> BusName
    -> ObjectPath
    -> IO (Either MethodError (Maybe String))
    forall {f :: * -> *} {t} {t} {t} {d} {b}.
    Functor f =>
    (t -> t -> t -> f (Either d b))
    -> t -> t -> t -> f (Either d (Maybe b))
    getMaybe Client -> BusName -> ObjectPath -> IO (Either MethodError String)
    I.getStatus

          clientRegistrationPairs =
            [ (Client
    -> MatchRule
    -> (Signal -> IO ())
    -> (Signal -> IO ())
    -> IO SignalHandler
    I.registerForNewIcon, Signal -> IO ()
    handleNewIcon)
            , (Client
    -> MatchRule
    -> (Signal -> IO ())
    -> (Signal -> IO ())
    -> IO SignalHandler
    I.registerForNewIconThemePath, Signal -> IO ()
    handleNewIcon)
            , (Client
    -> MatchRule
    -> (Signal -> IO ())
    -> (Signal -> IO ())
    -> IO SignalHandler
    I.registerForNewOverlayIcon, Signal -> IO ()
    handleNewOverlayIcon)
            , (Client
    -> MatchRule
    -> (Signal -> IO ())
    -> (Signal -> IO ())
    -> IO SignalHandler
    I.registerForNewTitle, Signal -> IO ()
    handleNewTitle)
            , (Client
    -> MatchRule
    -> (Signal -> IO ())
    -> (Signal -> IO ())
    -> IO SignalHandler
    I.registerForNewToolTip, Signal -> IO ()
    handleNewTooltip)
            , (Client
    -> MatchRule
    -> (Signal -> IO ())
    -> (Signal -> IO ())
    -> IO SignalHandler
    I.registerForNewStatus, Signal -> IO ()
    handleNewStatus)
            ]

          initializeItemInfoMap = MVar (Map BusName ItemInfo)
    -> (Map BusName ItemInfo -> IO (Map BusName ItemInfo, Bool))
    -> IO Bool
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar (Map BusName ItemInfo)
    itemInfoMapVar ((Map BusName ItemInfo -> IO (Map BusName ItemInfo, Bool))
     -> IO Bool)
    -> (Map BusName ItemInfo -> IO (Map BusName ItemInfo, Bool))
    -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Map BusName ItemInfo
    itemInfoMap -> do
            -- All initialization is done inside this modifyMVar to avoid race
            -- conditions with the itemInfoMapVar.
            clientSignalHandlers <- [(Client
      -> MatchRule
      -> (Signal -> IO ())
      -> (Signal -> IO ())
      -> IO SignalHandler,
      Signal -> IO ())]
    -> IO [SignalHandler]
    forall {b} {b}.
    [(Client -> MatchRule -> b -> (Signal -> IO ()) -> IO b, b)]
    -> IO [b]
    registerWithPairs [(Client
      -> MatchRule
      -> (Signal -> IO ())
      -> (Signal -> IO ())
      -> IO SignalHandler,
      Signal -> IO ())]
    clientRegistrationPairs
            watcherSignalHandlers <- registerWithPairs watcherRegistrationPairs
            let unregisterAll =
                    (SignalHandler -> IO ()) -> [SignalHandler] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Client -> SignalHandler -> IO ()
    removeMatch Client
    client) ([SignalHandler] -> IO ()) -> [SignalHandler] -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                        [SignalHandler]
    clientSignalHandlers [SignalHandler] -> [SignalHandler] -> [SignalHandler]
    forall a. [a] -> [a] -> [a]
    ++ [SignalHandler]
    watcherSignalHandlers
                shutdownHost = do
                    String -> IO ()
    logInfo String
    "Shutting down StatusNotifierHost"
                    IO ()
    unregisterAll
                    Client -> BusName -> IO ReleaseNameReply
    releaseName Client
    client (String -> BusName
    forall a. IsString a => String -> a
    fromString String
    busName)
                    () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                logErrorAndShutdown a
    error =
                  String -> IO ()
    logError (a -> String
    forall a. Show a => a -> String
    show a
    error) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    shutdownHost IO () -> IO (Map k a, Bool) -> IO (Map k a, Bool)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (Map k a, Bool) -> IO (Map k a, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map k a
    forall k a. Map k a
    Map.empty, Bool
    False)
                finishInitialization [String]
    serviceNames = do
                  itemInfos <- [String] -> IO [ItemInfo]
    createAll [String]
    serviceNames
                  let newMap = [(BusName, ItemInfo)] -> Map BusName ItemInfo
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(BusName, ItemInfo)] -> Map BusName ItemInfo)
    -> [(BusName, ItemInfo)] -> Map BusName ItemInfo
    forall a b. (a -> b) -> a -> b
    $ (ItemInfo -> (BusName, ItemInfo))
    -> [ItemInfo] -> [(BusName, ItemInfo)]
    forall a b. (a -> b) -> [a] -> [b]
    map (ItemInfo -> BusName
    itemServiceName (ItemInfo -> BusName)
    -> (ItemInfo -> ItemInfo) -> ItemInfo -> (BusName, ItemInfo)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& ItemInfo -> ItemInfo
    forall a. a -> a
    id) [ItemInfo]
    itemInfos
                      resultMap = Map BusName ItemInfo
    -> Map BusName ItemInfo -> Map BusName ItemInfo
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union Map BusName ItemInfo
    itemInfoMap Map BusName ItemInfo
    newMap
                  W.registerStatusNotifierHost client busName >>=
                   either logErrorAndShutdown (const $ return (resultMap, True))
            W.getRegisteredStatusNotifierItems client >>=
             either logErrorAndShutdown finishInitialization

          startWatcherIfNeeded = do
            let watcherName :: String
    watcherName = String -> (BusName -> String) -> Maybe BusName -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" BusName -> String
    forall a b. Coercible a b => a -> b
    coerce (Maybe BusName -> String) -> Maybe BusName -> String
    forall a b. (a -> b) -> a -> b
    $ GenerationParams -> Maybe BusName
    genBusName GenerationParams
    W.watcherClientGenerationParams
                startWatcher :: IO RequestNameReply
    startWatcher = do
                  (_, doIt) <- WatcherParams -> IO (Interface, IO RequestNameReply)
    W.buildWatcher WatcherParams
    W.defaultWatcherParams
                  doIt
            res <- Client -> String -> IO (Either MethodError String)
    DTH.getNameOwner Client
    client String
    watcherName
            case res of
              Right String
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              Left MethodError
    _ -> IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ IO RequestNameReply -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void IO RequestNameReply
    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
          , forceUpdate = handleItemAdded . coerce
          }
        else Nothing
      else do
        logErrorWithMessage "Failed to obtain desired service name" nameRequestResult
        return Nothing