{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
import Data.Default
import Data.List as List
import Data.Ratio
import System.Exit
import System.IO
import qualified Data.Map as Map

-- import XMonad.Actions.DwmPromote
-- import XMonad.Actions.Warp
-- import XMonad.Layout.Maximize
-- import XMonad.Layout.Monitor
-- import XMonad.Layout.ResizableTile
-- import XMonad.Layout.TabBarDecoration
-- import XMonad.Util.EZConfig
-- import XMonad.Util.EZConfig(additionalKeys)
-- import XMonad.Util.WorkspaceCompare
import XMonad hiding ((|||))
import XMonad.Actions.CopyWindow
import XMonad.Actions.CycleWS
import XMonad.Actions.SwapWorkspaces
import XMonad.Actions.UpdatePointer
import XMonad.Config.Azerty
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.SetWMName
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.Fullscreen
import XMonad.Layout.Grid
import XMonad.Layout.IndependentScreens
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.Magnifier
import XMonad.Layout.MultiToggle
import XMonad.Layout.MultiToggle.Instances
import XMonad.Layout.NoBorders
import XMonad.Layout.ResizableTile
import XMonad.Layout.Spiral
import XMonad.Layout.Tabbed
import XMonad.Layout.ThreeColumns
import XMonad.Util.Run(spawnPipe)
import XMonad.Util.SpawnOnce
import qualified XMonad.StackSet as W

myKeys
 conf@XConfig{XMonad.modMask} =
  Map.fromList $
  let xK_XF86Backward = 0x1008ff26
      xK_XF86Forward = 0x1008ff27 in
  [
  -- Start a terminal
    ((modMask, xK_Return), spawn $ XMonad.terminal conf)
  -- Launch a program
  , ((modMask, xK_Menu), spawn "exec rofi -show run -no-disable-history -run-command \"bash -c 'systemd-run --user --unit=app-org.rofi.\\$(systemd-escape \\\"{cmd}\\\")@\\$RANDOM -p CollectMode=inactive-or-failed {cmd}'\"")
  -- Browse the filesystem
  , ((modMask, xK_BackSpace), spawn "systemd-run --user --unit=app-org.rofi.caja@$RANDOM -p CollectMode=inactive-or-failed caja")

  -- Lock the screen
  , ((0, xK_Pause), spawn "systemctl --user start xss-lock.service; xset s activate dpms force off")

  -- Take a full screenshot
  , ((0, xK_Print), spawn "cd ~/img/cap && scrot --quality 42 '%Y-%m-%d_%H-%M-%S.png' && caja ~/img/cap")
  -- Take a selective screenshot
  , ((modMask, xK_Print), spawn "select-screenshot")

  -- Volume control
  , ((0, 0x1008FF12), spawn "pactl -- set-sink-mute @DEFAULT_SINK@ toggle") -- XF88AudioMute
  , ((0, 0x1008FF11), spawn "pactl -- set-sink-volume @DEFAULT_SINK@ -5%") -- XF86AudioLowerVolume
  , ((0, 0x1008FF13), spawn "pactl -- set-sink-volume @DEFAULT_SINK@ +5%") -- XF86AudioRaiseVolume
  -- Audio previous
  -- , ((0, 0x1008FF16), spawn "")
  -- Play/pause
  -- , ((0, 0x1008FF14), spawn "")
  -- Audio next
  -- , ((0, 0x1008FF17), spawn "")
  -- Eject CD tray
  -- , ((0, 0x1008FF2C), spawn "eject -T")

  -- Close focused window.
  , ((modMask, xK_Escape), kill)
  , ((modMask, xK_q), kill)

  -- Clipboard
  , ((modMask, xK_c), spawn "clipster --select --primary")

  -- Temporarily maximize a window
  , ((modMask, xK_f), sendMessage $ XMonad.Layout.MultiToggle.Toggle FULL)
  -- , ((modMask, xK_f), withFocused (sendMessage . maximizeRestore))

  -- Cycle through the available layout algorithms
  , ((modMask, 0x13bd),        sendMessage NextLayout) -- oe (²)
  , ((modMask, xK_ampersand),  sendMessage $ JumpToLayout "ResizableTall") -- & (1)
  , ((modMask, xK_eacute),     sendMessage $ JumpToLayout "Mirror ResizableTall") -- é (2)
  , ((modMask, xK_quotedbl),   sendMessage $ JumpToLayout "Tabbed Simplest") -- ' (3)
  , ((modMask, xK_apostrophe), sendMessage $ JumpToLayout "Magnifier Grid") -- " (4)
  , ((modMask, xK_parenleft),  sendMessage $ JumpToLayout "Spiral") -- ( (5)
  , ((modMask, xK_minus),      sendMessage $ JumpToLayout "Full") -- - (6)
  , ((modMask, xK_egrave),     sendMessage $ JumpToLayout "ThreeCol") -- è (7)

  -- Reset the layouts on the current workspace to default
  -- , ((modMask .|. shiftMask, xK_space), setLayout $ XMonad.layoutHook conf)

  -- Resize viewed windows to the correct size.
  , ((modMask, xK_n), refresh)

  -- Move focus between windows
  , ((modMask, xK_Tab), windows W.focusDown)
  , ((modMask .|. shiftMask, xK_Tab), windows W.focusUp)
  , ((modMask, xK_i), windows W.focusUp)
  , ((modMask, xK_k), windows W.focusDown)

  -- Move focus to the master window
  , ((modMask, xK_m), windows W.focusMaster)
  -- Swap the focused window and the master window
  , ((modMask, xK_space), windows W.swapMaster)

  -- Swap the focused window with the next window.
  --, ((modMask, xK_o), windows W.swapDown >> windows W.focusMaster)
  -- Swap the focused window with the previous window.
  , ((modMask, xK_m), windows W.swapUp >> windows W.focusMaster)

  -- Push window back into tiling.
  , ((modMask, xK_t), withFocused $ windows . W.sink)

  -- Change the number of windows in the master area
  , ((modMask, xK_Up), sendMessage $ IncMasterN 1)
  , ((modMask, xK_Down), sendMessage $ IncMasterN (-1))

  -- Toggle the status bar gap.
  , ((modMask, xK_b), sendMessage ToggleStruts)

  -- Quit xmonad
  , ((modMask .|. shiftMask, xK_End), io exitSuccess)
  -- Restart xmonad
  , ((modMask, xK_End), restart "xmonad" True)

  -- Workspace management
  -- XF86Back: Switch to previous workspace
  , ((0, xK_XF86Backward), prevWS)
  , ((modMask, xK_j), prevWS)
  -- Switch to next workspace
  , ((0, xK_XF86Forward), nextWS)
  , ((modMask, xK_l), nextWS)
  -- XF86Back: Move the current client to the previous workspace and go there
  , ((modMask, xK_XF86Backward), shiftToPrev >> prevWS)
  , ((modMask .|. shiftMask, xK_j), shiftToPrev >> prevWS)
  -- Move the current client to the next workspace and go there
  , ((modMask, xK_XF86Forward), shiftToNext >> nextWS)
  , ((modMask .|. shiftMask, xK_l), shiftToNext >> nextWS)
  -- Switch to previous workspace
  -- Switch to next workspace
  {-
  -- Move the current client to the previous workspace
  , ((0 .|. shiftMask   , xK_XF86Backward), shiftToPrev          )
  -- Move the current client to the next workspace
  , ((0 .|. shiftMask   , xK_XF86Forward), shiftToNext          )
  -}

  -- Toggle copying window on all workspaces (sticky window)
  , ((modMask, xK_s), do
      copies <- wsContainingCopies -- NOTE: consider only hidden workspaces
      case copies of
       [] -> windows copyToAll
       _  -> killAllOtherCopies
    )

  -- Resize the master area
  , ((modMask, xK_Left), sendMessage Shrink)
  , ((modMask, xK_Right), sendMessage Expand)
  -- Resize windows in ResizableTall mode
  , ((modMask .|. shiftMask, xK_Left), sendMessage MirrorShrink)
  , ((modMask .|. shiftMask, xK_Right), sendMessage MirrorExpand)
  ] ++

  -- mod-[F1..F9], Switch to workspace N
  -- mod-shift-[F1..F9], Move client to workspace N
  [ ((m .|. modMask, k), windows $ f i)
  | (i, k) <- zip (workspaces conf) [xK_F1 ..] ++
              zip (workspaces conf) [xK_1 ..]
  , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]
  ] ++
  {- NOTE: with Xinerama
  [((m .|. modMask, k), windows $ onCurrentScreen f i)
   | (i, k) <- zip (workspaces' conf) [xK_F1 ..]
   , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)] ]
  -}

  -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
  -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3
  [ ((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))
  | (key, sc) <- zip [xK_w, xK_e, xK_r] [0 ..]
  , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]
  ] ++

  -- mod-shift-[F1..F9], Swap workspace with workspace N
  -- mod-shift-[1..9], Swap workspace with workspace N
  [ ((modMask .|. controlMask, k), windows $ swapWithCurrent i)
  | (i, k) <- zip (workspaces conf) [xK_F1 ..] ++
              zip (workspaces conf) [xK_1 ..]
  ]
  {- NOTE: with Xinerama
  [((modMask .|. controlMask, k), windows $ onCurrentScreen swapWithCurrent i)
   | (i, k) <- zip (workspaces' conf) [xK_F1 ..] ]
  -}


myMouseBindings
 XConfig{XMonad.modMask} =
  Map.fromList
  [
  -- mod-button1, Set the window to floating mode and move by dragging
    ((modMask, button1), \w -> focus w >> mouseMoveWindow w)

  -- mod-button2, Raise the window to the top of the stack
  , ((modMask, button2), \w -> focus w >> windows W.swapMaster)

  -- mod-button3, Set the window to floating mode and resize by dragging
  , ((modMask, button3), \w -> focus w >> mouseResizeWindow w)

  , ((modMask, button4), \_ -> windows W.focusUp)
  , ((modMask, button5), \_ -> windows W.focusDown)

  -- Cycle through workspaces
  , ((controlMask .|. modMask, button5), nextNonEmptyWS)
  , ((controlMask .|. modMask, button4), prevNonEmptyWS)
  ]
  where
    nextNonEmptyWS _ = moveTo Next (WSIs ((not .) <$> isWindowSpaceVisible))
    prevNonEmptyWS _ = moveTo Prev (WSIs ((not .) <$> isWindowSpaceVisible))

isWindowSpaceVisible :: X (WindowSpace -> Bool)
isWindowSpaceVisible = do
  vs <- gets (map (W.tag . W.workspace) . W.visible . windowset)
  return (\w -> W.tag w `elem` vs)

defaults xmproc _nScreens = docks $ ewmhFullscreen $ ewmh $
 azertyConfig
  { borderWidth        = 1
  , focusFollowsMouse  = True
  , focusedBorderColor = "#00b10b"
  , handleEventHook    = handleEventHook def
  , keys               = myKeys
  , layoutHook         = smartBorders $
                         mkToggle (NOBORDERS ?? FULL ?? EOT) $ -- enable temporarily maximizing a window
                         avoidStruts $ -- prevents windows from overlapping dock windows
                         let tall = ResizableTall 1 (1%200) (8%13) [] in tall
                         ||| Mirror tall
                         ||| tabbed shrinkText tabConfig
                         ||| magnifiercz (13%10) Grid
                         ||| spiral (6%7)
                         ||| noBorders (fullscreenFull Full)
                         ||| ThreeColMid 1 (1%200) (1%2)
                         -- ||| Tall 1 (3/100) (1/2)
  , manageHook         = composeAll
                         -- [ , isFullscreen --> (doF W.focusDown <+> doFullFloat)
                         [ isFullscreen --> doFullFloat
                         , manageHook def
                         , manageDocks -- NOTE: do not tile dock windows
                         , resource  =? "desktop_window" --> doIgnore
                         , className =? "Gimp"           --> doFloat
                         , resource  =? "gpicview"       --> doSink
                         , className =? "mpv"            --> doFloat
                         --, className =? "MPlayer"        --> doShift "3:media" -- <+> doFloat
                         --, className =? "vlc"            --> doShift "3:media"
                         , className =? "stalonetray"    --> doIgnore
                         ]
  , modMask            = mod4Mask
  , mouseBindings      = myMouseBindings
  , normalBorderColor  = "#7C7C7C"
  , startupHook        = setWMName "XMonad"
                       <+> spawn "wmname XMonad"
                       <+> spawn "xrdb -all .Xresources"
                       <+> spawn "sleep 1 && xmodmap .Xmodmap"
                       <+> spawn "xset r rate 250 25"
                       <+> spawn "xset b off"
                       <+> spawn "xhost local:root"
                       <+> spawn "setxkbmap -option keypad:pointerkeys"
                       -- Useful for programs launched by rofi
                       <+> spawnOnce "exec systemctl --user import-environment GNUPGHOME PASSWORD_STORE_DIR PATH"
                       -- <+> spawnOnce "exec arbtt-capture -r 60"
                       -- <+> spawnOnce "exec parcellite"
                       -- <+> spawnOnce "exec xautolock"
                       -- <+> spawnOnce "exec redshift-gtk -l -45.7800:1.9700 -t 6500:3700"
                       <+> spawnOnce "exec nm-applet"
                       <+> spawnOnce (List.unwords
                                     [ "exec stalonetray"
                                     , "--background '#000000'"
                                     , "--geometry 5x1-0+0"
                                     , "--icon-gravity E"
                                     , "--icon-size 16"
                                     , "--kludges force_icons_size"
                                     , "--max-geometry 0x1+0+0"
                                     , "--skip-taskbar"
                                     , "--window-strut none"
                                     ])
  , terminal           = "urxvtc"
  , workspaces         = {- withScreens nScreens $ -}
                         {-["1:work","2:web","3:media"] ++-}
                         map show [1::Int .. 9]
  , logHook =
   dynamicLogWithPP xmobarPP
    { ppCurrent = xmobarColor "black" "#CCCCCC"
    , ppHidden  = xmobarColor "#CCCCCC" "black"
    , ppHiddenNoWindows = xmobarColor "#606060" "black"
    , ppLayout  = \s -> xmobarColor "black" "#606060" $
                   case s of
                    "ResizableTall"        -> " | "
                    "Mirror ResizableTall" -> " - "
                    "Tabbed Simplest"      -> " + "
                    "Magnifier Grid"       -> " ~ "
                    "Spiral"               -> " @ "
                    "Full"                 -> " O "
                    "ThreeCol"             -> " # "
                    _                      -> s
    , ppOutput  = hPutStrLn xmproc
    , ppSep     = "  "
    , ppTitle   = xmobarColor "white" "black" . shorten 50
    , ppUrgent  = xmobarColor "yellow" "black"
    , ppWsSep   = " "
    }
    >> updatePointer (0.5, 0.5) (0, 0)
    -- >> updatePointer (Relative 0.5 0.5)
  }
  where
    tabConfig = def
     { activeBorderColor   = "#7C7C7C"
     , activeColor         = "#000000"
     , activeTextColor     = "#00FF00"
     , inactiveBorderColor = "#7C7C7C"
     , inactiveColor       = "#000000"
     , inactiveTextColor   = "#EEEEEE"
     , fontName            = "Hack 7"
     }

--
-- Run xmonad
--
main = do
  nScreens <- countScreens
  xmproc <- spawnPipe "exec xmobar ~/.xmonad/xmobar.hs"
  xmonad $
   withUrgencyHook NoUrgencyHook $ -- dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }
   defaults xmproc (nScreens::Integer)