{-# 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
/= :: UpdateType -> UpdateType -> Bool
$c/= :: UpdateType -> UpdateType -> Bool
== :: UpdateType -> UpdateType -> Bool
$c== :: 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
showList :: [UpdateType] -> String -> String
$cshowList :: [UpdateType] -> String -> String
show :: UpdateType -> String
$cshow :: UpdateType -> String
showsPrec :: Int -> UpdateType -> String -> String
$cshowsPrec :: Int -> 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 :: Maybe Client -> String -> String -> Bool -> Bool -> Params
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
/= :: ItemInfo -> ItemInfo -> Bool
$c/= :: ItemInfo -> ItemInfo -> Bool
== :: ItemInfo -> ItemInfo -> Bool
$c== :: 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
showList :: [ItemInfo] -> String -> String
$cshowList :: [ItemInfo] -> String -> String
show :: ItemInfo -> String
$cshow :: ItemInfo -> String
showsPrec :: Int -> ItemInfo -> String -> String
$cshowsPrec :: Int -> ItemInfo -> String -> String
Show)

supressPixelData :: ItemInfo -> ItemInfo
supressPixelData ItemInfo
info =
  ItemInfo
info { iconPixmaps :: ImageInfo
iconPixmaps = ((Int32, Int32, ByteString) -> (Int32, Int32, ByteString))
-> ImageInfo -> ImageInfo
forall a b. (a -> b) -> [a] -> [b]
map (\(Int32
w, Int32
h, ByteString
_) -> (Int32
w, Int32
h, ByteString
"")) (ImageInfo -> ImageInfo) -> ImageInfo -> ImageInfo
forall a b. (a -> b) -> a -> b
$ ItemInfo -> ImageInfo
iconPixmaps ItemInfo
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
_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
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe Client
mclient
  MVar (Map BusName ItemInfo)
itemInfoMapVar <- Map BusName ItemInfo -> IO (MVar (Map BusName ItemInfo))
forall a. a -> IO (MVar a)
newMVar Map BusName ItemInfo
forall k a. Map k a
Map.empty
  MVar [(Unique, UpdateHandler)]
updateHandlersVar <- [(Unique, UpdateHandler)] -> IO (MVar [(Unique, UpdateHandler)])
forall a. a -> IO (MVar a)
newMVar ([] :: [(Unique, UpdateHandler)])
  let busName :: String
busName = String -> String -> String
getBusName String
namespaceString String
uniqueID

      logError :: String -> IO ()
logError = Priority -> String -> IO ()
hostLogger Priority
ERROR
      logErrorWithMessage :: String -> a -> IO ()
logErrorWithMessage String
message a
error = String -> IO ()
logError String
message IO () -> IO () -> IO ()
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 :: String -> IO ()
logInfo = Priority -> String -> IO ()
hostLogger Priority
INFO
      logErrorAndThen :: IO b -> a -> IO b
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
andThen

      doUpdateForHandler :: t -> ItemInfo -> (Unique, t -> ItemInfo -> IO ()) -> IO ThreadId
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 :: UpdateHandler
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 (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 -> IO Unique
addHandler UpdateHandler
handler = do
        Unique
unique <- IO Unique
newUnique
        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 (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
unique, UpdateHandler
handler)(Unique, UpdateHandler)
-> [(Unique, UpdateHandler)] -> [(Unique, UpdateHandler)]
forall a. a -> [a] -> [a]
:))
        let doUpdateForInfo :: ItemInfo -> IO ThreadId
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)
        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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ItemInfo -> IO ThreadId) -> Map BusName ItemInfo -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ItemInfo -> IO ThreadId
doUpdateForInfo
        Unique -> IO Unique
