summaryrefslogtreecommitdiffstats
path: root/pkgs/haskell/xmonad-tv
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2023-09-11 18:24:28 +0200
committertv <tv@krebsco.de>2023-09-13 18:07:11 +0200
commit0c4f3acb281be6290c55a6e96bc29fab5b5c7a11 (patch)
treedadaec00477a095273475ac345b2066b4748c399 /pkgs/haskell/xmonad-tv
parentab1d0479e90f11806d4703ec6fffed3d5f782914 (diff)
stockholm -> hrm
Diffstat (limited to 'pkgs/haskell/xmonad-tv')
-rw-r--r--pkgs/haskell/xmonad-tv/default.nix16
-rw-r--r--pkgs/haskell/xmonad-tv/shell.nix83
-rw-r--r--pkgs/haskell/xmonad-tv/src/Shutdown.hs113
-rw-r--r--pkgs/haskell/xmonad-tv/src/XMonad/Extra.hs14
-rw-r--r--pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs117
-rw-r--r--pkgs/haskell/xmonad-tv/src/main.hs227
-rw-r--r--pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal29
7 files changed, 599 insertions, 0 deletions
diff --git a/pkgs/haskell/xmonad-tv/default.nix b/pkgs/haskell/xmonad-tv/default.nix
new file mode 100644
index 0000000..f42f97c
--- /dev/null
+++ b/pkgs/haskell/xmonad-tv/default.nix
@@ -0,0 +1,16 @@
+{ mkDerivation, aeson, base, bytestring, containers, directory
+, extra, filepath, lib, pager, unix, X11, xmonad, xmonad-contrib
+}:
+mkDerivation {
+ pname = "xmonad-tv";
+ version = "1.0.0";
+ src = ./src;
+ isLibrary = false;
+ isExecutable = true;
+ executableHaskellDepends = [
+ aeson base bytestring containers directory extra filepath pager
+ unix X11 xmonad xmonad-contrib
+ ];
+ license = lib.licenses.mit;
+ mainProgram = "xmonad";
+}
diff --git a/pkgs/haskell/xmonad-tv/shell.nix b/pkgs/haskell/xmonad-tv/shell.nix
new file mode 100644
index 0000000..6ca00bc
--- /dev/null
+++ b/pkgs/haskell/xmonad-tv/shell.nix
@@ -0,0 +1,83 @@
+{ compiler ? "default" }: let
+
+ stockholm = import <stockholm>;
+
+ inherit (stockholm.systems.${lib.krops.getHostName}) config pkgs;
+ inherit (stockholm) lib;
+
+ haskellPackages =
+ if compiler == "default"
+ then pkgs.haskellPackages
+ else pkgs.haskell.packages.${compiler};
+
+ xmonadDrv = haskellPackages.callPackage (import ./.) {};
+
+in
+
+ lib.overrideDerivation xmonadDrv.env (oldAttrs: {
+ shellHook = ''
+ pkg_name=${lib.shell.escape (lib.baseNameOf (toString ./.))}
+
+ WORKDIR=${toString ./src}
+ CACHEDIR=$HOME/tmp/$pkg_name
+ HISTFILE=$CACHEDIR/bash_history
+
+ mkdir -p "$CACHEDIR"
+
+ config_XMONAD_CACHE_DIR=${lib.shell.escape
+ config.systemd.services.xmonad.environment.XMONAD_CACHE_DIR
+ }
+
+ xmonad=$CACHEDIR/xmonad-${lib.currentSystem}
+
+ xmonad_build() {(
+ set -efu
+ cd "$WORKDIR"
+ options=$(
+ ${pkgs.cabal-read}/bin/ghc-options "$WORKDIR/$pkg_name.cabal" xmonad
+ )
+ ghc $options \
+ -odir "$CACHEDIR" \
+ -hidir "$CACHEDIR" \
+ -o "$xmonad" \
+ main.hs
+ )}
+
+ xmonad_restart() {(
+ set -efu
+ cd "$WORKDIR"
+ if systemctl --quiet is-active xmonad; then
+ sudo systemctl stop xmonad
+ cp -b "$config_XMONAD_CACHE_DIR"/xmonad.state "$CACHEDIR"/
+ echo "xmonad.state: $(cat "$CACHEDIR"/xmonad.state)"
+ else
+ "$xmonad" --shutdown || :
+ fi
+ "$xmonad" &
+ echo xmonad pid: $! >&2
+ )}
+
+ xmonad_yield() {(
+ set -efu
+ if ! systemctl --quiet is-active xmonad; then
+ "$xmonad" --shutdown
+ cp -b "$CACHEDIR"/xmonad.state "$config_XMONAD_CACHE_DIR"/
+ sudo systemctl start xmonad
+ else
+ echo "xmonad.service is already running" >&2
+ exit -1
+ fi
+ )}
+
+ export PATH=${config.systemd.services.xmonad.path}:$PATH
+ export SHELL=/run/current-system/sw/bin/bash
+
+ export XMONAD_CACHE_DIR="$CACHEDIR"
+ export XMONAD_DATA_DIR="$CACHEDIR"
+ export XMONAD_CONFIG_DIR=/var/empty
+
+ unset XMONAD_STARTUP_HOOK
+
+ cd "$WORKDIR"
+ '';
+ })
diff --git a/pkgs/haskell/xmonad-tv/src/Shutdown.hs b/pkgs/haskell/xmonad-tv/src/Shutdown.hs
new file mode 100644
index 0000000..d4a4d93
--- /dev/null
+++ b/pkgs/haskell/xmonad-tv/src/Shutdown.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Shutdown
+ ( newShutdownEventHandler
+ , shutdown
+ )
+ where
+
+import Control.Applicative ((<|>), empty)
+import Control.Concurrent (threadDelay)
+import Control.Monad (forever, guard, when)
+import Data.Monoid (All(All))
+import System.Directory (XdgDirectory(XdgData), createDirectoryIfMissing, doesFileExist, getAppUserDataDirectory, getXdgDirectory)
+import System.Exit (exitSuccess)
+import System.Environment (lookupEnv)
+import System.FilePath ((</>))
+import System.IO.Error (isDoesNotExistError, tryIOError)
+import System.IO (hPutStrLn, stderr)
+import System.Posix.Process (getProcessID)
+import System.Posix.Signals (nullSignal, signalProcess)
+import System.Posix.Types (ProcessID)
+import XMonad hiding (getXMonadDataDir)
+
+
+-- XXX this is for compatibility with both xmonad<0.17 and xmonad>=0.17
+getXMonadDataDir :: IO String
+getXMonadDataDir = xmEnvDir <|> xmDir <|> xdgDir
+ where
+ -- | Check for xmonad's environment variables first
+ xmEnvDir :: IO String
+ xmEnvDir =
+ maybe empty pure =<< lookupEnv "XMONAD_DATA_DIR"
+
+ -- | Check whether the config file or a build script is in the
+ -- @~\/.xmonad@ directory
+ xmDir :: IO String
+ xmDir = do
+ d <- getAppUserDataDirectory "xmonad"
+ conf <- doesFileExist $ d </> "xmonad.hs"
+ build <- doesFileExist $ d </> "build"
+ pid <- doesFileExist $ d </> "xmonad.pid"
+
+ -- Place *everything* in ~/.xmonad if yes
+ guard $ conf || build || pid
+ pure d
+
+ -- | Use XDG directories as a fallback
+ xdgDir :: IO String
+ xdgDir = do
+ d <- getXdgDirectory XdgData "xmonad"
+ d <$ createDirectoryIfMissing True d
+
+
+newShutdownEventHandler :: IO (Event -> X All)
+newShutdownEventHandler = do
+ writeProcessIDToFile
+ return handleShutdownEvent
+
+handleShutdownEvent :: Event -> X All
+handleShutdownEvent = \case
+ ClientMessageEvent { ev_message_type = mt } -> do
+ isShutdownEvent <- (mt ==) <$> getAtom "XMONAD_SHUTDOWN"
+ when isShutdownEvent $ do
+ broadcastMessage ReleaseResources
+ writeStateToFile
+ io exitSuccess >> return ()
+ return (All (not isShutdownEvent))
+ _ ->
+ return (All True)
+
+sendShutdownEvent :: IO ()
+sendShutdownEvent = do
+ dpy <- openDisplay ""
+ rw <- rootWindow dpy $ defaultScreen dpy
+ a <- internAtom dpy "XMONAD_SHUTDOWN" False
+ allocaXEvent $ \e -> do
+ setEventType e clientMessage
+ setClientMessageEvent e rw a 32 0 currentTime
+ sendEvent dpy rw False structureNotifyMask e
+ sync dpy False
+
+shutdown :: IO ()
+shutdown = do
+ pid <- readProcessIDFromFile
+ sendShutdownEvent
+ hPutStrLn stderr ("waiting for: " <> show pid)
+ result <- tryIOError (waitProcess pid)
+ if isSuccess result
+ then hPutStrLn stderr ("result: " <> show result <> " [AKA success^_^]")
+ else hPutStrLn stderr ("result: " <> show result)
+ where
+ isSuccess = either isDoesNotExistError (const False)
+
+waitProcess :: ProcessID -> IO ()
+waitProcess pid = forever (signalProcess nullSignal pid >> threadDelay 10000)
+
+--
+-- PID file stuff
+--
+
+getProcessIDFileName :: IO FilePath
+getProcessIDFileName = (</> "xmonad.pid") <$> getXMonadDataDir
+
+writeProcessIDToFile :: IO ()
+writeProcessIDToFile = do
+ pidFileName <- getProcessIDFileName
+ pid <- getProcessID
+ writeFile pidFileName (show pid)
+
+readProcessIDFromFile :: IO ProcessID
+readProcessIDFromFile = do
+ pidFileName <- getProcessIDFileName
+ read <$> readFile pidFileName
diff --git a/pkgs/haskell/xmonad-tv/src/XMonad/Extra.hs b/pkgs/haskell/xmonad-tv/src/XMonad/Extra.hs
new file mode 100644
index 0000000..7422271
--- /dev/null
+++ b/pkgs/haskell/xmonad-tv/src/XMonad/Extra.hs
@@ -0,0 +1,14 @@
+module XMonad.Extra where
+
+import XMonad
+import qualified Data.Map as Map
+import qualified XMonad.StackSet as W
+
+
+isFloating :: Window -> WindowSet -> Bool
+isFloating w =
+ Map.member w . W.floating
+
+isFloatingX :: Window -> X Bool
+isFloatingX w =
+ isFloating w <$> gets windowset
diff --git a/pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs b/pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs
new file mode 100644
index 0000000..bf84314
--- /dev/null
+++ b/pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module XMonad.Hooks.EwmhDesktops.Extra where
+
+import Control.Monad (when)
+import Data.Maybe (fromMaybe)
+import Data.Monoid (All)
+import Data.Tuple.Extra (both)
+import Graphics.X11.EWMH (getDesktopNames, setDesktopNames)
+import Graphics.X11.EWMH.Atom (_NET_DESKTOP_NAMES)
+import Graphics.X11.Xlib.Display.Extra (withDefaultDisplay)
+import XMonad hiding (workspaces)
+import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace, removeEmptyWorkspaceByTag)
+import XMonad.StackSet (mapWorkspace, tag, workspaces)
+import XMonad.Util.WorkspaceCompare (getSortByIndex)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified XMonad
+
+
+ewmhExtra :: XConfig a -> IO (XConfig a)
+ewmhExtra c = do
+ -- XMonad.Hooks.EwmhDesktops.setDesktopViewport uses _NET_DESKTOP_VIEWPORT
+ -- only if it exists. This seems to be a harmless issue, but by creating
+ -- the atom here, we suppress the error message:
+ --
+ -- xmonad: X11 error: BadAtom (invalid Atom parameter),
+ -- request code=18, error code=5
+ --
+ _ <-
+ withDefaultDisplay $ \dpy -> internAtom dpy "_NET_DESKTOP_VIEWPORT" False
+
+ initialWorkspaces <-
+ Data.Maybe.fromMaybe (XMonad.workspaces def)
+ <$> withDefaultDisplay getDesktopNames
+
+ return
+ c { handleEventHook = ewmhDesktopsExtraEventHook <> handleEventHook c
+ , rootMask = rootMask c .|. propertyChangeMask
+ , XMonad.workspaces = initialWorkspaces
+ }
+
+ewmhDesktopsExtraEventHook :: Event -> X All
+ewmhDesktopsExtraEventHook = \case
+ PropertyEvent{ev_window, ev_atom} -> do
+ r <- asks theRoot
+ when (ev_window == r && ev_atom == _NET_DESKTOP_NAMES) $
+ withDisplay $ \dpy -> do
+ sort <- getSortByIndex
+
+ oldNames <- gets $ map tag . sort . workspaces . windowset
+ newNames <- fromMaybe oldNames <$> io (getDesktopNames dpy)
+
+ let
+ (renamesFrom, renamesTo) = both Set.fromList $ unzip renames
+
+ renames = go oldNames newNames where
+ go old@(headOld : tailOld) new@(headNew : tailNew) = do
+ let
+ deleteOld = Set.member headOld deleteNameSet
+ createNew = Set.member headNew createNameSet
+
+ if
+ | headOld == headNew ->
+ -- assert (not deleteOld && not createNew)
+ go tailOld tailNew
+
+ | deleteOld && createNew ->
+ (headOld, headNew) :
+ go tailOld tailNew
+
+ | deleteOld ->
+ go tailOld new
+
+ | createNew ->
+ go old tailNew
+
+ | otherwise ->
+ -- assert (headOld == headNew)
+ go tailOld tailNew
+
+ go _ _ = []
+
+ oldNameSet = Set.fromList oldNames
+ newNameSet = Set.fromList newNames
+ deleteNameSet = Set.difference oldNameSet newNameSet
+ createNameSet = Set.difference newNameSet oldNameSet
+
+ deleteNames = Set.toAscList $
+ Set.difference deleteNameSet renamesFrom
+ createNames = Set.toAscList $
+ Set.difference createNameSet renamesTo
+
+ mapM_ addHiddenWorkspace createNames
+ mapM_ removeEmptyWorkspaceByTag deleteNames
+ when (not (null renames)) $ do
+ let
+ renameMap = Map.fromList renames
+ rename w =
+ case Map.lookup (tag w) renameMap of
+ Just newName -> w { tag = newName }
+ Nothing -> w
+
+ modifyWindowSet $ mapWorkspace rename
+
+ names <- gets $ map tag . sort . workspaces . windowset
+
+ when (names /= newNames) $ do
+ trace $ "setDesktopNames " <> show names
+ io (setDesktopNames names dpy)
+
+ mempty
+
+ _ ->
+ mempty
diff --git a/pkgs/haskell/xmonad-tv/src/main.hs b/pkgs/haskell/xmonad-tv/src/main.hs
new file mode 100644
index 0000000..7256963
--- /dev/null
+++ b/pkgs/haskell/xmonad-tv/src/main.hs
@@ -0,0 +1,227 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module Main (main) where
+
+import System.Exit (exitFailure)
+import XMonad.Hooks.EwmhDesktops (ewmh)
+import XMonad.Hooks.EwmhDesktops.Extra (ewmhExtra)
+import XMonad.Hooks.RefocusLast (refocusLastLayoutHook, toggleFocus)
+
+import Control.Monad.Extra (whenJustM)
+import qualified Data.Aeson
+import qualified Data.ByteString.Char8
+import qualified Data.List
+import qualified Data.Maybe
+import Graphics.X11.ExtraTypes.XF86
+import XMonad
+import XMonad.Extra (isFloatingX)
+import System.IO (hPutStrLn, stderr)
+import System.Environment (getArgs, getEnv, getEnvironment, lookupEnv)
+import System.Posix.Process (executeFile)
+import XMonad.Actions.DynamicWorkspaces ( addWorkspacePrompt, renameWorkspace
+ , removeEmptyWorkspace)
+import XMonad.Actions.CycleWS (toggleWS)
+import XMonad.Layout.Gaps (Direction2D(U,R,D,L), gaps)
+import XMonad.Layout.NoBorders ( smartBorders )
+import XMonad.Layout.ResizableTile (ResizableTall(ResizableTall))
+import XMonad.Layout.ResizableTile (MirrorResize(MirrorExpand,MirrorShrink))
+import XMonad.Layout.StateFull (pattern StateFull)
+import qualified XMonad.Prompt
+import qualified XMonad.StackSet as W
+import Data.Map (Map)
+import qualified Data.Map as Map
+import XMonad.Hooks.UrgencyHook
+ ( BorderUrgencyHook(BorderUrgencyHook,urgencyBorderColor)
+ , RemindWhen(Dont)
+ , SuppressWhen(Never)
+ , UrgencyConfig(UrgencyConfig,remindWhen,suppressWhen)
+ , withUrgencyHookC
+ )
+import XMonad.Hooks.ManageHelpers (doCenterFloat,doRectFloat)
+import Data.Ratio
+import XMonad.Hooks.Place (placeHook, smart)
+import XMonad.Actions.PerWorkspaceKeys (chooseAction)
+
+import Shutdown (shutdown, newShutdownEventHandler)
+
+
+main :: IO ()
+main = getArgs >>= \case
+ [] -> mainNoArgs
+ ["--shutdown"] -> shutdown
+ args -> hPutStrLn stderr ("bad arguments: " <> show args) >> exitFailure
+
+
+(=??) :: Query a -> (a -> Bool) -> Query Bool
+(=??) x p = fmap p x
+
+readEnv :: Data.Aeson.FromJSON b => String -> IO b
+readEnv name =
+ readEnv' (error $ "could not get environment variable: " <> name) name
+
+readEnv' :: Data.Aeson.FromJSON b => b -> String -> IO b
+readEnv' defaultValue name =
+ Data.Maybe.fromMaybe defaultValue
+ . Data.Aeson.decodeStrict'
+ . Data.ByteString.Char8.pack
+ . Data.Maybe.fromMaybe mempty
+ <$> lookupEnv name
+
+mainNoArgs :: IO ()
+mainNoArgs = do
+ myScreenGaps <- readEnv' [] "XMONAD_SCREEN_GAPS" :: IO [Int]
+ myScreenWidth <- readEnv "XMONAD_SCREEN_WIDTH" :: IO Dimension
+ myTermFont <- getEnv "XMONAD_TERM_FONT"
+ myTermFontWidth <- readEnv "XMONAD_TERM_FONT_WIDTH" :: IO Dimension
+ myTermPadding <- readEnv "XMONAD_TERM_PADDING" :: IO Dimension
+ handleShutdownEvent <- newShutdownEventHandler
+ config <-
+ ewmhExtra
+ $ ewmh
+ $ withUrgencyHookC
+ BorderUrgencyHook
+ { urgencyBorderColor = "#ff0000"
+ }
+ UrgencyConfig
+ { remindWhen = Dont
+ , suppressWhen = Never
+ }
+ $ def
+ { terminal = {-pkg:alacritty-tv-}"alacritty"
+ , modMask = mod4Mask
+ , keys = myKeys myTermFont
+ , layoutHook =
+ refocusLastLayoutHook $
+ gaps (zip [U,R,D,L] myScreenGaps) $
+ smartBorders $
+ ResizableTall
+ 1
+ (fromIntegral (10 * myTermFontWidth) / fromIntegral myScreenWidth)
+ (fromIntegral (80 * myTermFontWidth + 2 * (myTermPadding + borderWidth def)) / fromIntegral myScreenWidth)
+ []
+ |||
+ StateFull
+ , manageHook =
+ composeAll
+ [ appName =? "fzmenu-urxvt" --> doCenterFloat
+ , appName =?? Data.List.isPrefixOf "pinentry" --> doCenterFloat
+ , appName =?? Data.List.isInfixOf "Float" --> doCenterFloat
+ , title =? "Upload to Imgur" -->
+ doRectFloat (W.RationalRect 0 0 (1 % 8) (1 % 8))
+ , placeHook (smart (1,0))
+ ]
+ , startupHook =
+ whenJustM (io (lookupEnv "XMONAD_STARTUP_HOOK"))
+ (\path -> forkFile path [] Nothing)
+ , normalBorderColor = "#1c1c1c"
+ , focusedBorderColor = "#f000b0"
+ , handleEventHook = handleShutdownEvent
+ }
+ directories <- getDirectories
+ launch config directories
+
+
+forkFile :: FilePath -> [String] -> Maybe [(String, String)] -> X ()
+forkFile path args env =
+ xfork (executeFile path True args env) >> return ()
+
+
+spawnRootTerm :: X ()
+spawnRootTerm =
+ forkFile
+ {-pkg:alacritty-tv-}"alacritty"
+ ["--profile=root", "-e", "/run/wrappers/bin/su", "-"]
+ Nothing
+
+
+myKeys :: String -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
+myKeys font conf = Map.fromList $
+ [ ((_4 , xK_Escape ), forkFile {-pkg-}"slock" [] Nothing)
+ , ((_4S , xK_c ), kill)
+
+ , ((_4 , xK_o ), forkFile {-pkg:fzmenu-}"otpmenu" [] Nothing)
+ , ((_4 , xK_p ), forkFile {-pkg:fzmenu-}"passmenu" [] Nothing)
+
+ , ((_4 , xK_x ), forkFile {-pkg:alacritty-tv-}"alacritty" ["--singleton"] Nothing)
+ , ((_4C , xK_x ), spawnRootTerm)
+
+ , ((_C , xK_Menu ), toggleWS)
+
+ , ((_4 , xK_space ), withFocused $ \w -> ifM (isFloatingX w) xdeny $ sendMessage NextLayout)
+ , ((_4M , xK_space ), withFocused $ \w -> ifM (isFloatingX w) xdeny $ resetLayout)
+
+ , ((_4 , xK_l ), toggleFocus)
+
+ , ((_4 , xK_m ), windows W.focusMaster)
+ , ((_4 , xK_j ), windows W.focusDown)
+ , ((_4 , xK_k ), windows W.focusUp)
+
+ , ((_4S , xK_m ), windows W.swapMaster)
+ , ((_4S , xK_j ), windows W.swapDown)
+ , ((_4S , xK_k ), windows W.swapUp)
+
+ , ((_4M , xK_h ), sendMessage Shrink)
+ , ((_4M , xK_l ), sendMessage Expand)
+
+ , ((_4M , xK_j ), sendMessage MirrorShrink)
+ , ((_4M , xK_k ), sendMessage MirrorExpand)
+
+ , ((_4 , xK_t ), withFocused $ windows . W.sink)
+
+ , ((_4 , xK_comma ), sendMessage $ IncMasterN 1)
+ , ((_4 , xK_period ), sendMessage $ IncMasterN (-1))
+
+ , ((_4 , xK_a ), addWorkspacePrompt promptXPConfig)
+ , ((_4 , xK_r ), renameWorkspace promptXPConfig)
+ , ((_4 , xK_Delete ), removeEmptyWorkspace)
+
+ , ((_4 , xK_Return ), toggleWS)
+
+ , ((0, xF86XK_AudioLowerVolume), audioLowerVolume)
+ , ((0, xF86XK_AudioRaiseVolume), audioRaiseVolume)
+ , ((0, xF86XK_AudioMute), audioMute)
+ , ((0, xF86XK_AudioMicMute), audioMicMute)
+ , ((_4, xF86XK_AudioMute), pavucontrol [])
+
+ , ((_4, xK_Prior), forkFile {-pkg-}"xcalib" ["-invert", "-alter"] Nothing)
+
+ , ((0, xK_Print), forkFile {-pkg:flameshot-once-tv-}"flameshot-once" [] Nothing)
+
+ , ((_C, xF86XK_Forward), forkFile {-pkg:xdpytools-}"xdpychvt" ["next"] Nothing)
+ , ((_C, xF86XK_Back), forkFile {-pkg:xdpytools-}"xdpychvt" ["prev"] Nothing)
+ ]
+ where
+ _4 = mod4Mask
+ _C = controlMask
+ _S = shiftMask
+ _M = mod1Mask
+ _4C = _4 .|. _C
+ _4S = _4 .|. _S
+ _4M = _4 .|. _M
+ _4CM = _4 .|. _C .|. _M
+ _4SM = _4 .|. _S .|. _M
+
+ amixer args = forkFile {-pkg:alsaUtils-}"amixer" args Nothing
+ pavucontrol args = forkFile {-pkg-}"pavucontrol" args Nothing
+
+ audioLowerVolume = amixer ["-q", "sset", "Master", "5%-"]
+ audioRaiseVolume = amixer ["-q", "sset", "Master", "5%+"]
+ audioMute = amixer ["-q", "sset", "Master", "toggle"]
+ audioMicMute = amixer ["-q", "sset", "Capture", "toggle"]
+
+ resetLayout = setLayout $ XMonad.layoutHook conf
+
+ promptXPConfig =
+ def { XMonad.Prompt.font = font }
+
+ xdeny =
+ forkFile
+ {-pkg-}"xterm"
+ [ "-fn", font
+ , "-geometry", "300x100"
+ , "-name", "AlertFloat"
+ , "-bg", "#E4002B"
+ , "-e", "sleep", "0.05"
+ ]
+ Nothing
diff --git a/pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal b/pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal
new file mode 100644
index 0000000..f211627
--- /dev/null
+++ b/pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal
@@ -0,0 +1,29 @@
+name: xmonad-tv
+version: 1.0.0
+license: MIT
+author: tv <tv@krebsco.de>
+maintainer: tv <tv@krebsco.de>
+build-type: Simple
+cabal-version: >=1.10
+
+executable xmonad
+ main-is: main.hs
+ build-depends:
+ base
+ , X11
+ , aeson
+ , bytestring
+ , containers
+ , directory
+ , extra
+ , filepath
+ , pager
+ , unix
+ , xmonad
+ , xmonad-contrib
+ other-modules:
+ Shutdown
+ XMonad.Extra
+ XMonad.Hooks.EwmhDesktops.Extra
+ default-language: Haskell2010
+ ghc-options: -O2 -Wall