{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Widget.Windows
-- Copyright   : (c) Ivan Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan Malison <IvanMalison@gmail.com>
-- Stability   : unstable
-- Portability : unportable
--
-- Menu widget that shows the title of the currently focused window and that,
-- when clicked, displays a menu from which the user may select a window to
-- which to switch the focus.
-----------------------------------------------------------------------------

module System.Taffybar.Widget.Windows where

import           Control.Monad
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.Maybe
import           Data.Default (Default(..))
import           Data.Maybe
import qualified Data.Text as T
import           GI.GLib (markupEscapeText)
import qualified GI.Gtk as Gtk
import           System.Taffybar.Context
import           System.Taffybar.Information.EWMHDesktopInfo
import           System.Taffybar.Widget.Generic.AutoSizeImage
import           System.Taffybar.Widget.Generic.DynamicMenu
import           System.Taffybar.Widget.Util
import           System.Taffybar.Widget.Workspaces (WindowIconPixbufGetter, getWindowData, defaultGetWindowIconPixbuf)
import           System.Taffybar.Util

data WindowsConfig = WindowsConfig
  { getMenuLabel :: X11Window -> TaffyIO T.Text
  -- ^ A monadic function that will be used to make a label for the window in
  -- the window menu.
  , getActiveLabel :: TaffyIO T.Text
  -- ^ Action to build the label text for the active window.
  , getActiveWindowIconPixbuf :: Maybe WindowIconPixbufGetter
  -- ^ Optional function to retrieve a pixbuf to show next to the
  -- window label.
  }

defaultGetMenuLabel :: X11Window -> TaffyIO T.Text
defaultGetMenuLabel window = do
  windowString <- runX11Def "(nameless window)" (getWindowTitle window)
  return $ T.pack windowString

defaultGetActiveLabel :: TaffyIO T.Text
defaultGetActiveLabel = do
  label <- fromMaybe "" <$> (runX11Def Nothing getActiveWindow >>=
                                       traverse defaultGetMenuLabel)
  markupEscapeText label (-1)

truncatedGetActiveLabel :: Int -> TaffyIO T.Text
truncatedGetActiveLabel maxLength =
  truncateText maxLength <$> defaultGetActiveLabel

truncatedGetMenuLabel :: Int -> X11Window -> TaffyIO T.Text
truncatedGetMenuLabel maxLength =
  fmap (truncateText maxLength) . defaultGetMenuLabel

defaultWindowsConfig :: WindowsConfig
defaultWindowsConfig =
  WindowsConfig
  { getMenuLabel = truncatedGetMenuLabel 35
  , getActiveLabel = truncatedGetActiveLabel 35
  , getActiveWindowIconPixbuf = Just defaultGetWindowIconPixbuf
  }

instance Default WindowsConfig where
  def = defaultWindowsConfig

-- | Create a new Windows widget that will use the given Pager as
-- its source of events.
windowsNew :: WindowsConfig -> TaffyIO Gtk.Widget
windowsNew config = do
  hbox <- lift $ Gtk.boxNew Gtk.OrientationHorizontal 0

  refreshIcon <- case getActiveWindowIconPixbuf config of
    Just getIcon -> do
      (rf, icon) <- buildWindowsIcon getIcon
      Gtk.boxPackStart hbox icon True True 0
      pure rf
    Nothing -> pure (pure ())

  (setLabelTitle, label) <- buildWindowsLabel
  Gtk.boxPackStart hbox label True True 0
  let refreshLabel = getActiveLabel config >>= lift . setLabelTitle

  subscription <- subscribeToPropertyEvents
    [ewmhActiveWindow, ewmhWMName, ewmhWMClass]
    (const $ refreshLabel >> lift refreshIcon)

  void $ mapReaderT (Gtk.onWidgetUnrealize hbox) (unsubscribe subscription)

  Gtk.widgetShowAll hbox
  boxWidget <- Gtk.toWidget hbox

  runTaffy <- asks (flip runReaderT)
  menu <- dynamicMenuNew
    DynamicMenuConfig { dmClickWidget = boxWidget
                      , dmPopulateMenu = runTaffy . fillMenu config
                      }

  widgetSetClassGI menu "windows"

buildWindowsLabel :: TaffyIO (T.Text -> IO (), Gtk.Widget)
buildWindowsLabel = do
  label <- lift $ Gtk.labelNew Nothing
  let setLabelTitle title = postGUIASync $ Gtk.labelSetMarkup label title
  (setLabelTitle,) <$> Gtk.toWidget label

buildWindowsIcon :: WindowIconPixbufGetter -> TaffyIO (IO (), Gtk.Widget)
buildWindowsIcon windowIconPixbufGetter = do
  icon <- lift Gtk.imageNew

  runTaffy <- asks (flip runReaderT)
  let getActiveWindowPixbuf size = runTaffy . runMaybeT $ do
        wd <- MaybeT $ runX11Def Nothing $
          traverse (getWindowData Nothing []) =<< getActiveWindow
        MaybeT $ windowIconPixbufGetter size wd

  updateImage <- autoSizeImage icon getActiveWindowPixbuf Gtk.OrientationHorizontal
  (postGUIASync updateImage,) <$> Gtk.toWidget icon

-- | Populate the given menu widget with the list of all currently open windows.
fillMenu :: Gtk.IsMenuShell a => WindowsConfig -> a -> ReaderT Context IO ()
fillMenu config menu = ask >>= \context ->
  runX11Def () $ do
    windowIds <- getWindows
    forM_ windowIds $ \windowId ->
      lift $ do
        labelText <- runReaderT (getMenuLabel config windowId) context
        let focusCallback = runReaderT (runX11 $ focusWindow windowId) context >>
                            return True
        item <- Gtk.menuItemNewWithLabel labelText
        _ <- Gtk.onWidgetButtonPressEvent item $ const focusCallback
        Gtk.menuShellAppend menu item
        Gtk.widgetShow item
