{-# LANGUAGE NegativeLiterals  #-}

import XMonad
import XMonad.Actions.CopyWindow
import XMonad.Actions.Sift
import XMonad.Actions.Submap
import XMonad.Actions.SwapWorkspaces
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.InsertPosition
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.OnPropertyChange
import XMonad.Hooks.RefocusLast
import XMonad.Hooks.StatusBar
import XMonad.Layout.NoBorders
import XMonad.Layout.Reflect
import XMonad.Layout.Reflect.Message
import XMonad.Layout.Renamed
import XMonad.Layout.ResizableTile
import XMonad.Layout.ResizableTile.FixDescription
import XMonad.Layout.Spacing
import qualified XMonad.StackSet as W
import XMonad.Util.EZConfig
import XMonad.Util.Hacks
import XMonad.Util.NamedScratchpad
import XMonad.Util.SpawnOnce
import XMonad.Layout.Magnifier

import Data.Char.Greek
import Data.Semigroup
import qualified Data.Map.Strict as M
import System.Posix
import Graphics.X11.ExtraTypes.XF86

main :: IO ()
main =
  xmonad
  -- Fix all java things that don't scale with XMonad
  -- https://wiki.archlinux.org/title/java#Gray_window,_applications_not_resizing_with_WM,_menus_immediately_closing
  . javaHack
  . withSB xmobarConfig . docks
  . setEwmhActivateHook myActivateHook
  . ewmhFullscreen . ewmh
  $ def
      { modMask            = superMask
      , borderWidth        = 5
      , normalBorderColor  = "#18005f"
      , focusedBorderColor = "#875fff"
      , focusFollowsMouse  = True
      , terminal           = myTerm
      , workspaces         = myWorkspaces
      , logHook            = refocusLastLogHook
      , startupHook        = myStartupHook
      , layoutHook         = myLayout
      , manageHook         = myManageHook
      , handleEventHook    = myEventHandleHook
      }

    -- Only remove mappings that needs pass through
    `removeKeys` removedKeybinds
    `additionalKeys` keybinds

myLayout =
  let tallr = renamed [ KeepWordsRight 2 ] {- keep "ResizableTall n" -}
              $ smartSpacingWithEdge 5
              $ reflectMsg . reflectHoriz
              $ RTFixDescription
              $ ResizableTall 1 (1/10) (3/7) []
      mag = magnifyxy 1.05 1.3 (NoMaster 3) False
   in avoidStruts . smartBorders $
        mag tallr ||| Full

isSioyek :: Query Bool
isSioyek = className =? "sioyek"

isDiscord :: Query Bool
isDiscord =
  let electronDiscord = className =? "discord"
      firefoxDiscord = isFirefox <&&> title ~? "Discord"
  in  electronDiscord <||> firefoxDiscord

isEvolution :: Query Bool
isEvolution = className ~? "gnome.Evolution"

isFirefox :: Query Bool
isFirefox = className =? "firefox"

isSpotify :: Query Bool
isSpotify = isFirefox <&&> title ~? "Spotify"

isYouTube :: Query Bool
isYouTube = isFirefox <&&> title ~? "YouTube"

isWhatsApp :: Query Bool
isWhatsApp = isFirefox <&&> title ~? "WhatsApp"

isSignal :: Query Bool
isSignal = className =? "Signal"

isElement :: Query Bool
isElement = isFirefox <&&> title ~? "Element"

-- This changes depending on the locale of the browser :/
isFirefoxPip :: Query Bool
isFirefoxPip = isFirefox <&&> title =? "Incrustation vidéo"

isFeh :: Query Bool
isFeh = className =? "feh"

isNautilus :: Query Bool
isNautilus = className ~? "Nautilus"

isNautilusPreviewer :: Query Bool
isNautilusPreviewer = className ~? "NautilusPreviewer"

isMinder :: Query Bool
isMinder = className =? "Minder" <&&> (not <$> title ~? "Pick a Color")

isKitty :: Query Bool
isKitty = className =? "kitty"

myActivateHook :: ManageHook
myActivateHook =
  -- Ignore activate request
  composeOne
    [ isDiscord   -?> mempty
    , isEvolution -?> mempty
    , isSignal    -?> mempty
    , isSioyek    -?> mempty
    , isFeh       -?> mempty
    , return True -?> doFocus
    ]

myManageHook :: ManageHook
myManageHook =
  composeOne
    [ isNautilusPreviewer      -?> customFloating centeredFloat
    , isFeh                    -?> doF copyToAll <> customFloating buttomRightFloat
    , isMinder                 -?> customFloating centeredFloat
    , isFirefoxPip             -?> doF copyToAll <> customFloating buttomRightFloat
    , isDiscord                -?> doShift chatWS
    , isEvolution              -?> doShift chatWS
    , isSignal                 -?> doShift chatWS
    , isFirefox                -?> insertPosition Master Newer
    , isKitty                  -?> insertPosition Below Newer
    , isNautilus <||> isSioyek -?> insertPosition End Older
    ]
  <> namedScratchpadManageHook myScratchpads

-- TODO: is there a way to always open certain sites in new windows in firefox?
-- TODO: stop full screen when move happens
myEventHandleHook :: Event -> X All
myEventHandleHook =
  -- If the title changes in the background, we don't want to greedy view that workspace.
  -- Imagine Spotify playing in the background, a track change would focus that workspace.
  -- We prevent this by checking if the window is in the current workspace
  onTitleChange
    $ (windowIsInCurrentWorkspace -->)
    $ composeAll
    [ isSpotify  --> doShiftAndGreedyView multimediaWS
    , isYouTube  --> doShiftAndGreedyView multimediaWS
    , isDiscord  --> doShiftAndGreedyView chatWS
    , isWhatsApp --> doShiftAndGreedyView chatWS
    , isElement  --> doShiftAndGreedyView chatWS
    ]

doShiftAndGreedyView :: WorkspaceId -> Query (Endo WindowSet)
doShiftAndGreedyView n = doF . go =<< ask
  where go :: Window -> WindowSet -> WindowSet
        go w s = W.greedyView n $ W.shiftWin n w s

hasProp :: (Window -> WindowSet -> Bool) -> Query Bool
hasProp f = f <$> ask <*> (liftX $ gets windowset)

windowIsInCurrentWorkspace :: Query Bool
windowIsInCurrentWorkspace = hasProp $ \w s -> case W.findTag w s of
  Just from | from == W.currentTag s -> True
  _ -> False

myStartupHook :: X ()
myStartupHook = do
  spawnOnce "fcitx5 &"                                -- Input method

  spawn "feh --no-fehbg --bg-fill ~/.wallpaper &" -- wallpaper

  -- Needed to make gnome keyring work
  -- https://wiki.archlinux.org/title/GNOME/Keyring#Using_gnome-keyring-daemon_outside_desktop_environments_(KDE,_GNOME,_XFCE,_...)
  spawn "dbus-update-activation-environment DISPLAY XAUTHORITY WAYLAND_DISPLAY"

  io $ do
    -- This is done here because:
    -- - setting `home.sessionVariable` (home-manager) would only effect shells, probably due to the order of launched processes blah blah
    -- - setting `environment.sessionVariables` (NixOS) would make my set up less portable
    putEnv "GLFW_IM_MODULE=ibus"  -- Make sure kitty knows how to talk to fcitx
    putEnv "MOZ_USE_XINPUT2=1"    -- Force touchpad for firefox

removedKeybinds :: [(KeyMask, KeySym)]
removedKeybinds =
  [ (superMask, xK_h)
  , (superMask, xK_l)
  , (superMask, xK_p)

    -- It has been more than once that I actidently killed xmonad >:(
  , (superMask .|. shiftMask, xK_q)
  ]
  ++ [ (superMask              , n) | n <- [xK_1 .. xK_9] ]
  ++ [ (superMask .|. shiftMask, n) | n <- [xK_1 .. xK_9] ]

keybinds :: [((KeyMask, KeySym), X ())]
keybinds =
  [
    -- Display
    ((0,         xF86XK_MonBrightnessDown), spawn "light -U 5")
  , ((0,         xF86XK_MonBrightnessUp  ), spawn "light -A 5")
  , ((shiftMask, xF86XK_MonBrightnessDown), spawn "light -U 1")
  , ((shiftMask, xF86XK_MonBrightnessUp  ), spawn "light -A 1")
  , ((altMask,   xF86XK_MonBrightnessUp  ), spawn "autorandr --change --ignore-lid")
  , ((altMask,   xF86XK_MonBrightnessDown), spawn "autorandr --change --ignore-lid")

    -- Volume adjustments
    -- Don't overload the mute button
    -- In case of doubt, smashing the button becomes deterministic
  , ((0,           xF86XK_AudioMute),        spawn "pactl -- set-sink-mute 0 1"    ) -- mute
  , ((controlMask, xF86XK_AudioMute),        spawn "pactl -- set-sink-mute 0 0"    ) -- unmute
  , ((0,           xF86XK_AudioLowerVolume), spawn "pactl -- set-sink-volume 0 -5%")
  , ((0,           xF86XK_AudioRaiseVolume), spawn "pactl -- set-sink-volume 0 +5%")
  , ((shiftMask,   xF86XK_AudioLowerVolume), spawn "pactl -- set-sink-volume 0 -1%")
  , ((shiftMask,   xF86XK_AudioRaiseVolume), spawn "pactl -- set-sink-volume 0 +1%")

    -- Playback control
  , ((0, xF86XK_AudioPrev), spawn "playerctl previous"  )
  , ((0, xF86XK_AudioPlay), spawn "playerctl play-pause")
  , ((0, xF86XK_AudioNext), spawn "playerctl next"      )

    -- Toggle fullscreen
  , ((superMask, xK_Escape), sendMessage NextLayout)

    -- Sift instead of swap
  , ((superMask .|. shiftMask, xK_j), windows siftDown)
  , ((superMask .|. shiftMask, xK_k), windows siftUp  )

    -- Resize windows
  , ((superMask, xK_equal               ), sendMessage $ IncMasterN  1)
  , ((superMask, xK_minus               ), sendMessage $ IncMasterN -1)
  , ((superMask, xK_comma               ), sendMessage Shrink         )
  , ((superMask, xK_period              ), sendMessage Expand         )
  , ((superMask .|. shiftMask, xK_comma ), sendMessage MirrorShrink   )
  , ((superMask .|. shiftMask, xK_period), sendMessage MirrorExpand   )
  , ((superMask              , xK_apostrophe), sendMessage Toggle     )

    -- [D]o sink and lift
  , ( (superMask, xK_d)
    , submap $ M.fromList
        [ ((0, xK_t), withFocused $ windows . W.sink)
        , ((0, xK_l), withFocused $ windows . flip W.float centeredFloat)
        ]
    )
  ]

    -- Screenshots
  ++ (let fullscreen = "maim -u | xclip -in -selection clipboard -t image/png"
          withSelection = "maim -u -s -b 5 -o | xclip -in -selection clipboard -t image/png"
          toFloat = "maim -u -s -b 5 -o | feh --auto-zoom -"
      in  [ ((0,                       xK_Print), spawn fullscreen   )
          , ((superMask .|. shiftMask, xK_3    ), spawn fullscreen   )
          , ((superMask .|. shiftMask, xK_4    ), spawn withSelection)
          , ((superMask .|. shiftMask, xK_5    ), spawn toFloat      )
          ]
     )

  -- Yeet
  ++ (let workspaceKeys = [xK_h, xK_t, xK_n, xK_s, xK_m, xK_w, xK_v, xK_z]
      in  [ ((superMask, k), windows $ W.greedyView space)
          | (k, space) <- zip workspaceKeys myWorkspaces
          ]
          ++ [ ((superMask .|. altMask, k), windows $ W.greedyView space . W.shift space)
             | (k, space) <- zip workspaceKeys myWorkspaces
             ]
          ++ [ ((superMask .|. controlMask, k), windows $ swapWithCurrent space)
             | (k, space) <- zip workspaceKeys myWorkspaces
             ]
     )

  -- Launcher
  ++ (let launchFirefox = "if type firefox; then firefox; else firefox-esr; fi"
          launchDmenu = "dmenu_run -i -fn \"Iosevka-14\" -nb \"#36363a\" -nf \"#e2e2e4\" -sb \"#f7f7f8\" -sf \"#36363a\" -l 10"
          lock = "xscreensaver-command -lock"
      in  [ ((controlMask .|. altMask, xK_m), namedScratchpadAction myScratchpads "cmus"  )
          , ((controlMask .|. altMask, xK_t), namedScratchpadAction myScratchpads "btop"  )
          , ((controlMask .|. altMask, xK_p), namedScratchpadAction myScratchpads "pass"  )
          , ((controlMask .|. altMask, xK_e), namedScratchpadAction myScratchpads "emoji-picker")
          , ((controlMask .|. altMask, xK_b), spawn launchFirefox                         )
          , ((superMask,               xK_o), spawn launchDmenu                           )
          , ((superMask,               xK_l), spawn lock                                  )
          ]
     )

  ++ (let powerprofile p = (p, spawn $ "powerprofilesctl set " ++ p)
      in  [ ( (superMask, xK_p), visualSubmap def $ M.fromList
                [ ((0, xK_1), powerprofile "power-saver")
                , ((0, xK_2), powerprofile "balanced"   )
                , ((0, xK_3), powerprofile "performance")
                ]
            )
          ]
     )

myTerm :: String
myTerm = "kitty"

superMask, altMask :: KeyMask
superMask = mod4Mask
altMask = mod1Mask

myWorkspaces :: [WorkspaceId]
myWorkspaces = map (:[]) $ take 8 greekLower

multimediaWS :: WorkspaceId
multimediaWS = myWorkspaces !! 6

chatWS :: WorkspaceId
chatWS = myWorkspaces !! 3

centeredFloat, smallFloat, fullFloat, buttomRightFloat :: W.RationalRect
centeredFloat    = W.RationalRect (1/9) (1/9) (7/9) (7/9)
smallFloat       = W.RationalRect (3/5) (3/5) (2/7) (2/7)
fullFloat        = W.RationalRect     0     0     1     1
buttomRightFloat = W.RationalRect (1/2) (1/2) (1/2) (1/2)

xmobarConfig :: StatusBarConfig
xmobarConfig = statusBarProp "xmobar -x 0" (pure myPrettyPrinter)
  where
    myPrettyPrinter =
      filterOutWsPP [scratchpadWorkspaceTag]
      $ def
        { ppCurrent         = xmobarColor "#000000" "#ffffff" . wrap " " " " . fmap toUpper
        , ppHiddenNoWindows = xmobarColor "#9c9c9c" "" . const "⋅"
        , ppSep             = " | "
        }

myScratchpads :: [NamedScratchpad]
myScratchpads =
  [ NS
      "cmus"
      (myTerm ++ " -T 'cmus' cmus")
      (title =? "cmus")
      (customFloating centeredFloat)
  , NS
      "btop"
      (myTerm ++ " -T 'btop' btop")
      (title =? "btop")
      (customFloating fullFloat)
  , NS
      "pass"
      (myTerm ++ " -T 'pass' -- fish -i -c 'while :; fzf-pass; end'")
      (title =? "pass")
      (customFloating smallFloat)
  , NS
      "emoji-picker"
      (myTerm ++ " -T 'emoji-picker' -- fish -i -c 'while :; emoji-picker; end'")
      (title =? "emoji-picker")
      (customFloating smallFloat)
  ]