forall (m :: * -> *) a. Monad m => a -> m a
return Unique
unique

      removeHandler :: Unique -> IO ()
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 (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)) -> t -> t -> t -> f (f ImageInfo)
getPixmaps t -> t -> t -> f (f ImageInfo)
getter t
a1 t
a2 t
a3 =
        (ImageInfo -> ImageInfo) -> f ImageInfo -> f ImageInfo
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))
-> t -> t -> t -> f (Either d (Maybe b))
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 (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 -> IO (Either MethodError ItemInfo)
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
        String
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 :: BusName
busName = String -> BusName
forall a. IsString a => String -> a
fromString String
name
            path :: ObjectPath
path = String -> ObjectPath
objectPath_ String
pathString
            doGetDef :: a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
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))
-> ExceptT e m a
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
        ImageInfo
pixmaps <- ImageInfo
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
-> ExceptT MethodError IO ImageInfo
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef [] ((Client
  -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
 -> ExceptT MethodError IO ImageInfo)
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
-> ExceptT MethodError IO ImageInfo
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
        String
iName <- String
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError String))
-> ExceptT MethodError IO String
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef String
name Client -> BusName -> ObjectPath -> IO (Either MethodError String)
I.getIconName
        ImageInfo
overlayPixmap <- ImageInfo
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
-> ExceptT MethodError IO ImageInfo
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef [] ((Client
  -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
 -> ExceptT MethodError IO ImageInfo)
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError ImageInfo))
-> ExceptT MethodError IO ImageInfo
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
        Maybe String
overlayIName <- Maybe String
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef Maybe String
forall a. Maybe a
Nothing ((Client
  -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
 -> ExceptT MethodError IO (Maybe String))
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
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
        Maybe String
themePath <- Maybe String
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef Maybe String
forall a. Maybe a
Nothing ((Client
  -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
 -> ExceptT MethodError IO (Maybe String))
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
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.getIconThemePath
        Maybe ObjectPath
menu <- Maybe ObjectPath
-> (Client
    -> BusName
    -> ObjectPath
    -> IO (Either MethodError (Maybe ObjectPath)))
-> ExceptT MethodError IO (Maybe ObjectPath)
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef Maybe ObjectPath
forall a. Maybe a
Nothing ((Client
  -> BusName
  -> ObjectPath
  -> IO (Either MethodError (Maybe ObjectPath)))
 -> ExceptT MethodError IO (Maybe ObjectPath))
-> (Client
    -> BusName
    -> ObjectPath
    -> IO (Either MethodError (Maybe ObjectPath)))
-> ExceptT MethodError IO (Maybe ObjectPath)
forall a b. (a -> b) -> a -> b
$ (Client
 -> BusName -> ObjectPath -> IO (Either MethodError ObjectPath))
-> Client
-> BusName
-> ObjectPath
-> IO (Either MethodError (Maybe ObjectPath))
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 ObjectPath)
I.getMenu
        String
title <- String
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError String))
-> ExceptT MethodError IO String
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef String
"" Client -> BusName -> ObjectPath -> IO (Either MethodError String)
I.getTitle
        Maybe (String, ImageInfo, String, String)
tooltip <- Maybe (String, ImageInfo, String, String)
-> (Client
    -> BusName
    -> ObjectPath
    -> IO
         (Either MethodError (Maybe (String, ImageInfo, String, String))))
-> ExceptT
     MethodError IO (Maybe (String, ImageInfo, String, String))
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef Maybe (String, ImageInfo, String, String)
forall a. Maybe a
Nothing ((Client
  -> BusName
  -> ObjectPath
  -> IO
       (Either MethodError (Maybe (String, ImageInfo, String, String))))
 -> ExceptT
      MethodError IO (Maybe (String, ImageInfo, String, String)))
-> (Client
    -> BusName
    -> ObjectPath
    -> IO
         (Either MethodError (Maybe (String, ImageInfo, String, String))))
-> ExceptT
     MethodError IO (Maybe (String, ImageInfo, String, String))
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
        Maybe String
