{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import Control.Arrow (second)
import Control.Monad (liftM2)
import Data.List (isInfixOf)
import qualified Data.Monoid
import Data.Ratio
import XMonad
  ( ChangeLayout (NextLayout),
    Default (def),
    Full (Full),
    Mirror (Mirror),
    Query,
    Rectangle (Rectangle),
    Tall (Tall),
    WindowSet,
    WindowSpace,
    X,
    XConfig
      ( borderWidth,
        focusedBorderColor,
        layoutHook,
        logHook,
        manageHook,
        modMask,
        normalBorderColor,
        startupHook,
        terminal,
        workspaces
      ),
    button1,
    button3,
    className,
    composeAll,
    doF,
    doFloat,
    doIgnore,
    doShift,
    focus,
    handleEventHook,
    mod4Mask,
    mouseMoveWindow,
    mouseResizeWindow,
    resource,
    sendMessage,
    shiftMask,
    spawn,
    title,
    withWindowSet,
    xmonad,
    (-->),
    (.|.),
    (<&&>),
    (<+>),
    (=?),
    (|||),
  )
import XMonad.Actions.FloatSnap
import XMonad.Actions.Navigation2D (windowGo, withNavigation2DConfig)
import XMonad.Actions.WindowGo (raise, runOrRaise)
import XMonad.Hooks.DynamicLog
  ( PP
      ( ppCurrent,
        ppExtras,
        ppHidden,
        ppHiddenNoWindows,
        ppOrder,
        ppSep,
        ppSort,
        ppTitleSanitize,
        ppUrgent
      ),
    ppVisible,
    shorten,
    wrap,
    xmobarBorder,
    xmobarColor,
    xmobarRaw,
    xmobarStrip,
  )
import XMonad.Hooks.EwmhDesktops
  ( ewmh,
    ewmhFullscreen,
  )
import XMonad.Hooks.InsertPosition (Focus (Newer), Position (End), insertPosition)
import XMonad.Hooks.ManageHelpers (doRectFloat)
import XMonad.Hooks.Place (placeHook, simpleSmart)
import XMonad.Hooks.SetWMName (setWMName)
import XMonad.Hooks.StatusBar
  ( defToggleStrutsKey,
    statusBarProp,
    withEasySB,
  )
import XMonad.Layout (JumpToLayout (JumpToLayout), Resize (Expand, Shrink))
import XMonad.Layout.Fullscreen (fullscreenEventHook, fullscreenFull, fullscreenManageHook)
import XMonad.Layout.LayoutModifier
import qualified XMonad.Layout.LayoutModifier
import XMonad.Layout.Named (named)
import XMonad.Layout.NoBorders
import XMonad.Layout.ResizableTile (MirrorResize (MirrorExpand), ResizableTall (ResizableTall))
import XMonad.Layout.Spacing
  ( Border (Border),
    Spacing,
    spacingRaw,
  )
import XMonad.Layout.WindowNavigation
  ( Direction2D (L, R),
    Navigate (Go),
    windowNavigation,
  )
import XMonad.StackSet (RationalRect (RationalRect), Stack (Stack), Workspace (tag), currentTag, greedyView, integrate', shift, stack)
import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings)
import XMonad.Util.Font (fi)
import XMonad.Util.Loggers (logTitles, wrapL)
import XMonad.Util.SpawnOnce (spawnOnce)
import XMonad.Util.Ungrab (unGrab)
import XMonad.Util.WorkspaceCompare (getSortByIndex)

main :: IO ()
main = do
  colors <- getWalColors
  xmonad . ewmhFullscreen . ewmh
    . withEasySB (statusBarProp "xmobar ~/.config/xmobar/xmobarrc" (pure $ myXmobarPP colors)) defToggleStrutsKey
    $ withNavigation2DConfig def $
      def
        { modMask = mod4Mask,
          terminal = "st",
          startupHook = myStartupHook,
          borderWidth = 2,
          normalBorderColor = head colors,
          focusedBorderColor = colors !! 4,
          workspaces = myWorkspaces,
          manageHook = myManageHook,
          layoutHook = myLayout,
          handleEventHook =
            handleEventHook def <+> fullscreenEventHook
        }
        `additionalKeysP` [ ("M-S-z", spawn "xscreensaver-command -lock"),
                            ("M-S-s", unGrab *> spawn "cast_screenshot"),
                            ("M-f", runOrRaise "brave" (className =? "Brave-browser")),
                            ("M-o", runOrRaise "emacs" (className =? "Emacs")),
                            ("M-i", raise (className =? "jetbrains-idea")),
                            ("M-<Space>", spawn "rofi -show drun"),
                            ("M-p", spawn "dmenu-with-suggestions"),
                            -- audio settings
                            ("<XF86AudioLowerVolume>", spawn "amixer set Master 5%- unmute"),
                            ("<XF86AudioRaiseVolume>", spawn "amixer set Master 5%+ unmute"),
                            ("<XF86AudioMute>", spawn "amixer set Master toggle"),
                            ("<XF86AudioPlay>", spawn "playerctl play-pause"),
                            ("<XF86AudioPrev>", spawn "playerctl previous"),
                            ("<XF86AudioNext>", spawn "playerctl next"),
                            -- window navigation
                            ("M-l", windowGo R False),
                            ("M-h", windowGo L False),
                            ("M-S-h", sendMessage Shrink), -- Shrink horiz window width
                            ("M-S-l", sendMessage Expand), -- Expand horiz window width
                            -- layout switching
                            ("M-<Tab>", sendMessage NextLayout),
                            ("M-<F11>", sendMessage $ JumpToLayout "Full"), -- jump directly to the Full layout
                            -- dmenu stuff
                            ("M1-<F4>", spawn "powerbutton"),
                            -- lockscreen
                            ("M-<F1>", spawn "betterlockscreen -l & sleep 4 && xdg-screensaver activate")
                          ]
        `additionalMouseBindings` [ ((mod4Mask, button1), \w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicMove (Just 200) (Just 200) w)),
                                    ((mod4Mask .|. shiftMask, button1), \w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicResize [L, R, U, D] (Just 200) (Just 200) w)),
                                    ((mod4Mask, button3), \w -> focus w >> mouseResizeWindow w >> afterDrag (snapMagicResize [R, D] (Just 50) (Just 50) w))
                                  ]

