path: root/lib/XMonad/Config/LaNinpre.hs

----------------------------------------------------------------------
-- |
-- Module       :   XMonad.Config.LaNinpre
-- Description  :   xmonad config of la ninpre
-- Maintainer   :   la-ninpre
-- License      :   ISC
-- Copyright    :   la-ninpre <aaoth AT aaoth DOT xyz>
--
----------------------------------------------------------------------

module XMonad.Config.LaNinpre where

import Data.List(intercalate)
import System.Exit

import XMonad
import qualified XMonad.StackSet as W

import XMonad.Actions.GridSelect
    ( GSConfig(GSConfig, gs_font, gs_bordercolor)
    , buildDefaultGSConfig
    , bringSelected
    , gridselect
    , goToSelected
    )
import XMonad.Actions.WithAll (sinkAll)

import XMonad.Hooks.EwmhDesktops
    ( ewmhFullscreen
    , ewmh
    )
import XMonad.Hooks.ManageDocks (ToggleStruts(ToggleStruts))
import XMonad.Hooks.ManageHelpers
    ( doFullFloat
    , isFullscreen
    )
import XMonad.Hooks.StatusBar
    ( StatusBarConfig
    , defToggleStrutsKey
    , statusBarProp
    , withEasySB
    )
import XMonad.Hooks.StatusBar.PP
    ( PP(ppSep, ppCurrent, ppHidden, ppHiddenNoWindows, ppLayout)
    , filterOutWsPP
    , xmobarColor
    , xmobarFont
    )

import XMonad.Layout.BoringWindows
    ( boringWindows
    , focusDown
    , focusMaster
    , focusUp
    , swapDown
    , swapUp
    )
import XMonad.Layout.NoBorders (noBorders, smartBorders)
import XMonad.Layout.Renamed
    ( Rename(Replace)
    , renamed
    )
import XMonad.Layout.ResizableThreeColumns (ResizableThreeCol(ResizableThreeColMid))
import XMonad.Layout.ResizableTile
    (ResizableTall(ResizableTall)
    , MirrorResize(MirrorShrink, MirrorExpand)
    )
import XMonad.Layout.Simplest (Simplest(Simplest))
import XMonad.Layout.Spacing
    ( spacingWithEdge
    , toggleWindowSpacingEnabled
    , toggleScreenSpacingEnabled, Border (top)
    )
import XMonad.Layout.SubLayouts
    ( GroupMsg(UnMerge, UnMergeAll)
    , onGroup
    , pullGroup
    , subLayout
    )
import XMonad.Layout.Tabbed
    (Theme
        ( activeBorderWidth
        , activeColor
        , activeTextColor
        , fontName
        , inactiveBorderWidth
        , inactiveColor
        , inactiveTextColor
        , urgentBorderWidth
        , urgentColor
        , urgentTextColor
        )
    , addTabs
    , shrinkText
    )
import XMonad.Layout.ToggleLayouts (ToggleLayout(ToggleLayout), toggleLayouts)
import XMonad.Layout.WindowNavigation (Direction2D(D, L, R, U), windowNavigation)

import XMonad.Util.ClickableWorkspaces (clickablePP)
import XMonad.Util.EZConfig (mkKeymap)
import XMonad.Util.NamedScratchpad
    ( NamedScratchpad(NS)
    , customFloating
    , namedScratchpadAction
    , namedScratchpadManageHook
    , scratchpadWorkspaceTag
    )
import XMonad.Layout.Groups (onLayout)

-- * fonts
-- 
-- $fonts
--
-- default font and helper for fonts.

-- | default font
fontDef :: String
fontDef = fontXft "Lato" "regular" 14

-- | font constructor
--
-- it is just a helper function to simplify the process of specifying font
-- with xft.
fontXft :: String   -- ^ font family
        -> String   -- ^ font style
        -> Int      -- ^ font size
        -> String
fontXft font style size = intercalate ":" [ "xft"
                                , font
                                , style
                                , "size=" ++ show size
                                , "antialias=true"
                                , "hinting=true"
                                ]

-- * colors
--
-- $colors
--
-- color theme and stuff

-- | default color theme
colorTheme :: ColorTheme
colorTheme = ColorTheme "#111111" "#ccbbcc" "#223333" "#ffaaaa"

-- | color theme datatype
--
-- 'Default' instance gives simple four-color colorscheme
data ColorTheme = ColorTheme {
  col_bg     :: String,
  col_fg     :: String,
  col_bg_alt :: String,
  col_fg_alt :: String
}

instance Default ColorTheme where
    def = colorTheme


-- * software
--
-- $software
--
-- these are just contstants

-- | set terminal emulator
terminalEmulator :: String
terminalEmulator = "alacritty"

