-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.AfterDrag
-- Description :  Allows you to add actions dependent on the current mouse drag.
-- Copyright   :  (c) 2014 Anders Engstrom <ankaan@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Anders Engstrom <ankaan@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Perform an action after the current mouse drag is completed.
-----------------------------------------------------------------------------

module XMonad.Actions.AfterDrag (
                -- * Usage
                -- $usage
                afterDrag,
                ifClick,
                ifClick') where

import XMonad

import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- >    import XMonad.Actions.AfterDrag
--
-- Then add appropriate mouse bindings, for example:
--
-- >        , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (windows $ W.float w $ W.RationalRect 0 0 1 1)))
--
-- This will allow you to resize windows as usual, but if you instead of
-- draging click the mouse button the window will be automatically resized to
-- fill the whole screen.
--
-- For detailed instructions on editing your mouse bindings, see
-- "XMonad.Doc.Extending#Editing_mouse_bindings".
--
-- More practical examples are available in "XMonad.Actions.FloatSnap".

-- | Schedule a task to take place after the current dragging is completed.
afterDrag
    :: X () -- ^ The task to schedule.
    -> X ()
afterDrag :: X () -> X ()
afterDrag X ()
task = do Maybe (Position -> Position -> X (), X ())
drag <- (XState -> Maybe (Position -> Position -> X (), X ()))
-> X (Maybe (Position -> Position -> X (), X ()))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Maybe (Position -> Position -> X (), X ())
dragging
                    case Maybe (Position -> Position -> X (), X ())
drag of
                        Maybe (Position -> Position -> X (), X ())
Nothing -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Not dragging
                        Just (Position -> Position -> X ()
motion, X ()
cleanup) -> (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((XState -> XState) -> X ()) -> (XState -> XState) -> X ()
forall a b. (a -> b) -> a -> b
$ \XState
s -> XState
s { dragging :: Maybe (Position -> Position -> X (), X ())
dragging = (Position -> Position -> X (), X ())
-> Maybe (Position -> Position -> X (), X ())
forall a. a -> Maybe a
Just(Position -> Position -> X ()
motion, X ()
cleanup X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
task) }

-- | Take an action if the current dragging can be considered a click,
--   supposing the drag just started before this function is called.
--   A drag is considered a click if it is completed within 300 ms.
ifClick
  :: X ()   -- ^ The action to take if the dragging turned out to be a click.
  -> X ()
ifClick :: X () -> X ()
ifClick X ()
action = Int -> X () -> X () -> X ()
ifClick' Int
300 X ()
action (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Take an action if the current dragging is completed within a certain time (in milliseconds.)
ifClick'
  :: Int    -- ^ Maximum time of dragging for it to be considered a click (in milliseconds.)
  -> X ()   -- ^ The action to take if the dragging turned out to be a click.
  -> X ()   -- ^ The action to take if the dragging turned out to not be a click.
  -> X ()
ifClick' :: Int -> X () -> X () -> X ()
ifClick' Int
ms X ()
click X ()
drag = do
  UTCTime
start <- IO UTCTime -> X UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO UTCTime
getCurrentTime
  X () -> X ()
afterDrag (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
stop <- IO UTCTime -> X UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO UTCTime
getCurrentTime
    if UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
stop UTCTime
start NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ms NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
10NominalDiffTime -> Integer -> NominalDiffTime
forall a b. (Num a, Integral b) => a -> b -> a
^(Integer
3 :: Integer) :: NominalDiffTime)
      then X ()
click
      else X ()
drag