idString <- Maybe String
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef Maybe String
forall a. Maybe a
Nothing ((Client
  -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
 -> ExceptT MethodError IO (Maybe String))
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
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.getId
        Maybe String
status <- Maybe String
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef Maybe String
forall a. Maybe a
Nothing ((Client
  -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
 -> ExceptT MethodError IO (Maybe String))
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
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
        Maybe String
category <- Maybe String
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef Maybe String
forall a. Maybe a
Nothing ((Client
  -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
 -> ExceptT MethodError IO (Maybe String))
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError (Maybe String)))
-> ExceptT MethodError IO (Maybe String)
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.getCategory
        Bool
itemIsMenu <- Bool
-> (Client
    -> BusName -> ObjectPath -> IO (Either MethodError Bool))
-> ExceptT MethodError IO Bool
forall (m :: * -> *) a.
Functor m =>
a
-> (Client -> BusName -> ObjectPath -> m (Either MethodError a))
-> ExceptT MethodError m a
doGetDef Bool
False Client -> BusName -> ObjectPath -> IO (Either MethodError Bool)
I.getItemIsMenu
        ItemInfo -> ExceptT MethodError IO ItemInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ItemInfo :: BusName
-> ObjectPath
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe (String, ImageInfo, String, String)
-> String
-> String
-> Maybe String
-> Maybe String
-> ImageInfo
-> ImageInfo
-> Maybe ObjectPath
-> Bool
-> ItemInfo
ItemInfo
                 { itemServiceName :: BusName
itemServiceName = String -> BusName
busName_ String
name
                 , itemId :: Maybe String
itemId = Maybe String
idString
                 , itemStatus :: Maybe String
itemStatus = Maybe String
status
                 , itemCategory :: Maybe String
itemCategory = Maybe String
category
                 , itemServicePath :: ObjectPath
itemServicePath = ObjectPath
path
                 , itemToolTip :: Maybe (String, ImageInfo, String, String)
itemToolTip = Maybe (String, ImageInfo, String, String)
tooltip
                 , iconPixmaps :: ImageInfo
iconPixmaps = ImageInfo
pixmaps
                 , iconThemePath :: Maybe String
iconThemePath = Maybe String
themePath
                 , iconName :: String
iconName = String
iName
                 , iconTitle :: String
iconTitle = String
title
                 , menuPath :: Maybe ObjectPath
menuPath = Maybe ObjectPath
menu
                 , overlayIconName :: Maybe String
overlayIconName = Maybe String
overlayIName
                 , overlayIconPixmaps :: ImageInfo
overlayIconPixmaps = ImageInfo
overlayPixmap
                 , itemIsMenu :: Bool
itemIsMenu = Bool
itemIsMenu
                 }

      createAll :: [String] -> IO [ItemInfo]
createAll [String]
serviceNames = do
        ([MethodError]
errors, [ItemInfo]
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)
mapM String -> IO (Either MethodError ItemInfo)
buildItemInfo [String]
serviceNames
        (MethodError -> IO ()) -> [MethodError] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> MethodError -> IO ()
forall a. Show a => String -> a -> IO ()
logErrorWithMessage String
"Error in item building at startup:") [MethodError]
errors
        [ItemInfo] -> IO [ItemInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [ItemInfo]
itemInfos

      registerWithPairs :: [(Client -> MatchRule -> t -> (Signal -> IO ()) -> IO b, t)]
-> IO [b]
registerWithPairs =
        ((Client -> MatchRule -> t -> (Signal -> IO ()) -> IO b, t)
 -> IO b)
-> [(Client -> MatchRule -> t -> (Signal -> IO ()) -> IO b, t)]
-> IO [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Client -> MatchRule -> t -> (Signal -> IO ()) -> IO b)
 -> t -> IO b)
