[XMonad] One line for each language pragma

This commit is contained in:
Ivan Malison 2021-07-31 19:40:50 -06:00
parent 04efb2d3ca
commit f0d01b08c0
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8

View File

@ -1,6 +1,11 @@
{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, {-# LANGUAGE DeriveDataTypeable #-}
MultiParamTypeClasses, ExistentialQuantification, {-# LANGUAGE ExistentialQuantification #-}
FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Main where module Main where
import Codec.Binary.UTF8.String as UTF8 import Codec.Binary.UTF8.String as UTF8
@ -186,31 +191,27 @@ getWorkspaceDmenu = myDmenu (workspaces myConfig)
-- Selectors -- Selectors
isHangoutsTitle = isPrefixOf "Google Hangouts"
isGmailTitle t = isInfixOf "@gmail.com" t && isInfixOf "Gmail" t isGmailTitle t = isInfixOf "@gmail.com" t && isInfixOf "Gmail" t
isChromeClass = isInfixOf "chrome" isChromeClass = isInfixOf "chrome"
chromeSelectorBase = isChromeClass <$> className chromeSelectorBase = isChromeClass <$> className
chromeSelector = chromeSelector =
chromeSelectorBase <&&> chromeSelectorBase <&&>
(\t -> not $ any ($ t) [isHangoutsTitle, isGmailTitle]) <$> title (\t -> not $ any ($ t) [isGmailTitle]) <$> title
spotifySelector = className =? "Spotify" spotifySelector = className =? "Spotify"
emacsSelector = className =? "Emacs" emacsSelector = className =? "Emacs"
transmissionSelector = fmap (isPrefixOf "Transmission") title transmissionSelector = fmap (isPrefixOf "Transmission") title
hangoutsSelector = chromeSelectorBase <&&> fmap isHangoutsTitle title
gmailSelector = chromeSelectorBase <&&> fmap isGmailTitle title gmailSelector = chromeSelectorBase <&&> fmap isGmailTitle title
volumeSelector = className =? "Pavucontrol" volumeSelector = className =? "Pavucontrol"
virtualClasses = virtualClasses =
[ (hangoutsSelector, "Hangouts") [ (gmailSelector, "Gmail")
, (gmailSelector, "Gmail")
, (chromeSelector, "Chrome") , (chromeSelector, "Chrome")
, (transmissionSelector, "Transmission") , (transmissionSelector, "Transmission")
] ]
-- Commands -- Commands
hangoutsCommand = "start_hangouts.sh"
gmailCommand = "start_chrome.sh --new-window https://mail.google.com/mail/u/0/#inbox" gmailCommand = "start_chrome.sh --new-window https://mail.google.com/mail/u/0/#inbox"
spotifyCommand = "spotify" spotifyCommand = "spotify"
chromeCommand = "start_chrome.sh" chromeCommand = "start_chrome.sh"
@ -429,37 +430,6 @@ data ChromeInfo = ChromeInfo
, tabTitle :: String , tabTitle :: String
} deriving (Eq, Show) } deriving (Eq, Show)
getChromeTabInfo = do
output <- runProcessWithInput "chromix-too" ["ls"] ""
return $ M.fromList $ map parseChromixLine $ lines output
where parseChromixLine line =
case splitOn " " line of
[] -> undefined
tid:uri:rest -> let ttl = concat rest in
(printf "%s - %s" tid ttl :: String,
ChromeInfo { tabId = read tid
, tabUri = uri
, tabTitle = ttl
})
[_] -> undefined
selectChromeTab WindowBringerConfig { menuCommand = cmd
, menuArgs = args
} =
liftIO getChromeTabInfo >>= void . DM.menuMapArgs cmd args
chromeTabAction doSplit action selected =
case selected of
Left wid -> action wid
Right ChromeInfo { tabId = tid } ->
liftIO $ do
let command = if doSplit then
"split_tab_by_id.sh %s"
else
"focus_tab_by_id.sh %s"
spawn $ printf command $ show tid
return ()
menuIndexArgs :: MonadIO m => String -> [String] -> [(String, a)] -> menuIndexArgs :: MonadIO m => String -> [String] -> [(String, a)] ->
m (Maybe a) m (Maybe a)
menuIndexArgs menuCmd args selectionPairs = do menuIndexArgs menuCmd args selectionPairs = do
@ -835,7 +805,6 @@ swapMinimizeStateAfter action =
scratchpads = scratchpads =
[ NS "htop" htopCommand (title =? "htop") nonFloating [ NS "htop" htopCommand (title =? "htop") nonFloating
, NS "spotify" spotifyCommand spotifySelector nonFloating , NS "spotify" spotifyCommand spotifySelector nonFloating
, NS "hangouts" hangoutsCommand hangoutsSelector nonFloating
, NS "volume" volumeCommand volumeSelector nonFloating , NS "volume" volumeCommand volumeSelector nonFloating
] ]
@ -912,7 +881,34 @@ mute = spawn "set_volume.sh --toggle-mute"
shiftToEmptyOnScreen direction = shiftToEmptyOnScreen direction =
followingWindow (windowToScreen direction True) >> shiftToEmptyAndView followingWindow (windowToScreen direction True) >> shiftToEmptyAndView
directionalUp = xK_k
directionalDown = xK_j
directionalLeft = xK_h
directionalRight = xK_l
buildDirectionalBindings mask commandFn =
[ ((mask, directionalUp ), commandFn U)
, ((mask, directionalDown ), commandFn D)
, ((mask, directionalLeft ), commandFn L)
, ((mask, directionalRight), commandFn R)
]
addKeys conf@XConfig { modMask = modm } = addKeys conf@XConfig { modMask = modm } =
-- Directional navigation
(buildDirectionalBindings
modm $ flip windowGo True) ++
(buildDirectionalBindings
(modm .|. shiftMask) $ flip windowSwap True) ++
(buildDirectionalBindings
(modm .|. controlMask) $ followingWindow . (flip windowToScreen True)) ++
(buildDirectionalBindings
hyper $ flip screenGo True) ++
(buildDirectionalBindings
(hyper .|. shiftMask) $ followingWindow . (flip screenSwap True)) ++
(buildDirectionalBindings
(hyper .|. controlMask) $ shiftToEmptyOnScreen) ++
-- Specific program spawning -- Specific program spawning
bindBringAndRaiseMany bindBringAndRaiseMany
@ -925,10 +921,7 @@ addKeys conf@XConfig { modMask = modm } =
-- ScratchPads -- ScratchPads
[ ((modalt, xK_m), doScratchpad "htop") [ ((modalt, xK_m), doScratchpad "htop")
, ((modalt, xK_v), doScratchpad "volume") , ((modalt, xK_v), doScratchpad "volume")
, ((modalt, xK_h), doScratchpad "hangouts")
, ((modalt, xK_s), doScratchpad "spotify") , ((modalt, xK_s), doScratchpad "spotify")
, ((modalt .|. controlMask, xK_h),
myRaiseNextMaybe (spawn hangoutsCommand) hangoutsSelector)
, ((modalt .|. controlMask, xK_s), , ((modalt .|. controlMask, xK_s),
myRaiseNextMaybe (spawn spotifyCommand) spotifySelector) myRaiseNextMaybe (spawn spotifyCommand) spotifySelector)
@ -954,36 +947,6 @@ addKeys conf@XConfig { modMask = modm } =
, ((modm .|. controlMask, xK_c), chromeReplaceKill) , ((modm .|. controlMask, xK_c), chromeReplaceKill)
, ((hyper, xK_g), gatherThisClass) , ((hyper, xK_g), gatherThisClass)
-- Directional navigation
, ((modm, xK_w), windowGo U True)
, ((modm, xK_s), windowGo D True)
, ((modm, xK_a), windowGo L True)
, ((modm, xK_d), windowGo R True)
, ((modm .|. shiftMask, xK_w), windowSwap U True)
, ((modm .|. shiftMask, xK_s), windowSwap D True)
, ((modm .|. shiftMask, xK_a), windowSwap L True)
, ((modm .|. shiftMask, xK_d), windowSwap R True)
, ((modm .|. controlMask, xK_w), followingWindow $ windowToScreen U True)
, ((modm .|. controlMask, xK_s), followingWindow $ windowToScreen D True)
, ((modm .|. controlMask, xK_a), followingWindow $ windowToScreen L True)
, ((modm .|. controlMask, xK_d), followingWindow $ windowToScreen R True)
, ((hyper, xK_w), screenGo U True)
, ((hyper, xK_s), screenGo D True)
, ((hyper, xK_a), screenGo L True)
, ((hyper, xK_d), screenGo R True)
, ((hyper .|. shiftMask, xK_w), followingWindow $ screenSwap U True)
, ((hyper .|. shiftMask, xK_s), followingWindow $ screenSwap D True)
, ((hyper .|. shiftMask, xK_a), followingWindow $ screenSwap L True)
, ((hyper .|. shiftMask, xK_d), followingWindow $ screenSwap R True)
, ((hyper .|. controlMask, xK_w), shiftToEmptyOnScreen U)
, ((hyper .|. controlMask, xK_s), shiftToEmptyOnScreen D)
, ((hyper .|. controlMask, xK_a), shiftToEmptyOnScreen L)
, ((hyper .|. controlMask, xK_d), shiftToEmptyOnScreen R)
-- Focus/Layout manipulation -- Focus/Layout manipulation