module Rahm.Desktop.Dragging where

import Control.Monad (filterM, when)
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Maybe (fromMaybe)
import Rahm.Desktop.Common (pointerLocation, pointerWindow, runMaybeT_, setBorderColor)
import Rahm.Desktop.Layout.Hole (addHoleForWindow, removeHoleForWindow, resetHole)
import Rahm.Desktop.Layout.PinWindow (isWindowPinned, pinWindow, unpinWindow)
import Rahm.Desktop.Logger
import Rahm.Desktop.Marking (setAlternateWindows)
import qualified Rahm.Desktop.StackSet as W
import XMonad (X, io)
import qualified XMonad as X
import XMonad.Util.WindowProperties (getProp32s)

-- Action which happens after a dragging event.
--
-- The window is the window under
newtype AfterDragAction = AfterDragAction (X.Window -> X.Button -> X ())

instance Semigroup AfterDragAction where
  (AfterDragAction f1) <> (AfterDragAction f2) =
    AfterDragAction $ \w b -> f1 w b >> f2 w b

instance Monoid AfterDragAction where
  mappend = (<>)
  mempty = AfterDragAction $ \_ _ -> return ()

afterDrag :: X () -> X ()
afterDrag action = do
  X.modify $ \case
    st@(X.XState {X.dragging = Just (fn, cleanup)}) ->
      st {X.dragging = Just (fn, cleanup >> action)}
    s -> s

windowsUnderCursor :: X [X.Window]
windowsUnderCursor = do
  (dpy, root) <- X.asks $ (,) <$> X.display <*> X.theRoot
  aw <- X.withWindowSet (return . W.allVisibleWindows)
  let fi :: (Integral a, Integral b) => a -> b
      fi = fromIntegral
  (cx, cy) <- pointerLocation

  filterM
    ( \win -> do
        (_, fi -> x, fi -> y, fi -> w, fi -> h, _, _) <- io $ X.getGeometry dpy win
        return
          ( cx > x
              && cx < x + fi w
              && cy > y
              && cy < y + h
          )
    )
    aw

sinkOnRelease :: AfterDragAction
sinkOnRelease = AfterDragAction $ \window _ -> do
  (cx, cy) <- pointerLocation
  wins <- filter (/= window) <$> windowsUnderCursor
  t <- fmap (W.tag . W.workspace) <$> X.pointScreen cx cy

  X.windows $
    W.focusWindow window
      . case wins of
        (h : _) -> W.sinkBy window h
        _ -> W.sink window
      . ( \ss -> case t of
            Nothing -> ss
            Just t' -> W.shiftWin t' window ss
        )
  where
    fi = fromIntegral

ifReleased :: X.Button -> AfterDragAction -> AfterDragAction
ifReleased but (AfterDragAction act) = AfterDragAction $ \win b -> do
  when (but == b) $ act win b

-- Like ifReleased, but with a function instead of an AfterDragAction
ifReleased' :: X.Button -> (X.Window -> X.Button -> X ()) -> AfterDragAction
ifReleased' but act = ifReleased but (AfterDragAction act)

mouseResizeWindowAndThen :: (X.Window -> X ()) ->
  AfterDragAction -> X.Window -> X ()
mouseResizeWindowAndThen beforeAction (AfterDragAction releaseAction) window = do
  beforeAction window
  windowPinned <- isWindowPinned window
  unpinWindow window
  tilePosition <- X.withWindowSet $ return . W.windowTilePosition window
  mapM_ (X.broadcastMessage . flip addHoleForWindow window) tilePosition

  X.mouseResizeWindow window

  afterDrag $ do
    X.broadcastMessage $ removeHoleForWindow window
    curev <- X.asks X.currentEvent
    when windowPinned $
      pinWindow window
    releaseAction window (maybe 0 X.ev_button curev)
    X.refresh


mouseMoveWindowAndThen ::
  (X.Window -> X ()) ->
  AfterDragAction ->
  X.Window ->
  X ()
mouseMoveWindowAndThen beforeAction (AfterDragAction releaseAction) window = do
  beforeAction window
  windowPinned <- isWindowPinned window
  unpinWindow window
  tilePosition <- X.withWindowSet $ return . W.windowTilePosition window
  mapM_ (X.broadcastMessage . flip addHoleForWindow window) tilePosition
  X.mouseMoveWindow window

  afterDrag $ do
    X.broadcastMessage $ removeHoleForWindow window
    curev <- X.asks X.currentEvent
    when windowPinned $
      pinWindow window
    releaseAction window (maybe 0 X.ev_button curev)
    X.refresh

dragWorkspace :: X ()
dragWorkspace = do
  (ox, oy) <- pointerLocation
  X.mouseDrag (\_ _ -> return ()) $ do
    (nx, ny) <- pointerLocation
    runMaybeT_ $ do
      (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ X.pointScreen ox oy
      (W.Screen (W.tag -> ws2) _ _) <- MaybeT $ X.pointScreen nx ny

      lift $ X.windows $ W.switchWorkspaces ws1 ws2

dragWindow :: X ()
dragWindow = do
  w <- pointerWindow
  if w == 0
    then dragWorkspace
    else do
      cleanup <- setBorderColor "#00ffff" [w]

      ref <- io $ newIORef (w, return ())

      X.mouseDrag
        ( \_ _ -> do
            w' <- pointerWindow
            (ow, ocleanup) <- io $ readIORef ref
            case () of
              () | ow /= w' -> do
                ocleanup
                cleanup' <-
                  if w' == 0 || w' == w
                    then return (return ())
                    else setBorderColor "#80a0a0" [w']
                io $ writeIORef ref (w', cleanup')
              () -> return ()

            return ()
        )
        $ do
          (nx, ny) <- pointerLocation
          w' <- pointerWindow
          (_, iocleanup) <- io $ readIORef ref
          dock <- X.getAtom "_NET_WM_WINDOW_TYPE_DOCK"
          desk <- X.getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
          mbr <-
            if w' == 0
              then return Nothing
              else getProp32s "_NET_WM_WINDOW_TYPE" w'

          let isDock =
                maybe False (any ((`elem` [dock, desk]) . fromIntegral)) mbr
          case w' of
            _ | w' == 0 || isDock ->
              runMaybeT_ $ do
                (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ X.pointScreen nx ny
                lift $ do
                  setAlternateWindows [w]
                  X.windows $ W.sink w . W.shiftWin ws1 w
            _ -> do
              X.windows $ W.focusWindow w . W.swapWindows [(w, w')]

              setAlternateWindows [w, w']

              iocleanup
              cleanup