-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.CycleWorkspaceByScreen
-- Copyright   :  (c) 2017 Ivan Malison
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  IvanMalison@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- Cycle through previously viewed workspaces in the order they were viewed most
-- recently on the screen where cycling is taking place.
--
-----------------------------------------------------------------------------

module XMonad.Actions.CycleWorkspaceByScreen (
    -- * Usage
    -- $usage
    cycleWorkspaceOnScreen
  , cycleWorkspaceOnCurrentScreen
  , handleKeyEvent
  , repeatableAction
  ) where

import           Control.Monad
import           Data.IORef
import           Data.List
import           Data.Maybe

import           Graphics.X11.Xlib.Extras

import           XMonad
import           XMonad.Hooks.WorkspaceHistory
import qualified XMonad.StackSet as W

-- $usage
-- This module must be used in conjuction with XMonad.Hooks.WorkspaceHistory
--
-- To use, add something like the following to your keybindings
-- , ((mod4Mask,  xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)

repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X ()
repeatableAction mods pressHandler = do
  XConf {theRoot = root, display = d} <- ask
  let getNextEvent = io $ allocaXEvent $ \p ->
                 do
                   maskEvent d (keyPressMask .|. keyReleaseMask) p
                   KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
                   s <- io $ keycodeToKeysym d c 0
                   return (t, s)
      handleEvent (t, s)
        | t == keyRelease && s `elem` mods = return ()
        | otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent

  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
  getNextEvent >>= handleEvent
  io $ ungrabKeyboard d currentTime

handleKeyEvent :: EventType
               -> KeySym
               -> X ()
               -> EventType
               -> KeySym
               -> Maybe (X ())
handleKeyEvent eventType key action = helper
  where
  helper et k
    | et == eventType && k == key = Just action
    | otherwise = Nothing


runFirst :: [EventType -> KeySym -> Maybe (X ())] -> EventType -> KeySym -> X ()
runFirst matchers eventType key =
  fromMaybe (return ()) $ join $ find isJust $ map (\fn -> fn eventType key) matchers

cycleWorkspaceOnScreen :: ScreenId -> [KeySym] -> KeySym -> KeySym -> X ()
cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransaction $ do
  startingHistory <- workspaceHistoryByScreen
  currentWSIndex <- io $ newIORef 1
  let cycleWorkspaces = fromMaybe [] $ lookup screenId startingHistory
      getAndIncrementWS increment = do
        current <- readIORef currentWSIndex
        modifyIORef
          currentWSIndex
          ((`mod` (length cycleWorkspaces)) . (+ increment))
        return $ cycleWorkspaces !! current
      focusIncrement i = (io $ getAndIncrementWS i) >>= (windows . W.greedyView)

  focusIncrement 1 -- Do the first workspace cycle
  repeatableAction mods $
    runFirst
      [ handleKeyEvent keyPress nextKey $ focusIncrement 1
      , handleKeyEvent keyPress prevKey $ focusIncrement (-1)
      ]
  return ()

cycleWorkspaceOnCurrentScreen
  :: [KeySym] -> KeySym -> KeySym -> X ()
cycleWorkspaceOnCurrentScreen mods n p =
  withWindowSet $ \ws ->
    cycleWorkspaceOnScreen (W.screen $ W.current ws) mods n p