From 37e55957fbf411b928184465acb2b1ecd5ca6852 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 17 Jan 2025 22:20:56 +0100 Subject: mako --- accounts/gkleen@sif/xmonad/.gitignore | 4 - accounts/gkleen@sif/xmonad/default.nix | 7 - accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs | 127 --- .../gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs | 94 --- .../gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs | 105 --- .../gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs | 246 ------ accounts/gkleen@sif/xmonad/package.yaml | 31 - accounts/gkleen@sif/xmonad/stack.nix | 17 - accounts/gkleen@sif/xmonad/stack.yaml | 10 - accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix | 21 - accounts/gkleen@sif/xmonad/xmonad.hs | 939 --------------------- 11 files changed, 1601 deletions(-) delete mode 100644 accounts/gkleen@sif/xmonad/.gitignore delete mode 100644 accounts/gkleen@sif/xmonad/default.nix delete mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs delete mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs delete mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs delete mode 100644 accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs delete mode 100644 accounts/gkleen@sif/xmonad/package.yaml delete mode 100644 accounts/gkleen@sif/xmonad/stack.nix delete mode 100644 accounts/gkleen@sif/xmonad/stack.yaml delete mode 100644 accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix delete mode 100644 accounts/gkleen@sif/xmonad/xmonad.hs (limited to 'accounts/gkleen@sif/xmonad') diff --git a/accounts/gkleen@sif/xmonad/.gitignore b/accounts/gkleen@sif/xmonad/.gitignore deleted file mode 100644 index c11891cd..00000000 --- a/accounts/gkleen@sif/xmonad/.gitignore +++ /dev/null @@ -1,4 +0,0 @@ -**/#*# -**/.stack-work/ -/stack.yaml.lock -/*.cabal diff --git a/accounts/gkleen@sif/xmonad/default.nix b/accounts/gkleen@sif/xmonad/default.nix deleted file mode 100644 index 8790c12f..00000000 --- a/accounts/gkleen@sif/xmonad/default.nix +++ /dev/null @@ -1,7 +0,0 @@ -argumentPackages@{ ... }: - -let - # defaultPackages = (import ./stackage.nix {}); - # haskellPackages = defaultPackages // argumentPackages; - haskellPackages = argumentPackages; -in haskellPackages.callPackage ./xmonad-yggdrasil.nix {} diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs deleted file mode 100644 index e6accdcc..00000000 --- a/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs +++ /dev/null @@ -1,127 +0,0 @@ -{-# LANGUAGE DeriveGeneric, OverloadedLists, OverloadedStrings, ViewPatterns, ExistentialQuantification, MultiWayIf #-} - -module XMonad.Mpv - ( MpvCommand(..), MpvResponse(..), MpvException(..) - , mpv - , mpvDir - , mpvAll, mpvOne - , mpvResponse - ) where - -import Data.Aeson - -import Data.Monoid - -import Network.Socket hiding (recv) -import Network.Socket.ByteString - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as CBS -import qualified Data.ByteString.Lazy as LBS - -import GHC.Generics (Generic) -import Data.Typeable (Typeable) -import Data.String (IsString(..)) - -import Control.Exception - -import System.IO.Temp (getCanonicalTemporaryDirectory) - -import Control.Monad -import Control.Exception (bracket) -import Control.Monad.IO.Class (MonadIO(..)) - -import System.FilePath -import System.Directory (getDirectoryContents) - -import Data.List -import Data.Either -import Data.Maybe - -import Debug.Trace - - -data MpvCommand - = forall a. ToJSON a => MpvSetProperty String a - | MpvGetProperty String -data MpvResponse - = MpvError String - | MpvSuccess (Maybe Value) - deriving (Read, Show, Generic, Eq) -data MpvException = MpvException String - | MpvNoValue - | MpvNoParse String - deriving (Generic, Typeable, Read, Show) -instance Exception MpvException - - -instance ToJSON MpvCommand where - toJSON (MpvSetProperty name val) = Array ["set_property", fromString name, toJSON val] - toJSON (MpvGetProperty name) = Array ["get_property", fromString name] - -instance FromJSON MpvResponse where - parseJSON = withObject "response object" $ \obj -> do - mval <- obj .:? "data" - err <- obj .: "error" - - let ret - | err == "success" = MpvSuccess mval - | otherwise = MpvError err - - return ret - -mpvSocket :: FilePath -> (Socket -> IO a) -> IO a -mpvSocket sockPath = withSocketsDo . bracket mkSock close - where - mkSock = do - sock <- socket AF_UNIX Stream defaultProtocol - connect sock $ SockAddrUnix (traceId sockPath) - return sock - -mpvResponse :: FromJSON v => MpvResponse -> IO v -mpvResponse (MpvError str) = throwIO $ MpvException str -mpvResponse (MpvSuccess Nothing) = throwIO MpvNoValue -mpvResponse (MpvSuccess (Just v)) = case fromJSON v of - Success v' -> return v' - Error str -> throwIO $ MpvNoParse str - -mpv :: FilePath -> MpvCommand -> IO MpvResponse -mpv sockPath cmd = mpvSocket sockPath $ \sock -> do - let message = (`BS.append` "\n") . LBS.toStrict . encode $ Object [("command", toJSON cmd)] - traceIO $ show message - sendAll sock message - let recvAll = do - prefix <- recv sock 4096 - if - | (prefix', rest) <- CBS.break (== '\n') prefix - , not (BS.null rest) -> return prefix' - | BS.null prefix -> return prefix - | otherwise -> BS.append prefix <$> recvAll - response <- recvAll - traceIO $ show response - either (ioError . userError) return . traceShowId $ eitherDecodeStrict' response - -mpvDir :: Exception e => FilePath -> (FilePath -> [(FilePath, Either e MpvResponse)] -> Maybe MpvCommand) -> IO [(FilePath, Either e MpvResponse)] -mpvDir dir step = do - socks <- filter (".sock" `isSuffixOf`) <$> getDirectoryContents dir - go [] socks - where - go acc [] = return acc - go acc (sock:socks) - | Just cmd <- step sock acc = do - res <- try $ mpv (dir sock) cmd - go ((sock, res) : acc) socks - | otherwise = - go acc socks - -mpvAll :: FilePath -> MpvCommand -> IO [MpvResponse] -mpvAll dir cmd = do - results <- map snd <$> (mpvDir dir (\_ _ -> Just cmd) :: IO [(FilePath, Either SomeException MpvResponse)]) - mapM (either throwIO return) results - -mpvOne :: FilePath -> MpvCommand -> IO (Maybe MpvResponse) -mpvOne dir cmd = listToMaybe . snd . partitionEithers . map snd <$> (mpvDir dir step :: IO [(FilePath, Either SomeException MpvResponse)]) - where - step _ results - | any (isRight . snd) results = Nothing - | otherwise = Just cmd diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs deleted file mode 100644 index 1caefae5..00000000 --- a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs +++ /dev/null @@ -1,94 +0,0 @@ -module XMonad.Prompt.MyPass - ( - -- * Usages - -- $usages - mkPassPrompt - ) where - -import Control.Monad (liftM) -import XMonad.Core -import XMonad.Prompt ( XPrompt - , showXPrompt - , commandToComplete - , nextCompletion - , getNextCompletion - , XPConfig - , mkXPrompt - , searchPredicate) -import System.Directory (getHomeDirectory) -import System.FilePath (takeExtension, dropExtension, combine) -import System.Posix.Env (getEnv) -import XMonad.Util.Run (runProcessWithInput) - --- $usages --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Prompt.Pass --- --- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt': --- --- > , ((modMask x , xK_p) , passPrompt xpconfig) --- > , ((modMask x .|. controlMask, xK_p) , passGeneratePrompt xpconfig) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig) --- --- For detailed instructions on: --- --- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". --- --- - how to setup the password storage, see --- - -type Predicate = String -> String -> Bool - -getPassCompl :: [String] -> Predicate -> String -> IO [String] -getPassCompl compls p s - | length s <= minL - , all ((> minL) . length) compls = return [] - | otherwise = do return $ filter (p s) compls - where - minL = 3 - -type PromptLabel = String - -data Pass = Pass PromptLabel - -instance XPrompt Pass where - showXPrompt (Pass prompt) = prompt ++ ": " - commandToComplete _ c = c - nextCompletion _ = getNextCompletion - --- | Default password store folder in $HOME/.password-store --- -passwordStoreFolderDefault :: String -> String -passwordStoreFolderDefault home = combine home ".password-store" - --- | Compute the password store's location. --- Use the PASSWORD_STORE_DIR environment variable to set the password store. --- If empty, return the password store located in user's home. --- -passwordStoreFolder :: IO String -passwordStoreFolder = - getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir - where computePasswordStoreDir Nothing = liftM passwordStoreFolderDefault getHomeDirectory - computePasswordStoreDir (Just storeDir) = return storeDir - --- | A pass prompt factory --- -mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X () -mkPassPrompt promptLabel passwordFunction xpconfig = do - passwords <- io (passwordStoreFolder >>= getPasswords) - mkXPrompt (Pass promptLabel) xpconfig (getPassCompl passwords $ searchPredicate xpconfig) passwordFunction - --- | Retrieve the list of passwords from the password storage 'passwordStoreDir -getPasswords :: FilePath -> IO [String] -getPasswords passwordStoreDir = do - files <- runProcessWithInput "find" [ - passwordStoreDir, - "-type", "f", - "-name", "*.gpg", - "-printf", "%P\n"] [] - return $ map removeGpgExtension $ lines files - -removeGpgExtension :: String -> String -removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file - | otherwise = file diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs deleted file mode 100644 index c268f87d..00000000 --- a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs +++ /dev/null @@ -1,105 +0,0 @@ -module XMonad.Prompt.MyShell - ( Shell (..) - , shellPrompt - , prompt - , safePrompt - , unsafePrompt - , getCommands - , getShellCompl - , split - ) where - -import Codec.Binary.UTF8.String (encodeString) -import Control.Exception as E -import Control.Monad (forM) -import Data.List (isPrefixOf) -import System.Directory (doesDirectoryExist, getDirectoryContents) -import System.Environment (getEnv) -import System.Posix.Files (getFileStatus, isDirectory) - -import XMonad hiding (config) -import XMonad.Prompt -import XMonad.Util.Run - -econst :: Monad m => a -> IOException -> m a -econst = const . return - -data Shell = Shell String - -instance XPrompt Shell where - showXPrompt (Shell q) = q - completionToCommand _ = escape - -shellPrompt :: String -> XPConfig -> X () -shellPrompt q c = do - cmds <- io getCommands - mkXPrompt (Shell q) c (getShellCompl cmds) spawn - -{- $spawns - See safe and unsafeSpawn in "XMonad.Util.Run". - prompt is an alias for safePrompt; - safePrompt and unsafePrompt work on the same principles, but will use - XPrompt to interactively query the user for input; the appearance is - set by passing an XPConfig as the second argument. The first argument - is the program to be run with the interactive input. - You would use these like this: - - > , ((modm, xK_b), safePrompt "firefox" greenXPConfig) - > , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig) - - Note that you want to use safePrompt for Firefox input, as Firefox - wants URLs, and unsafePrompt for the XTerm example because this allows - you to easily start a terminal executing an arbitrary command, like - 'top'. -} - -prompt, unsafePrompt, safePrompt :: String -> FilePath -> XPConfig -> X () -prompt = unsafePrompt -safePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run - where run = safeSpawn c . return -unsafePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run - where run a = unsafeSpawn $ c ++ " " ++ a - -getShellCompl :: [String] -> String -> IO [String] -getShellCompl cmds s | s == "" || last s == ' ' = return [] - | otherwise = do - f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- " - ++ s ++ "\n") - files <- case f of - [x] -> do fs <- getFileStatus (encodeString x) - if isDirectory fs then return [x ++ "/"] - else return [x] - _ -> return f - return . uniqSort $ files ++ commandCompletionFunction cmds s - -commandCompletionFunction :: [String] -> String -> [String] -commandCompletionFunction cmds str | '/' `elem` str = [] - | otherwise = filter (isPrefixOf str) cmds - -getCommands :: IO [String] -getCommands = do - p <- getEnv "PATH" `E.catch` econst [] - let ds = filter (/= "") $ split ':' p - es <- forM ds $ \d -> do - exists <- doesDirectoryExist d - if exists - then getDirectoryContents d - else return [] - return . uniqSort . filter ((/= '.') . head) . concat $ es - -split :: Eq a => a -> [a] -> [[a]] -split _ [] = [] -split e l = - f : split e (rest ls) - where - (f,ls) = span (/=e) l - rest s | s == [] = [] - | otherwise = tail s - -escape :: String -> String -escape [] = "" -escape (x:xs) - | isSpecialChar x = '\\' : x : escape xs - | otherwise = x : escape xs - -isSpecialChar :: Char -> Bool -isSpecialChar = flip elem " &\\@\"'#?$*()[]{};" diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs deleted file mode 100644 index 998c533e..00000000 --- a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs +++ /dev/null @@ -1,246 +0,0 @@ -module XMonad.Prompt.MySsh - ( -- * Usage - -- $usage - sshPrompt, - Ssh, - Override (..), - mkOverride, - Conn (..), - moshCmd, - moshCmd', - sshCmd, - inTmux, - withEnv - ) where - -import XMonad -import XMonad.Util.Run -import XMonad.Prompt - -import System.Directory -import System.Environment -import qualified Control.Exception as E - -import Control.Monad -import Data.Maybe - -import Text.Parsec.String -import Text.Parsec -import Data.Char (isSpace) - -econst :: Monad m => a -> E.IOException -> m a -econst = const . return - --- $usage --- 1. In your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Prompt --- > import XMonad.Prompt.Ssh --- --- 2. In your keybindings add something like: --- --- > , ((modm .|. controlMask, xK_s), sshPrompt defaultXPConfig) --- --- Keep in mind, that if you want to use the completion you have to --- disable the "HashKnownHosts" option in your ssh_config --- --- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". - -data Override = Override - { oUser :: Maybe String - , oHost :: String - , oPort :: Maybe Int - , oCommand :: Conn -> String - } - -mkOverride = Override { oUser = Nothing, oHost = "", oPort = Nothing, oCommand = sshCmd } -sshCmd c = concat - [ "ssh -t " - , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else "" - , cHost c - , if isJust $ cPort c then " -p " ++ (show $ fromJust $ cPort c) else "" - , " -- " - , cCommand c - ] -moshCmd c = concat - [ "mosh " - , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else "" - , cHost c - , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else "" - , " -- " - , cCommand c - ] -moshCmd' p c = concat - [ "mosh " - , "--server=" ++ p ++ " " - , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else "" - , cHost c - , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else "" - , " -- " - , cCommand c - ] -inTmux Nothing c - | null $ cCommand c = c { cCommand = "tmux new-session" } - | otherwise = c { cCommand = "tmux new-session \"" ++ (cCommand c) ++ "\"" } -inTmux (Just h) c - | null $ cCommand c = c { cCommand = "tmux new-session -As " <> h } - | otherwise = c { cCommand = "tmux new-session \"" ++ (cCommand c) ++ "\"" } -withEnv :: [(String, String)] -> Conn -> Conn -withEnv envs c = c { cCommand = "env" ++ (concat $ map (\(n, v) -> ' ' : (n ++ "=" ++ v)) envs) ++ " " ++ (cCommand c) } - -data Conn = Conn - { cUser :: Maybe String - , cHost :: String - , cPort :: Maybe Int - , cCommand :: String - } deriving (Eq, Show, Read) - -data Ssh = Ssh - -instance XPrompt Ssh where - showXPrompt Ssh = "SSH to: " - commandToComplete _ c = c - nextCompletion _ = getNextCompletion - -toConn :: String -> Maybe Conn -toConn = toConn' . parse connParser "(unknown)" -toConn' :: Either ParseError Conn -> Maybe Conn -toConn' (Left _) = Nothing -toConn' (Right a) = Just a - -connParser :: Parser Conn -connParser = do - spaces - user' <- optionMaybe $ try $ do - str <- many1 $ satisfy (\c -> (not $ isSpace c) && (c /= '@')) - char '@' - return str - host' <- many1 $ satisfy (not . isSpace) - port' <- optionMaybe $ try $ do - space - string "-p" - spaces - int <- many1 digit - (space >> return ()) <|> eof - return $ (read int :: Int) - spaces - command' <- many anyChar - eof - return $ Conn - { cHost = host' - , cUser = user' - , cPort = port' - , cCommand = command' - } - -sshPrompt :: [Override] -> XPConfig -> X () -sshPrompt o c = do - sc <- io sshComplList - mkXPrompt Ssh c (mkComplFunFromList c sc) $ ssh o - -ssh :: [Override] -> String -> X () -ssh overrides str = do - let cmd = applyOverrides overrides str - liftIO $ putStr "SSH Command: " - liftIO $ putStrLn cmd - runInTerm "" cmd - -applyOverrides :: [Override] -> String -> String -applyOverrides [] str = "ssh " ++ str -applyOverrides (o:os) str = case (applyOverride o str) of - Just str -> str - Nothing -> applyOverrides os str - -applyOverride :: Override -> String -> Maybe String -applyOverride o str = let - conn = toConn str - in - if isNothing conn then Nothing else - case (fromJust conn) `matches` o of - True -> Just $ (oCommand o) (fromJust conn) - False -> Nothing - -matches :: Conn -> Override -> Bool -a `matches` b = and - [ justBool (cUser a) (oUser b) (==) - , (cHost a) == (oHost b) - , justBool (cPort a) (oPort b) (==) - ] - -justBool :: Eq a => Maybe a -> Maybe a -> (a -> a -> Bool) -> Bool -justBool Nothing _ _ = True -justBool _ Nothing _ = True -justBool (Just a) (Just b) match = a `match` b - -sshComplList :: IO [String] -sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal - -sshComplListLocal :: IO [String] -sshComplListLocal = do - h <- getEnv "HOME" - s1 <- sshComplListFile $ h ++ "/.ssh/known_hosts" - s2 <- sshComplListConf $ h ++ "/.ssh/config" - return $ s1 ++ s2 - -sshComplListGlobal :: IO [String] -sshComplListGlobal = do - env <- getEnv "SSH_KNOWN_HOSTS" `E.catch` econst "/nonexistent" - fs <- mapM fileExists [ env - , "/usr/local/etc/ssh/ssh_known_hosts" - , "/usr/local/etc/ssh_known_hosts" - , "/etc/ssh/ssh_known_hosts" - , "/etc/ssh_known_hosts" - ] - case catMaybes fs of - [] -> return [] - (f:_) -> sshComplListFile' f - -sshComplListFile :: String -> IO [String] -sshComplListFile kh = do - f <- doesFileExist kh - if f then sshComplListFile' kh - else return [] - -sshComplListFile' :: String -> IO [String] -sshComplListFile' kh = do - l <- readFile kh - return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words) - $ filter nonComment - $ lines l - -sshComplListConf :: String -> IO [String] -sshComplListConf kh = do - f <- doesFileExist kh - if f then sshComplListConf' kh - else return [] - -sshComplListConf' :: String -> IO [String] -sshComplListConf' kh = do - l <- readFile kh - return $ map (!!1) - $ filter isHost - $ map words - $ lines l - where - isHost ws = take 1 ws == ["Host"] && length ws > 1 - -fileExists :: String -> IO (Maybe String) -fileExists kh = do - f <- doesFileExist kh - if f then return $ Just kh - else return Nothing - -nonComment :: String -> Bool -nonComment [] = False -nonComment ('#':_) = False -nonComment ('|':_) = False -- hashed, undecodeable -nonComment _ = True - -getWithPort :: String -> String -getWithPort ('[':str) = host ++ " -p " ++ port - where (host,p) = break (==']') str - port = case p of - ']':':':x -> x - _ -> "22" -getWithPort str = str diff --git a/accounts/gkleen@sif/xmonad/package.yaml b/accounts/gkleen@sif/xmonad/package.yaml deleted file mode 100644 index f65137af..00000000 --- a/accounts/gkleen@sif/xmonad/package.yaml +++ /dev/null @@ -1,31 +0,0 @@ -name: xmonad-yggdrasil - -executables: - xmonad: - dependencies: - - base - - xmonad - - xmonad-contrib - - aeson - - bytestring - - text - - temporary - - filepath - - directory - - network - - unix - - utf8-string - - parsec - - process - - mtl - - X11 - - transformers - - containers - - hostname - - libnotify - - taffybar - - main: xmonad.hs - source-dirs: - - . - - lib diff --git a/accounts/gkleen@sif/xmonad/stack.nix b/accounts/gkleen@sif/xmonad/stack.nix deleted file mode 100644 index 17a49e04..00000000 --- a/accounts/gkleen@sif/xmonad/stack.nix +++ /dev/null @@ -1,17 +0,0 @@ -{ ghc, nixpkgs ? import ./nixpkgs.nix {} }: - -let - haskellPackages = import ./stackage.nix { inherit nixpkgs; }; - inherit (nixpkgs {}) pkgs; -in pkgs.haskell.lib.buildStackProject { - inherit ghc; - inherit (haskellPackages) stack; - name = "stackenv"; - buildInputs = (with pkgs; - [ xorg.libX11 xorg.libXrandr xorg.libXinerama xorg.libXScrnSaver xorg.libXext xorg.libXft - cairo - glib - ]) ++ (with haskellPackages; - [ - ]); -} diff --git a/accounts/gkleen@sif/xmonad/stack.yaml b/accounts/gkleen@sif/xmonad/stack.yaml deleted file mode 100644 index b8ed1147..00000000 --- a/accounts/gkleen@sif/xmonad/stack.yaml +++ /dev/null @@ -1,10 +0,0 @@ -nix: - enable: true - shell-file: stack.nix - -resolver: lts-13.21 - -packages: - - . - -extra-deps: [] diff --git a/accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix b/accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix deleted file mode 100644 index 7c853619..00000000 --- a/accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix +++ /dev/null @@ -1,21 +0,0 @@ -{ mkDerivation, aeson, base, bytestring, containers, directory -, filepath, hostname, hpack, mtl, network, parsec, process, lib -, temporary, transformers, unix, utf8-string, X11, xmonad -, xmonad-contrib, libnotify, taffybar -}: -mkDerivation { - pname = "xmonad-yggdrasil"; - version = "0.0.0"; - src = ./.; - isLibrary = false; - isExecutable = true; - libraryToolDepends = [ hpack ]; - executableHaskellDepends = [ - aeson base bytestring containers directory filepath hostname mtl - network parsec process temporary transformers unix utf8-string X11 - xmonad xmonad-contrib libnotify taffybar - ]; - preConfigure = "hpack"; - license = "unknown"; - hydraPlatforms = lib.platforms.none; -} diff --git a/accounts/gkleen@sif/xmonad/xmonad.hs b/accounts/gkleen@sif/xmonad/xmonad.hs deleted file mode 100644 index a44d3bb7..00000000 --- a/accounts/gkleen@sif/xmonad/xmonad.hs +++ /dev/null @@ -1,939 +0,0 @@ -{-# LANGUAGE TupleSections, ViewPatterns, OverloadedStrings, FlexibleInstances, UndecidableInstances, MultiWayIf, NumDecimals #-} - -import XMonad -import XMonad.Hooks.DynamicLog -import XMonad.Hooks.ManageDocks -import XMonad.Util.Run hiding (proc) -import XMonad.Util.Loggers -import XMonad.Util.EZConfig(additionalKeys) -import System.IO -import System.IO.Error -import System.Environment -import Data.Map (Map) -import qualified Data.Map as Map -import qualified XMonad.StackSet as W -import System.Exit -import Control.Monad.State (get) --- import XMonad.Layout.Spiral -import Data.Ratio -import Data.List -import Data.Char -import Data.Maybe (fromMaybe, listToMaybe, maybeToList, catMaybes, isJust) -import XMonad.Layout.Tabbed -import XMonad.Prompt -import XMonad.Prompt.Input -import XMonad.Util.Scratchpad -import XMonad.Util.NamedScratchpad -import XMonad.Util.Ungrab -import Control.Monad (sequence, liftM, liftM2, join, void) -import XMonad.Util.WorkspaceCompare -import XMonad.Layout.NoBorders -import XMonad.Layout.PerWorkspace -import XMonad.Layout.SimplestFloat -import XMonad.Layout.Renamed -import XMonad.Layout.Reflect -import XMonad.Layout.OnHost -import XMonad.Layout.Combo -import XMonad.Layout.ComboP -import XMonad.Layout.Column -import XMonad.Layout.TwoPane -import XMonad.Layout.IfMax -import XMonad.Layout.LayoutBuilder -import XMonad.Layout.WindowNavigation -import XMonad.Layout.Dwindle -import XMonad.Layout.TrackFloating -import System.Process -import System.Directory (removeFile) -import System.Posix.Files -import System.FilePath (()) -import Control.Concurrent -import System.Posix.Process (getProcessID) -import System.IO.Error -import System.IO -import XMonad.Hooks.ManageHelpers hiding (CW) -import XMonad.Hooks.UrgencyHook as U -import XMonad.Hooks.EwmhDesktops -import XMonad.StackSet (RationalRect (..)) -import Control.Monad (when, filterM, (<=<)) -import Graphics.X11.ExtraTypes.XF86 -import XMonad.Util.Cursor -import XMonad.Actions.Warp -import XMonad.Actions.FloatKeys -import XMonad.Util.SpawnOnce -import System.Directory -import System.FilePath -import XMonad.Actions.CopyWindow -import XMonad.Hooks.ServerMode -import XMonad.Actions.Commands -import XMonad.Actions.CycleWS -import XMonad.Actions.RotSlaves -import XMonad.Actions.UpdatePointer -import XMonad.Prompt.Window -import Data.IORef -import Data.Monoid -import Data.String -import qualified XMonad.Actions.PhysicalScreens as P - -import XMonad.Layout.IM - -import System.Taffybar.Support.PagerHints (pagerHints) - -import XMonad.Prompt.MyShell -import XMonad.Prompt.MyPass -import XMonad.Prompt.MySsh - -import XMonad.Mpv - -import Network.HostName - -import Control.Applicative ((<$>)) - -import Libnotify as Notify hiding (appName) -import qualified Libnotify as Notify (appName) -import Libnotify (Notification) --- import System.Information.Battery - -import Data.Int (Int32) - -import System.Posix.Process -import System.Posix.Signals -import System.Posix.IO as Posix -import Control.Exception - -import System.IO.Unsafe - -import Control.Monad.Trans.Class -import Control.Monad.Trans.Maybe - -import Data.Fixed (Micro) - -import qualified Data.Text as Text -import Data.Ord (comparing) -import Debug.Trace - -instance MonadIO m => IsString (m ()) where - fromString = spawn - -type KeyMap = Map (ButtonMask, KeySym) (X ()) - -data Host = Host - { hName :: HostName - , hManageHook :: ManageHook - , hWsp :: Integer -> WorkspaceId - , hCoWsp :: String -> Maybe WorkspaceId - , hKeysMod :: XConfig Layout -> (KeyMap -> KeyMap) - , hScreens :: [P.PhysicalScreen] - , hKbLayouts :: [(String, Maybe String)] - , hCmds :: X [(String, X ())] - , hKeyUpKeys :: XConfig Layout -> KeyMap - } - -defaultHost = Host { hName = "unkown" - , hManageHook = composeOne [manageScratchTerm] - , hWsp = show - , hCoWsp = const Nothing - , hKeysMod = const id - , hScreens = [0,1..] - , hKbLayouts = [ ("us", Just "dvp") - , ("us", Nothing) - , ("de", Nothing) - ] - , hCmds = return [] - , hKeyUpKeys = const Map.empty - } - -browser :: String -browser = "env MOZ_USE_XINPUT2=1 firefox" - -gray, darkGray, red, green :: String -gray = "#808080" -darkGray = "#202020" -red = "#800000" -green = "#008000" - -hostFromName :: HostName -> Host -hostFromName h@("vali") = defaultHost { hName = h - , hManageHook = composeOne $ catMaybes [ Just manageScratchTerm - , assign "web" $ className =? ".dwb-wrapped" - , assign "web" $ className =? "Chromium" - , assign "work" $ className =? "Emacs" - , assign "media" $ className =? "mpv" - ] - , hWsp = hWsp - , hCoWsp = hCoWsp - , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_d, ["chromium", "chromium $(xclip -o)"]) - , (xK_e, ["emacsclient -c"]) - ]) - `Map.union` - ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), scratchpadSpawnActionCustom $ (XMonad.terminal conf) ++ " -name scratchpad -title scratchpad -e tmux new-session -D -s scratch") - ] ) - , hScreens = hScreens defaultHost - } - where - workspaceNames = Map.fromList [ (2, "web") - , (3, "work") - , (10, "media") - ] - hWsp = wspFromMap workspaceNames - hCoWsp = coWspFromMap workspaceNames - assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp -hostFromName h - | h `elem` ["hel", "sif"] = defaultHost { hName = h - , hManageHook = namedScratchpadManageHook scratchpads <+> composeOne (catMaybes - [ assign "mpv" $ className =? "mpv" - , assign "mpv" $ stringProperty "WM_WINDOW_ROLE" =? "presentation" - , assign "read" $ stringProperty "WM_WINDOW_ROLE" =? "presenter" - , assign "mpv" $ className =? "factorio" - , assign "mpv" $ resource =? "twitch" - , assign "web" $ className =? "chromium-browser" - , assign "web" $ className =? "Google-chrome" - , assign "work" $ (appName =? "Devtools" <&&> className =? "firefox") - , assign "work" $ className =? "Postman" - , assign "web" $ (appName =? "Navigator" <&&> className =? "firefox") - , assign "comm" $ (className =? "Emacs" <&&> title =? "Mail") - , assign "comm" $ className =? "Zulip" - , assign "comm" $ className =? "Element" - , assign "comm" $ className =? "Rocket.Chat" - , assign "comm" $ className =? "Discord" - , assign "comm" $ className =? "Rainbow" - , assign "media" $ resource =? "media" - , assign "monitor" $ className =? "Grafana" - , assign "monitor" $ className =? "Virt-viewer" - , assign "monitor" $ resource =? "htop" - , assign "monitor" $ resource =? "monitor" - , assign "monitor" $ className =? "xfreerdp" - , assign "monitor" $ className =? "org.remmina.Remmina" - , Just $ resource =? "htop" -?> centerFloat - , Just $ (className =? "Scp-dbus-service.py") -?> centerFloat - , Just $ resource =? "log" -?> centerFloat - , assign "work" $ className =? "Alacritty" - , Just $ (appName =? "Edit with Emacs FRAME") -?> centerFloat - , assign' ["work", "uni"] $ (className =? "Emacs" <&&> appName /=? "Edit with Emacs FRAME") - , assign' ["work", "uni"] $ className =? "jetbrains-idea-ce" - , assign "read" $ className =? "llpp" - , assign "read" $ className =? "Evince" - , assign "read" $ className =? "Zathura" - , assign "read" $ className =? "MuPDF" - , assign "read" $ className =? "Xournal" - , assign "read" $ appName =? "libreoffice" - , assign "read" $ appName =? "com-trollworks-gcs-app-GCS" - , assign "read" $ appName =? "Tux.py" - , assign "read" $ className =? "Gnucash" - , assign "comm" $ className =? "Skype" - , assign "comm" $ className =? "Daily" - , assign "comm" $ className =? "Pidgin" - , assign "comm" $ className =? "Thunderbird" - , assign "comm" $ className =? "Slack" - , Just $ (resource =? "xvkbd") -?> doRectFloat $ RationalRect (1 % 8) (3 % 8) (6 % 8) (4 % 8) - , Just $ (stringProperty "_NET_WM_WINDOW_TYPE" =? "_NET_WM_WINDOW_TYPE_DIALOG") -?> doFloat - , Just $ (className =? "Dunst") -?> doFloat - , Just $ (className =? "Xmessage") -?> doCenterFloat - , Just $ (className =? "Nm-openconnect-auth-dialog") -?> centerFloat - , Just $ (className =? "Pinentry") -?> doCenterFloat - , Just $ (className =? "pinentry") -?> doCenterFloat - , Just $ (stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooseDialog") -?> centerFloatSmall - , Just $ (className =? "Nvidia-settings") -?> doCenterFloat - , Just $ fmap ("Minetest" `isInfixOf`) title -?> doIgnore - , Just $ fmap ("Automachef" `isInfixOf`) title -?> doIgnore - , assign "call" $ className =? "zoom" - ]) - , hWsp = hWsp - , hCoWsp = hCoWsp - , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_e, ["emacsclient -c"]) - , (xK_d, [fromString browser, "google-chrome" {- , "notmuch-links" -}]) - , (xK_c, [ inputPrompt xPConfigMonospace "dc" ?+ dc ]) - , (xK_g, ["pidgin"]) - , (xK_s, ["skype"]) - -- , (xK_p, [mkPassPrompt "Type password" pwType xPConfig, mkPassPrompt "Show password" pwShow xPConfig, mkPassPrompt "Copy password" pwClip xPConfig]) - , (xK_w, ["sudo rewacom"]) - , (xK_y, [ "tmux new-window -dt media /var/media/link.hs $(xclip -o)" - , "tmux new-window -dt media /var/media/download.hs $(xclip -o)" - , "tmux new-window -dt media /var/media/download.hs $(xclip -o -selection clipboard)" - ]) - , (xK_l, [ "tmux new-window -dt media mpv $(xclip -o)" - , "tmux new-window -dt media mpv $(xclip -o -selection clipboard)" - , "alacritty --class media -e tmuxp load /var/media" - ]) - {- , (xK_m, [ "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch)'" - , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch-mua-new-mail)'" - , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e \"(browse-url-mail \"$(xclip -o)\")\"" - ]) -} - , (xK_Return, ["keynav start,windowzoom", "keynav start"]) - , (xK_t, [inputPrompt xPConfigMonospace "fuzzytime timer" ?+ fuzzytime, fuzzytime "unset", work_fuzzytime]) - , (xK_a, [inputPrompt xPConfigMonospace "adjmix" ?+ adjmix]) - , (xK_s, [ inputPromptWithCompl xPConfigMonospace "start synergy" synergyCompl ?+ synergyStart - , inputPromptWithCompl xPConfigMonospace "stop synergy" synergyCompl ?+ synergyStop - ]) - , (xK_h, [ "alacritty --class htop -e htop" - , "alacritty --class log -e journalctl -xef" - ]) - , (xK_x, [ "autorandr -c" - , "autorandr -fl def" - ]) - , (xK_z, [ "zulip -- --force-device-scale-factor=2" - ]) - ]) - `Map.union` - ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), namedScratchpadAction scratchpads "term") - , ((XMonad.modMask conf .|. controlMask, xK_a), namedScratchpadAction scratchpads "pavucontrol") - , ((XMonad.modMask conf .|. controlMask, xK_o), namedScratchpadAction scratchpads "easyeffects") - , ((XMonad.modMask conf .|. controlMask .|. shiftMask, xK_o), namedScratchpadAction scratchpads "helvum") - , ((XMonad.modMask conf .|. controlMask, xK_w), namedScratchpadAction scratchpads "alarms") - , ((XMonad.modMask conf .|. controlMask, xK_b), namedScratchpadAction scratchpads "blueman") - , ((XMonad.modMask conf .|. controlMask, xK_p), namedScratchpadAction scratchpads "keepassxc") - , ((XMonad.modMask conf .|. controlMask, xK_t), namedScratchpadAction scratchpads "toggl") - , ((XMonad.modMask conf .|. controlMask, xK_e), namedScratchpadAction scratchpads "emacs") - , ((XMonad.modMask conf .|. controlMask, xK_m), namedScratchpadAction scratchpads "calendar") - , ((XMonad.modMask conf .|. controlMask, xK_f), namedScratchpadAction scratchpads "music") - , ((XMonad.modMask conf .|. mod1Mask, xK_Up), rotate U) - , ((XMonad.modMask conf .|. mod1Mask, xK_Down), rotate D) - , ((XMonad.modMask conf .|. mod1Mask, xK_Left), rotate L) - , ((XMonad.modMask conf .|. mod1Mask, xK_Right), rotate R) - , ((controlMask, xK_space ), "dunstctl close" ) - , ((controlMask .|. shiftMask, xK_space ), "dunstctl close-all" ) - , ((controlMask, xK_period), "dunstctl context" ) - , ((controlMask, xK_comma ), "dunstctl history-pop") - -- , ((XMonad.modMask conf .|. shiftMask, xK_a), startMute "hel") - ] ) - , hKeyUpKeys = \conf -> Map.fromList [ -- ((XMonad.modMask conf .|. shiftMask, xK_a), stopMute "hel") - ] - , hScreens = hScreens defaultHost - , hCmds = return [ ("prev-workspace", prevWS) - , ("next-workspace", nextWS) - , ("prev-window", rotAllDown) - , ("next-window", rotAllUp) - , ("banish", banishScreen LowerRight) - , ("update-gpg-tty", safeSpawn "gpg-connect-agent" ["UPDATESTARTUPTTY", "/bye"]) - , ("rescreen", rescreen) - , ("repanel", do - spawn "nm-applet" - spawn "blueman-applet" - spawn "pasystray" - spawn "kdeconnect-indicator" - spawn "dunst -print" - spawn "udiskie" - spawn "autocutsel -s PRIMARY" - spawn "autocutsel -s CLIPBOARD" - ) - , ("pause", mediaMpv $ MpvSetProperty "pause" True) - , ("unpause", mediaMpv $ MpvSetProperty "pause" False) - , ("exit", io $ exitWith ExitSuccess) - ] - } - where - withGdkScale act = void . xfork $ setEnv "GDK_SCALE" "2" >> act - workspaceNames = Map.fromList [ (1, "comm") - , (2, "web") - , (3, "work") - , (4, "read") - , (5, "monitor") - , (6, "uni") - , (8, "call") - , (9, "media") - , (10, "mpv") - ] - scratchpads = [ NS "term" "alacritty --class scratchpad --title scratchpad -e tmux new-session -AD -s scratch" (resource =? "scratchpad") centerFloat - , NS "pavucontrol" "pavucontrol" (resource =? "pavucontrol") centerFloat - , NS "helvum" "helvum" (resource =? "helvum") centerFloat - , NS "easyeffects" "easyeffects" (resource =? "easyeffects") centerFloat - , NS "alarms" "alarm-clock-applet" (className =? "Alarm-clock-applet" <&&> title =? "Alarms") centerFloat - , NS "blueman" "blueman-manager" (className =? ".blueman-manager-wrapped") centerFloat - , NS "keepassxc" "keepassxc" (className =? "KeePassXC") centerFloat - , NS "toggl" "toggldesktop" (className =? "Toggl Desktop") centerFloat - , NS "calendar" "minetime -- --force-device-scale-factor=1.6" (className =? "MineTime") centerFloat - , NS "emacs" "emacsclient -c -F \"'(title . \\\"Scratchpad\\\")\"" (className =? "Emacs" <&&> title =? "Scratchpad") centerFloat - , NS "music" "ytmdesktop" (className =? "youtube-music-desktop-app") centerFloat - ] - centerFloat = customFloating $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8) - centerFloatSmall = customFloating $ RationalRect (1 % 4) (1 % 4) (1 % 2) (1 % 2) - hWsp = wspFromMap workspaceNames - hCoWsp = coWspFromMap workspaceNames - assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp - assign' :: [String] -> Query Bool -> Maybe MaybeManageHook - assign' wsps test = do - wsIds <- mapM hCoWsp wsps - return $ test -?> go wsIds - where - go :: [WorkspaceId] -> ManageHook - go wsps = do - visWsps <- liftX $ (\wset -> W.tag . W.workspace <$> W.current wset : W.visible wset) <$> gets windowset - case (filter (`elem` visWsps) wsps, wsps) of - (wsp : _, _) -> doShift wsp - (_, wsp : _) -> doShift wsp - ([], []) -> return mempty - rotate rot = do - safeSpawn "xrandr" ["--output", "eDP-1", "--rotate", xrandrDir] - mapM_ rotTouch touchscreens - where - xrandrDir = case rot of - U -> "normal" - L -> "left" - R -> "right" - D -> "inverted" - matrix = case rot of - U -> [ [ 1, 0, 0] - , [ 0, 1, 0] - , [ 0, 0, 1] - ] - L -> [ [ 0, -1, 1] - , [ 1, 0, 0] - , [ 0, 0, 1] - ] - R -> [ [ 0, 1, 0] - , [-1, 0, 1] - , [ 0, 0, 1] - ] - D -> [ [-1, 0, 1] - , [ 0, -1, 1] - , [ 0, 0, 1] - ] - touchscreens = [ "Wacom Co.,Ltd. Pen and multitouch sensor Finger touch" - , "Wacom Co.,Ltd. Pen and multitouch sensor Pen stylus" - , "Wacom Co.,Ltd. Pen and multitouch sensor Pen eraser" - ] - rotTouch screen = do - safeSpawn "xinput" $ ["set-prop", screen, "Coordinate Transformation Matrix"] ++ map (\n -> show n ++ ",") (concat matrix) - safeSpawn "xinput" ["map-to-output", screen, "eDP-1"] - withPw f label = io . void . forkProcess $ do - uninstallSignalHandlers - void $ createSession - (dropWhileEnd isSpace -> pw) <- readCreateProcess (proc "pass" ["show", label]) "" - void $ f pw - pwType :: String -> X () - pwType = withPw $ readCreateProcess (proc "xdotool" ["type", "--clearmodifiers", "--file", "-"]) - pwClip label = safeSpawn "pass" ["show", "--clip", label] - pwShow :: String -> X () - pwShow = withPw $ \pw -> do - xmessage <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE") - readCreateProcess (proc xmessage ["-file", "-"]) pw - fuzzytime str = safeSpawn "fuzzytime" $ "timer" : words str - work_fuzzytime = io . void . forkProcess $ do - readCreateProcess (proc "worktime" []) "" >>= safeSpawn "fuzzytime" . ("timer" : ) . pure - adjmix str = safeSpawn "adjmix" $ words str - dc expr = void . xfork $ do - result <- readProcess "dc" [] $ expr ++ "f" - let - (first : rest) = filter (not . null) $ lines result - notification = Notify.summary first <> Notify.body (unlines rest) <> Notify.timeout Infinite <> Notify.urgency Normal <> Notify.appName "dc" - void $ Notify.display notification - synergyCompl = mkComplFunFromList' xPConfigMonospace ["mathw86"] - synergyStart host = safeSpawn "systemctl" ["--user", "start", "synergy-rtunnel@" ++ host ++ ".service"] - synergyStop host = safeSpawn "systemctl" ["--user", "stop", "synergy-rtunnel@" ++ host ++ ".service"] - -hostFromName _ = defaultHost - --- muteRef :: IORef (Maybe (String, Notification)) --- {-# NOINLINE muteRef #-} --- muteRef = unsafePerformIO $ newIORef Nothing - --- startMute, stopMute :: String -> X () --- startMute sink = liftIO $ do --- muted <- isJust <$> readIORef muteRef --- when (not muted) $ do --- let --- notification = Notify.summary "Muted" <> Notify.timeout Infinite <> Notify.urgency Normal --- level = "0.0dB" --- -- level <- runProcessWithInput "ssh" ["bragi", "cat", "/dev/shm/mix/" ++ sink ++ "/level"] "" --- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", "0"] --- hPutStrLn stderr "Mute" --- writeIORef muteRef . Just . (level, ) =<< Notify.display notification --- stopMute sink = liftIO $ do --- let --- unmute (Just (level, notification)) = do --- hPutStrLn stderr "Unmute" --- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", level] --- Notify.close notification --- unmute Nothing = return () --- muted <- isJust <$> readIORef muteRef --- when muted . join . atomicModifyIORef muteRef $ (Nothing, ) . unmute - -wspFromMap workspaceNames = \i -> case Map.lookup i workspaceNames of - Just str -> show i ++ " " ++ str - Nothing -> show i - -coWspFromMap workspaceNames = \str -> case filter ((== str) . snd) $ Map.toList workspaceNames of - [] -> Nothing - [(i, _)] -> Just $ wspFromMap workspaceNames i - _ -> Nothing - -spawnModifiers = [0, controlMask, shiftMask .|. controlMask] -spawnBindings :: XConfig layout -> (KeySym, [X ()]) -> [((KeyMask, KeySym), X ())] -spawnBindings conf (k, cmds) = zipWith (\m cmd -> ((modm .|. mod1Mask .|. m, k), cmd)) spawnModifiers cmds - where - modm = XMonad.modMask conf - -manageScratchTerm = (resource =? "scratchpad" <||> resource =? "keysetup") -?> doRectFloat $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8) - -tabbedLayout t = renamed [Replace "Tabbed"] $ reflectHoriz $ t CustomShrink $ tabbedTheme -tabbedLayoutHoriz t = renamed [Replace "Tabbed Horiz"] $ reflectVert $ t CustomShrink $ tabbedTheme -tabbedTheme = def - { activeColor = "black" - , inactiveColor = "black" - , urgentColor = "black" - , activeBorderColor = gray - , inactiveBorderColor = darkGray - , urgentBorderColor = red - , activeTextColor = gray - , inactiveTextColor = gray - , urgentTextColor = gray - , decoHeight = 32 - , fontName = "xft:Fira Sans:pixelsize=21" - } - -main :: IO () -main = do - arguments <- either (const []) id <$> tryIOError getArgs - case arguments of - ["--command", s] -> do - d <- openDisplay "" - rw <- rootWindow d $ defaultScreen d - a <- internAtom d "XMONAD_COMMAND" False - m <- internAtom d s False - allocaXEvent $ \e -> do - setEventType e clientMessage - setClientMessageEvent e rw a 32 m currentTime - sendEvent d rw False structureNotifyMask e - sync d False - _ -> do - -- batteryMon <- xfork $ monitorBattery Nothing Nothing - hostname <- getHostName - let - host = hostFromName hostname - setEnv "HOST" hostname - let myConfig = withHostUrgency . ewmhFullscreen . ewmh . pagerHints $ docks def - { manageHook = hManageHook host - , terminal = "alacritty" - , layoutHook = smartBorders . avoidStruts $ windowNavigation layout' - , logHook = do - dynamicLogString xmobarPP' >>= writeProps - updatePointer (99 % 100, 98 % 100) (0, 0) - , modMask = mod4Mask - , keys = \conf -> hKeysMod host conf $ myKeys' conf host - , workspaces = take (length numKeys) $ map wsp [1..] - , startupHook = setDefaultCursor xC_left_ptr - , normalBorderColor = darkGray - , focusedBorderColor = gray - , handleEventHook = serverModeEventHookCmd' (hCmds host) <+> keyUpEventHook - } - writeProps str = do - let encodeCChar = map $ fromIntegral . fromEnum - atoms = [ "_XMONAD_WORKSPACES" - , "_XMONAD_LAYOUT" - , "_XMONAD_TITLE" - ] - (flip mapM_) (zip atoms (lines str)) $ \(atom', content) -> do - ustring <- getAtom "UTF8_STRING" - atom <- getAtom atom' - withDisplay $ \dpy -> io $ do - root <- rootWindow dpy $ defaultScreen dpy - changeProperty8 dpy root atom ustring propModeReplace $ encodeCChar content - sync dpy True - wsp = hWsp host - -- We can´t define per-host layout modifiers because we lack dependent types - layout' = onHost "skadhi" ( onWorkspace (wsp 1) (Full ||| withIM (1%5) (Title "Buddy List") tabbedLayout') $ - onWorkspace (wsp 10) Full $ - onWorkspace (wsp 2) (Full ||| tabbedLayout') $ - onWorkspace (wsp 5) tabbedLayout' $ - onWorkspace (wsp 8) (withIM (1%5) (Title "Friends") tabbedLayout') $ - defaultLayouts - ) $ - onHost "vali" ( onWorkspace (wsp 2) (Full ||| tabbedLayout' ||| combineTwo (TwoPane 0.01 0.57) Full tabbedLayout') $ - onWorkspace (wsp 3) workLayouts $ - defaultLayouts - ) $ - onHost "hel" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $ - onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ - onWorkspace (wsp 3) workLayouts $ - onWorkspace (wsp 6) workLayouts $ - onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $ - onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ - onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $ - defaultLayouts - ) $ - onHost "sif" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $ - onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ - onWorkspace (wsp 3) workLayouts $ - onWorkspace (wsp 6) workLayouts $ - onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $ - onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ - onWorkspace (wsp 8) tabbedLayout''' $ - onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $ - defaultLayouts - ) $ - defaultLayouts - -- tabbedLayout''' = renamed [Replace "Tabbed'"] $ IfMax 1 (noBorders Full) (tabbedLayout tabbedBottomAlways) - tabbedLayout''' = tabbedLayout tabbedBottom - tabbedLayout' = tabbedLayout tabbedBottomAlways - tabbedLayoutHoriz' = tabbedLayoutHoriz tabbedLeftAlways - defaultLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW 1 (5 % 100) ||| tabbedLayout' ||| Full - -- workLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW (2 % 1) (5 % 100) ||| tabbedLayout' ||| Full - workLayouts = tabbedLayout' ||| (renamed [Replace "Combined"] $ combineTwoP (TwoPane (1 % 100) (1891 % 2560)) tabbedLayout''' (Column 1.6) (ClassName "Postman" `Or` ClassName "Emacs" `Or` ClassName "jetbrains-idea-ce" `Or` (Resource "Devtools" `And` ClassName "Firefox"))) ||| Full ||| Dwindle R CW 1 (5 % 100) - sqrtTwo = approxRational (sqrt 2) (1 / 2560) - xmobarPP' = xmobarPP { ppTitle = shorten 80 - , ppSort = (liftM2 (.)) getSortByIndex $ return scratchpadFilterOutWorkspace - , ppUrgent = wrap "(" ")" . xmobarColor "#800000" "" - , ppHiddenNoWindows = xmobarColor "#202020" "" . wrap "(" ")" - , ppVisible = wrap "(" ")" . xmobarColor "#808000" "" - , ppCurrent = wrap "(" ")" . xmobarColor "#008000" "" - , ppHidden = wrap "(" ")" - , ppWsSep = " " - , ppSep = "\n" - } - withHostUrgency = case hostname of - "sif" -> withUrgencyHookC urgencyHook' $ def { suppressWhen = U.Never, remindWhen = Every 2 } - _ -> id - urgencyHook' window = do - let blinkLight = (lightHigh >> threadDelay 0.5e6) `finally` lightLow - where - lightHigh = - writeFile "/sys/class/leds/input0::capslock/brightness" =<< readFile "/sys/class/leds/input0::capslock/max_brightness" - lightLow = writeFile "/sys/class/leds/input0::capslock/brightness" "0" - runQuery ((resource =? "comm" <||> resource =? "Pidgin" <||> className =? "Gajim" <||> className =? "Skype" <||> className =? "Thunderbird") --> void (xfork blinkLight)) window - urgencyHook (BorderUrgencyHook { urgencyBorderColor = red }) window - shutdown :: SomeException -> IO a - shutdown e = do - let pids = [ -- batteryMon - ] - mapM_ (signalProcess sigTERM) pids - mapM_ (getProcessStatus False False) pids - throw e - keyUpEventHook :: Event -> X All - keyUpEventHook event = handle event >> return (All True) - where - handle (KeyEvent { ev_event_type = t, ev_state = m, ev_keycode = code }) - | t == keyRelease = withDisplay $ \dpy -> do - s <- io $ keycodeToKeysym dpy code 0 - mClean <- cleanMask m - ks <- asks $ hKeyUpKeys host . config - userCodeDef () $ whenJust (Map.lookup (mClean, s) ks) id - | otherwise = return () - handle _ = return () - handle shutdown $ launch myConfig =<< getDirectories - -secs :: Int -> Int -secs = (* 1000000) - --- monitorBattery :: Maybe BatteryContext -> Maybe Notification -> IO () --- monitorBattery Nothing n = do --- ctx <- batteryContextNew --- case ctx of --- Nothing -> threadDelay (secs 10) >> monitorBattery Nothing n --- Just _ -> monitorBattery ctx n --- monitorBattery ctx@(Just ctx') n = do --- batInfo <- getBatteryInfo ctx' --- case batInfo of --- Nothing -> threadDelay (secs 1) >> monitorBattery ctx n --- Just batInfo -> do --- let n' --- | batteryState batInfo == BatteryStateDischarging --- , timeLeft <= 1200 --- , timeLeft > 0 = Just $ summary "Discharging" <> hint "value" percentage <> urgency u <> body (duz timeLeft ++ "left") --- | otherwise = Nothing --- u --- | timeLeft <= 600 = Critical --- | timeLeft <= 1800 = Normal --- | otherwise = Low --- timeLeft = batteryTimeToEmpty batInfo --- percentage :: Int32 --- percentage = round $ batteryPercentage batInfo --- ts = [("s", 60), ("m", 60), ("h", 24), ("d", 365), ("y", 1)] --- duz ms = ss --- where (ss, _) = foldl (\(ss, x) (s, y) -> ((if rem x y > 0 then show (rem x y) ++ s ++ " " else "") ++ ss , quot x y)) ("", ms) ts --- case n' of --- Just n' -> Notify.display (maybe mempty reuse n <> Notify.appName "monitorBattery" <> n') >>= (\n -> threadDelay (secs 2) >> monitorBattery ctx (Just n)) --- Nothing -> threadDelay (secs 30) >> monitorBattery ctx n - -disableTouchpad, disableTrackpoint, enableTrackpoint, enableTouchpad :: X () -enableTouchpad = safeSpawn "xinput" ["enable", "SynPS/2 Synaptics TouchPad"] -disableTouchpad = safeSpawn "xinput" ["disable", "SynPS/2 Synaptics TouchPad"] -enableTrackpoint = safeSpawn "xinput" ["enable", "TPPS/2 IBM TrackPoint"] -disableTrackpoint = safeSpawn "xinput" ["disable", "TPPS/2 IBM TrackPoint"] - -isDisabled :: String -> X Bool -isDisabled str = do - out <- runProcessWithInput "xinput" ["list", str] "" - return $ "disabled" `isInfixOf` out - - -spawnKeychain :: X () -spawnKeychain = do - home <- liftIO getHomeDirectory - let keys = (map ((home ) . (".ssh/" ++)) ["id", "id-rsa"]) ++ ["6B13AA67"] - liftIO (maybe (return ()) (setEnv "SSH_ASKPASS") =<< findAskpass) - safeSpawn "keychain" . (["--agents", "gpg,ssh"] ++)=<< liftIO (filterM doesFileExist keys) - where - findAskpass = filter `liftM` readFile "/etc/zshrc" - filter = listToMaybe . catMaybes . map (stripPrefix "export SSH_ASKPASS=") . lines - -assimilateKeychain :: X () -assimilateKeychain = liftIO $ assimilateKeychain' >> return () -assimilateKeychain' = tryIOError $ do - -- pid <- getProcessID - -- tmpDir <- lookupEnv "TMPDIR" - -- let tmpDir' = fromMaybe "/tmp" tmpDir - -- tmpFile = tmpDir' "xmonad-keychain" ++ (show pid) ++ ".env" - env <- runProcessWithInput "sh" ["-c", "eval $(keychain --eval --noask --agents gpg,ssh); env"] "" -- > " ++ tmpFile] "" - -- env <- readFile tmpFile - let envVars = Map.fromList $ map (\(k, v) -> (k, tail' v)) $ map (span (/= '=')) $ envLines - envVars' = Map.filterWithKey (\k _ -> k `elem` transfer) envVars - transfer = ["SSH_AUTH_SOCK", "SSH_AGENT_PID", "GPG_AGENT_INFO"] - envLines = filter (elem '=') $ lines env :: [String] - sequence $ map (\(k, c) -> setEnv k c) $ Map.toList envVars' - -- removeFile tmpFile - where - tail' [] = [] - tail' (x:xs) = xs - - -numKeys = [xK_parenleft, xK_parenright, xK_braceright, xK_plus, xK_braceleft, xK_bracketright, xK_bracketleft, xK_exclam, xK_equal, xK_asterisk] - -instance Shrinker CustomShrink where - shrinkIt _ "" = [""] - shrinkIt s cs - | length cs >= 4 = cs : shrinkIt s ((reverse . drop 4 . reverse $ cs) ++ "...") - | otherwise = cs : shrinkIt s (init cs) - -xPConfig, xPConfigMonospace :: XPConfig -xPConfig = def - { font = "xft:Fira Sans:pixelsize=21" - , height = 32 - , bgColor = "black" - , fgColor = gray - , fgHLight = green - , bgHLight = "black" - , borderColor = gray - , searchPredicate = (\needle haystack -> all (`isInfixOf` map toLower haystack) . map (map toLower) $ words needle) - , position = Top - } -xPConfigMonospace = xPConfig { font = "xft:Fira Code:pixelsize=21" } - -sshOverrides host = map (\h -> mkOverride { oHost = h, oCommand = moshCmd . inTmux host} ) - [ "odin" - , "ymir" - , "surtr" - , "vidhar" - , "srv02.uniworx.de" - ] - ++ - map (\h -> mkOverride { oHost = h, oCommand = moshCmd' "/run/current-system/sw/bin/mosh-server" . withEnv [("TERM", "xterm")] . inTmux host} ) - [ "bragi", "bragi.asgard.yggdrasil" - ] - ++ - map (\h -> mkOverride { oHost = h, oCommand = sshCmd . inTmux host } ) - [ "uni2work-dev1", "srv01.uniworx.de" - ] - ++ - map (\h -> mkOverride { oHost = h, oCommand = sshCmd . withEnv [("TERM", "xterm")] . inTmux host } ) - [ "remote.cip.ifi.lmu.de" - , "uniworx3", "uniworx4", "uniworx5", "uniworxdb2" - , "testworx" - ] - -backlight :: (Rational -> Rational) -> X () -backlight f = void . xfork . liftIO $ do - [ _device - , _class - , read . Text.unpack -> currentBright - , _currentPercentage - , read . Text.unpack -> maximumBright - ] <- Text.splitOn "," . Text.pack <$> readProcess "brightnessctl" ["-m"] "" - let current = currentBright % maximumBright - new' = f current * fromIntegral maximumBright - new :: Integer - new | floor new' < 0 = 0 - | ceiling new' > maximumBright = maximumBright - | new' >= maximumBright % 2 = ceiling new' - | otherwise = floor new' - callProcess "brightnessctl" ["-m", "s", show new] - -cycleThrough :: [Rational] -> (Rational -> Rational) -cycleThrough opts current = fromMaybe currentOpt $ listToMaybe next' - where currentOpt = minimumBy (comparing $ abs . subtract current) opts - (_, _ : next') = break (== currentOpt) opts - -cycleKbLayout :: [(String, Maybe String)] -> X () -cycleKbLayout [] = return () -cycleKbLayout layouts = liftIO $ do - next <- (getNext . extract) `liftM` runProcessWithInput "setxkbmap" ["-query"] "" - let - args = case next of - (l, Just v) -> [l, v] - (l, Nothing) -> [l] - safeSpawn "setxkbmap" args - where - extract :: String -> Maybe (String, Maybe String) - extract str = listToMaybe $ do - ["layout:", l] <- str' - [(l, Just v) | ["variant:", v] <- str'] ++ pure (l, Nothing) - where - str' = map words $ lines str - getNext :: Maybe (String, Maybe String) -> (String, Maybe String) - getNext = maybe (head layouts) getNext' - getNext' x = case elemIndex x layouts of - Nothing -> getNext Nothing - Just i -> layouts !! ((i + 1) `mod` length layouts) - -mpvAll' :: MpvCommand -> IO [MpvResponse] -mpvAll' = mpvAll "/var/media/.mpv-ipc" - -mpvOne' :: MpvCommand -> IO (Maybe MpvResponse) -mpvOne' = mpvOne "/var/media/.mpv-ipc" - -mediaMpv :: MpvCommand -> X () -mediaMpv cmd = void . xfork $ print =<< mpvAll' cmd - -mediaMpvTogglePause :: X () -mediaMpvTogglePause = void . xfork $ do - paused <- mapM mpvResponse <=< mpvAll' $ MpvGetProperty "pause" - if - | and paused -> print <=< mpvAll' $ MpvSetProperty "pause" False - | otherwise -> print <=< mpvOne' $ MpvSetProperty "pause" True - -myKeys' conf host = Map.fromList $ - -- launch a terminal - [ ((modm, xK_Return), spawn $ (XMonad.terminal conf) ++ " -e tmux") - , ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) - - -- launch dmenu - --, ((modm, xK_d ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") - , ((modm, xK_d ), shellPrompt "Run: " xPConfigMonospace) - , ((modm .|. shiftMask, xK_d ), prompt "Run in Terminal: " ("alacritty" ++ " -e") xPConfigMonospace) - , ((modm, xK_at ), sshPrompt (sshOverrides . Just $ hName host) xPConfigMonospace) - - -- close focused window - , ((modm .|. shiftMask, xK_q ), kill) - , ((modm .|. controlMask .|. shiftMask, xK_q ), spawn "xkill") - - -- Rotate through the available layout algorithms - , ((modm, xK_space ), sendMessage NextLayout) - - -- Reset the layouts on the current workspace to default - , ((modm .|. controlMask, xK_r ), (setLayout $ XMonad.layoutHook conf) >> refresh) - - -- Resize viewed windows to the correct size - , ((modm, xK_r ), refresh) - - -- Move focus to the next window - , ((modm, xK_t ), windows W.focusDown) - - -- Move focus to the previous window - , ((modm, xK_n ), windows W.focusUp ) - - -- Move focus to the master window - , ((modm, xK_m ), windows W.focusMaster ) - - -- Swap the focused window and the master window - , ((modm .|. shiftMask, xK_m ), windows W.swapMaster) - - -- Swap the focused window with the next window - , ((modm .|. shiftMask, xK_t ), windows W.swapDown ) - - -- Swap the focused window with the previous window - , ((modm .|. shiftMask, xK_n ), windows W.swapUp ) - - -- Swap the focused window with the previous window - , ((modm .|. shiftMask .|. controlMask, xK_m), sendMessage SwapWindow) - - , ((modm, xK_Right), sendMessage $ Go R) - , ((modm, xK_Left ), sendMessage $ Go L) - , ((modm, xK_Up ), sendMessage $ Go U) - , ((modm, xK_Down ), sendMessage $ Go D) - , ((modm .|. shiftMask , xK_Right), sendMessage $ Move R) - , ((modm .|. shiftMask , xK_Left ), sendMessage $ Move L) - , ((modm .|. shiftMask , xK_Up ), sendMessage $ Move U) - , ((modm .|. shiftMask , xK_Down ), sendMessage $ Move D) - -- , ((modm .|. controlMask, xK_Right), withFocused $ keysMoveWindow (10, 0)) - -- , ((modm .|. controlMask, xK_Left ), withFocused $ keysMoveWindow (-10, 0)) - -- , ((modm .|. controlMask, xK_Up ), withFocused $ keysMoveWindow (0, -10)) - -- , ((modm .|. controlMask, xK_Down ), withFocused $ keysMoveWindow (0, 10)) - -- Shrink the master area - , ((modm, xK_h ), sendMessage Shrink) - - -- Expand the master area - , ((modm, xK_s ), sendMessage Expand) - - -- Push window back into tiling - , ((modm .|. shiftMask, xK_space ), withFocused $ windows . W.sink) - , ((modm, xK_BackSpace), focusUrgent) - , ((modm .|. shiftMask, xK_BackSpace), clearUrgents) - - -- Increment the number of windows in the master area - , ((modm , xK_comma ), sendMessage (IncMasterN 1)) - - -- Deincrement the number of windows in the master area - , ((modm , xK_period), sendMessage (IncMasterN (-1))) - - , ((0, xF86XK_AudioRaiseVolume), safeSpawn "pamixer" ["-i", "2"]) - , ((0, xF86XK_AudioLowerVolume), safeSpawn "pamixer" ["-d", "2"]) - , ((0, xF86XK_AudioMute), safeSpawn "pamixer" ["-t"]) - , ((0, xF86XK_AudioPause), mediaMpv $ MpvSetProperty "pause" False) - , ((0, {-xF86XK_AudioMicMute-} 269025202), safeSpawn "pulseaudio-ctl" ["mute-input"]) - , ((0, xF86XK_AudioPlay), mediaMpvTogglePause) - , ((0, xK_Print), do - home <- liftIO getHomeDirectory - unGrab - safeSpawn "scrot" ["-s", "-F", home "screenshots" "%Y-%m-%dT%H:%M:%S.png", "-e", "xclip -selection clipboard -t image/png -i $f"] - ) - , ((modm .|. mod1Mask, xK_space), mediaMpvTogglePause) - - -- , ((0, xF86XK_MonBrightnessDown), backlight . cycleThrough $ reverse brCycle) - -- , ((0, xF86XK_MonBrightnessUp ), backlight $ cycleThrough brCycle) - , ((modm .|. shiftMask , xK_b), backlight . cycleThrough $ reverse brCycle) - , ((modm .|. shiftMask .|. controlMask, xK_b), backlight $ cycleThrough brCycle) - - , ((modm , xK_Escape), cycleKbLayout (hKbLayouts host)) - , ((modm .|. controlMask, xK_Escape), safeSpawn "setxkbmap" $ fst (head $ hKbLayouts host) : maybeToList (snd . head $ hKbLayouts host)) - - -- Toggle the status bar gap - -- Use this binding with avoidStruts from Hooks.ManageDocks. - -- See also the statusBar function from Hooks.DynamicLog. - -- - , ((modm , xK_b ), sendMessage ToggleStruts) - - , ((modm .|. shiftMask, xK_p ), safeSpawn "playerctl" ["-a", "pause"]) - - -- Quit xmonad - , ((modm .|. shiftMask, xK_e ), io (exitWith ExitSuccess)) - - -- Restart xmonad - -- , ((modm .|. shiftMask .|. controlMask, xK_r ), void . xfork $ recompile False >>= flip when (safeSpawn "xmonad" ["--restart"])) - , ((modm .|. shiftMask, xK_r ), void . liftIO $ executeFile "xmonad" True [] Nothing) - , ((modm .|. shiftMask, xK_l ), void . xfork $ do - sessId <- getEnv "XDG_SESSION_ID" - safeSpawn "loginctl" ["lock-session", sessId] - ) - , ((modm .|. shiftMask, xK_s ), safeSpawn "systemctl" ["suspend"]) - , ((modm .|. shiftMask, xK_h ), inputPromptWithCompl xPConfigMonospace "systemctl" powerActCompl ?+ powerAct) - , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible - , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back - , ((modm .|. shiftMask, xK_g ), windowPrompt xPConfig Goto wsWindows) - , ((modm , xK_g ), windowPrompt xPConfig Bring allWindows) - ] - ++ - - -- - -- mod-[1..9], Switch to workspace N - -- - -- mod-[1..9], Switch to workspace N - -- mod-shift-[1..9], Move client to workspace N - -- - [((m .|. modm, k), windows $ f i) - | (i, k) <- zip (XMonad.workspaces conf) $ numKeys - , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)] - ] - ++ - [((m .|. modm .|. controlMask, k), void . runMaybeT $ - MaybeT (P.getScreen def i) >>= MaybeT . screenWorkspace >>= lift . windows . f - ) - | (i, k) <- zip (hScreens host) [xK_g, xK_c, xK_r, xK_l] - , (f, m) <- [(W.view, 0), (W.shift, shiftMask)] - ] - where - modm = XMonad.modMask conf - - brCycle = [0, 1 % 500, 1 % 250, 1 % 100, 1 % 10, 1 % 4, 1 % 2, 3 % 4, 1] - - powerActWords = ["poweroff", "reboot", "hibernate", "suspend"] - powerActCompl = mkComplFunFromList' xPConfigMonospace powerActWords - powerAct act | act `elem` powerActWords = safeSpawn "systemctl" $ pure act - | otherwise = return () -- cgit v1.2.3