-----------------------------------------------------------------------------
-- |
-- 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
  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))
  setWidgetTooltipText item (feComment de)
  menuShellAppend ms item
  _ <- onMenuItemActivate item $ do
    let cmd = MenuEntry -> String
feCommand MenuEntry
de
    logHere DEBUG $ "Launching '" ++ cmd ++ "'"
    _ <- spawnCommand cmd
    return ()
  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
    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))
    menuShellAppend ms item
    subMenu <- menuNew
    menuItemSetSubmenu item (Just subMenu)
    mapM_ (addMenu subMenu) subMenus
    mapM_ (addItem subMenu) 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
  mb <- IO MenuBar
forall (m :: * -> *). (HasCallStack, MonadIO m) => m MenuBar
menuBarNew
  m <- buildMenu mMenuPrefix
  addMenu mb m
  widgetShowAll mb
  toWidget mb