-> (Client -> MatchRule -> t -> (Signal -> IO ()) -> IO b, t)
-> IO b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Client -> MatchRule -> t -> (Signal -> IO ()) -> IO b)
-> t -> 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 -> IO ()
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 (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 (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
ObjectPath
BusName
itemIsMenu :: Bool
menuPath :: Maybe ObjectPath
overlayIconPixmaps :: ImageInfo
iconPixmaps :: ImageInfo
iconThemePath :: Maybe String
overlayIconName :: Maybe String
iconName :: String
iconTitle :: String
itemToolTip :: Maybe (String, ImageInfo, String, String)
itemCategory :: Maybe String
itemStatus :: Maybe String
itemId :: Maybe String
itemServicePath :: ObjectPath
itemServiceName :: BusName
itemIsMenu :: ItemInfo -> Bool
menuPath :: ItemInfo -> Maybe ObjectPath
overlayIconPixmaps :: ItemInfo -> ImageInfo
iconPixmaps :: ItemInfo -> ImageInfo
iconThemePath :: ItemInfo -> Maybe String
overlayIconName :: ItemInfo -> Maybe String
iconName :: ItemInfo -> String
iconTitle :: ItemInfo -> String
itemToolTip :: ItemInfo -> Maybe (String, ImageInfo, String, String)
itemCategory :: ItemInfo -> Maybe String
itemStatus :: ItemInfo -> Maybe String
itemId :: ItemInfo -> Maybe String
itemServicePath :: ItemInfo -> ObjectPath
itemServiceName :: ItemInfo -> BusName
..} =
                  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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                       Map BusName ItemInfo -> IO (Map BusName ItemInfo)
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 -> IO ObjectPath
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 -> IO ()
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 (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 (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,
  b -> String -> IO ())]
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 ()) -> Signal -> IO ()
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 (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) -> BusName -> IO b
runProperty Client -> BusName -> ObjectPath -> IO b
prop BusName
serviceName =
        BusName -> IO ObjectPath
getObjectPathForItemName BusName
serviceName IO ObjectPath -> (ObjectPath -> 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 -> a -> IO ()
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 :: Signal -> IO (Maybe ItemInfo)
identifySender M.Signal { signalSender :: Signal -> Maybe BusName
M.signalSender = Just BusName
sender
                              , signalPath :: Signal -> ObjectPath
M.signalPath = ObjectPath
senderPath
                              } = do
        Map BusName ItemInfo
infoMap <- MVar (Map BusName ItemInfo) -> IO (Map BusName ItemInfo)
forall a. MVar a -> IO a
readMVar MVar (Map BusName ItemInfo)
itemInfoMapVar
        let identifySenderBySender :: IO (Maybe ItemInfo)
identifySenderBySender = Maybe ItemInfo -> IO (Maybe ItemInfo)
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 :: IO (Maybe ItemInfo)
identifySenderById = (Maybe (Maybe ItemInfo) -> Maybe ItemInfo)
-> IO (Maybe (Maybe ItemInfo)) -> IO (Maybe ItemInfo)
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 (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_ :: IO (Either MethodError (Maybe ItemInfo))
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
              String
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 -> IO Bool
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
                      Either MethodError String
senderNameOwner <- Client -> String -> IO (Either MethodError String)
DTH.getNameOwner Client
client (BusName -> String
coerce BusName
sender)
                      Either MethodError String
infoNameOwner <- Client -> String -> IO (Either MethodError String)
DTH.getNameOwner Client
client (BusName -> String
coerce (BusName -> String) -> BusName -> String
forall a b. (a -> b) -> a -> b
$ ItemInfo -> BusName
itemServiceName ItemInfo
info)
                      let warningMsg :: String
warningMsg =
                            String
"Matched sender id: %s, but name owners do not \
                            \ match: %s %s. Considered match: %s."
                          warningText :: String
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)
                      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either MethodError String
senderNameOwner Either MethodError String -> Either MethodError String -> Bool
forall a. Eq a => a -> a -> Bool
/= Either MethodError String
infoNameOwner) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                           Priority -> String -> IO ()
hostLogger Priority
WARNING String
warningText
                      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
