diff options
Diffstat (limited to 'pkgs')
76 files changed, 3316 insertions, 0 deletions
diff --git a/pkgs/compat/default.nix b/pkgs/compat/default.nix new file mode 100644 index 0000000..0d1e61b --- /dev/null +++ b/pkgs/compat/default.nix @@ -0,0 +1 @@ +self: super: {} diff --git a/pkgs/default.nix b/pkgs/default.nix new file mode 100644 index 0000000..41e17c8 --- /dev/null +++ b/pkgs/default.nix @@ -0,0 +1,24 @@ +self: super: + +let + inherit (super) lib; + + mylib = import ../lib/pure.nix { + inherit lib; + }; + + pushBack = x: xs: + if builtins.elem x xs then + lib.remove x xs ++ [ x ] + else + xs; +in + +# Import files and subdirectories like they are overlays. +lib.fix + (builtins.foldl' (lib.flip lib.extends) (_: super) + (map + (name: import (./. + "/${name}")) + (pushBack "override" + (builtins.attrNames + (lib.filterAttrs mylib.isNixDirEntry (builtins.readDir ./.)))))) 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 #-} + |