-- | set web browser
webBrowser :: String
webBrowser = "firefox"

-- | set gemini client
geminiBrowser :: String
geminiBrowser = "lagrange"

-- | set file manager
fileManager :: String
fileManager = "thunar"

-- | music on console
--
-- this is to avoid spamming strings everywhere. @moc@ doesn't comply with
-- XDG_CONFIG_HOME, so we force it to do so.
mocpString :: String
mocpString = "mocp -M '~/.config/moc'"

-- | set editor
editor :: String
editor = terminalEmulator ++ " -e vi"

-- * manage hook
--
-- $managehook
--
-- send some windows here and there.

-- | manage hook
localManageHook :: [String] -> ManageHook
localManageHook ws = composeAll
     [ className =? "confirm"         --> doFloat
     , className =? "file_progress"   --> doFloat
     , className =? "dialog"          --> doFloat
     , className =? "download"        --> doFloat
     , className =? "error"           --> doFloat
     , className =? "notification"    --> doFloat
     , className =? "splash"          --> doFloat
     , className =? "toolbar"         --> doFloat
     , className =? "Image Lounge"    --> doFloat
     -- web workspace
     , title =? "Mozilla Firefox"     --> doShift ( ws !! 1 )
     , className =? "Brave-browser"   --> doShift ( ws !! 1 )
     , className =? "amfora"          --> doShift ( ws !! 1 )
     , className =? "qutebrowser"     --> doShift ( ws !! 1 )
     -- doc workspace
     , className =? "Geary"           --> doShift ( ws !! 3 )
     , className =? "libreoffice"     --> doShift ( ws !! 3 )
     -- vm workspace
     -- chat workspace
     , className =? "discord"         --> doShift ( ws !! 5 )
     , className =? "TelegramDesktop" --> doShift ( ws !! 5 )
     , className =? "Element"         --> doShift ( ws !! 5 )
     , className =? "Steam"           --> doShift ( ws !! 5 )
     -- full workspace
     , isFullscreen                   --> doShift ( ws !! 6 )
     -- vid workspace
     , className =? "Deadbeef"        --> doShift ( ws !! 7 )
     , appName   =? "mpv"             --> doShift ( ws !! 7 )
     , className =? "vlc"             --> doShift ( ws !! 7 )
     -- gfx workspace
     , className =? "Gimp"            --> doShift ( ws !! 8 )
     , className =? "Blender"         --> doShift ( ws !! 8 )
     , className =? "obs"             --> doShift ( ws !! 8 )
     , isFullscreen -->  doFullFloat
     ] <+> namedScratchpadManageHook scratchPads

-- * scratchpads
--
-- $scratchpads
--
-- currently i have:
--
--     *   plain terminal scratchpad
--
--     *   music on console
--     
--     *   calculator (qalculate-gtk)
--
--     *   mpv instance that plays playlist in @~\/Video\/sp_playlist.m3u@

-- | scratchpad list
scratchPads :: [NamedScratchpad]
scratchPads = [ NS "terminal" spawnTerm findTerm manageTerm
              , NS "mocp" spawnMocp findMocp manageMocp
              , NS "calculator" spawnCalc findCalc manageCalc
              , NS "mpvfloat" spawnMpv findMpv manageMpv
              ]
  where
    -- terminal
    spawnTerm  = terminalEmulator ++ " -t scratchpad"
    findTerm   = title =? "scratchpad"
    manageTerm = customFloating $ W.RationalRect l t w h
               where
                 h = 0.9
                 w = 0.9
                 t = 0.95 - h
                 l = 0.95 - w
    -- music on console
    spawnMocp  = terminalEmulator ++ " -t mocp -e " ++ mocpString
    findMocp   = title =? "mocp"
    manageMocp = customFloating $ W.RationalRect l t w h
               where
                 h = 0.9
                 w = 0.9
                 t = 0.95 - h
                 l = 0.95 - w 
    -- calculator
    spawnCalc  = "qalculate-gtk"
    findCalc   = className =? "Qalculate-gtk"
    manageCalc = customFloating $ W.RationalRect l t w h
               where
                 h = 0.5
                 w = 0.4
                 t = 0.75 - h
                 l = 0.70 - w
    -- mpv scratchpad to watch some stuff listed in ~/Video/sp_playlist.m3u
    spawnMpv  = "mpv --pause -x11-name mpv-sp ~/Video/sp_playlist.m3u"
                ++ mpvGeometry mpvPercentage mpvPercentage
    findMpv   = appName =? "mpv-sp"
    manageMpv = customFloating $ W.RationalRect l t w h
               where
                 h = mpvPercentage
                 w = mpvPercentage
                 t = 0.03
                 l = 0.996 - w
    mpvPercentage = 1/4
    mpvGeometry h w = " --geometry=" ++ show pw ++ "x" ++ show ph
       where
         pw = ceiling (1920 * w)
         ph = ceiling (1080 * h)

