Merge branch 'master' of prism.r:stockholm

6 files changed, 364 insertions, 0 deletions

diff --git a/tv/5pkgs/haskell/xmonad-tv/default.nix b/tv/5pkgs/haskell/xmonad-tv/default.nix
new file mode 100644
index 000000000..42eb13d41
--- /dev/null
+++ b/tv/5pkgs/haskell/xmonad-tv/default.nix
@@ -0,0 +1,15 @@
+{ mkDerivation, base, containers, directory, extra, stdenv, unix
+, X11, xmonad, xmonad-contrib, xmonad-stockholm
+}:
+mkDerivation {
+  pname = "xmonad-tv";
+  version = "1.0.0";
+  src = ./src;
+  isLibrary = false;
+  isExecutable = true;
+  executableHaskellDepends = [
+    base containers directory extra unix X11 xmonad xmonad-contrib
+    xmonad-stockholm
+  ];
+  license = stdenv.lib.licenses.mit;
+}
diff --git a/tv/5pkgs/haskell/xmonad-tv/shell.nix b/tv/5pkgs/haskell/xmonad-tv/shell.nix
new file mode 100644
index 000000000..936e69627
--- /dev/null
+++ b/tv/5pkgs/haskell/xmonad-tv/shell.nix
@@ -0,0 +1,78 @@
+{ 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 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
+        "$xmonad" --shutdown
+        cp -b "$CACHEDIR"/xmonad.state "$config_XMONAD_CACHE_DIR"/
+        sudo systemctl start xmonad
+      )}
+
+      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/tv/5pkgs/haskell/xmonad-tv/src/Helpers/Path.hs b/tv/5pkgs/haskell/xmonad-tv/src/Helpers/Path.hs
new file mode 100644
index 000000000..1029d60be
--- /dev/null
+++ b/tv/5pkgs/haskell/xmonad-tv/src/Helpers/Path.hs
@@ -0,0 +1,15 @@
+module Helpers.Path where
+
+import qualified Data.List
+import qualified System.Directory
+import qualified System.IO.Unsafe
+
+
+findExecutable :: String -> FilePath
+findExecutable =
+    System.IO.Unsafe.unsafePerformIO . find
+  where
+    find name =
+        maybe failure id <$> System.Directory.findExecutable name
+      where
+        failure = error (Data.List.intercalate " " [name, "not found"])
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/Paths.hs b/tv/5pkgs/haskell/xmonad-tv/src/Paths.hs
new file mode 100644
index 000000000..3a879b5d0
--- /dev/null
+++ b/tv/5pkgs/haskell/xmonad-tv/src/Paths.hs
@@ -0,0 +1,25 @@
+module Paths where
+
+import Helpers.Path
+
+
+otpmenu :: FilePath
+otpmenu = findExecutable "otpmenu"
+
+pactl :: FilePath
+pactl = findExecutable "pactl"
+
+passmenu :: FilePath
+passmenu = findExecutable "passmenu"
+
+slock :: FilePath
+slock = findExecutable "slock"
+
+su :: FilePath
+su = findExecutable "su"
+
+urxvtc :: FilePath
+urxvtc = findExecutable "urxvtc"
+
+xcalib :: FilePath
+xcalib = findExecutable "xcalib"
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/main.hs b/tv/5pkgs/haskell/xmonad-tv/src/main.hs
new file mode 100644
index 000000000..b7d4e9bca
--- /dev/null
+++ b/tv/5pkgs/haskell/xmonad-tv/src/main.hs
@@ -0,0 +1,206 @@
+{-# LANGUAGE DeriveDataTypeable #-} -- for XS
+{-# LANGUAGE FlexibleContexts #-} -- for xmonad'
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+
+module Main (main) where
+
+import System.Exit (exitFailure)
+
+import Control.Exception
+import Control.Monad.Extra (whenJustM)
+import Graphics.X11.ExtraTypes.XF86
+import Text.Read (readEither)
+import XMonad
+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.NoBorders ( smartBorders )
+import XMonad.Layout.ResizableTile (ResizableTall(ResizableTall))
+import XMonad.Layout.ResizableTile (MirrorResize(MirrorExpand,MirrorShrink))
+import qualified XMonad.StackSet as W
+import Data.Map (Map)
+import qualified Data.Map as Map
+import XMonad.Hooks.UrgencyHook (SpawnUrgencyHook(..), withUrgencyHook)
+import XMonad.Hooks.ManageHelpers (doCenterFloat)
+import XMonad.Hooks.Place (placeHook, smart)
+import XMonad.Actions.PerWorkspaceKeys (chooseAction)
+
+import XMonad.Stockholm.Pager
+import XMonad.Stockholm.Shutdown
+import qualified Paths
+
+
+myFont :: String
+myFont = "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*"
+
+
+main :: IO ()
+main = getArgs >>= \case
+    [] -> mainNoArgs
+    ["--shutdown"] -> shutdown
+    args -> hPutStrLn stderr ("bad arguments: " <> show args) >> exitFailure
+
+
+mainNoArgs :: IO ()
+mainNoArgs = do
+    let width = 1366
+    workspaces0 <- getWorkspaces0
+    handleShutdownEvent <- newShutdownEventHandler
+    xmonad
+        $ withUrgencyHook (SpawnUrgencyHook "echo emit Urgency ")
+        $ def
+            { terminal          = Paths.urxvtc
+            , modMask           = mod4Mask
+            , keys              = myKeys
+            , workspaces        = workspaces0
+            , layoutHook =
+                smartBorders $
+                  ResizableTall
+                    1
+                    (10 * 6 / width)
+                    ((80 * 6 + 2 * (1+1+1))/width) []
+                  |||
+                  Full
+            , manageHook =
+                composeAll
+                  [ appName =? "fzmenu-urxvt" --> doCenterFloat
+                  , appName =? "pinentry" --> doCenterFloat
+                  , placeHook (smart (1,0))
+                  ]
+            , startupHook =
+                whenJustM (io (lookupEnv "XMONAD_STARTUP_HOOK"))
+                          (\path -> forkFile path [] Nothing)
+            , normalBorderColor  = "#1c1c1c"
+            , focusedBorderColor = "#f000b0"
+            , handleEventHook = handleShutdownEvent
+            }
+
+
+getWorkspaces0 :: IO [String]
+getWorkspaces0 =
+    try (getEnv "XMONAD_WORKSPACES0_FILE") >>= \case
+      Left e -> warn (displaySomeException e)
+      Right p -> try (readFile p) >>= \case
+        Left e -> warn (displaySomeException e)
+        Right x -> case readEither x of
+          Left e -> warn e
+          Right y -> return y
+  where
+    warn msg = hPutStrLn stderr ("getWorkspaces0: " ++ msg) >> return []
+
+
+displaySomeException :: SomeException -> String
+displaySomeException = displayException
+
+
+forkFile :: FilePath -> [String] -> Maybe [(String, String)] -> X ()
+forkFile path args env =
+    xfork (executeFile path False args env) >> return ()
+
+
+spawnRootTerm :: X ()
+spawnRootTerm =
+    forkFile
+        Paths.urxvtc
+        ["-name", "root-urxvt", "-e", Paths.su, "-"]
+        Nothing
+
+
+spawnTermAt :: String -> X ()
+spawnTermAt ws = do
+    env <- io getEnvironment
+    let env' = ("XMONAD_SPAWN_WORKSPACE", ws) : env
+    forkFile Paths.urxvtc [] (Just env')
+
+
+myKeys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
+myKeys conf = Map.fromList $
+    [ ((_4  , xK_Escape ), forkFile Paths.slock [] Nothing)
+    , ((_4S , xK_c      ), kill)
+
+    , ((_4  , xK_o      ), forkFile Paths.otpmenu [] Nothing)
+    , ((_4  , xK_p      ), forkFile Paths.passmenu [] Nothing)
+
+    , ((_4  , xK_x      ), chooseAction spawnTermAt)
+    , ((_4C , xK_x      ), spawnRootTerm)
+
+    , ((0   , xK_Menu   ), gets windowset >>= allWorkspaceNames >>= pager pagerConfig (windows . W.view) )
+    , ((_S  , xK_Menu   ), gets windowset >>= allWorkspaceNames >>= pager pagerConfig (windows . W.shift) )
+    , ((_C  , xK_Menu   ), toggleWS)
+
+    , ((_4  , xK_space  ), sendMessage NextLayout)
+    , ((_4M , xK_space  ), resetLayout)
+
+    , ((_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 def)
+    , ((_4  , xK_r      ), renameWorkspace def)
+    , ((_4  , xK_Delete ), removeEmptyWorkspace)
+
+    , ((_4  , xK_Return ), toggleWS)
+
+    , ((0, xF86XK_AudioLowerVolume), audioLowerVolume)
+    , ((0, xF86XK_AudioRaiseVolume), audioRaiseVolume)
+    , ((0, xF86XK_AudioMute), audioMute)
+
+    , ((_4, xK_Prior), forkFile Paths.xcalib ["-invert", "-alter"] 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
+
+    pactl args = forkFile Paths.pactl args Nothing
+    audioLowerVolume = pactl ["--", "set-sink-volume", "@DEFAULT_SINK@", "-5%"]
+    audioRaiseVolume = pactl ["--", "set-sink-volume", "@DEFAULT_SINK@", "+5%"]
+    audioMute = pactl ["--", "set-sink-mute", "@DEFAULT_SINK@", "toggle"]
+
+    resetLayout = setLayout $ XMonad.layoutHook conf
+
+
+pagerConfig :: PagerConfig
+pagerConfig = def
+    { pc_font           = myFont
+    , pc_cellwidth      = 64
+    , pc_matchmethod    = MatchPrefix
+    , pc_windowColors   = windowColors
+    }
+    where
+    windowColors _ _ _ True _ = ("#ef4242","#ff2323")
+    windowColors wsf m c u wf = do
+        let y = defaultWindowColors wsf m c u wf
+        if m == False && wf == True
+            then ("#402020", snd y)
+            else y
+
+
+allWorkspaceNames :: W.StackSet i l a sid sd -> X [i]
+allWorkspaceNames = return . map W.tag . W.workspaces
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal b/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal
new file mode 100644
index 000000000..f10bc4aeb
--- /dev/null
+++ b/tv/5pkgs/haskell/xmonad-tv/src/xmonad-tv.cabal
@@ -0,0 +1,25 @@
+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,
+    containers,
+    directory,
+    extra,
+    unix,
+    X11,
+    xmonad,
+    xmonad-contrib,
+    xmonad-stockholm
+  other-modules:
+    Helpers.Path,
+    Paths
+  default-language: Haskell2010
+  ghc-options: -O2 -Wall -threaded