doMatchUnmatchedSender
                    else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
              IO (Maybe ItemInfo) -> ExceptT MethodError IO (Maybe ItemInfo)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe ItemInfo) -> ExceptT MethodError IO (Maybe ItemInfo))
-> IO (Maybe ItemInfo) -> ExceptT MethodError IO (Maybe ItemInfo)
forall a b. (a -> b) -> a -> b
$ (ItemInfo -> IO Bool) -> [ItemInfo] -> IO (Maybe ItemInfo)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM ItemInfo -> IO Bool
matchesSender (Map BusName ItemInfo -> [ItemInfo]
forall k a. Map k a -> [a]
Map.elems Map BusName ItemInfo
infoMap)
        IO (Maybe ItemInfo)
identifySenderBySender IO (Maybe ItemInfo) -> IO (Maybe ItemInfo) -> IO (Maybe ItemInfo)
forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> m (Maybe a) -> m (Maybe a)
<||> IO (Maybe ItemInfo)
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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe ItemInfo
forall a. Maybe a
Nothing

      updateItemByLensAndProp :: ((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 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
        a
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 -> m (Map BusName ItemInfo, Maybe ItemInfo)
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. Prism (Maybe a) (Maybe b) a 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 (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)
        IO (Either MethodError ItemInfo) -> ExceptT MethodError IO ItemInfo
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either MethodError ItemInfo)
 -> ExceptT MethodError IO ItemInfo)
-> IO (Either MethodError ItemInfo)
-> ExceptT MethodError IO ItemInfo
forall a b. (a -> b) -> a -> b
$ MethodError -> Maybe ItemInfo -> Either MethodError ItemInfo
forall b a. b -> Maybe a -> Either b a
maybeToEither (Serial -> ErrorName -> MethodError
methodError (Word32 -> Serial
Serial Word32
0) ErrorName
errorFailed) (Maybe ItemInfo -> Either MethodError ItemInfo)
-> IO (Maybe ItemInfo) -> IO (Either MethodError ItemInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                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 :: * -> *).
Monad m =>
Map BusName ItemInfo -> m (Map BusName ItemInfo, Maybe ItemInfo)
modify

      logErrorsHandler :: ((a -> Identity a) -> ItemInfo -> Identity ItemInfo)
-> UpdateType
-> (Client -> BusName -> ObjectPath -> IO (Either MethodError a))
-> Signal
-> IO ()
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 :: [a -> IO (Either a ItemInfo)] -> UpdateType -> a -> IO ()
runUpdatersForService [a -> IO (Either a ItemInfo)]
updaters UpdateType
updateType a
serviceName = do
        [Either a ItemInfo]
updateResults <- ((a -> IO (Either a ItemInfo)) -> IO (Either a ItemInfo))
-> [a -> 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)
mapM ((a -> IO (Either a ItemInfo)) -> a -> IO (Either a ItemInfo)
forall a b. (a -> b) -> a -> b
$ a
serviceName) [a -> IO (Either a ItemInfo)]
updaters
        let ([a]
failures, [ItemInfo]
updates) = [Either a ItemInfo] -> ([a], [ItemInfo])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either a ItemInfo]
updateResults
            logLevel :: Priority
logLevel = if [ItemInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ItemInfo]
updates then Priority
ERROR else Priority
DEBUG
        (ItemInfo -> IO ()) -> [ItemInfo] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (UpdateHandler
doUpdate UpdateType
updateType) [ItemInfo]
updates
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
failures) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
             Priority -> String -> IO ()