-- * workspaces
--
-- $workspaces
--
-- i've got two ways of specifying them. first one is pretty close to the
-- original dt's config and second one is using linja pona font by jan same
-- (check it out [here](http://musilili.net/linja-pona/)).

-- | normal english workspace names
workspacesNorm :: [String]
workspacesNorm = [ "dev"
                 , "www"
                 , "term"
                 , "doc"
                 , "vm"
                 , "chat"
                 , "full"
                 , "vid"
                 , "misc"
                 ]

-- | toki pona workspace names
--
-- uses sitelen-pona font.
workspacesTP :: [String]
workspacesTP = [ "\xe661\xe921" -- sona nanpa
               , "\xe63b"       -- musi
               , "\xe649"       -- pali
               , "\xe62a\xf105" -- lipu ale
               , "\xe653\xf115" -- poki ilo
               , "\xe66c"       -- toki
               , "\xe62a\xf200" -- lipu suli
               , "\xf010\xe915" -- sitelen tawa
               , "\xf010\xf107" -- sitelen ante
               ]

-- * grid select
--
-- $gridselect
--
-- stuff for 'GridSelect'

-- | app grid for 'GridSelect' layout
appGrid :: [(String,String)]
appGrid = [
      ("files"     ,"thunar"          )
    , ("mail"      ,"thunderbird"     )
    , ("blender"   ,"blender-3.3"     )
    , ("inkscape"  ,"inkscape"        )
    , ("discord"   ,"discord"         )
    , ("steam"     ,"steam"           )
    , ("obs"       ,"obs"             )
    , ("gimp"      ,"gimp"            )
    , ("ardour"    ,"ardour7"         )
    , ("mumble"    ,"mumble"          )
    , ("gajim"     ,"gajim"           )
    , ("element"   ,"element-desktop" )
    , ("kdenlive"  ,"kdenlive"        )
    ]

-- | uses colors from 'ColorTheme'
boringColorizer :: a -> Bool -> X (String, String)
boringColorizer _ active = if active
                           then return (col_bg_alt def, col_fg_alt def)
                           else return (col_bg     def, col_fg     def)

-- | 'GridSelect' config
gridSelectConfig :: GSConfig a
gridSelectConfig = (buildDefaultGSConfig boringColorizer)
           { gs_font        = fontDef
           , gs_bordercolor = col_bg_alt def
           }

-- | allows to add aliases for commands unlike original 'spawnSelected'
spawnSelected' :: GSConfig String -> [(String, String)] -> X ()
spawnSelected' conf lst = gridselect conf lst >>= flip whenJust spawn

-- * keybindings
--
-- $keybindings
--
-- list of keybindings. it supposed to override the default keybindings.

-- | keybindings in 'EZConfig' format
keybinds :: [String] -> [(String, X ())]
keybinds ws = [ ("M-<Return>", spawn terminalEmulator)
           , ("M-w",        spawn webBrowser)
           , ("M-p",        spawn "dmenu_run")
           , ("M-<Delete>", spawn "slock")
           , ("<Print>",    spawn "scrot_cmd -f")
           , ("C-<Print>",  spawn "scrot_cmd -a")
           , ("M1-<Print>", spawn "scrot_cmd -w")

           , ("M-s t",      namedScratchpadAction scratchPads "terminal")
           , ("M-s c",      namedScratchpadAction scratchPads "calculator")
           , ("M-s m",      namedScratchpadAction scratchPads "mocp")
           , ("M-s v",      namedScratchpadAction scratchPads "mpvfloat")

           , ("M-g t",      goToSelected gridSelectConfig)
           , ("M-g b",      bringSelected gridSelectConfig)
           , ("M-g g",      spawnSelected' gridSelectConfig appGrid)

           , ("M-S-c",      kill)
           , ("M-<Space>",  sendMessage NextLayout)
           , ("M-f",        sendMessage ToggleLayout >> sendMessage ToggleStruts)
           , ("M-h",        sendMessage Shrink)
           , ("M-l",        sendMessage Expand)
           , ("M-C-j",      sendMessage MirrorShrink)
           , ("M-C-k",      sendMessage MirrorExpand)
           , ("M-M1-h",     sendMessage $ pullGroup L)
           , ("M-M1-j",     sendMessage $ pullGroup D)
           , ("M-M1-k",     sendMessage $ pullGroup U)
           , ("M-M1-l",     sendMessage $ pullGroup R)
           , ("M-M1-u",     withFocused $ sendMessage . UnMerge)
           , ("M-M1-m",     withFocused $ sendMessage . UnMergeAll)
           , ("M-M1-,",     onGroup W.focusDown')
           , ("M-M1-.",     onGroup W.focusUp')
           , ("M-j",        focusDown)
           , ("M-k",        focusUp)
           , ("M-S-j",      swapDown)
           , ("M-S-k",      swapUp)
           , ("M-m",        focusMaster)
           , ("M-S-m",      windows W.swapMaster)
           , ("M-t",        withFocused $ windows . W.sink)
           , ("M-S-t",      sinkAll)
           , ("M-<Tab>",    toggleWindowSpacingEnabled >> toggleScreenSpacingEnabled)

           , ("M-S-q",      io exitSuccess)
           , ("M-S-r",      spawn "xmonad --recompile && xmonad --restart")

           , ("<XF86AudioPlay>",        spawn $ mocpString ++ " -G")
           , ("<XF86AudioRaiseVolume>", spawn $ mocpString ++ " -v +5")
           , ("<XF86AudioLowerVolume>", spawn $ mocpString ++ " -v -5")
           , ("<XF86AudioMute>",        spawn $ mocpString ++ " -v 0")
           , ("<XF86AudioPrev>",        spawn $ mocpString ++ " --previous")
           , ("<XF86AudioNext>",        spawn $ mocpString ++ " --next")
           ]
           ++
           [("M-" ++ m ++ show k, windows $ f i)
               | (i, k) <- zip ws [1..9]
               , (f, m) <- [(W.greedyView, ""), (W.shift, "S-")]
           ]

-- * xmobar
--
-- $xmobar
--
-- stuff for xmobar

-- | xmobar pretty printer
localXmobarPP :: PP
localXmobarPP = def
           { ppSep             = xmobarColor (col_bg_alt def) "" " | "
           , ppCurrent         = xmobarColor (col_fg_alt def) "" . sitelen
           , ppHidden          = xmobarColor (col_fg     def) "" . sitelen
           , ppHiddenNoWindows = xmobarColor (col_bg_alt def) "" . sitelen
           , ppLayout          = sitelen
           } where
               sitelen = xmobarFont 1

-- | status bar config
statusBarConfig :: StatusBarConfig
statusBarConfig = statusBarProp "xmobar"
     $ clickablePP $ filterOutWsPP [scratchpadWorkspaceTag] localXmobarPP

-- * layouts 
--
-- $layouts
--
-- stuff for layouts

-- | theme for 'Tabbed' layout
tabTheme :: Theme
tabTheme = def
           { fontName            = fontDef
           , activeTextColor     = col_fg_alt def
           , activeColor         = col_bg_alt def
           , activeBorderWidth   = 0
           , inactiveTextColor   = col_fg def
           , inactiveColor       = col_bg def
           , inactiveBorderWidth = 0
           , urgentTextColor     = col_bg_alt def
           , urgentColor         = col_fg_alt def
           , urgentBorderWidth   = 0
           }

-- * misc

-- | names for layouts
--
-- this is to allow specifying layout names. not very flexible but plausible.
data LayoutNames = LayoutNames
    { tiledName     :: String
    , threeColName  :: String
    , fullName      :: String
    }

-- | layout hook 
--
-- __NOTE__: it uses sitelen-pona font to name layouts.
localLayoutHook ln = windowNavigation
         $ boringWindows
         $ toggleLayouts full
         $ smartBorders
         $ tiled ||| threeCol
         where
            tiled    = renamed [Replace $ tiledName ln] -- lawa
                     $ addTabs shrinkText tabTheme
                     $ subLayout [] Simplest
                     $ spacingWithEdge space
                     $ ResizableTall nmaster delta ratio []
            threeCol = renamed [Replace $ threeColName ln] -- supa
                     $ addTabs shrinkText tabTheme
                     $ subLayout [] Simplest
                     $ spacingWithEdge space
                     $ ResizableThreeColMid nmaster delta ratio []
            full     = renamed [Replace $ fullName ln] -- suli
                     $ noBorders Full
            nmaster  = 1
            ratio    = 1/2
            delta    = 3/100
            space    = 4

-- | main config 
--
-- takes a list of workspaces and @LayoutNames@, be sure to specify them.
--
-- @
--     myConfig = laNinpreConfig workspacesNorm
--     main = xmonad myConfig
-- @
laNinpreConfig ws ln = def
         { terminal           = terminalEmulator
         , modMask            = mod4Mask
         , layoutHook         = localLayoutHook ln
         , manageHook         = localManageHook ws
         , workspaces         = ws
         , borderWidth        = 1
         , keys               = (`mkKeymap` keybinds ws)
         , normalBorderColor  = col_bg_alt def
         , focusedBorderColor = col_fg_alt def
         }