dots-of-war/files/.xmonad/lib/Config.hs

{-# LANGUAGE FlexibleContexts #-}
{-# Language ScopedTypeVariables, LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-binds #-}
-- Imports -------------------------------------------------------- {{{

module Config (main) where

import Control.Concurrent
import           Control.Exception              ( catch
                                                , SomeException
                                                )
import           Control.Monad                  ( filterM )
import           Data.List                      ( isPrefixOf
                                                , isSuffixOf
                                                )
import System.Exit (exitSuccess)

import qualified Rofi
import qualified DescribedSubmap

import Data.Function ((&))
import qualified Data.Monoid
import           Data.Foldable                  ( for_ )
import qualified System.IO as SysIO

import XMonad.Layout.HintedGrid

import XMonad hiding ((|||))
import XMonad.Actions.CopyWindow
import XMonad.Config.Desktop
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.SetWMName (setWMName)
import XMonad.Layout.BinarySpacePartition
import XMonad.Layout.BorderResize
import XMonad.Layout.Gaps
import XMonad.Layout.LayoutCombinators ((|||))

import XMonad.Layout.Simplest
import XMonad.Layout.LayoutHints
import XMonad.Layout.MouseResizableTile
import XMonad.Layout.NoBorders
import XMonad.Layout.Renamed (renamed, Rename(Replace))
import XMonad.Layout.ResizableTile
import XMonad.Layout.Spacing (spacingRaw, Border(..), toggleWindowSpacingEnabled)
import qualified XMonad.Layout.ToggleLayouts as ToggleLayouts
import XMonad.Layout.ZoomRow
import           XMonad.Util.EZConfig           ( additionalKeysP
                                                , removeKeysP
                                                , checkKeymap
                                                )
import XMonad.Util.NamedScratchpad

import qualified XMonad.Layout.MultiToggle as MTog
import qualified XMonad.Layout.MultiToggle.Instances as MTog
import XMonad.Util.Run
import XMonad.Util.SpawnOnce (spawnOnce)
import XMonad.Layout.Tabbed
import qualified XMonad.Actions.Navigation2D as Nav2d
import           XMonad.Actions.PhysicalScreens ( horizontalScreenOrderer )
import           XMonad.Actions.SpawnOn
import qualified XMonad.Hooks.EwmhDesktops as Ewmh
import qualified XMonad.Hooks.ManageHelpers as ManageHelpers
import qualified XMonad.Layout.BoringWindows as BoringWindows
import           XMonad.Layout.IndependentScreens
import           XMonad.Layout.SubLayouts
import qualified XMonad.StackSet as W
import qualified XMonad.Util.XSelection as XSel
import           XMonad.Util.WorkspaceCompare   ( getSortByXineramaPhysicalRule
                                                , getSortByIndex
                                                )
import           XMonad.Layout.WindowNavigation ( windowNavigation )


{-# ANN module "HLint: ignore Redundant $" #-}
{-# ANN module "HLint: ignore Redundant bracket" #-}
{-# ANN module "HLint: ignore Move brackets to avoid $" #-}
{-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}

-- }}}

-- Values -------------------- {{{

myModMask  = mod4Mask
myLauncher = Rofi.asCommand (def { Rofi.theme = Rofi.bigTheme }) ["-show run"]
myTerminal = "alacritty"
myBrowser = "qutebrowser"
useSharedWorkspaces = False
--myBrowser = "google-chrome-stable"

{-| adds the scripts-directory path to the filename of a script |-}
scriptFile :: String -> String
scriptFile script = "/home/leon/scripts/" ++ script


scratchpads :: [NamedScratchpad]
scratchpads =
  [ NS "terminal" "alacritty --class scratchpad_term" (className =? "scratchpad_term")      defaultFloating
  , NS "spotify"  "spotify"                           (appName   =? "spotify")              defaultFloating
  , NS "discord"  "discord"                           (appName   =? "discord")              defaultFloating
  , NS "whatsapp" "whatsapp-nativefier"               (("WhatsApp" `isSuffixOf`) <$> title) defaultFloating
  , NS "slack"    "slack"                             (("Slack | " `isPrefixOf`) <$> title) defaultFloating
  ]
--launchWhatsapp = "gtk-launch chrome-hnpfjngllnobngcgfapefoaidbinmjnm-Default.desktop"


-- Colors ------ {{{
fg        = "#ebdbb2"
bg        = "#282828"
gray      = "#888974"
bg1       = "#3c3836"
bg2       = "#504945"
bg3       = "#665c54"
bg4       = "#7c6f64"

green     = "#b8bb26"
darkgreen = "#98971a"
red       = "#fb4934"
darkred   = "#cc241d"
yellow    = "#fabd2f"
blue      = "#83a598"
purple    = "#d3869b"
aqua      = "#8ec07c"
-- }}}

-- }}}

-- Layout ---------------------------------------- {{{

myTabTheme = def
    { activeColor           = "#504945"
    , inactiveColor         = "#282828"
    , activeBorderColor     = "#fbf1c7"
    , inactiveBorderColor   = "#282828"
    , activeTextColor       = "#fbf1c7"
    , inactiveTextColor     = "#fbf1c7"
    , fontName = "-*-jetbrains mono-medium-r-normal-12-0-0-0-0-m-0-ascii-1"
    }


-- layoutHints .

myLayout = avoidStruts
         $ smartBorders
         $ MTog.mkToggle1 MTog.FULL
         $ ToggleLayouts.toggleLayouts resizableTabbedLayout
         $ layoutHintsToCenter
         $ layouts
  where
    layouts =((rename "Tall"       $ onlySpacing    $ mouseResizableTile         {draggerType = dragger})
          ||| (rename "Horizon"    $ onlySpacing    $ mouseResizableTileMirrored {draggerType = dragger})
          ||| (rename "BSP"        $ spacingAndGaps $ borderResize $ emptyBSP)
          ||| (rename "TabbedRow"  $ makeTabbed $ spacingAndGaps $ zoomRow)
          ||| (rename "TabbedGrid" $ makeTabbed $ spacingAndGaps $ Grid False))
          -- ||| (rename "threeCol" $ spacingAndGaps $ ThreeColMid 1 (3/100) (1/2))
          -- ||| (rename "spiral"   $ spacingAndGaps $ spiral (9/21))

    rename n = renamed [Replace n]

    resizableTabbedLayout = rename "Tabbed" .  makeTabbed . spacingAndGaps $ ResizableTall 1 (3/100) (1/2) []

    gap            = 10
    onlySpacing = gaps [ (dir, (gap*2)) | dir <- [L, R, D, U] ]  -- gaps are included in mouseResizableTile
    dragger        = let x = fromIntegral gap * 2
                     in FixedDragger x x
    spacingAndGaps = let intGap = fromIntegral gap
                         border = Border (intGap) (intGap) (intGap) (intGap)
                     in spacingRaw False border True border True

    -- transform a layout into supporting tabs
    makeTabbed layout = BoringWindows.boringWindows . windowNavigation . addTabs shrinkText myTabTheme $ subLayout [] Simplest $ layout
-- }}}

-- Startuphook ----------------------------- {{{

myStartupHook :: X ()
myStartupHook = do
  setWMName "LG3D" -- Java stuff hack
  --spawnOnce "pasystray" -- just open the UI by right-clicking on polybar's pulseaudio module
  spawnOnce "nm-applet &"
  spawnOnce "udiskie -s &" -- Mount USB sticks automatically. -s is smart systray mode: systray icon if something is mounted
  spawnOnce "xfce4-clipman &"
  spawnOnce "mailspring --background &"
  spawnOnce "redshift -P -O 5000 &"
  spawn "xset r rate 300 50 &" -- make key repeat quicker

  -- polybar and nitrogen need the screen layout to be restored fully before starting
  spawn "/home/leon/.screenlayout/dualscreen.sh "
  io $ threadDelay $ 1000 * 100
  spawnOnce "picom --config ~/.config/picom.conf"  --no-fading-openclose"
  spawn "/home/leon/.config/polybar/launch.sh"
  spawnOnce "nitrogen --restore"

-- }}}

-- Keymap --------------------------------------- {{{

-- Default mappings that need to be removed
removedKeys :: [String]
removedKeys = ["M-<Tab>", "M-S-c", "M-S-q", "M-h", "M-l", "M-j", "M-k", "M-S-<Return>"]
  ++ if useSharedWorkspaces then [key ++ show n | key <- ["M-", "M-S-", "M-C-"], n <- [1..9 :: Int]] else []

multiMonitorOperation :: (WorkspaceId -> WindowSet -> WindowSet) -> ScreenId -> X ()
multiMonitorOperation operation n = do
  monitor <- screenWorkspace n
  case monitor of
    Just mon -> windows $ operation mon
    Nothing -> return ()


myKeys :: [(String, X ())]
myKeys =
  -- ZoomRow
  [ ("M-+", sendMessage zoomIn)
  , ("M--", sendMessage zoomOut)
  , ("M-#", sendMessage zoomReset)


  -- Tabs
  , ("M-j",                ifLayoutName ("Tabbed" `isPrefixOf`) (BoringWindows.focusDown) (windows W.focusDown))
  , ("M-k",                ifLayoutName ("Tabbed" `isPrefixOf`) (BoringWindows.focusUp)   (windows W.focusUp))
  , ("M-C-S-h",            sendMessage $ pullGroup L)
  , ("M-C-S-j",            sendMessage $ pullGroup D)
  , ("M-C-S-k",            sendMessage $ pullGroup U)
  , ("M-C-S-l",            sendMessage $ pullGroup R)
  , ("M-S-C-m",            withFocused (sendMessage . MergeAll))
  , ("M-S-C-<Backspace>",  withFocused (sendMessage . UnMerge))
  , ("M-<Tab>",            onGroup W.focusDown')
  , ("M-C-<Tab>",          onGroup W.focusUp')
  , ("M-S-t",              toggleTabbedLayout)

  -- In tabbed mode, while focussing master pane, cycle tabs on the first slave
  , ("M-S-<Tab>", do windows W.focusMaster
                     BoringWindows.focusDown
                     onGroup W.focusDown'
                     windows W.focusMaster)


  , ("M-f", do sendMessage $ MTog.Toggle MTog.FULL
               sendMessage ToggleStruts)

  , ("M-b",          launchWithBackgroundInstance (className =? "qutebrowser") "bwrap --bind / / --dev-bind /dev /dev --tmpfs /tmp --tmpfs /run qutebrowser")
  , ("M-S-<Return>", launchWithBackgroundInstance (className =? "Alacritty")   "alacritty")

  , ("M-S-C-c", kill1)
  , ("M-S-C-q", io exitSuccess)

  -- Binary space partitioning
  , ("M-<Backspace>",    sendMessage Swap)
  , ("M-M1-<Backspace>", sendMessage Rotate)

  -- Media
  , ("<XF86AudioRaiseVolume>", spawn "amixer sset Master 5%+")
  , ("<XF86AudioLowerVolume>", spawn "amixer sset Master 5%-")

  -- Multi monitor
  , ("M-s",   multiMonitorOperation W.view 1)
  , ("M-d",   multiMonitorOperation W.view 0)
  , ("M-S-s", (multiMonitorOperation W.shift 1) >> multiMonitorOperation W.view 1)
  , ("M-S-d", (multiMonitorOperation W.shift 0) >> multiMonitorOperation W.view 0)

  -- programs
  , ("M-p",      spawn myLauncher)
  , ("M-S-p",    Rofi.showCombi  (def { Rofi.theme = Rofi.bigTheme }) [ "drun", "window", "ssh" ])
  , ("M-S-e",    Rofi.showNormal (def { Rofi.theme = Rofi.bigTheme }) "emoji" )
  --, ("M-s",      spawn $ scriptFile "rofi-search.sh")
  , ("M-S-o",    spawn $ scriptFile "rofi-open.sh")
  , ("M-n",      scratchpadSubmap)
  , ("M-e",      Rofi.promptRunCommand def specialCommands)
  , ("M-o",      Rofi.promptRunCommand def withSelectionCommands)
  , ("M-S-C-g",  spawn "killall -INT -g giph" >> notify "gif" "saved gif in ~/Bilder/gifs") -- stop gif recording
  ] ++ generatedMappings
  where
    generatedMappings :: [(String, X ())]
    generatedMappings = windowGoMappings ++ windowSwapMappings ++ resizeMappings ++ workspaceMappings
        where
          workspaceMappings =
            if useSharedWorkspaces then [] else
              [ (mappingPrefix ++ show wspNum,
                  do
                    -- get all workspaces from the config by running an X action to query the config
                    wsps <- workspaces' <$> asks config
                    windows $ onCurrentScreen action (wsps !! (wspNum - 1))
                )
                 | (wspNum) <- [1..9 :: Int]
                , (mappingPrefix, action) <- [("M-", W.greedyView), ("M-S-", W.shift), ("M-C-", copy)]
              ]

          keyDirPairs = [("h", L), ("j", D), ("k", U), ("l", R)]

          windowGoMappings   = [ ("M-M1-"   ++ key, Nav2d.windowGo   dir False) | (key, dir) <- keyDirPairs ]
          windowSwapMappings = [ ("M-S-M1-" ++ key, Nav2d.windowSwap dir False) | (key, dir) <- keyDirPairs ]
          resizeMappings =
              [ ("M-C-h", ifLayoutIs "BSP" (sendMessage $ ExpandTowards L) (ifLayoutIs "Horizon" (sendMessage ShrinkSlave) (sendMessage Shrink)))
              , ("M-C-j", ifLayoutIs "BSP" (sendMessage $ ExpandTowards D) (ifLayoutIs "Horizon" (sendMessage Expand)      (sendMessage MirrorShrink >> sendMessage ExpandSlave)))
              , ("M-C-k", ifLayoutIs "BSP" (sendMessage $ ExpandTowards U) (ifLayoutIs "Horizon" (sendMessage Shrink)      (sendMessage MirrorExpand >> sendMessage ShrinkSlave)))
              , ("M-C-l", ifLayoutIs "BSP" (sendMessage $ ExpandTowards R) (ifLayoutIs "Horizon" (sendMessage ExpandSlave) (sendMessage Expand)))
              ]



    scratchpadSubmap :: X ()
    scratchpadSubmap = DescribedSubmap.describedSubmap "Scratchpads"
      [ ("M-n", "terminal", namedScratchpadAction scratchpads "terminal")
      , ("M-w", "whatsapp", namedScratchpadAction scratchpads "whatsapp")
      , ("M-s", "slack",    namedScratchpadAction scratchpads "slack")
      , ("M-m", "spotify",  namedScratchpadAction scratchpads "spotify")
      , ("M-d", "discord",  namedScratchpadAction scratchpads "discord")
      ]



    -- | toggle tabbed Tall layout, merging all non-master windows
    -- into a single tab group when initializing the tabbed layout.
    toggleTabbedLayout :: X ()
    toggleTabbedLayout = do
      sendMessage $ ToggleLayouts.Toggle "Tabbed"
      ifLayoutIs "Tabbed" (do BoringWindows.focusMaster
                              withFocused (sendMessage . MergeAll)
                              withFocused (sendMessage . UnMerge)
                              -- refresh the tabs, so they draw correctly
                              windows W.focusUp
                              windows W.focusDown)
                          (return ())

    -- | launch a program by starting an instance in a hidden workspace,
    -- and just raising an already running instance. This allows for super quick "startup" time.
    -- For this to work, the window needs to have the `_NET_WM_PID` set and unique!
    launchWithBackgroundInstance :: (Query Bool) -> String -> X ()
    launchWithBackgroundInstance windowQuery commandToRun = withWindowSet $ \winSet -> do
        quteWins <- (W.allWindows winSet) |> filter (\win -> Just "NSP" == W.findTag win winSet)
                                          |> filterM (runQuery windowQuery)
        case quteWins of
          []        -> do spawnHere commandToRun
                          spawnOn "NSP" commandToRun
          [winId]   -> do windows $ W.shiftWin (W.currentTag winSet) winId
                          spawnOn "NSP" commandToRun
          (winId:_) -> windows $ W.shiftWin (W.currentTag winSet) winId

    withSelectionCommands :: [(String, X ())]
    withSelectionCommands =
      [ ("Google",    XSel.transformPromptSelection  ("https://google.com/search?q=" ++) "qutebrowser")
      , ("Hoogle",    XSel.transformPromptSelection  ("https://hoogle.haskell.org/?hoogle=" ++) "qutebrowser")
      , ("Translate", XSel.transformPromptSelection  ("https://translate.google.com/#view=home&op=translate&sl=auto&tl=en&text=" ++) "qutebrowser")
      ]


    specialCommands :: [(String,  X ())]
    specialCommands =
      [ ("screenshot",              spawn $ scriptFile "screenshot.sh")
      , ("screenshot to file",      spawn $ scriptFile "screenshot.sh --tofile")
      , ("screenshot full to file", spawn $ scriptFile "screenshot.sh --tofile --fullscreen")
      , ("screengif to file",       spawn (scriptFile "screengif.sh") >> notify "gif" "stop gif-recording with M-S-C-g")
      , ("toggleOptimal",           sendMessage ToggleGaps >> toggleWindowSpacingEnabled)
      , ("toggleSpacing",           toggleWindowSpacingEnabled)
      , ("toggleGaps",              sendMessage ToggleGaps)
      , ("Copy to all workspaces",  windows copyToAll)
      , ("Kill all other copies",   killAllOtherCopies)
      , ("toggle polybar",          sendMessage ToggleStruts >> safeSpawn "polybar-msg" ["cmd", "toggle"])
      ]


-- }}}

-- ManageHook -------------------------------{{{

myManageHook :: Query (Data.Monoid.Endo WindowSet)
myManageHook = composeAll
  [ resource  =? "Dialog"                      --> ManageHelpers.doCenterFloat
  , appName   =? "pavucontrol"                 --> ManageHelpers.doCenterFloat
  , className =? "mpv"                         --> ManageHelpers.doRectFloat (W.RationalRect 0.9 0.9 0.1 0.1)
  , title     =? "Something"                   --> doFloat
  , className =? "termite_floating"            --> ManageHelpers.doRectFloat(W.RationalRect 0.2 0.2 0.6 0.6)
  , className =? "bar_system_status_indicator" --> ManageHelpers.doRectFloat (W.RationalRect 0.7 0.05 0.29 0.26)
  , manageDocks
  , namedScratchpadManageHook scratchpads
  ]

-- }}}

-- Main ------------------------------------ {{{
main :: IO ()
main = do
  currentScreenCount :: Int <- countScreens
  let monitorIndices = [0..currentScreenCount - 1]

  -- create a fifo named pipe for every monitor (called /tmp/xmonad-state-bar0, etc)
  for_ monitorIndices (\idx -> safeSpawn "mkfifo" ["/tmp/xmonad-state-bar" ++ show idx])

  -- create polybarLogHooks for every monitor and combine them using the <+> monoid instance
  let polybarLogHooks = composeAll $ map polybarLogHook monitorIndices

  let myConfig = desktopConfig
        { terminal           = myTerminal
        , workspaces         = if useSharedWorkspaces
                                  then (map show [1..9 :: Int]) ++ ["NSP"]
                                  else (withScreens (fromIntegral currentScreenCount) (map show [1..6 :: Int])) ++ ["NSP"]
        , modMask            = myModMask
        , borderWidth        = 2
        , layoutHook         = myLayout
        , logHook            = polybarLogHooks <+> logHook def
        , startupHook        = myStartupHook <+> startupHook def <+> return () >> checkKeymap myConfig myKeys
        , manageHook         = manageSpawn <+> myManageHook <+> manageHook def
        , focusedBorderColor = aqua
        , normalBorderColor  = "#282828"
        --, handleEventHook  = minimizeEventHook <+> handleEventHook def <+> hintsEventHook -- <+> Ewmh.fullscreenEventHook
       } `removeKeysP` removedKeys `additionalKeysP` myKeys



  xmonad
    $ docks
    $ Ewmh.ewmh
    $ Nav2d.withNavigation2DConfig def { Nav2d.defaultTiledNavigation = Nav2d.sideNavigation }
    $ myConfig

-- }}}

-- POLYBAR Kram -------------------------------------- {{{

-- | Loghook for polybar on a given monitor.
-- Will write the polybar formatted string to /tmp/xmonad-state-bar${monitor}
polybarLogHook :: Int -> X ()
polybarLogHook monitor = do
  barOut <- dynamicLogString $ polybarPP $ fromIntegral monitor
  io $ SysIO.appendFile ("/tmp/xmonad-state-bar" ++ show monitor) (barOut ++ "\n")


-- swapping namedScratchpadFilterOutWorkspacePP and marshallPP  will throw "Prelude.read no Parse" errors..... wtf
-- | create a polybar Pretty printer, marshalled for given monitor.
polybarPP :: ScreenId -> PP
polybarPP monitor = namedScratchpadFilterOutWorkspacePP . (if useSharedWorkspaces then id else marshallPP $ fromIntegral monitor) $ def
  { ppCurrent          = withFG aqua . withMargin . withFont 5 . const "__active__"
  , ppVisible          = withFG aqua . withMargin . withFont 5 . const "__active__"
  , ppUrgent           = withFG red  . withMargin . withFont 5 . const "__urgent__"
  , ppHidden           = withFG gray . withMargin . withFont 5 . (`wrapClickableWorkspace` "__hidden__")
  , ppHiddenNoWindows  = withFG gray . withMargin . withFont 5 . (`wrapClickableWorkspace` "__empty__")
  , ppWsSep            = ""
  , ppSep              = ""
  , ppLayout           = \l -> if l == "Tall" || l == "Horizon" then ""
                                 else (withFG gray " | ") ++ (removeWords ["Minimize", "Hinted", "Spacing", "Tall"] . withFG purple . withMargin $ l)
  , ppExtras           = []
  , ppTitle            = const "" -- withFG aqua . (shorten 40)
  , ppSort = if useSharedWorkspaces then getSortByXineramaPhysicalRule horizontalScreenOrderer
                                    else onlyRelevantWspsSorter
  }
    where
      withMargin                 = wrap " " " "
      removeWord substr          = unwords . filter (/= substr) . words
      removeWords wrds           = unwords . filter (`notElem` wrds). words
      withFont fNum              = wrap ("%{T" ++ show (fNum :: Int) ++ "}") "%{T}"
      withBG col                 = wrap ("%{B" ++ col ++ "}") "%{B-}"
      withFG col                 = wrap ("%{F" ++ col ++ "}") "%{F-}"
      wrapOnClickCmd command     = wrap ("%{A1:" ++ command ++ ":}") "%{A}"
      wrapClickableWorkspace wsp = wrapOnClickCmd ("xdotool key super+" ++ wsp)

      onlyRelevantWspsSorter = do
        sortByIndex <- getSortByIndex
        visibleWorkspaceTags <- getVisibleWorkspacesTagsOnMonitor monitor
        let isEmptyAndNotOpened wsp = (null $ W.stack wsp) && (W.tag wsp) `notElem` visibleWorkspaceTags
        return $ dropEndWhile isEmptyAndNotOpened . sortByIndex

-- }}}

-- Utilities --------------------------------------------------- {{{

(|>) :: a -> (a -> b) -> b
(|>) = (&)
infixl 1 |>


dropEndWhile :: (a -> Bool) -> [a] -> [a]
dropEndWhile _    []  = []
dropEndWhile test xs  = if test $ last xs then dropEndWhile test (init xs) else xs

catchAndNotifyAny :: IO () -> IO ()
catchAndNotifyAny ioAction = catch ioAction (\(e :: SomeException) -> notify "Xmonad exception" (show e))


getVisibleWorkspacesTagsOnMonitor :: ScreenId -> X [VirtualWorkspace]
getVisibleWorkspacesTagsOnMonitor monitor = do
  ws <- gets windowset
  return $ W.current ws : W.visible ws
    |> map (W.tag . W.workspace)
    |> filter (\tag -> monitor == fromIntegral (unmarshallS tag))
    |> map unmarshallW


notify :: MonadIO m => String -> String -> m ()
notify notificationTitle notificationMsg = safeSpawn "notify-send" [notificationTitle, notificationMsg]


ifLayoutIs :: String -> X a -> X a -> X a
ifLayoutIs layoutAName = ifLayoutName (== layoutAName)

ifLayoutName :: (String -> Bool) -> X a -> X a -> X a
ifLayoutName check onLayoutA onLayoutB = do
  layout <- getActiveLayoutDescription
  if (check layout) then onLayoutA else onLayoutB

-- Get the name of the active layout.
getActiveLayoutDescription :: X String
getActiveLayoutDescription = (description . W.layout . W.workspace . W.current) <$> gets windowset
-- }}}