myXmobarPP :: [String] -> PP
myXmobarPP colors =
  def
    { ppSep = walXmobarColor 1 " \63617 ",
      ppTitleSanitize = xmobarStrip,
      ppCurrent = wrap " " "" . xmobarBorder "Top" (colors !! 6) 2,
      ppHidden = walXmobarColor 2 . wrap " " "",
      ppHiddenNoWindows = walXmobarColor 1 . wrap " " "",
      ppUrgent = red . wrap (yellow "!") (yellow "!"),
      ppVisible = wrap " " "" . xmobarBorder "Bottom" (colors !! 6) 2,
      ppOrder = \[ws, l, _, wins] -> [ws, l, wins],
      ppExtras = [logTitles formatFocused formatUnfocused],
      ppSort = hideWorkspaces
    }
  where
    formatFocused = wrap (walXmobarColor 4 "<fn=2>\58279</fn>") (walXmobarColor 4 "<fn=2>\58254</fn>") . walXmobarColor 4 . ppWindow
    formatUnfocused = wrap (walXmobarColor 7 "<fn=2>\58279</fn>") (walXmobarColor 7 "<fn=2>\58254</fn>") . walXmobarColor 7 . ppWindow
    walXmobarColor index = xmobarColor (colors !! index) ""
    ppWindow :: String -> String
    ppWindow = xmobarRaw . (\w -> if null w then "untitled" else w) . shorten 30

    lowWhite, red, white, yellow :: String -> String
    white = xmobarColor "#f8f8f2" ""
    yellow = xmobarColor "#f1fa8c" ""
    red = xmobarColor "#ff5555" ""
    lowWhite = xmobarColor "#bbbbbb" ""
    hideWorkspaces = do
      sortByIndex <- getSortByIndex
      wsfilter <- thefilter
      return (wsfilter . sortByIndex)
      where
        thefilter :: X ([WindowSpace] -> [WindowSpace])
        --thefilter = filter ( not . isEmptyWs) . sortworkspaces
        thefilter = do
          currentWS <- withWindowSet (pure . currentTag)
          return $ reverse . dropWhile (liftM2 (&&) ((currentWS /=) . tag) isEmptyWs) . reverse
        isEmptyWs workspace = null $ integrate' $ stack workspace

myStartupHook :: X ()
myStartupHook = do
  mapM_
    spawnOnce
    [ "picom --experimental-backends &",
      "sh $HOME/.fehbg",
      "setxkbmap -option caps:escape",
      "xset r rate 300 50",
      "signal-deskto &"
    ]

