REF move code to separate submodules
This commit is contained in:
parent
9ff68d97e9
commit
96b7253c9b
235
bin/xmonad.hs
235
bin/xmonad.hs
|
@ -1,27 +1,23 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
|
import Capture
|
||||||
|
import General
|
||||||
import Internal.DMenu
|
import Internal.DMenu
|
||||||
|
import Power
|
||||||
|
|
||||||
import ACPI
|
import ACPI
|
||||||
import DBus.Common
|
import DBus.Common
|
||||||
import DBus.IntelBacklight
|
|
||||||
import DBus.Screensaver
|
|
||||||
import Notify
|
|
||||||
import Process
|
import Process
|
||||||
import SendXMsg
|
import SendXMsg
|
||||||
import Shell
|
import Shell
|
||||||
import qualified Theme as T
|
import qualified Theme as T
|
||||||
import WorkspaceMon
|
import WorkspaceMon
|
||||||
|
|
||||||
import Control.Arrow (first)
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad (forM_, mapM_, void, when)
|
|
||||||
|
|
||||||
import Data.List (isPrefixOf, sortBy, sortOn)
|
import Data.List (isPrefixOf, sortBy, sortOn)
|
||||||
import qualified Data.Map.Lazy as M
|
|
||||||
import Data.Maybe (isJust)
|
import Data.Maybe (isJust)
|
||||||
import Data.Monoid (All (..))
|
import Data.Monoid (All (..))
|
||||||
|
|
||||||
|
@ -29,20 +25,15 @@ import Graphics.X11.Types
|
||||||
import Graphics.X11.Xlib.Atom
|
import Graphics.X11.Xlib.Atom
|
||||||
import Graphics.X11.Xlib.Extras
|
import Graphics.X11.Xlib.Extras
|
||||||
|
|
||||||
import System.Directory
|
|
||||||
import System.Exit
|
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Process
|
import System.Process
|
||||||
|
|
||||||
import Text.Read (readMaybe)
|
|
||||||
|
|
||||||
import Xmobar.Common
|
import Xmobar.Common
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Actions.CopyWindow
|
import XMonad.Actions.CopyWindow
|
||||||
import XMonad.Actions.CycleWS
|
import XMonad.Actions.CycleWS
|
||||||
import XMonad.Actions.PhysicalScreens
|
import XMonad.Actions.PhysicalScreens
|
||||||
import XMonad.Actions.Volume
|
|
||||||
import XMonad.Actions.Warp
|
import XMonad.Actions.Warp
|
||||||
import XMonad.Hooks.EwmhDesktops
|
import XMonad.Hooks.EwmhDesktops
|
||||||
import XMonad.Hooks.ManageDocks
|
import XMonad.Hooks.ManageDocks
|
||||||
|
@ -52,8 +43,6 @@ import XMonad.Layout.NoFrillsDecoration
|
||||||
import XMonad.Layout.PerWorkspace
|
import XMonad.Layout.PerWorkspace
|
||||||
import XMonad.Layout.Renamed
|
import XMonad.Layout.Renamed
|
||||||
import XMonad.Layout.Tabbed
|
import XMonad.Layout.Tabbed
|
||||||
import XMonad.Prompt
|
|
||||||
import XMonad.Prompt.ConfirmPrompt
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import XMonad.Util.EZConfig
|
import XMonad.Util.EZConfig
|
||||||
import XMonad.Util.NamedActions
|
import XMonad.Util.NamedActions
|
||||||
|
@ -86,14 +75,20 @@ main = do
|
||||||
, focusedBorderColor = T.selectedBordersColor
|
, focusedBorderColor = T.selectedBordersColor
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Data structure to hold the dbus client, threadIDs, and process IDs started
|
-- | Multithread setup
|
||||||
-- outside the main Xmonad thread. Maybe I could use a ReaderT here but I'm lazy
|
|
||||||
data ThreadState = ThreadState
|
data ThreadState = ThreadState
|
||||||
{ client :: Client
|
{ client :: Client
|
||||||
, childPIDs :: [Pid]
|
, childPIDs :: [Pid]
|
||||||
, childHandles :: [Handle]
|
, childHandles :: [Handle]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
-- TODO shouldn't this be run by a signal handler?
|
||||||
|
runCleanup :: ThreadState -> X ()
|
||||||
|
runCleanup ts = io $ do
|
||||||
|
mapM_ killPID $ childPIDs ts
|
||||||
|
stopXMonadService $ client ts
|
||||||
|
|
||||||
-- | Startuphook configuration
|
-- | Startuphook configuration
|
||||||
|
|
||||||
myStartupHook :: X ()
|
myStartupHook :: X ()
|
||||||
|
@ -242,215 +237,17 @@ manageApps = composeOne $ concatMap dwHook allDWs ++
|
||||||
-- | Eventhook configuration
|
-- | Eventhook configuration
|
||||||
|
|
||||||
myEventHook :: Event -> X All
|
myEventHook :: Event -> X All
|
||||||
myEventHook = monitorEventHook <+> docksEventHook <+> handleEventHook def
|
myEventHook = xMsgEventHook <+> docksEventHook <+> handleEventHook def
|
||||||
|
|
||||||
monitorEventHook :: Event -> X All
|
xMsgEventHook :: Event -> X All
|
||||||
monitorEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
xMsgEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
| t == bITMAP = do
|
| t == bITMAP = do
|
||||||
let (xtype, tag) = splitXMsg d
|
let (xtype, tag) = splitXMsg d
|
||||||
case xtype of
|
case xtype of
|
||||||
Workspace -> removeDynamicWorkspace tag
|
Workspace -> removeDynamicWorkspace tag
|
||||||
ACPI -> do
|
ACPI -> handleACPI tag
|
||||||
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
|
|
||||||
forM_ acpiTag $ \case
|
|
||||||
Power -> runPowerPrompt
|
|
||||||
Sleep -> confirmPrompt T.promptTheme "suspend?" runSuspend
|
|
||||||
LidClose -> do
|
|
||||||
status <- io isDischarging
|
|
||||||
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
|
||||||
return (All True)
|
return (All True)
|
||||||
monitorEventHook _ = return (All True)
|
xMsgEventHook _ = return (All True)
|
||||||
|
|
||||||
data PowerPrompt = PowerPrompt
|
|
||||||
|
|
||||||
instance XPrompt PowerPrompt where
|
|
||||||
showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
|
|
||||||
|
|
||||||
runScreenLock :: X ()
|
|
||||||
runScreenLock = spawn "screenlock"
|
|
||||||
|
|
||||||
runPowerOff :: X ()
|
|
||||||
runPowerOff = spawn "systemctl poweroff"
|
|
||||||
|
|
||||||
runSuspend :: X ()
|
|
||||||
runSuspend = spawn "systemctl suspend"
|
|
||||||
|
|
||||||
runHibernate :: X ()
|
|
||||||
runHibernate = spawn "systemctl hibernate"
|
|
||||||
|
|
||||||
runReboot :: X ()
|
|
||||||
runReboot = spawn "systemctl reboot"
|
|
||||||
|
|
||||||
data PowerAction = Poweroff
|
|
||||||
| Shutdown
|
|
||||||
| Hibernate
|
|
||||||
| Reboot
|
|
||||||
deriving (Eq)
|
|
||||||
|
|
||||||
instance Enum PowerAction where
|
|
||||||
toEnum 0 = Poweroff
|
|
||||||
toEnum 1 = Shutdown
|
|
||||||
toEnum 2 = Hibernate
|
|
||||||
toEnum 3 = Reboot
|
|
||||||
toEnum _ = errorWithoutStackTrace "Main.Enum.PowerAction.toEnum: bad argument"
|
|
||||||
|
|
||||||
fromEnum Poweroff = 0
|
|
||||||
fromEnum Shutdown = 1
|
|
||||||
fromEnum Hibernate = 2
|
|
||||||
fromEnum Reboot = 3
|
|
||||||
|
|
||||||
runPowerPrompt :: X ()
|
|
||||||
runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
|
|
||||||
where
|
|
||||||
comp = mkComplFunFromList []
|
|
||||||
theme = T.promptTheme { promptKeymap = keymap }
|
|
||||||
keymap = M.fromList
|
|
||||||
$ ((controlMask, xK_g), quit) :
|
|
||||||
map (first $ (,) 0)
|
|
||||||
[ (xK_p, sendAction Poweroff)
|
|
||||||
, (xK_s, sendAction Shutdown)
|
|
||||||
, (xK_h, sendAction Hibernate)
|
|
||||||
, (xK_r, sendAction Reboot)
|
|
||||||
, (xK_Return, quit)
|
|
||||||
, (xK_Escape, quit)
|
|
||||||
]
|
|
||||||
sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
|
|
||||||
executeAction a = case toEnum $ read a of
|
|
||||||
Poweroff -> runPowerOff
|
|
||||||
Shutdown -> runScreenLock >> runSuspend
|
|
||||||
Hibernate -> runScreenLock >> runHibernate
|
|
||||||
Reboot -> runReboot
|
|
||||||
|
|
||||||
runQuitPrompt :: X ()
|
|
||||||
runQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess
|
|
||||||
|
|
||||||
-- TODO for some reason the screen never wakes up after suspend when
|
|
||||||
-- the nvidia card is up, so block suspend if nvidia card is running
|
|
||||||
-- and warn user
|
|
||||||
isUsingNvidia :: IO Bool
|
|
||||||
isUsingNvidia = doesDirectoryExist "/sys/module/nvidia"
|
|
||||||
|
|
||||||
runOptimusPrompt :: X ()
|
|
||||||
runOptimusPrompt = do
|
|
||||||
nvidiaOn <- io isUsingNvidia
|
|
||||||
switch $ if nvidiaOn then "intel" else "nvidia"
|
|
||||||
where
|
|
||||||
switch mode = confirmPrompt T.promptTheme (prompt mode) (cmd mode)
|
|
||||||
prompt mode = "gpu switch to " ++ mode ++ "?"
|
|
||||||
cmd mode = spawnCmd "optimus-manager"
|
|
||||||
["--switch", mode, "--no-confirm"]
|
|
||||||
>> io exitSuccess
|
|
||||||
|
|
||||||
-- shell commands
|
|
||||||
|
|
||||||
myTerm :: String
|
|
||||||
myTerm = "urxvt"
|
|
||||||
|
|
||||||
runTerm :: X ()
|
|
||||||
runTerm = spawn myTerm
|
|
||||||
|
|
||||||
runCalc :: X ()
|
|
||||||
runCalc = spawnCmd myTerm ["-e", "R"]
|
|
||||||
|
|
||||||
runBrowser :: X ()
|
|
||||||
runBrowser = spawn "brave"
|
|
||||||
|
|
||||||
runEditor :: X ()
|
|
||||||
runEditor = spawnCmd "emacsclient"
|
|
||||||
["-c", "-e", "\"(select-frame-set-input-focus (selected-frame))\""]
|
|
||||||
|
|
||||||
runFileManager :: X ()
|
|
||||||
runFileManager = spawn "pcmanfm"
|
|
||||||
|
|
||||||
getScreenshotDir :: IO FilePath
|
|
||||||
getScreenshotDir = do
|
|
||||||
h <- getHomeDirectory
|
|
||||||
return $ h ++ "/Pictures/screenshots"
|
|
||||||
|
|
||||||
runFlameshot :: String -> X ()
|
|
||||||
runFlameshot mode = do
|
|
||||||
ssDir <- io getScreenshotDir
|
|
||||||
spawnCmd "flameshot" $ mode : ["-p", ssDir]
|
|
||||||
|
|
||||||
-- TODO this will steal focus from the current window (and puts it
|
|
||||||
-- in the root window?) ...need to fix
|
|
||||||
runAreaCapture :: X ()
|
|
||||||
runAreaCapture = runFlameshot "gui"
|
|
||||||
|
|
||||||
-- myWindowCap = "screencap -w" --external script
|
|
||||||
|
|
||||||
runScreenCapture :: X ()
|
|
||||||
runScreenCapture = runFlameshot "screen"
|
|
||||||
|
|
||||||
runDesktopCapture :: X ()
|
|
||||||
runDesktopCapture = runFlameshot "full"
|
|
||||||
|
|
||||||
runCleanup :: ThreadState -> X ()
|
|
||||||
runCleanup ts = io $ do
|
|
||||||
mapM_ killPID $ childPIDs ts
|
|
||||||
stopXMonadService $ client ts
|
|
||||||
|
|
||||||
runRestart :: X ()
|
|
||||||
runRestart = restart "xmonad" True
|
|
||||||
|
|
||||||
runRecompile :: X ()
|
|
||||||
runRecompile = do
|
|
||||||
-- assume that the conf directory contains a valid stack project
|
|
||||||
-- TODO this is hacky AF
|
|
||||||
confDir <- getXMonadDir
|
|
||||||
spawn $ cmd confDir
|
|
||||||
where
|
|
||||||
cmd c = fmtCmd "cd" [c]
|
|
||||||
#!&& fmtCmd "stack" ["install", ":xmonad"]
|
|
||||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
|
|
||||||
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
|
|
||||||
|
|
||||||
myMultimediaCtl :: String
|
|
||||||
myMultimediaCtl = "playerctl"
|
|
||||||
|
|
||||||
runTogglePlay :: X ()
|
|
||||||
runTogglePlay = spawnCmd myMultimediaCtl ["play-pause"]
|
|
||||||
|
|
||||||
runPrevTrack :: X ()
|
|
||||||
runPrevTrack = spawnCmd myMultimediaCtl ["previous"]
|
|
||||||
|
|
||||||
runNextTrack :: X ()
|
|
||||||
runNextTrack = spawnCmd myMultimediaCtl ["next"]
|
|
||||||
|
|
||||||
runStopPlay :: X ()
|
|
||||||
runStopPlay = spawnCmd myMultimediaCtl ["stop"]
|
|
||||||
|
|
||||||
runVolumeDown :: X ()
|
|
||||||
runVolumeDown = void (lowerVolume 2)
|
|
||||||
|
|
||||||
runVolumeUp :: X ()
|
|
||||||
runVolumeUp = void (raiseVolume 2)
|
|
||||||
|
|
||||||
runVolumeMute :: X ()
|
|
||||||
runVolumeMute = void toggleMute
|
|
||||||
|
|
||||||
runToggleBluetooth :: X ()
|
|
||||||
runToggleBluetooth = spawn
|
|
||||||
$ "bluetoothctl show | grep -q \"Powered: no\""
|
|
||||||
#!&& "a=on"
|
|
||||||
#!|| "a=off"
|
|
||||||
#!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"]
|
|
||||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
|
||||||
|
|
||||||
runIncBacklight :: X ()
|
|
||||||
runIncBacklight = io $ void callIncBrightness
|
|
||||||
|
|
||||||
runDecBacklight :: X ()
|
|
||||||
runDecBacklight = io $ void callDecBrightness
|
|
||||||
|
|
||||||
runMinBacklight :: X ()
|
|
||||||
runMinBacklight = io $ void callMinBrightness
|
|
||||||
|
|
||||||
runMaxBacklight :: X ()
|
|
||||||
runMaxBacklight = io $ void callMaxBrightness
|
|
||||||
|
|
||||||
runToggleDPMS :: X ()
|
|
||||||
runToggleDPMS = io $ void callToggle
|
|
||||||
|
|
||||||
-- | Keymap configuration
|
-- | Keymap configuration
|
||||||
|
|
||||||
|
|
17
lib/ACPI.hs
17
lib/ACPI.hs
|
@ -1,11 +1,14 @@
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module ACPI
|
module ACPI
|
||||||
( ACPIEvent(..)
|
( ACPIEvent(..)
|
||||||
, isDischarging
|
, isDischarging
|
||||||
, runPowermon
|
, runPowermon
|
||||||
|
, handleACPI
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Power
|
||||||
import SendXMsg
|
import SendXMsg
|
||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
|
@ -18,6 +21,10 @@ import Data.Connection
|
||||||
import System.IO.Streams.Internal as S (read)
|
import System.IO.Streams.Internal as S (read)
|
||||||
import System.IO.Streams.UnixSocket
|
import System.IO.Streams.UnixSocket
|
||||||
|
|
||||||
|
import Text.Read (readMaybe)
|
||||||
|
|
||||||
|
import XMonad.Core
|
||||||
|
|
||||||
data ACPIEvent = Power
|
data ACPIEvent = Power
|
||||||
| Sleep
|
| Sleep
|
||||||
| LidClose
|
| LidClose
|
||||||
|
@ -65,3 +72,13 @@ runPowermon = do
|
||||||
readStream s = do
|
readStream s = do
|
||||||
out <- S.read s
|
out <- S.read s
|
||||||
mapM_ sendACPIEvent $ parseLine =<< out
|
mapM_ sendACPIEvent $ parseLine =<< out
|
||||||
|
|
||||||
|
handleACPI :: String -> X ()
|
||||||
|
handleACPI tag = do
|
||||||
|
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
|
||||||
|
forM_ acpiTag $ \case
|
||||||
|
Power -> runPowerPrompt
|
||||||
|
Sleep -> runSuspendPrompt
|
||||||
|
LidClose -> do
|
||||||
|
status <- io isDischarging
|
||||||
|
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
||||||
|
|
|
@ -0,0 +1,35 @@
|
||||||
|
module Capture
|
||||||
|
( runAreaCapture
|
||||||
|
, runDesktopCapture
|
||||||
|
, runScreenCapture
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Shell
|
||||||
|
|
||||||
|
import System.Directory
|
||||||
|
|
||||||
|
import XMonad.Core
|
||||||
|
|
||||||
|
getScreenshotDir :: IO FilePath
|
||||||
|
getScreenshotDir = do
|
||||||
|
h <- getHomeDirectory
|
||||||
|
return $ h ++ "/Pictures/screenshots"
|
||||||
|
|
||||||
|
runFlameshot :: String -> X ()
|
||||||
|
runFlameshot mode = do
|
||||||
|
ssDir <- io getScreenshotDir
|
||||||
|
spawnCmd "flameshot" $ mode : ["-p", ssDir]
|
||||||
|
|
||||||
|
-- TODO this will steal focus from the current window (and puts it
|
||||||
|
-- in the root window?) ...need to fix
|
||||||
|
runAreaCapture :: X ()
|
||||||
|
runAreaCapture = runFlameshot "gui"
|
||||||
|
|
||||||
|
-- myWindowCap = "screencap -w" --external script
|
||||||
|
|
||||||
|
runScreenCapture :: X ()
|
||||||
|
runScreenCapture = runFlameshot "screen"
|
||||||
|
|
||||||
|
runDesktopCapture :: X ()
|
||||||
|
runDesktopCapture = runFlameshot "full"
|
|
@ -0,0 +1,106 @@
|
||||||
|
module General where
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | General commands
|
||||||
|
|
||||||
|
import Notify
|
||||||
|
import Shell
|
||||||
|
|
||||||
|
import DBus.IntelBacklight
|
||||||
|
import DBus.Screensaver
|
||||||
|
|
||||||
|
import Control.Monad (void)
|
||||||
|
|
||||||
|
import XMonad.Actions.Volume
|
||||||
|
import XMonad.Core
|
||||||
|
import XMonad.Operations
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Some nice apps
|
||||||
|
|
||||||
|
runTerm :: X ()
|
||||||
|
runTerm = spawn myTerm
|
||||||
|
|
||||||
|
runCalc :: X ()
|
||||||
|
runCalc = spawnCmd myTerm ["-e", "R"]
|
||||||
|
|
||||||
|
runBrowser :: X ()
|
||||||
|
runBrowser = spawn "brave"
|
||||||
|
|
||||||
|
runEditor :: X ()
|
||||||
|
runEditor = spawnCmd "emacsclient"
|
||||||
|
["-c", "-e", "\"(select-frame-set-input-focus (selected-frame))\""]
|
||||||
|
|
||||||
|
runFileManager :: X ()
|
||||||
|
runFileManager = spawn "pcmanfm"
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Multimedia Commands
|
||||||
|
|
||||||
|
myMultimediaCtl :: String
|
||||||
|
myMultimediaCtl = "playerctl"
|
||||||
|
|
||||||
|
runTogglePlay :: X ()
|
||||||
|
runTogglePlay = spawnCmd myMultimediaCtl ["play-pause"]
|
||||||
|
|
||||||
|
runPrevTrack :: X ()
|
||||||
|
runPrevTrack = spawnCmd myMultimediaCtl ["previous"]
|
||||||
|
|
||||||
|
runNextTrack :: X ()
|
||||||
|
runNextTrack = spawnCmd myMultimediaCtl ["next"]
|
||||||
|
|
||||||
|
runStopPlay :: X ()
|
||||||
|
runStopPlay = spawnCmd myMultimediaCtl ["stop"]
|
||||||
|
|
||||||
|
runVolumeDown :: X ()
|
||||||
|
runVolumeDown = void (lowerVolume 2)
|
||||||
|
|
||||||
|
runVolumeUp :: X ()
|
||||||
|
runVolumeUp = void (raiseVolume 2)
|
||||||
|
|
||||||
|
runVolumeMute :: X ()
|
||||||
|
runVolumeMute = void toggleMute
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | System commands
|
||||||
|
|
||||||
|
runToggleBluetooth :: X ()
|
||||||
|
runToggleBluetooth = spawn
|
||||||
|
$ "bluetoothctl show | grep -q \"Powered: no\""
|
||||||
|
#!&& "a=on"
|
||||||
|
#!|| "a=off"
|
||||||
|
#!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"]
|
||||||
|
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
||||||
|
|
||||||
|
runIncBacklight :: X ()
|
||||||
|
runIncBacklight = io $ void callIncBrightness
|
||||||
|
|
||||||
|
runDecBacklight :: X ()
|
||||||
|
runDecBacklight = io $ void callDecBrightness
|
||||||
|
|
||||||
|
runMinBacklight :: X ()
|
||||||
|
runMinBacklight = io $ void callMinBrightness
|
||||||
|
|
||||||
|
runMaxBacklight :: X ()
|
||||||
|
runMaxBacklight = io $ void callMaxBrightness
|
||||||
|
|
||||||
|
runToggleDPMS :: X ()
|
||||||
|
runToggleDPMS = io $ void callToggle
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Configuration commands
|
||||||
|
|
||||||
|
runRestart :: X ()
|
||||||
|
runRestart = restart "xmonad" True
|
||||||
|
|
||||||
|
runRecompile :: X ()
|
||||||
|
runRecompile = do
|
||||||
|
-- assume that the conf directory contains a valid stack project
|
||||||
|
-- TODO this is hacky AF
|
||||||
|
confDir <- getXMonadDir
|
||||||
|
spawn $ cmd confDir
|
||||||
|
where
|
||||||
|
cmd c = fmtCmd "cd" [c]
|
||||||
|
#!&& fmtCmd "stack" ["install", ":xmonad"]
|
||||||
|
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
|
||||||
|
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
|
|
@ -0,0 +1,126 @@
|
||||||
|
module Power
|
||||||
|
( runHibernate
|
||||||
|
, runOptimusPrompt
|
||||||
|
, runPowerOff
|
||||||
|
, runPowerPrompt
|
||||||
|
, runReboot
|
||||||
|
, runScreenLock
|
||||||
|
, runSuspend
|
||||||
|
, runSuspendPrompt
|
||||||
|
, runQuitPrompt
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Commands for controlling power
|
||||||
|
|
||||||
|
import Shell
|
||||||
|
import qualified Theme as T
|
||||||
|
|
||||||
|
import Control.Arrow (first)
|
||||||
|
|
||||||
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
import Graphics.X11.Types
|
||||||
|
|
||||||
|
import XMonad.Core
|
||||||
|
import XMonad.Prompt
|
||||||
|
import XMonad.Prompt.ConfirmPrompt
|
||||||
|
|
||||||
|
import System.Directory
|
||||||
|
import System.Exit
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Core commands
|
||||||
|
|
||||||
|
runScreenLock :: X ()
|
||||||
|
runScreenLock = spawn "screenlock"
|
||||||
|
|
||||||
|
runPowerOff :: X ()
|
||||||
|
runPowerOff = spawn "systemctl poweroff"
|
||||||
|
|
||||||
|
runSuspend :: X ()
|
||||||
|
runSuspend = spawn "systemctl suspend"
|
||||||
|
|
||||||
|
runHibernate :: X ()
|
||||||
|
runHibernate = spawn "systemctl hibernate"
|
||||||
|
|
||||||
|
runReboot :: X ()
|
||||||
|
runReboot = spawn "systemctl reboot"
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Confirm prompt wrappers
|
||||||
|
|
||||||
|
runSuspendPrompt :: X ()
|
||||||
|
runSuspendPrompt = confirmPrompt T.promptTheme "suspend?" runSuspend
|
||||||
|
|
||||||
|
runQuitPrompt :: X ()
|
||||||
|
runQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Nvidia Optimus
|
||||||
|
|
||||||
|
-- TODO for some reason the screen never wakes up after suspend when
|
||||||
|
-- the nvidia card is up, so block suspend if nvidia card is running
|
||||||
|
-- and warn user
|
||||||
|
isUsingNvidia :: IO Bool
|
||||||
|
isUsingNvidia = doesDirectoryExist "/sys/module/nvidia"
|
||||||
|
|
||||||
|
runOptimusPrompt :: X ()
|
||||||
|
runOptimusPrompt = do
|
||||||
|
nvidiaOn <- io isUsingNvidia
|
||||||
|
switch $ if nvidiaOn then "intel" else "nvidia"
|
||||||
|
where
|
||||||
|
switch mode = confirmPrompt T.promptTheme (prompt mode) (cmd mode)
|
||||||
|
prompt mode = "gpu switch to " ++ mode ++ "?"
|
||||||
|
cmd mode = spawnCmd "optimus-manager"
|
||||||
|
["--switch", mode, "--no-confirm"]
|
||||||
|
>> io exitSuccess
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Universal power prompt
|
||||||
|
|
||||||
|
data PowerAction = Poweroff
|
||||||
|
| Shutdown
|
||||||
|
| Hibernate
|
||||||
|
| Reboot
|
||||||
|
deriving (Eq)
|
||||||
|
|
||||||
|
instance Enum PowerAction where
|
||||||
|
toEnum 0 = Poweroff
|
||||||
|
toEnum 1 = Shutdown
|
||||||
|
toEnum 2 = Hibernate
|
||||||
|
toEnum 3 = Reboot
|
||||||
|
toEnum _ = errorWithoutStackTrace "Main.Enum.PowerAction.toEnum: bad argument"
|
||||||
|
|
||||||
|
fromEnum Poweroff = 0
|
||||||
|
fromEnum Shutdown = 1
|
||||||
|
fromEnum Hibernate = 2
|
||||||
|
fromEnum Reboot = 3
|
||||||
|
|
||||||
|
data PowerPrompt = PowerPrompt
|
||||||
|
|
||||||
|
instance XPrompt PowerPrompt where
|
||||||
|
showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
|
||||||
|
|
||||||
|
runPowerPrompt :: X ()
|
||||||
|
runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
|
||||||
|
where
|
||||||
|
comp = mkComplFunFromList []
|
||||||
|
theme = T.promptTheme { promptKeymap = keymap }
|
||||||
|
keymap = M.fromList
|
||||||
|
$ ((controlMask, xK_g), quit) :
|
||||||
|
map (first $ (,) 0)
|
||||||
|
[ (xK_p, sendAction Poweroff)
|
||||||
|
, (xK_s, sendAction Shutdown)
|
||||||
|
, (xK_h, sendAction Hibernate)
|
||||||
|
, (xK_r, sendAction Reboot)
|
||||||
|
, (xK_Return, quit)
|
||||||
|
, (xK_Escape, quit)
|
||||||
|
]
|
||||||
|
sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
|
||||||
|
executeAction a = case toEnum $ read a of
|
||||||
|
Poweroff -> runPowerOff
|
||||||
|
Shutdown -> runScreenLock >> runSuspend
|
||||||
|
Hibernate -> runScreenLock >> runHibernate
|
||||||
|
Reboot -> runReboot
|
|
@ -2,6 +2,9 @@ module Shell where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
|
|
||||||
|
myTerm :: String
|
||||||
|
myTerm = "urxvt"
|
||||||
|
|
||||||
fmtCmd :: String -> [String] -> String
|
fmtCmd :: String -> [String] -> String
|
||||||
fmtCmd cmd args = unwords $ cmd : args
|
fmtCmd cmd args = unwords $ cmd : args
|
||||||
|
|
||||||
|
|
|
@ -10,7 +10,10 @@ library
|
||||||
, Theme
|
, Theme
|
||||||
, Notify
|
, Notify
|
||||||
, Shell
|
, Shell
|
||||||
|
, Power
|
||||||
, WorkspaceMon
|
, WorkspaceMon
|
||||||
|
, Capture
|
||||||
|
, General
|
||||||
, Internal.DMenu
|
, Internal.DMenu
|
||||||
, DBus.Common
|
, DBus.Common
|
||||||
, DBus.IntelBacklight
|
, DBus.IntelBacklight
|
||||||
|
@ -37,6 +40,7 @@ library
|
||||||
, directory >= 1.3.3.0
|
, directory >= 1.3.3.0
|
||||||
, process >= 1.6.5.0
|
, process >= 1.6.5.0
|
||||||
, xmobar
|
, xmobar
|
||||||
|
, xmonad-extras >= 0.15.2
|
||||||
, xmonad >= 0.13
|
, xmonad >= 0.13
|
||||||
, xmonad-contrib >= 0.13
|
, xmonad-contrib >= 0.13
|
||||||
ghc-options: -Wall -Werror -fno-warn-missing-signatures
|
ghc-options: -Wall -Werror -fno-warn-missing-signatures
|
||||||
|
@ -53,7 +57,6 @@ executable xmonad
|
||||||
, unix >= 2.7.2.2
|
, unix >= 2.7.2.2
|
||||||
, xmonad >= 0.13
|
, xmonad >= 0.13
|
||||||
, xmonad-contrib >= 0.13
|
, xmonad-contrib >= 0.13
|
||||||
, xmonad-extras >= 0.15.2
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded
|
ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue