stockholm -> hrm

11 files changed, 709 insertions, 0 deletions

diff --git a/pkgs/haskell/default.nix b/pkgs/haskell/default.nix
new file mode 100644
index 0000000..7baaa89
--- /dev/null
+++ b/pkgs/haskell/default.nix
@@ -0,0 +1,31 @@
+let
+  overrides = { lib, mylib }: self: super:
+    mylib.mapNixDir (path: self.callPackage path {}) [
+      ./.
+    ] // {
+      xmonad-tv = self.callPackage ./xmonad-tv {
+        pager = self.desktop-pager;
+      };
+    };
+in
+  self: super: let
+    inherit (super) lib;
+    mylib = import ../../lib/pure.nix {
+      inherit lib;
+    };
+  in {
+    haskell = super.haskell // {
+      packages = lib.mapAttrs (name: value:
+        if builtins.hasAttr "override" value
+          then value.override (old: {
+            overrides =
+              lib.composeExtensions (old.overrides or (_: _: { })) (overrides { inherit lib mylib; });
+          })
+          else value
+      ) super.haskell.packages;
+    };
+    haskellPackages = super.haskellPackages.override (old: {
+      overrides =
+        lib.composeExtensions (old.overrides or (_: _: { })) (overrides { inherit lib mylib; });
+    });
+  }
diff --git a/pkgs/haskell/th-env/default.nix b/pkgs/haskell/th-env/default.nix
new file mode 100644
index 0000000..158fb16
--- /dev/null
+++ b/pkgs/haskell/th-env/default.nix
@@ -0,0 +1,10 @@
+{ mkDerivation, base, lib, template-haskell, text }:
+mkDerivation {
+  pname = "th-env";
+  version = "1.0.0";
+  src = ./.;
+  libraryHaskellDepends = [ base template-haskell text ];
+  homepage = "https://stackoverflow.com/q/57635686";
+  license = "unknown";
+  hydraPlatforms = lib.platforms.none;
+}
diff --git a/pkgs/haskell/th-env/src/THEnv.hs b/pkgs/haskell/th-env/src/THEnv.hs
new file mode 100644
index 0000000..b04f2ce
--- /dev/null
+++ b/pkgs/haskell/th-env/src/THEnv.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE TemplateHaskell #-}
+module THEnv
+    (
+    -- * Compile-time configuration
+      lookupCompileEnv
+    , lookupCompileEnvExp
+    , getCompileEnv
+    , getCompileEnvExp
+    , fileAsString
+    ) where
+
+import Control.Monad
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (Lift(..))
+import System.Environment (getEnvironment)
+
+-- Functions that work with compile-time configuration
+
+-- | Looks up a compile-time environment variable.
+lookupCompileEnv :: String -> Q (Maybe String)
+lookupCompileEnv key = lookup key `liftM` runIO getEnvironment
+
+-- | Looks up a compile-time environment variable. The result is a TH
+-- expression of type @Maybe String@.
+lookupCompileEnvExp :: String -> Q Exp
+lookupCompileEnvExp = (`sigE` [t| Maybe String |]) . lift <=< lookupCompileEnv
+    -- We need to explicly type the result so that things like `print Nothing`
+    -- work.
+
+-- | Looks up an compile-time environment variable and fail, if it's not
+-- present.
+getCompileEnv :: String -> Q String
+getCompileEnv key =
+  lookupCompileEnv key >>=
+  maybe (fail $ "Environment variable " ++ key ++ " not defined") return
+
+-- | Looks up an compile-time environment variable and fail, if it's not
+-- present. The result is a TH expression of type @String@.
+getCompileEnvExp :: String -> Q Exp
+getCompileEnvExp = lift <=< getCompileEnv
+
+-- | Loads the content of a file as a string constant expression.
+-- The given path is relative to the source directory.
+fileAsString :: FilePath -> Q Exp
+fileAsString = do
+  -- addDependentFile path -- works only with template-haskell >= 2.7
+  stringE . T.unpack . T.strip <=< runIO . T.readFile
diff --git a/pkgs/haskell/th-env/th-env.cabal b/pkgs/haskell/th-env/th-env.cabal
new file mode 100644
index 0000000..b9a2cff
--- /dev/null
+++ b/pkgs/haskell/th-env/th-env.cabal
@@ -0,0 +1,20 @@
+name: th-env
+version: 1.0.0
+-- license: https://creativecommons.org/licenses/by-sa/4.0/
+license: OtherLicense
+author: https://stackoverflow.com/users/9348482
+homepage: https://stackoverflow.com/q/57635686
+maintainer: tv <tv@krebsco.de>
+build-type: Simple
+cabal-version: >=1.10
+
+library
+  hs-source-dirs: src
+  build-depends:
+    base,
+    template-haskell,
+    text
+  exposed-modules:
+    THEnv
+  default-language: Haskell2010
+  ghc-options: -O2 -Wall
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