    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE OverloadedLabels #-}
    {-# LANGUAGE CPP #-}
    module StatusNotifier.Tray where

    import           Control.Concurrent.MVar as MV
    import           Control.Exception.Base
    import           Control.Exception.Enclosed (catchAny)
    import           Control.Monad
    import           Control.Monad.Trans.Class
    import           Control.Monad.Trans.Maybe
    import           DBus.Client
    import qualified DBus.Internal.Types as DBusTypes
    import           Data.Bool (bool)
    import qualified Data.ByteString as BS
    import           Data.Coerce
    import           Data.Foldable (traverse_)
    import           Data.GI.Base.GError
    import           Data.Int
    import           Data.List
    import qualified Data.Map.Strict as Map
    import           Data.Maybe
    import           Data.Ord
    import           Data.Ratio
    import qualified Data.Text as T
    import qualified GI.DbusmenuGtk3.Objects.Menu as DM
    import qualified GI.GLib as GLib
    import           GI.GLib.Structs.Bytes
    import qualified GI.Gdk as Gdk
    import           GI.Gdk.Enums
    import           GI.Gdk.Objects.Screen
    import           GI.Gdk.Structs.EventScroll
    import           GI.GdkPixbuf.Enums
    import           GI.GdkPixbuf.Objects.Pixbuf as Gdk
    import qualified GI.Gtk as Gtk
    import           GI.Gtk.Flags
    import           GI.Gtk.Objects.IconTheme
    import           Graphics.UI.GIGtkStrut
    import           StatusNotifier.Host.Service
    import qualified StatusNotifier.Item.Client as IC
    import           System.Directory
    import           System.FilePath
    import           System.Log.Logger
    import           Text.Printf

    trayLogger :: Priority -> String -> IO ()
    trayLogger :: Priority -> String -> IO ()
    trayLogger = String -> Priority -> String -> IO ()
    logM String
    "StatusNotifier.Tray"

    logItemInfo :: ItemInfo -> String -> IO ()
    logItemInfo :: ItemInfo -> String -> IO ()
    logItemInfo ItemInfo
    info String
    message =
      Priority -> String -> IO ()
    trayLogger Priority
    INFO (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "%s - %s pixmap count: %s" String
    message
             (ItemInfo -> String
    forall a. Show a => a -> String
    show (ItemInfo -> String) -> ItemInfo -> String
    forall a b. (a -> b) -> a -> b
    $ ItemInfo
    info { iconPixmaps = []})
             (Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> Int -> String
    forall a b. (a -> b) -> a -> b
    $ [(Int32, Int32, ByteString)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([(Int32, Int32, ByteString)] -> Int)
    -> [(Int32, Int32, ByteString)] -> Int
    forall a b. (a -> b) -> a -> b
    $ ItemInfo -> [(Int32, Int32, ByteString)]
    iconPixmaps ItemInfo
    info)

    getScaledWidthHeight :: Bool -> Int32 -> Int32 -> Int32 -> (Int32, Int32)
    getScaledWidthHeight :: Bool -> Int32 -> Int32 -> Int32 -> (Int32, Int32)
    getScaledWidthHeight Bool
    shouldTargetWidth Int32
    targetSize Int32
    width Int32
    height =
      let getRatio :: Int32 -> Rational
          getRatio :: Int32 -> Rational
    getRatio Int32
    toScale =
            Int32 -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    targetSize Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / Int32 -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    toScale
          getOther :: Int32 -> Int32 -> Int32
          getOther :: Int32 -> Int32 -> Int32
    getOther Int32
    toScale Int32
    other = Rational -> Int32
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational -> Int32) -> Rational -> Int32
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Rational
    getRatio Int32
    toScale Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Int32 -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    other
      in
        if Bool
    shouldTargetWidth
        then (Int32
    targetSize, Int32 -> Int32 -> Int32
    getOther Int32
    width Int32
    height)
        else (Int32 -> Int32 -> Int32
    getOther Int32
    height Int32
    width, Int32
    targetSize)

    scalePixbufToSize :: Int32 -> Gtk.Orientation -> Pixbuf -> IO Pixbuf
    scalePixbufToSize :: Int32 -> Orientation -> Pixbuf -> IO Pixbuf
    scalePixbufToSize Int32
    size Orientation
    orientation Pixbuf
    pixbuf = do
      width <- Pixbuf -> IO Int32
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsPixbuf a) =>
    a -> m Int32
    pixbufGetWidth Pixbuf
    pixbuf
      height <- pixbufGetHeight pixbuf
      let warnAndReturnOrig =
            Priority -> String -> IO ()
    trayLogger Priority
    WARNING String
    "Unable to scale pixbuf" IO () -> IO Pixbuf -> IO Pixbuf
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Pixbuf -> IO Pixbuf
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Pixbuf
    pixbuf
          targetWidth = case Orientation
    orientation of
                          Orientation
    Gtk.OrientationHorizontal -> Bool
    False
                          Orientation
    _ -> Bool
    True
          (scaledWidth, scaledHeight) =
            getScaledWidthHeight targetWidth size width height
      trayLogger DEBUG $
                 printf
                 "Scaling pb to %s, actualW: %s, actualH: %s, scaledW: %s, scaledH: %s"
                 (show size) (show width) (show height)
                 (show scaledWidth) (show scaledHeight)

      trayLogger DEBUG $ printf "targetW: %s, targetH: %s"
                   (show scaledWidth) (show scaledHeight)
      maybe warnAndReturnOrig return =<<
        pixbufScaleSimple pixbuf scaledWidth scaledHeight InterpTypeBilinear

    themeLoadFlags :: [IconLookupFlags]
    themeLoadFlags :: [IconLookupFlags]
    themeLoadFlags = [IconLookupFlags
    IconLookupFlagsGenericFallback, IconLookupFlags
    IconLookupFlagsUseBuiltin]

    getThemeWithDefaultFallbacks :: String -> IO IconTheme
    getThemeWithDefaultFallbacks :: String -> IO IconTheme
    getThemeWithDefaultFallbacks String
    themePath = do
      themeForIcon <- IO IconTheme
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m IconTheme
    iconThemeNew
      defaultTheme <- iconThemeGetDefault

      _ <- runMaybeT $ do
        screen <- MaybeT screenGetDefault
        lift $ iconThemeSetScreen themeForIcon screen

      filePaths <- iconThemeGetSearchPath defaultTheme
      iconThemeAppendSearchPath themeForIcon themePath
      mapM_ (iconThemeAppendSearchPath themeForIcon) filePaths

      return themeForIcon

    catchGErrorsAsLeft :: IO a -> IO (Either GError a)
    catchGErrorsAsLeft :: forall a. IO a -> IO (Either GError a)
    catchGErrorsAsLeft IO a
    action = IO (Either GError a)
    -> (GError -> IO (Either GError a)) -> IO (Either GError a)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    catch (a -> Either GError a
    forall a b. b -> Either a b
    Right (a -> Either GError a) -> IO a -> IO (Either GError a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO a
    action) (Either GError a -> IO (Either GError a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either GError a -> IO (Either GError a))
    -> (GError -> Either GError a) -> GError -> IO (Either GError a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GError -> Either GError a
    forall a b. a -> Either a b
    Left)

    catchGErrorsAsNothing :: IO a -> IO (Maybe a)
    catchGErrorsAsNothing :: forall a. IO a -> IO (Maybe a)
    catchGErrorsAsNothing IO a
    action = IO a -> IO (Either GError a)
    forall a. IO a -> IO (Either GError a)
    catchGErrorsAsLeft IO a
    action IO (Either GError a)
    -> (Either GError a -> IO (Maybe a)) -> IO (Maybe a)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Either GError a -> IO (Maybe a)
    forall {a} {a}. Show a => Either a a -> IO (Maybe a)
    rightToJustLogLeft
           where rightToJustLogLeft :: Either a a -> IO (Maybe a)
    rightToJustLogLeft (Right a
    value) = Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a
    forall a. a -> Maybe a
    Just a
    value
                 rightToJustLogLeft (Left a
    error) = do
                   Priority -> String -> IO ()
    trayLogger Priority
    WARNING (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Encountered error: %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ a -> String
    forall a. Show a => a -> String
    show a
    error
                   Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing

    safePixbufNewFromFile :: FilePath -> IO (Maybe Gdk.Pixbuf)
    safePixbufNewFromFile :: String -> IO (Maybe Pixbuf)
    safePixbufNewFromFile =
      IO (Maybe (Maybe Pixbuf)) -> IO (Maybe Pixbuf)
    forall {a}. IO (Maybe (Maybe a)) -> IO (Maybe a)
    handleResult (IO (Maybe (Maybe Pixbuf)) -> IO (Maybe Pixbuf))
    -> (String -> IO (Maybe (Maybe Pixbuf)))
    -> String
    -> IO (Maybe Pixbuf)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Maybe Pixbuf) -> IO (Maybe (Maybe Pixbuf))
    forall a. IO a -> IO (Maybe a)
    catchGErrorsAsNothing (IO (Maybe Pixbuf) -> IO (Maybe (Maybe Pixbuf)))
    -> (String -> IO (Maybe Pixbuf))
    -> String
    -> IO (Maybe (Maybe Pixbuf))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO (Maybe Pixbuf)
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    String -> m (Maybe Pixbuf)
    Gdk.pixbufNewFromFile
      where
    #if MIN_VERSION_gi_gdkpixbuf(2,0,26)
        handleResult :: IO (Maybe (Maybe a)) -> IO (Maybe a)
    handleResult = (Maybe (Maybe a) -> Maybe a)
    -> IO (Maybe (Maybe a)) -> IO (Maybe a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe (Maybe a) -> Maybe a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join
    #else
        handleResult = id
    #endif

    getIconPixbufByName :: Int32 -> T.Text -> Maybe String -> IO (Maybe Pixbuf)
    getIconPixbufByName :: Int32 -> Text -> Maybe String -> IO (Maybe Pixbuf)
    getIconPixbufByName Int32
    size Text
    name Maybe String
    themePath = do
      Priority -> String -> IO ()
    trayLogger Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> Text -> String
    forall r. PrintfType r => String -> r
    printf String
    "Getting Pixbuf from name for %s" Text
    name
      let nonEmptyThemePath :: Maybe String
    nonEmptyThemePath = Maybe String
    themePath Maybe String -> (String -> Maybe String) -> Maybe String
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\String
    x -> if String
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" then Maybe String
    forall a. Maybe a
    Nothing else String -> Maybe String
    forall a. a -> Maybe a
    Just String
    x)
      themeForIcon <-
        IO IconTheme
    -> (String -> IO IconTheme) -> Maybe String -> IO IconTheme
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO IconTheme
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m IconTheme
    iconThemeGetDefault String -> IO IconTheme
    getThemeWithDefaultFallbacks Maybe String
    nonEmptyThemePath

      let panelName = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text -> String
    forall r. PrintfType r => String -> r
    printf String
    "%s-panel" Text
    name
      hasPanelIcon <- iconThemeHasIcon themeForIcon panelName
      hasIcon <- iconThemeHasIcon themeForIcon name

      if hasIcon || hasPanelIcon

      then do
        let targetName = if Bool
    hasPanelIcon then Text
    panelName else Text
    name
        trayLogger DEBUG $ printf "Found icon %s in theme" name
        catchAny (iconThemeLoadIcon themeForIcon targetName size themeLoadFlags)
                 (const $ pure Nothing)

      else do
        trayLogger DEBUG $ printf "Trying to load icon %s as filepath" name
        -- Try to load the icon as a filepath
        let nameString = Text -> String
    T.unpack Text
    name
        fileExists <- doesFileExist nameString
        maybeFile <- if fileExists
        then return $ Just nameString
        else fmap join $ sequenceA $ getIconPathFromThemePath nameString <$> themePath
    #if MIN_VERSION_gi_gdkpixbuf(2,0,26)
        let handleResult = (Maybe (Maybe a) -> Maybe a)
    -> IO (Maybe (Maybe a)) -> IO (Maybe a)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe (Maybe a) -> Maybe a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (Maybe (Maybe a)) -> IO (Maybe a))
    -> (Maybe (IO (Maybe a)) -> IO (Maybe (Maybe a)))
    -> Maybe (IO (Maybe a))
    -> IO (Maybe a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (IO (Maybe a)) -> IO (Maybe (Maybe a))
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => Maybe (f a) -> f (Maybe a)
    sequenceA
    #else
        let handleResult = sequenceA
    #endif
        handleResult $ safePixbufNewFromFile <$> maybeFile

    getIconPathFromThemePath :: String -> String -> IO (Maybe String)
    getIconPathFromThemePath :: String -> String -> IO (Maybe String)
    getIconPathFromThemePath String
    name String
    themePath = if String
    name String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" then Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    forall a. Maybe a
    Nothing else do
      Priority -> String -> IO ()
    trayLogger Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf
        String
    "Trying to load icon %s as filepath with theme path %s"
        String
    name String
    themePath
      pathExists <- String -> IO Bool
    doesDirectoryExist String
    themePath
      if pathExists
      then do
        fileNames <- catchAny (listDirectory themePath) (const $ return [])
        trayLogger DEBUG $ printf
          "Found files in theme path %s" (show fileNames)
        return $ (themePath </>) <$> find (isPrefixOf name) fileNames
      else return Nothing

    getIconPixbufFromByteString :: Int32 -> Int32 -> BS.ByteString -> IO Pixbuf
    getIconPixbufFromByteString :: Int32 -> Int32 -> ByteString -> IO Pixbuf
    getIconPixbufFromByteString Int32
    width Int32
    height ByteString
    byteString = do
      Priority -> String -> IO ()
    trayLogger Priority
    DEBUG String
    "Getting Pixbuf from bytestring"
      bytes <- Maybe ByteString -> IO Bytes
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Maybe ByteString -> m Bytes
    bytesNew (Maybe ByteString -> IO Bytes) -> Maybe ByteString -> IO Bytes
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    byteString
      let bytesPerPixel = Int32
    4
          rowStride = Int32
    width Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    * Int32
    bytesPerPixel
          sampleBits = Int32
    8
      pixbufNewFromBytes bytes ColorspaceRgb True sampleBits width height rowStride

    data ItemContext = ItemContext
      { ItemContext -> BusName
    contextName :: DBusTypes.BusName
      , ItemContext -> Maybe Menu
    contextMenu :: Maybe DM.Menu
      , ItemContext -> Image
    contextImage :: Gtk.Image
      , ItemContext -> EventBox
    contextButton :: Gtk.EventBox
      }

    data TrayImageSize = Expand | TrayImageSize Int32

    data TrayClickAction = Activate | SecondaryActivate | PopupMenu

    data TrayParams = TrayParams
      { TrayParams -> Orientation
    trayOrientation :: Gtk.Orientation
      , TrayParams -> TrayImageSize
    trayImageSize :: TrayImageSize
      , TrayParams -> Bool
    trayIconExpand :: Bool
      , TrayParams -> StrutAlignment
    trayAlignment :: StrutAlignment
      , TrayParams -> Rational
    trayOverlayScale :: Rational
      , TrayParams -> TrayClickAction
    trayLeftClickAction :: TrayClickAction
      , TrayParams -> TrayClickAction
    trayMiddleClickAction :: TrayClickAction
      , TrayParams -> TrayClickAction
    trayRightClickAction :: TrayClickAction
      }

    defaultTrayParams :: TrayParams
    defaultTrayParams = TrayParams
      { trayOrientation :: Orientation
    trayOrientation = Orientation
    Gtk.OrientationHorizontal
      , trayImageSize :: TrayImageSize
    trayImageSize = TrayImageSize
    Expand
      , trayIconExpand :: Bool
    trayIconExpand = Bool
    False
      , trayAlignment :: StrutAlignment
    trayAlignment = StrutAlignment
    End
      , trayOverlayScale :: Rational
    trayOverlayScale = Integer
    3 Integer -> Integer -> Rational
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    5
      , trayLeftClickAction :: TrayClickAction
    trayLeftClickAction = TrayClickAction
    Activate
      , trayMiddleClickAction :: TrayClickAction
    trayMiddleClickAction = TrayClickAction
    SecondaryActivate
      , trayRightClickAction :: TrayClickAction
    trayRightClickAction = TrayClickAction
    PopupMenu
      }

    buildTray :: Host -> Client -> TrayParams -> IO Gtk.Box
    buildTray :: Host -> Client -> TrayParams -> IO Box
    buildTray Host
                { itemInfoMap :: Host -> IO (Map BusName ItemInfo)
    itemInfoMap = IO (Map BusName ItemInfo)
    getInfoMap
                , addUpdateHandler :: Host -> UpdateHandler -> IO Unique
    addUpdateHandler = UpdateHandler -> IO Unique
    addUHandler
                , removeUpdateHandler :: Host -> Unique -> IO ()
    removeUpdateHandler = Unique -> IO ()
    removeUHandler
                }
              Client
    client
              TrayParams { trayOrientation :: TrayParams -> Orientation
    trayOrientation = Orientation
    orientation
                         , trayImageSize :: TrayParams -> TrayImageSize
    trayImageSize = TrayImageSize
    imageSize
                         , trayIconExpand :: TrayParams -> Bool
    trayIconExpand = Bool
    shouldExpand
                         , trayAlignment :: TrayParams -> StrutAlignment
    trayAlignment = StrutAlignment
    alignment
                         , trayOverlayScale :: TrayParams -> Rational
    trayOverlayScale = Rational
    overlayScale
                         , trayLeftClickAction :: TrayParams -> TrayClickAction
    trayLeftClickAction = TrayClickAction
    leftClickAction
                         , trayMiddleClickAction :: TrayParams -> TrayClickAction
    trayMiddleClickAction = TrayClickAction
    middleClickAction
                         , trayRightClickAction :: TrayParams -> TrayClickAction
    trayRightClickAction = TrayClickAction
    rightClickAction
                         } = do
      Priority -> String -> IO ()
    trayLogger Priority
    INFO String
    "Building tray"

      trayBox <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    Gtk.boxNew Orientation
    orientation Int32
    0
      contextMap <- MV.newMVar Map.empty

      let getContext BusName
    name = BusName -> Map BusName ItemContext -> Maybe ItemContext
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup BusName
    name (Map BusName ItemContext -> Maybe ItemContext)
    -> IO (Map BusName ItemContext) -> IO (Maybe ItemContext)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVar (Map BusName ItemContext) -> IO (Map BusName ItemContext)
    forall a. MVar a -> IO a
    MV.readMVar MVar (Map BusName ItemContext)
    contextMap
          showInfo ItemInfo
    info = ItemInfo -> String
    forall a. Show a => a -> String
    show ItemInfo
    info { iconPixmaps = [] }

          getSize Rectangle
    rectangle =
            case Orientation
    orientation of
              Orientation
    Gtk.OrientationHorizontal ->
                Rectangle -> m Int32
    forall (m :: * -> *). MonadIO m => Rectangle -> m Int32
    Gdk.getRectangleHeight Rectangle
    rectangle
              Orientation
    _ ->
                Rectangle -> m Int32
    forall (m :: * -> *). MonadIO m => Rectangle -> m Int32
    Gdk.getRectangleWidth Rectangle
    rectangle

          getInfoAttr ItemInfo -> b
    fn b
    def BusName
    name = b -> (ItemInfo -> b) -> Maybe ItemInfo -> b
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe b
    def ItemInfo -> b
    fn (Maybe ItemInfo -> b)
    -> (Map BusName ItemInfo -> Maybe ItemInfo)
    -> Map BusName ItemInfo
    -> b
    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 -> b) -> IO (Map BusName ItemInfo) -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Map BusName ItemInfo)
    getInfoMap

          getInfo :: ItemInfo -> DBusTypes.BusName -> IO ItemInfo
          getInfo = (ItemInfo -> ItemInfo) -> ItemInfo -> BusName -> IO ItemInfo
    forall {b}. (ItemInfo -> b) -> b -> BusName -> IO b
    getInfoAttr ItemInfo -> ItemInfo
    forall a. a -> a
    id

          updateIconFromInfo info :: ItemInfo
    info@ItemInfo { itemServiceName :: ItemInfo -> BusName
    itemServiceName = BusName
    name } =
            BusName -> IO (Maybe ItemContext)
    getContext BusName
    name IO (Maybe ItemContext) -> (Maybe ItemContext -> 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
    >>= Maybe ItemContext -> IO ()
    updateIcon
            where updateIcon :: Maybe ItemContext -> IO ()
    updateIcon Maybe ItemContext
    Nothing = UpdateHandler
    updateHandler UpdateType
    ItemAdded ItemInfo
    info
                  updateIcon (Just ItemContext { contextImage :: ItemContext -> Image
    contextImage = Image
    image } ) = do
                    size <- case TrayImageSize
    imageSize of
                              TrayImageSize Int32
    size -> Int32 -> IO Int32
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int32
    size
                              TrayImageSize
    Expand -> Image -> IO Rectangle
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m Rectangle
    Gtk.widgetGetAllocation Image
    image IO Rectangle -> (Rectangle -> IO Int32) -> IO Int32
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Rectangle -> IO Int32
    forall (m :: * -> *). MonadIO m => Rectangle -> m Int32
    getSize
                    getScaledPixBufFromInfo size info >>=
                                      let handlePixbuf Maybe b
    mpbuf =
                                            if Maybe b -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe b
    mpbuf
                                            then Image -> Maybe b -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsImage a, IsPixbuf b) =>
    a -> Maybe b -> m ()
    Gtk.imageSetFromPixbuf Image
    image Maybe b
    mpbuf
                                            else Priority -> String -> IO ()
    trayLogger Priority
    WARNING (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                                                 String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Failed to get pixbuf for %s" (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
                                                 ItemInfo -> String
    showInfo ItemInfo
    info
                                      in handlePixbuf

          getTooltipText ItemInfo { itemToolTip :: ItemInfo
    -> Maybe (String, [(Int32, Int32, ByteString)], String, String)
    itemToolTip = Just (String
    _, [(Int32, Int32, ByteString)]
    _, String
    titleText, String
    fullText )}
            | String
    titleText String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    fullText = String
    fullText
            | String
    titleText String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" = String
    fullText
            | String
    fullText String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" = String
    titleText
            | Bool
    otherwise = String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "%s: %s" String
    titleText String
    fullText
          getTooltipText ItemInfo
    _ = String
    ""

          setTooltipText a
    widget ItemInfo
    info =
            a -> Maybe Text -> m ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> Maybe Text -> m ()
    Gtk.widgetSetTooltipText a
    widget (Maybe Text -> m ()) -> Maybe Text -> m ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ ItemInfo -> String
    getTooltipText ItemInfo
    info

          updateHandler UpdateType
    ItemAdded
                        info :: ItemInfo
    info@ItemInfo { menuPath :: ItemInfo -> Maybe ObjectPath
    menuPath = Maybe ObjectPath
    pathForMenu
                                      , itemServiceName :: ItemInfo -> BusName
    itemServiceName = BusName
    serviceName
                                      , itemServicePath :: ItemInfo -> ObjectPath
    itemServicePath = ObjectPath
    servicePath
                                      } =
            do
              let serviceNameStr :: String
    serviceNameStr = BusName -> String
    forall a b. Coercible a b => a -> b
    coerce BusName
    serviceName
                  servicePathStr :: String
    servicePathStr = ObjectPath -> String
    forall a b. Coercible a b => a -> b
    coerce ObjectPath
    servicePath :: String
                  serviceMenuPathStr :: Maybe String
    serviceMenuPathStr = ObjectPath -> String
    forall a b. Coercible a b => a -> b
    coerce (ObjectPath -> String) -> Maybe ObjectPath -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ObjectPath
    pathForMenu
                  logText :: String
    logText = String -> String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Adding widget for %s - %s"
                            String
    serviceNameStr String
    servicePathStr

              Priority -> String -> IO ()
    trayLogger Priority
    INFO String
    logText

              button <- IO EventBox
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m EventBox
    Gtk.eventBoxNew
              Gtk.widgetAddEvents button [Gdk.EventMaskScrollMask]

              image <-
                case imageSize of
                  TrayImageSize
    Expand -> do
                    image <- IO Image
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m Image
    Gtk.imageNew
                    lastAllocation <- MV.newMVar Nothing

                    let setPixbuf Rectangle
    allocation =
                          do
                            size <- Rectangle -> IO Int32
    forall (m :: * -> *). MonadIO m => Rectangle -> m Int32
    getSize Rectangle
    allocation

                            actualWidth <- Gdk.getRectangleWidth allocation
                            actualHeight <- Gdk.getRectangleHeight allocation

                            requestResize <- MV.modifyMVar lastAllocation $ \Maybe (Int32, Int32, Int32)
    previous ->
                              let thisTime :: Maybe (Int32, Int32, Int32)
    thisTime = (Int32, Int32, Int32) -> Maybe (Int32, Int32, Int32)
    forall a. a -> Maybe a
    Just (Int32
    size, Int32
    actualWidth, Int32
    actualHeight)
                              in (Maybe (Int32, Int32, Int32), Bool)
    -> IO (Maybe (Int32, Int32, Int32), Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Int32, Int32, Int32)
    thisTime, Maybe (Int32, Int32, Int32)
    thisTime Maybe (Int32, Int32, Int32) -> Maybe (Int32, Int32, Int32) -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe (Int32, Int32, Int32)
    previous)

                            trayLogger DEBUG $
                                       printf
                                       ("Allocating image size %s, width %s," <>
                                        " height %s, resize %s")
                                       (show size)
                                       (show actualWidth)
                                       (show actualHeight)
                                       (show requestResize)

                            when requestResize $ do
                              trayLogger DEBUG "Requesting resize"
                              pixBuf <- getInfo info serviceName >>=
                                        getScaledPixBufFromInfo size
                              when (isNothing pixBuf) $
                                   trayLogger WARNING $
                                              printf "Got null pixbuf for info %s" $
                                              showInfo info
                              Gtk.imageSetFromPixbuf image pixBuf
                              void $ traverse
                                     (\Pixbuf
    pb -> do
                                        width <- Pixbuf -> IO Int32
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsPixbuf a) =>
    a -> m Int32
    pixbufGetWidth Pixbuf
    pb
                                        height <- pixbufGetHeight pb
                                        Gtk.widgetSetSizeRequest image width height)
                                     pixBuf
                              void (Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT $
                                       Gtk.widgetQueueResize image >> return False)

                    _ <- Gtk.onWidgetSizeAllocate image setPixbuf
                    return image
                  TrayImageSize Int32
    size -> do
                    pixBuf <- Int32 -> ItemInfo -> IO (Maybe Pixbuf)
    getScaledPixBufFromInfo Int32
    size ItemInfo
    info
                    Gtk.imageNewFromPixbuf pixBuf

              Gtk.widgetGetStyleContext image >>=
                 flip Gtk.styleContextAddClass "tray-icon-image"

              Gtk.containerAdd button image
              setTooltipText button info

              maybeMenu <- sequenceA $ DM.menuNew (T.pack serviceNameStr) .
                           T.pack <$> serviceMenuPathStr

              let context =
                    ItemContext { contextName :: BusName
    contextName = BusName
    serviceName
                                , contextMenu :: Maybe Menu
    contextMenu = Maybe Menu
    maybeMenu
                                , contextImage :: Image
    contextImage = Image
    image
                                , contextButton :: EventBox
    contextButton = EventBox
    button
                                }
                  popupItemForMenu a
    menu =
                    a -> Image -> Gravity -> Gravity -> Maybe Event -> m ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsMenu a, IsWidget b) =>
    a -> b -> Gravity -> Gravity -> Maybe Event -> m ()
    Gtk.menuPopupAtWidget a
    menu Image
    image
                       Gravity
    GravitySouthWest Gravity
    GravityNorthWest Maybe Event
    forall a. Maybe a
    Nothing

              _ <- Gtk.onWidgetButtonPressEvent button $ \EventButton
    event -> do
                button <- EventButton -> IO Word32
    forall (m :: * -> *). MonadIO m => EventButton -> m Word32
    Gdk.getEventButtonButton EventButton
    event
                x <- round <$> Gdk.getEventButtonXRoot event
                y <- round <$> Gdk.getEventButtonYRoot event
                action <- case button of
                  Word32
    1 -> TrayClickAction -> TrayClickAction -> Bool -> TrayClickAction
    forall a. a -> a -> Bool -> a
    bool TrayClickAction
    leftClickAction TrayClickAction
    PopupMenu (Bool -> TrayClickAction) -> IO Bool -> IO TrayClickAction
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ItemInfo -> Bool) -> Bool -> BusName -> IO Bool
    forall {b}. (ItemInfo -> b) -> b -> BusName -> IO b
    getInfoAttr
                       ItemInfo -> Bool
    itemIsMenu Bool
    True BusName
    serviceName
                  Word32
    2 -> TrayClickAction -> IO TrayClickAction
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TrayClickAction
    middleClickAction
                  Word32
    _ -> TrayClickAction -> IO TrayClickAction
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TrayClickAction
    rightClickAction
                case action of
                  TrayClickAction
    Activate -> IO (Either MethodError ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either MethodError ()) -> IO ())
    -> IO (Either MethodError ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Client
    -> BusName
    -> ObjectPath
    -> Int32
    -> Int32
    -> IO (Either MethodError ())
    IC.activate Client
    client BusName
    serviceName ObjectPath
    servicePath Int32
    x Int32
    y
                  TrayClickAction
    SecondaryActivate -> IO (Either MethodError ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either MethodError ()) -> IO ())
    -> IO (Either MethodError ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Client
    -> BusName
    -> ObjectPath
    -> Int32
    -> Int32
    -> IO (Either MethodError ())
    IC.secondaryActivate Client
    client
                                       BusName
    serviceName ObjectPath
    servicePath Int32
    x Int32
    y
                  TrayClickAction
    PopupMenu -> IO () -> (Menu -> IO ()) -> Maybe Menu -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Menu -> IO ()
    forall {a} {m :: * -> *}.
    (IsDescendantOf Menu a, MonadIO m, GObject a) =>
    a -> m ()
    popupItemForMenu Maybe Menu
    maybeMenu
                return False
              _ <- Gtk.onWidgetScrollEvent button $ \EventScroll
    event -> do
                direction <- EventScroll -> IO ScrollDirection
    forall (m :: * -> *). MonadIO m => EventScroll -> m ScrollDirection
    getEventScrollDirection EventScroll
    event
                let direction' = case ScrollDirection
    direction of
                                   ScrollDirection
    ScrollDirectionUp -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "vertical"
                                   ScrollDirection
    ScrollDirectionDown -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "vertical"
                                   ScrollDirection
    ScrollDirectionLeft -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "horizontal"
                                   ScrollDirection
    ScrollDirectionRight -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "horizontal"
                                   ScrollDirection
    _ -> Maybe String
    forall a. Maybe a
    Nothing
                    -- deltaX/deltaY are provided only in case of smooth scrolling which
                    -- is enabled via additional flag, we don't to enable/handle it
                    delta = case ScrollDirection
    direction of
                              ScrollDirection
    ScrollDirectionUp -> -Int32
    1
                              ScrollDirection
    ScrollDirectionDown -> Int32
    1
                              ScrollDirection
    ScrollDirectionLeft -> -Int32
    1
                              ScrollDirection
    ScrollDirectionRight -> Int32
    1
                              ScrollDirection
    _ -> Int32
    0
                traverse_ (IC.scroll client serviceName servicePath delta) direction'
                return False

              MV.modifyMVar_ contextMap $ return . Map.insert serviceName context

              Gtk.widgetShowAll button
              let packFn =
                    case StrutAlignment
    alignment of
                      StrutAlignment
    End -> Box -> EventBox -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    Gtk.boxPackEnd
                      StrutAlignment
    _ -> Box -> EventBox -> Bool -> Bool -> Word32 -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
    a -> b -> Bool -> Bool -> Word32 -> m ()
    Gtk.boxPackStart

              packFn trayBox button shouldExpand True 0

          updateHandler UpdateType
    ItemRemoved ItemInfo { itemServiceName :: ItemInfo -> BusName
    itemServiceName = BusName
    name }
            = BusName -> IO (Maybe ItemContext)
    getContext BusName
    name IO (Maybe ItemContext) -> (Maybe ItemContext -> 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
    >>= Maybe ItemContext -> IO ()
    removeWidget
            where removeWidget :: Maybe ItemContext -> IO ()
    removeWidget Maybe ItemContext
    Nothing =
                    Priority -> String -> IO ()
    trayLogger Priority
    WARNING String
    "removeWidget: unrecognized service name."
                  removeWidget (Just ItemContext { contextButton :: ItemContext -> EventBox
    contextButton = EventBox
    widgetToRemove }) =
                    do
                      Box -> EventBox -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerRemove Box
    trayBox EventBox
    widgetToRemove
                      MVar (Map BusName ItemContext)
    -> (Map BusName ItemContext -> IO (Map BusName ItemContext))
    -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MV.modifyMVar_ MVar (Map BusName ItemContext)
    contextMap ((Map BusName ItemContext -> IO (Map BusName ItemContext))
     -> IO ())
    -> (Map BusName ItemContext -> IO (Map BusName ItemContext))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Map BusName ItemContext -> IO (Map BusName ItemContext)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map BusName ItemContext -> IO (Map BusName ItemContext))
    -> (Map BusName ItemContext -> Map BusName ItemContext)
    -> Map BusName ItemContext
    -> IO (Map BusName ItemContext)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BusName -> Map BusName ItemContext -> Map BusName ItemContext
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete BusName
    name

          updateHandler UpdateType
    IconUpdated ItemInfo
    i = ItemInfo -> IO ()
    updateIconFromInfo ItemInfo
    i
          updateHandler UpdateType
    OverlayIconUpdated ItemInfo
    i = ItemInfo -> IO ()
    updateIconFromInfo ItemInfo
    i

          updateHandler UpdateType
    ToolTipUpdated info :: ItemInfo
    info@ItemInfo { itemServiceName :: ItemInfo -> BusName
    itemServiceName = BusName
    name } =
            IO (Maybe ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ BusName -> IO (Maybe ItemContext)
    getContext BusName
    name IO (Maybe ItemContext)
    -> (Maybe ItemContext -> IO (Maybe ())) -> IO (Maybe ())
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                 (ItemContext -> IO ()) -> Maybe ItemContext -> IO (Maybe ())
    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 ((EventBox -> ItemInfo -> IO ()) -> ItemInfo -> EventBox -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip EventBox -> ItemInfo -> IO ()
    forall {a} {m :: * -> *}.
    (IsDescendantOf Widget a, MonadIO m, GObject a) =>
    a -> ItemInfo -> m ()
    setTooltipText ItemInfo
    info (EventBox -> IO ())
    -> (ItemContext -> EventBox) -> ItemContext -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ItemContext -> EventBox
    contextButton)

          updateHandler UpdateType
    _ ItemInfo
    _ = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

          maybeAddOverlayToPixbuf p
    size ItemInfo
    info b
    pixbuf = do
            MaybeT IO () -> IO (Maybe ())
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT IO () -> IO (Maybe ())) -> MaybeT IO () -> IO (Maybe ())
    forall a b. (a -> b) -> a -> b
    $ do
              let overlayHeight :: Int32
    overlayHeight = Rational -> Int32
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (p -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral p
    size Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    overlayScale)
              overlayPixbuf <-
                IO (Maybe Pixbuf) -> MaybeT IO Pixbuf
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (IO (Maybe Pixbuf) -> MaybeT IO Pixbuf)
    -> IO (Maybe Pixbuf) -> MaybeT IO Pixbuf
    forall a b. (a -> b) -> a -> b
    $ Int32 -> ItemInfo -> IO (Maybe Pixbuf)
    getOverlayPixBufFromInfo Int32
    overlayHeight ItemInfo
    info IO (Maybe Pixbuf)
    -> (Maybe Pixbuf -> IO (Maybe Pixbuf)) -> IO (Maybe Pixbuf)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                (Pixbuf -> IO Pixbuf) -> Maybe Pixbuf -> IO (Maybe Pixbuf)
    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 (Int32 -> Orientation -> Pixbuf -> IO Pixbuf
    scalePixbufToSize Int32
    overlayHeight Orientation
    Gtk.OrientationHorizontal)
              lift $ do
                actualOHeight <- getPixbufHeight overlayPixbuf
                actualOWidth <- getPixbufWidth overlayPixbuf
                mainHeight <- getPixbufHeight pixbuf
                mainWidth <- getPixbufWidth pixbuf
                pixbufComposite overlayPixbuf pixbuf
                  0 0                           -- Top left corner
                  actualOWidth actualOHeight    -- Overlay size
                  0 0                           -- Offset
                  1.0 1.0                       -- Scale
                  InterpTypeBilinear            -- InterpType
                  255                           -- Source image alpha
            b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    pixbuf

          getScaledPixBufFromInfo Int32
    size ItemInfo
    info =
            Int32 -> ItemInfo -> IO (Maybe Pixbuf)
    getPixBufFromInfo Int32
    size ItemInfo
    info IO (Maybe Pixbuf)
    -> (Maybe Pixbuf -> IO (Maybe Pixbuf)) -> IO (Maybe Pixbuf)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
            (Pixbuf -> IO Pixbuf) -> Maybe Pixbuf -> IO (Maybe Pixbuf)
    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 (Int32 -> Orientation -> Pixbuf -> IO Pixbuf
    scalePixbufToSize Int32
    size Orientation
    orientation (Pixbuf -> IO Pixbuf)
    -> (Pixbuf -> IO Pixbuf) -> Pixbuf -> IO Pixbuf
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                      Int32 -> ItemInfo -> Pixbuf -> IO Pixbuf
    forall {b} {p}.
    (IsDescendantOf Pixbuf b, GObject b, Integral p) =>
    p -> ItemInfo -> b -> IO b
    maybeAddOverlayToPixbuf Int32
    size ItemInfo
    info)

          getPixBufFromInfo Int32
    size
                            info :: ItemInfo
    info@ItemInfo { iconName :: ItemInfo -> String
    iconName = String
    name
                                          , iconThemePath :: ItemInfo -> Maybe String
    iconThemePath = Maybe String
    mpath
                                          , iconPixmaps :: ItemInfo -> [(Int32, Int32, ByteString)]
    iconPixmaps = [(Int32, Int32, ByteString)]
    pixmaps
                                          } = Int32
    -> String
    -> Maybe String
    -> [(Int32, Int32, ByteString)]
    -> IO (Maybe Pixbuf)
    getPixBufFrom Int32
    size String
    name Maybe String
    mpath [(Int32, Int32, ByteString)]
    pixmaps

          getOverlayPixBufFromInfo Int32
    size
                                   info :: ItemInfo
    info@ItemInfo
                                         { overlayIconName :: ItemInfo -> Maybe String
    overlayIconName = Maybe String
    name
                                         , iconThemePath :: ItemInfo -> Maybe String
    iconThemePath = Maybe String
    mpath
                                         , overlayIconPixmaps :: ItemInfo -> [(Int32, Int32, ByteString)]
    overlayIconPixmaps = [(Int32, Int32, ByteString)]
    pixmaps
                                         } = Int32
    -> String
    -> Maybe String
    -> [(Int32, Int32, ByteString)]
    -> IO (Maybe Pixbuf)
    getPixBufFrom Int32
    size (String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" Maybe String
    name)
                                   Maybe String
    mpath [(Int32, Int32, ByteString)]
    pixmaps

          getPixBufFrom Int32
    size String
    name Maybe String
    mpath [(Int32, Int32, ByteString)]
    pixmaps = do
            let tooSmall :: (Int32, Int32, c) -> Bool
    tooSmall (Int32
    w, Int32
    h, c
    _) = Int32
    w Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int32
    size Bool -> Bool -> Bool
    || Int32
    h Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int32
    size
                largeEnough :: [(Int32, Int32, ByteString)]
    largeEnough = ((Int32, Int32, ByteString) -> Bool)
    -> [(Int32, Int32, ByteString)] -> [(Int32, Int32, ByteString)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((Int32, Int32, ByteString) -> Bool)
    -> (Int32, Int32, ByteString)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int32, Int32, ByteString) -> Bool
    forall {c}. (Int32, Int32, c) -> Bool
    tooSmall) [(Int32, Int32, ByteString)]
    pixmaps
                orderer :: (a, a, c) -> (a, a, c) -> Ordering
    orderer (a
    w1, a
    h1, c
    _) (a
    w2, a
    h2, c
    _) =
                  case (a -> a) -> a -> a -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing a -> a
    forall a. a -> a
    id a
    w1 a
    w2 of
                    Ordering
    EQ -> (a -> a) -> a -> a -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing a -> a
    forall a. a -> a
    id a
    h1 a
    h2
                    Ordering
    a -> Ordering
    a
                selectedPixmap :: (Int32, Int32, ByteString)
    selectedPixmap =
                  if [(Int32, Int32, ByteString)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Int32, Int32, ByteString)]
    largeEnough
                  then ((Int32, Int32, ByteString)
     -> (Int32, Int32, ByteString) -> Ordering)
    -> [(Int32, Int32, ByteString)] -> (Int32, Int32, ByteString)
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    maximumBy (Int32, Int32, ByteString)
    -> (Int32, Int32, ByteString) -> Ordering
    forall {a} {a} {c} {c}.
    (Ord a, Ord a) =>
    (a, a, c) -> (a, a, c) -> Ordering
    orderer [(Int32, Int32, ByteString)]
    pixmaps
                  else ((Int32, Int32, ByteString)
     -> (Int32, Int32, ByteString) -> Ordering)
    -> [(Int32, Int32, ByteString)] -> (Int32, Int32, ByteString)
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    minimumBy (Int32, Int32, ByteString)
    -> (Int32, Int32, ByteString) -> Ordering
    forall {a} {a} {c} {c}.
    (Ord a, Ord a) =>
    (a, a, c) -> (a, a, c) -> Ordering
    orderer [(Int32, Int32, ByteString)]
    largeEnough
                getFromPixmaps :: (Int32, Int32, ByteString) -> Maybe (IO Pixbuf)
    getFromPixmaps (Int32
    w, Int32
    h, ByteString
    p) =
                  if ByteString -> Int
    BS.length ByteString
    p Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
                  then Maybe (IO Pixbuf)
    forall a. Maybe a
    Nothing
                  else IO Pixbuf -> Maybe (IO Pixbuf)
    forall a. a -> Maybe a
    Just (IO Pixbuf -> Maybe (IO Pixbuf)) -> IO Pixbuf -> Maybe (IO Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int32 -> ByteString -> IO Pixbuf
    getIconPixbufFromByteString Int32
    w Int32
    h ByteString
    p
            if [(Int32, Int32, ByteString)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Int32, Int32, ByteString)]
    pixmaps
            then Int32 -> Text -> Maybe String -> IO (Maybe Pixbuf)
    getIconPixbufByName Int32
    size (String -> Text
    T.pack String
    name) Maybe String
    mpath
            else Maybe (IO Pixbuf) -> IO (Maybe Pixbuf)
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => Maybe (f a) -> f (Maybe a)
    sequenceA (Maybe (IO Pixbuf) -> IO (Maybe Pixbuf))
    -> Maybe (IO Pixbuf) -> IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ (Int32, Int32, ByteString) -> Maybe (IO Pixbuf)
    getFromPixmaps (Int32, Int32, ByteString)
    selectedPixmap

          uiUpdateHandler UpdateType
    updateType ItemInfo
    info =
            f Word32 -> f ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (f Word32 -> f ()) -> f Word32 -> f ()
    forall a b. (a -> b) -> a -> b
    $ Int32 -> IO Bool -> f Word32
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Int32 -> IO Bool -> m Word32
    Gdk.threadsAddIdle Int32
    GLib.PRIORITY_DEFAULT (IO Bool -> f Word32) -> IO Bool -> f Word32
    forall a b. (a -> b) -> a -> b
    $
                 UpdateHandler
    updateHandler UpdateType
    updateType ItemInfo
    info IO () -> IO Bool -> IO Bool
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

      handlerId <- addUHandler uiUpdateHandler
      _ <- Gtk.onWidgetDestroy trayBox $ removeUHandler handlerId
      return trayBox