getWalColors :: IO [String]
getWalColors = do
  let file = "/home/qv/.cache/wal/colors"
  contents <- readFile file
  let colors = lines contents
  return (colors ++ replicate (16 - length colors) "#000000")

mySpacing' :: Integer -> l a -> XMonad.Layout.LayoutModifier.ModifiedLayout Spacing l a
mySpacing' i = spacingRaw True (Border i 0 i i) True (Border i 0 i i) True

--myWorkspaces = [" dev ", " www ", " sys ", " doc ", " vbox ", " chat ", " mus ", " vid ", " gfx "]
myWorkspaces :: [String]
myWorkspaces = show <$> ([1 .. 9] :: [Integer])

myLayout = fullscreenFull $ smartBorders $ tiled ||| smartBorders Full ||| Mirror (fullWSpacing 8 $ Tall nmaster delta ratio)
  where
    tiled = named "Tall" $ mySpacing' 8 $ Tall nmaster delta ratio
    nmaster = 1 -- Default number of windows in the master pane
    ratio = 1 / 2 -- Default proportion of screen occupied by master pane
    delta = 3 / 100 -- Percent of screen to increment by when resizing panes

myManageHook :: XMonad.Query (Data.Monoid.Endo WindowSet)
myManageHook =
  composeAll
    -- 'doFloat' forces a window to float.  Useful for dialog boxes and such.
    -- using 'doShift ( myWorkspaces !! 7)' sends program to workspace 8!
    -- I'm doing it this way because otherwise I would have to write out the full
    -- name of my workspaces and the names would be very long if using clickable workspaces.
    [ className =? "confirm" --> doFloat,
      className =? "file_progress" --> doFloat,
      className =? "dialog" --> doFloat,
      className =? "download" --> doFloat,
      className =? "error" --> doFloat,
      className =? "Gimp" --> doFloat,
      className =? "notification" --> doFloat,
      className =? "pinentry-gtk-2" --> doFloat,
      className =? "splash" --> doFloat,
      className =? "toolbar" --> doFloat,
      title =? "Oracle VM VirtualBox Manager" --> doFloat,
      title =? "Mozilla Firefox" --> viewShift (myWorkspaces !! 1),
      title =? "Signal" --> viewShift (myWorkspaces !! 2),
      className =? "TelegramDesktop" --> viewShift (myWorkspaces !! 2),
      className =? "Element" --> viewShift (myWorkspaces !! 2),
      className =? "Thunderbird" --> viewShift (myWorkspaces !! 2),
      className =? "Gimp" --> doShift (myWorkspaces !! 8),
      (className =? "firefox" <&&> resource =? "Dialog") --> doFloat, -- Float Firefox Dialog
      className =? "alfaview" --> viewShift (myWorkspaces !! 3),
      className =? "jetbrains-idea" --> viewShift (myWorkspaces !! 4),
      className =? "jetbrains-code-with-me-guest" --> viewShift (myWorkspaces !! 4),
      (className =? "jetbrains-studio") <&&> (title ~=? "win") --> doIgnore,
      (className =? "TelegramDesktop") <&&> (title ~=? "Media viewer") --> doFloat
    ]
    <+> insertPosition End Newer
    <+> fullscreenManageHook
  where
    viewShift = doF . liftM2 (.) greedyView shift

-- IntelliJ fix
(~=?) :: Eq a => Query [a] -> [a] -> Query Bool
q ~=? x = fmap (isInfixOf x) q

fullWSpacing :: Int -> l a -> ModifiedLayout FullWSpacing l a
fullWSpacing p = ModifiedLayout (FullWSpacing p)

data FullWSpacing a = FullWSpacing Int deriving (Show, Read)

instance LayoutModifier FullWSpacing a where
  pureModifier (FullWSpacing _) _ (Just (Stack f _ _)) [(param, rect)] = ([(param, shrinkRect 250 rect)], Nothing)
  pureModifier (FullWSpacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
  modifierDescription (FullWSpacing p) = "Tall center"

shrinkRect :: Int -> Rectangle -> Rectangle
shrinkRect p (Rectangle x y w h) = Rectangle (x + fi (p `div` 2)) (y + fi p) (fi $ max 1 $ fi w -2 * (p `div` 2)) (fi $ max 1 $ fi h -2 * p)