    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Widget.XDGMenu.MenuWidget
    -- Copyright   : 2017 Ulf Jasper
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ulf Jasper <ulf.jasper@web.de>
    -- Stability   : unstable
    -- Portability : unportable
    --
    -- MenuWidget provides a hierachical GTK menu containing all
    -- applicable desktop entries found on the system.  The menu is built
    -- according to the version 1.1 of the XDG "Desktop Menu
    -- Specification", see
    -- https://specifications.freedesktop.org/menu-spec/menu-spec-1.1.html
    -----------------------------------------------------------------------------

    module System.Taffybar.Widget.XDGMenu.MenuWidget
      (
      -- * Usage
      -- $usage
      menuWidgetNew
      )
    where

    import           Control.Monad
    import           Control.Monad.IO.Class
    import qualified Data.Text as T
    import           GI.Gtk hiding (Menu, imageMenuItemNew)
    import           System.Log.Logger
    import           System.Process
    import           System.Taffybar.Widget.Generic.AutoSizeImage
    import           System.Taffybar.Widget.Util
    import           System.Taffybar.Widget.XDGMenu.Menu

    -- $usage
    --
    -- In order to use this widget add the following line to your
    -- @taffybar.hs@ file:
    --
    -- > import System.Taffybar.Widget.XDGMenu.MenuWidget
    -- > main = do
    -- >   let menu = menuWidgetNew $ Just "PREFIX-"
    --
    -- The menu will look for a file named "PREFIX-applications.menu" in the
    -- (subdirectory "menus" of the) directories specified by the environment
    -- variables XDG_CONFIG_HOME and XDG_CONFIG_DIRS. (If XDG_CONFIG_HOME is not set
    -- or empty then $HOME/.config is used, if XDG_CONFIG_DIRS is not set or empty
    -- then "/etc/xdg" is used). If no prefix is given (i.e. if you pass Nothing)
    -- then the value of the environment variable XDG_MENU_PREFIX is used, if it is
    -- set. If taffybar is running inside a desktop environment like Mate, Gnome,
    -- XFCE etc. the environment variables XDG_CONFIG_DIRS and XDG_MENU_PREFIX
    -- should be set and you may create the menu like this:
    --
    -- >   let menu = menuWidgetNew Nothing
    --
    -- Now you can use @menu@ as any other Taffybar widget.

    logHere :: Priority -> String -> IO ()
    logHere :: Priority -> String -> IO ()
    logHere = String -> Priority -> String -> IO ()
    logM String
    "System.Taffybar.Widget.XDGMenu.MenuWidget"

    -- | Add a desktop entry to a gtk menu by appending a gtk menu item.
    addItem :: (IsMenuShell msc) =>
               msc -- ^ GTK menu
            -> MenuEntry -- ^ Desktop entry
            -> IO ()
    addItem :: forall msc. IsMenuShell msc => msc -> MenuEntry -> IO ()
    addItem msc
    ms MenuEntry
    de = do
      MenuItem
    item <- Text -> (Int32 -> IO (Maybe Pixbuf)) -> IO MenuItem
    forall (m :: * -> *).
    MonadIO m =>
    Text -> (Int32 -> IO (Maybe Pixbuf)) -> m MenuItem
    imageMenuItemNew (MenuEntry -> Text
    feName MenuEntry
    de) (Maybe Text -> Int32 -> IO (Maybe Pixbuf)
    getImageForMaybeIconName (MenuEntry -> Maybe Text
    feIcon MenuEntry
    de))
      MenuItem -> Text -> IO ()
    forall (m :: * -> *) o.
    (MonadIO m, IsWidget o) =>
    o -> Text -> m ()
    setWidgetTooltipText MenuItem
    item (MenuEntry -> Text
    feComment MenuEntry
    de)
      msc -> MenuItem -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsMenuShell a, IsMenuItem b) =>
    a -> b -> m ()
    menuShellAppend msc
    ms MenuItem
    item
      SignalHandlerId
    _ <- MenuItem -> ((?self::MenuItem) => IO ()) -> IO SignalHandlerId
    forall a (m :: * -> *).
    (IsMenuItem a, MonadIO m) =>
    a -> ((?self::a) => IO ()) -> m SignalHandlerId
    onMenuItemActivate MenuItem
    item (((?self::MenuItem) => IO ()) -> IO SignalHandlerId)
    -> ((?self::MenuItem) => IO ()) -> IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $ do
        let cmd :: String
    cmd = MenuEntry -> String
    feCommand MenuEntry
    de
        Priority -> String -> IO ()
    logHere Priority
    DEBUG (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Launching '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cmd String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'"
        ProcessHandle
    _ <- String -> IO ProcessHandle
    spawnCommand String
    cmd
        () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Add an xdg menu to a gtk menu by appending gtk menu items and submenus.
    addMenu
      :: (IsMenuShell msc)
      => msc -- ^ A GTK menu
      -> Menu -- ^ A menu object
      -> IO ()
    addMenu :: forall msc. IsMenuShell msc => msc -> Menu -> IO ()
    addMenu msc
    ms Menu
    fm = do
      let subMenus :: [Menu]
    subMenus = Menu -> [Menu]
    fmSubmenus Menu
    fm
          items :: [MenuEntry]
    items = Menu -> [MenuEntry]
    fmEntries Menu
    fm
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not ([MenuEntry] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [MenuEntry]
    items) Bool -> Bool -> Bool
    || Bool -> Bool
    not ([Menu] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Menu]
    subMenus)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        MenuItem
    item <- Text -> (Int32 -> IO (Maybe Pixbuf)) -> IO MenuItem
    forall (m :: * -> *).
    MonadIO m =>
    Text -> (Int32 -> IO (Maybe Pixbuf)) -> m MenuItem
    imageMenuItemNew (String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Menu -> String
    fmName Menu
    fm)
                (Maybe Text -> Int32 -> IO (Maybe Pixbuf)
    getImageForMaybeIconName (String -> Text
    T.pack (String -> Text) -> Maybe String -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Menu -> Maybe String
    fmIcon Menu
    fm))
        msc -> MenuItem -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsMenuShell a, IsMenuItem b) =>
    a -> b -> m ()
    menuShellAppend msc
    ms MenuItem
    item
        Menu
    subMenu <- IO Menu
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m Menu
    menuNew
        MenuItem -> Maybe Menu -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsMenuItem a, IsMenu b) =>
    a -> Maybe b -> m ()
    menuItemSetSubmenu MenuItem
    item (Menu -> Maybe Menu
    forall a. a -> Maybe a
    Just Menu
    subMenu)
        (Menu -> IO ()) -> [Menu] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Menu -> Menu -> IO ()
    forall msc. IsMenuShell msc => msc -> Menu -> IO ()
    addMenu Menu
    subMenu) [Menu]
    subMenus
        (MenuEntry -> IO ()) -> [MenuEntry] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Menu -> MenuEntry -> IO ()
    forall msc. IsMenuShell msc => msc -> MenuEntry -> IO ()
    addItem Menu
    subMenu) [MenuEntry]
    items

    -- | Create a new XDG Menu Widget.
    menuWidgetNew
      :: MonadIO m
      => Maybe String -- ^ menu name, must end with a dash, e.g. "mate-" or "gnome-"
      -> m GI.Gtk.Widget
    menuWidgetNew :: forall (m :: * -> *). MonadIO m => Maybe String -> m Widget
    menuWidgetNew Maybe String
    mMenuPrefix = IO Widget -> m Widget
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
    forall a b. (a -> b) -> a -> b
    $ do
      MenuBar
    mb <- IO MenuBar
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m MenuBar
    menuBarNew
      Menu
    m <- Maybe String -> IO Menu
    buildMenu Maybe String
    mMenuPrefix
      MenuBar -> Menu -> IO ()
    forall msc. IsMenuShell msc => msc -> Menu -> IO ()
    addMenu MenuBar
    mb Menu
    m
      MenuBar -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    widgetShowAll MenuBar
    mb
      MenuBar -> IO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    toWidget MenuBar
    mb