From 93f86940f52fde7a12073119fb9bf20edd4f3df9 Mon Sep 17 00:00:00 2001 From: tdback Date: Sun, 2 Feb 2025 21:18:10 -0500 Subject: here be dragons --- LICENSE | 21 ++++++++++++++++++++ flake.lock | 27 ++++++++++++++++++++++++++ flake.nix | 26 +++++++++++++++++++++++++ lib/Defaults.hs | 35 +++++++++++++++++++++++++++++++++ lib/KeyBindings.hs | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ lib/Layout.hs | 35 +++++++++++++++++++++++++++++++++ lib/LogHook.hs | 30 ++++++++++++++++++++++++++++ lib/WindowState.hs | 14 ++++++++++++++ xmonad.hs | 27 ++++++++++++++++++++++++++ 9 files changed, 272 insertions(+) create mode 100644 LICENSE create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 lib/Defaults.hs create mode 100644 lib/KeyBindings.hs create mode 100644 lib/Layout.hs create mode 100644 lib/LogHook.hs create mode 100644 lib/WindowState.hs create mode 100644 xmonad.hs diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..b87a126 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2025 Tyler Dunneback + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..bdbb3d8 --- /dev/null +++ b/flake.lock @@ -0,0 +1,27 @@ +{ + "nodes": { + "nixpkgs": { + "locked": { + "lastModified": 1738142207, + "narHash": "sha256-NGqpVVxNAHwIicXpgaVqJEJWeyqzoQJ9oc8lnK9+WC4=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "9d3ae807ebd2981d593cddd0080856873139aa40", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "nixpkgs": "nixpkgs" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..02c06c7 --- /dev/null +++ b/flake.nix @@ -0,0 +1,26 @@ +{ + inputs.nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable"; + outputs = + { nixpkgs, ... }: + let + supportedSystems = [ "x86_64-linux" ]; + eachSystem = nixpkgs.lib.genAttrs supportedSystems; + in + { + devShells = eachSystem ( + system: + let + pkgs = import nixpkgs { inherit system; }; + in + { + default = pkgs.mkShell { + buildInputs = with pkgs; [ + (haskellPackages.ghcWithPackages ( + ps: with ps; [ haskell-language-server ] + )) + ]; + }; + } + ); + }; +} diff --git a/lib/Defaults.hs b/lib/Defaults.hs new file mode 100644 index 0000000..8731d85 --- /dev/null +++ b/lib/Defaults.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Defaults where + +import XMonad + +myTerminal :: String +myTerminal = "alacritty" + +myBrowser :: String +myBrowser = "firefox" + +myModMask :: KeyMask +myModMask = mod4Mask + +altMask :: KeyMask +altMask = mod1Mask + +myFocusFollowsMouse :: Bool +myFocusFollowsMouse = True + +myClickJustFocuses :: Bool +myClickJustFocuses = False + +myWorkspaces :: [String] +myWorkspaces = map show ([1 .. 9] :: [Integer]) + +myBorderWidth :: Dimension +myBorderWidth = 2 + +myNormalBorderColor :: String +myNormalBorderColor = "#16191F" + +myFocusedBorderColor :: String +myFocusedBorderColor = "#485264" diff --git a/lib/KeyBindings.hs b/lib/KeyBindings.hs new file mode 100644 index 0000000..a4b26d3 --- /dev/null +++ b/lib/KeyBindings.hs @@ -0,0 +1,57 @@ +module KeyBindings where + +import Defaults +import Graphics.X11.ExtraTypes.XF86 +import XMonad +import XMonad.Actions.CycleWS +import XMonad.Actions.FindEmptyWorkspace +import XMonad.Layout.Gaps +import XMonad.Layout.MultiToggle +import XMonad.Layout.MultiToggle.Instances +import XMonad.Util.Paste +import XMonad.Util.Run + +import qualified Data.Map as M +import qualified WindowState as WS +import qualified XMonad.StackSet as W + +myKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +myKeys conf@(XConfig{XMonad.modMask = modm}) = + M.fromList $ + [ ((modm .|. shiftMask, xK_Return), safeSpawn (XMonad.terminal conf) []) + , ((modm, xK_b), safeSpawn myBrowser []) + , ((modm .|. shiftMask, xK_c), kill) + , ((modm, xK_n), refresh) + , ((modm, xK_q), spawn "xmonad --recompile; xmonad --restart") + , ((modm, xK_f), sendMessage $ Toggle FULL) + , ((modm .|. shiftMask, xK_f), withFocused WS.toggleFloat) + , ((modm, xK_space), sendMessage NextLayout) + , ((modm, xK_Tab), windows W.focusDown) + , ((modm, xK_j), windows W.focusDown) + , ((modm, xK_k), windows W.focusUp) + , ((modm, xK_m), windows W.focusMaster) + , ((modm .|. shiftMask, xK_j), windows W.swapDown) + , ((modm .|. shiftMask, xK_k), windows W.swapUp) + , ((modm, xK_Return), windows W.swapMaster) + , ((modm, xK_h), sendMessage Expand) + , ((modm, xK_l), sendMessage Shrink) + , ((modm, xK_Tab), toggleWS) + , ((modm, xK_e), viewEmptyWorkspace) + , ((modm .|. shiftMask, xK_e), tagToEmptyWorkspace) + , ((modm, xK_t), withFocused $ windows . W.sink) + , ((modm, xK_r), spawn "rofi -show drun") + , ((altMask, xK_Tab), spawn "rofi -show window") + , ((modm, xK_p), spawn "snapshot -f") + , ((modm .|. shiftMask, xK_p), spawn "snapshot") + , ((0, xF86XK_AudioPrev), spawn "mpc prev") + , ((0, xF86XK_AudioNext), spawn "mpc next") + , ((0, xF86XK_AudioPlay), spawn "mpc toggle") + , ((0, xF86XK_AudioRaiseVolume), spawn "pamixer -i 5") + , ((0, xF86XK_AudioLowerVolume), spawn "pamixer -d 5") + , ((0, xF86XK_AudioMute), spawn "pamixer -t") + ] + ++ + [ ((m .|. modm, k), windows $ f i) + | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9] + , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)] + ] diff --git a/lib/Layout.hs b/lib/Layout.hs new file mode 100644 index 0000000..aada696 --- /dev/null +++ b/lib/Layout.hs @@ -0,0 +1,35 @@ +module Layout (myLayoutHook) where + +import XMonad +import XMonad.Hooks.ManageDocks +import XMonad.Layout.Gaps +import XMonad.Layout.MultiToggle +import XMonad.Layout.MultiToggle.Instances +import XMonad.Layout.NoBorders +import XMonad.Layout.Reflect +import XMonad.Layout.Spacing +import XMonad.Layout.ThreeColumns + +myLayoutHook = + gaps [(L, 0), (R, 0), (U, 0), (D, 0)] $ + spacingRaw True (Border 0 0 0 0) True (Border 0 0 0 0) True $ + smartBorders myLayout + where + myLayout = + smartBorders $ + mkToggle (NOBORDERS ?? FULL ?? EOT) $ + avoidStruts + ( reflectHoriz tiled + ||| Mirror tiled + ||| Full + ||| ThreeColMid 1 (3 / 100) (3 / 7) + ) + + -- Default tiling algorithm. + tiled = Tall nmaster delta ratio + -- Default number of windows in the master pane. + nmaster = 1 + -- Default proportion of screen occupied by master pane. + ratio = 1 / 2 + -- Percent of screen to increment by when resizing panes. + delta = 3 / 100 diff --git a/lib/LogHook.hs b/lib/LogHook.hs new file mode 100644 index 0000000..b10fba0 --- /dev/null +++ b/lib/LogHook.hs @@ -0,0 +1,30 @@ +module LogHook + ( myLogHook + , withStatusBars + ) where + +import Defaults +import XMonad +import XMonad.Hooks.DynamicLog +import XMonad.Hooks.StatusBar +import XMonad.Hooks.StatusBar.PP + +myLogHook :: X () +myLogHook = return () + +withStatusBars :: (LayoutClass l Window) => XConfig l -> XConfig l +withStatusBars = dynamicSBs barSpawner + +barSpawner :: ScreenId -> IO StatusBarConfig +barSpawner = pure . xmobar + where + pp :: PP + pp = + def + { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" + , ppVisible = xmobarColor "white" "" . wrap "[" "]" + , ppUrgent = xmobarColor "red" "" . wrap "[" "]" + , ppOrder = \(ws:_:t:_) -> [ws, t] + } + xmobar :: ScreenId -> StatusBarConfig + xmobar (S screenId) = statusBarProp ("xmobar -x" <> show screenId) $ pure pp diff --git a/lib/WindowState.hs b/lib/WindowState.hs new file mode 100644 index 0000000..3f7d4fb --- /dev/null +++ b/lib/WindowState.hs @@ -0,0 +1,14 @@ +module WindowState (toggleFloat) where + +import XMonad + +import qualified Data.Map as Map +import qualified XMonad.StackSet as W + +toggleFloat :: Window -> X () +toggleFloat w = windows $ \windowSet -> + if Map.member w $ W.floating windowSet + then W.sink w windowSet + else W.float w floatingWindowRect windowSet + where + floatingWindowRect = W.RationalRect (1 / 3) (1 / 6) (1 / 2) (4 / 5) diff --git a/xmonad.hs b/xmonad.hs new file mode 100644 index 0000000..270f142 --- /dev/null +++ b/xmonad.hs @@ -0,0 +1,27 @@ +import XMonad +import XMonad.Hooks.EwmhDesktops +import XMonad.Hooks.ManageDocks +import XMonad.Layout.Fullscreen + +import Defaults +import KeyBindings +import Layout +import LogHook + +main :: IO () +main = xmonad . withStatusBars . fullscreenSupport . docks . ewmh $ defaults + where + defaults = + def + { modMask = myModMask + , keys = myKeys + , workspaces = myWorkspaces + , focusFollowsMouse = myFocusFollowsMouse + , clickJustFocuses = myClickJustFocuses + , logHook = myLogHook + , terminal = myTerminal + , layoutHook = myLayoutHook + , borderWidth = myBorderWidth + , normalBorderColor = myNormalBorderColor + , focusedBorderColor = myFocusedBorderColor + } -- cgit v1.2.3