hostLogger Priority
logLevel (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Property update failures %s" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
                        [a] -> String
forall a. Show a => a -> String
show [a]
failures

      runUpdaters :: [BusName -> IO (Either a ItemInfo)]
-> UpdateType -> Signal -> IO ()
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 (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 a.
Show a =>
[a -> IO (Either a ItemInfo)] -> UpdateType -> a -> 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 (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 (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 :: BusName -> IO (Either MethodError ItemInfo)
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 :: BusName -> IO (Either MethodError ItemInfo)
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 :: BusName -> IO (Either MethodError ItemInfo)
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 -> IO (Maybe (Either MethodError ItemInfo))
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 (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)
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 -> IO ()
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 :: BusName -> IO (Either MethodError ItemInfo)
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 :: BusName -> IO (Either MethodError ItemInfo)
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 -> IO ()
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
-> BusName -> ObjectPath -> IO (Either MethodError (Maybe String))
getThemePathDefault Client
client BusName
busName ObjectPath
objectPath =
        (String -> Maybe String)
-> Either MethodError String -> Either MethodError (Maybe String)
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 :: Signal -> IO ()
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 :: Signal -> IO ()
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 :: Signal -> IO ()
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,
  Signal -> IO ())]
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 :: IO Bool
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.
        [SignalHandler]
clientSignalHandlers <- [(Client
  -> MatchRule
  -> (Signal -> IO ())
  -> (Signal -> IO ())
  -> IO SignalHandler,
  Signal -> IO ())]
-> IO [SignalHandler]
forall t b.
[(Client -> MatchRule -> t -> (Signal -> IO ()) -> IO b, t)]
-> IO [b]
registerWithPairs [(Client
  -> MatchRule
  -> (Signal -> IO ())
  -> (Signal -> IO ())
  -> IO SignalHandler,
  Signal -> IO ())]
clientRegistrationPairs
        [SignalHandler]
watcherSignalHandlers <- [(Client
  -> MatchRule
  -> (Signal -> String -> IO ())
  -> (Signal -> IO ())
  -> IO SignalHandler,
  Signal -> String -> IO ())]
-> IO [SignalHandler]
forall t b.
[(Client -> MatchRule -> t -> (Signal -> IO ()) -> IO b, t)]
-> IO [b]
registerWithPairs [(Client
  -> MatchRule
  -> (Signal -> String -> IO ())
  -> (Signal -> IO ())
  -> IO SignalHandler,
  Signal -> String -> IO ())]
forall b.
[(Client
  -> MatchRule
  -> (Signal -> String -> IO ())
  -> (Signal -> IO ())
  -> IO SignalHandler,
  b -> String -> IO ())]
watcherRegistrationPairs
        let unregisterAll :: IO ()
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 :: IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()
            logErrorAndShutdown :: a -> IO (Map k a, Bool)
logErrorAndShutdown a
error =
              String -> IO ()
logError (a -> String
forall a. Show a => a -> String
show a
error) IO () -> IO () -> IO ()
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Map k a, Bool) -> IO (Map k a, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k a
forall k a. Map k a
Map.empty, Bool
False)
            finishInitialization :: [String] -> IO (Map BusName ItemInfo, Bool)
finishInitialization [String]
serviceNames = do
              [ItemInfo]
itemInfos <- [String] -> IO [ItemInfo]
createAll [String]
serviceNames
              let newMap :: Map BusName ItemInfo
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 (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
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
              Client -> String -> IO (Either MethodError ())
W.registerStatusNotifierHost Client
client String
busName IO (Either MethodError ())
-> (Either MethodError () -> IO (Map BusName ItemInfo, Bool))
-> IO (Map BusName ItemInfo, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
               (MethodError -> IO (Map BusName ItemInfo, Bool))
-> (() -> IO (Map BusName ItemInfo, Bool))
-> Either MethodError ()
-> IO (Map BusName ItemInfo, Bool)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MethodError -> IO (Map BusName ItemInfo, Bool)
forall a k a. Show a => a -> IO (Map k a, Bool)
logErrorAndShutdown (IO (Map BusName ItemInfo, Bool)
-> () -> IO (Map BusName ItemInfo, Bool)
forall a b. a -> b -> a
const (IO (Map BusName ItemInfo, Bool)
 -> () -> IO (Map BusName ItemInfo, Bool))
-> IO (Map BusName ItemInfo, Bool)
-> ()
-> IO (Map BusName ItemInfo, Bool)
forall a b. (a -> b) -> a -> b
$ (Map BusName ItemInfo, Bool) -> IO (Map BusName ItemInfo, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map BusName ItemInfo
resultMap, Bool
True))
        Client -> IO (Either MethodError [String])
W.getRegisteredStatusNotifierItems Client
client IO (Either MethodError [String])
-> (Either MethodError [String] -> IO (Map BusName ItemInfo, Bool))
-> IO (Map BusName ItemInfo, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         (MethodError -> IO (Map BusName ItemInfo, Bool))
-> ([String] -> IO (Map BusName ItemInfo, Bool))
-> Either MethodError [String]
-> IO (Map BusName ItemInfo, Bool)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MethodError -> IO (Map BusName ItemInfo, Bool)
forall a k a. Show a => a -> IO (Map k a, Bool)
logErrorAndShutdown [String] -> IO (Map BusName ItemInfo, Bool)
finishInitialization

      startWatcherIfNeeded :: IO ()
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
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
              (Interface
_, IO RequestNameReply
doIt) <- WatcherParams -> IO (Interface, IO RequestNameReply)
W.buildWatcher WatcherParams
W.defaultWatcherParams
              IO RequestNameReply
doIt
        Either MethodError String
res <- Client -> String -> IO (Either MethodError String)
DTH.getNameOwner Client
client String
watcherName
        case Either MethodError String
res of
          Right String
_ -> () -> IO ()
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

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldStartWatcher IO ()
startWatcherIfNeeded
  RequestNameReply
nameRequestResult <- Client -> BusName -> [RequestNameFlag] -> IO RequestNameReply
requestName Client
client (String -> BusName
forall a. IsString a => String -> a
fromString String
busName) []
  if RequestNameReply
nameRequestResult RequestNameReply -> RequestNameReply -> Bool
forall a. Eq a => a -> a -> Bool
== RequestNameReply
NamePrimaryOwner
  then do
    Bool
initializationSuccess <- IO Bool
initializeItemInfoMap
    Maybe Host -> IO (Maybe Host)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Host -> IO (Maybe Host)) -> Maybe Host -> IO (Maybe Host)
forall a b. (a -> b) -> a -> b
$ if Bool
initializationSuccess
    then
      Host -> Maybe Host
forall a. a -> Maybe a
Just Host :: IO (Map BusName ItemInfo)
-> (UpdateHandler -> IO Unique)
-> (Unique -> IO ())
-> (BusName -> IO ())
-> Host
Host
      { itemInfoMap :: IO (Map BusName ItemInfo)
itemInfoMap = MVar (Map BusName ItemInfo) -> IO (Map BusName ItemInfo)
forall a. MVar a -> IO a
readMVar MVar (Map BusName ItemInfo)
itemInfoMapVar
      , addUpdateHandler :: UpdateHandler -> IO Unique
addUpdateHandler = UpdateHandler -> IO Unique
addHandler
      , removeUpdateHandler :: Unique -> IO ()
removeUpdateHandler = Unique -> IO ()
removeHandler
      , forceUpdate :: BusName -> IO ()
forceUpdate = String -> IO ()
handleItemAdded (String -> IO ()) -> (BusName -> String) -> BusName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BusName -> String
coerce
      }
    else Maybe Host
forall a. Maybe a
Nothing
  else do
    String -> RequestNameReply -> IO ()
forall a. Show a => String -> a -> IO ()
logErrorWithMessage String
"Failed to obtain desired service name" RequestNameReply
nameRequestResult
    Maybe Host -> IO (Maybe Host)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Host
forall a. Maybe a
Nothing