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, isJust)
import Rahm.Desktop.BorderColors (setBorderColor, BorderColor (BorderColor))
import Rahm.Desktop.Common (pointerLocation, pointerWindow, runMaybeT_)
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 ()

dragBorderColor = BorderColor "#00ffff" "#80a0a0"

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

isDragging :: X Bool
isDragging = X.gets (isJust . X.dragging)

finishDrag :: X ()
finishDrag = runMaybeT_ $ do
  (_, cleanup) <- MaybeT $ X.gets X.dragging
  X.modify $ \s -> s {X.dragging = Nothing}
  lift cleanup

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 _ -> sinkByWindowUnderCursor window

sinkByWindowUnderCursor :: X.Window -> X ()
sinkByWindowUnderCursor window = do
  unpinWindow window

  (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
          ( \case
              X.ButtonEvent {X.ev_button = b} -> b
              _ -> 0
          )
          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
          ( \case
              X.ButtonEvent {X.ev_button = b} -> b
              _ -> 0
          )
          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
  isDockOrRoot <- windowIsDockOrRoot w
  if isDockOrRoot
    then dragWorkspace
    else do
      cleanup <- setBorderColor dragBorderColor [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 dragBorderColor [w']
                io $ writeIORef ref (w', cleanup')
              () -> return ()

            return ()
        )
        $ do
          (nx, ny) <- pointerLocation
          w' <- pointerWindow
          (_, iocleanup) <- io $ readIORef ref
          isDockOrRoot <- windowIsDockOrRoot w'
          if isDockOrRoot
            then 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
            else do
              X.windows $ W.focusWindow w . W.swapWindows [(w, w')]

              setAlternateWindows [w, w']

              iocleanup
              cleanup
  where
    windowIsDockOrRoot 0 = return True
    windowIsDockOrRoot w = do
      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

      return $ maybe False (any ((`elem` [dock, desk]) . fromIntegral)) mbr