ENH use features in external keymap
This commit is contained in:
parent
5c30d513eb
commit
7ec86d04c4
|
@ -306,7 +306,7 @@ getWireless = do
|
||||||
getEthernet :: IO (MaybeExe CmdSpec)
|
getEthernet :: IO (MaybeExe CmdSpec)
|
||||||
getEthernet = do
|
getEthernet = do
|
||||||
i <- readInterface isEthernet
|
i <- readInterface isEthernet
|
||||||
maybe (return $ Left []) (runIfInstalled [dep] . ethernetCmd) i
|
evalFeature $ maybe BlankFeature (featureRun [dep] . ethernetCmd) i
|
||||||
where
|
where
|
||||||
dep = dbusDep True devBus devPath devInterface $ Method_ devGetByIP
|
dep = dbusDep True devBus devPath devInterface $ Method_ devGetByIP
|
||||||
|
|
||||||
|
|
|
@ -9,7 +9,6 @@ module Main (main) where
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
|
|
||||||
import Data.Either (fromRight)
|
|
||||||
import Data.List
|
import Data.List
|
||||||
( isPrefixOf
|
( isPrefixOf
|
||||||
, sortBy
|
, sortBy
|
||||||
|
@ -74,7 +73,7 @@ main = do
|
||||||
, dxScreensaverCtrl = sc
|
, dxScreensaverCtrl = sc
|
||||||
} <- startXMonadService
|
} <- startXMonadService
|
||||||
(h, p) <- spawnPipe "xmobar"
|
(h, p) <- spawnPipe "xmobar"
|
||||||
depActions <- sequence [runPowermon, runRemovableMon]
|
depActions <- mapM evalFeature [runPowermon, runRemovableMon]
|
||||||
mapM_ (mapM_ forkIO) depActions
|
mapM_ (mapM_ forkIO) depActions
|
||||||
_ <- forkIO $ runWorkspaceMon allDWs
|
_ <- forkIO $ runWorkspaceMon allDWs
|
||||||
let ts = ThreadState
|
let ts = ThreadState
|
||||||
|
@ -82,7 +81,7 @@ main = do
|
||||||
, childPIDs = [p]
|
, childPIDs = [p]
|
||||||
, childHandles = [h]
|
, childHandles = [h]
|
||||||
}
|
}
|
||||||
lock <- fromRight skip <$> evalFeature runScreenLock
|
lock <- whenInstalled <$> evalFeature runScreenLock
|
||||||
ext <- evalExternal $ externalBindings bc sc ts lock
|
ext <- evalExternal $ externalBindings bc sc ts lock
|
||||||
warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions
|
warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions
|
||||||
-- IDK why this is necessary; nothing prior to this line will print if missing
|
-- IDK why this is necessary; nothing prior to this line will print if missing
|
||||||
|
@ -472,28 +471,20 @@ data KeyGroup a = KeyGroup
|
||||||
, kgBindings :: [KeyBinding a]
|
, kgBindings :: [KeyBinding a]
|
||||||
}
|
}
|
||||||
|
|
||||||
evalExternal :: [KeyGroup (IO MaybeX)] -> IO [KeyGroup MaybeX]
|
evalExternal :: [KeyGroup FeatureX] -> IO [KeyGroup MaybeX]
|
||||||
evalExternal = mapM go
|
evalExternal = mapM go
|
||||||
where
|
where
|
||||||
go k@KeyGroup { kgBindings = bs } =
|
go k@KeyGroup { kgBindings = bs } =
|
||||||
(\bs' -> k { kgBindings = bs' }) <$> mapM evalKeyBinding bs
|
(\bs' -> k { kgBindings = bs' }) <$> mapM evalKeyBinding bs
|
||||||
|
|
||||||
evalKeyBinding :: Monad m => KeyBinding (m a) -> m (KeyBinding a)
|
evalKeyBinding :: KeyBinding FeatureX -> IO (KeyBinding MaybeX)
|
||||||
evalKeyBinding k@KeyBinding { kbAction = a } = (\b -> k { kbAction = b }) <$> a
|
evalKeyBinding k@KeyBinding { kbAction = a } =
|
||||||
|
(\f -> k { kbAction = f }) <$> evalFeature a
|
||||||
|
|
||||||
filterExternal :: [KeyGroup MaybeX] -> [KeyGroup (X ())]
|
filterExternal :: [KeyGroup MaybeX] -> [KeyGroup (X ())]
|
||||||
filterExternal = fmap go
|
filterExternal = fmap go
|
||||||
where
|
where
|
||||||
go k@KeyGroup { kgBindings = bs } = k { kgBindings = mapMaybe flagKeyBinding bs }
|
go k@KeyGroup { kgBindings = bs } = k { kgBindings = mapMaybe flagKeyBinding bs }
|
||||||
-- go k@KeyGroup { kgBindings = bs } =
|
|
||||||
-- ( k { kgBindings = mapMaybe flagKeyBinding bs }
|
|
||||||
-- , concatMap go' bs
|
|
||||||
-- )
|
|
||||||
-- go' KeyBinding{ kbAction = a } = case a of
|
|
||||||
-- Installed _ opt -> opt
|
|
||||||
-- -- TODO this will mash together the optional and required deps
|
|
||||||
-- Missing req opt -> req ++ opt
|
|
||||||
-- Ignore -> []
|
|
||||||
|
|
||||||
externalToMissing :: [KeyGroup (MaybeExe a)] -> [MaybeExe a]
|
externalToMissing :: [KeyGroup (MaybeExe a)] -> [MaybeExe a]
|
||||||
externalToMissing = concatMap go
|
externalToMissing = concatMap go
|
||||||
|
@ -504,10 +495,9 @@ flagKeyBinding :: KeyBinding MaybeX -> Maybe (KeyBinding (X ()))
|
||||||
flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
|
flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
|
||||||
(Right x) -> Just $ k{ kbAction = x }
|
(Right x) -> Just $ k{ kbAction = x }
|
||||||
(Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip }
|
(Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip }
|
||||||
-- _ -> Nothing
|
|
||||||
|
|
||||||
externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X ()
|
externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X ()
|
||||||
-> [KeyGroup (IO MaybeX)]
|
-> [KeyGroup FeatureX]
|
||||||
externalBindings bc sc ts lock =
|
externalBindings bc sc ts lock =
|
||||||
[ KeyGroup "Launchers"
|
[ KeyGroup "Launchers"
|
||||||
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
|
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
|
||||||
|
@ -525,9 +515,9 @@ externalBindings bc sc ts lock =
|
||||||
]
|
]
|
||||||
|
|
||||||
, KeyGroup "Actions"
|
, KeyGroup "Actions"
|
||||||
[ KeyBinding "M-q" "close window" $ noCheck kill1
|
[ KeyBinding "M-q" "close window" $ ConstFeature kill1
|
||||||
, KeyBinding "M-r" "run program" runCmdMenu
|
, KeyBinding "M-r" "run program" runCmdMenu
|
||||||
, KeyBinding "M-<Space>" "warp pointer" $ noCheck $ warpToWindow 0.5 0.5
|
, KeyBinding "M-<Space>" "warp pointer" $ ConstFeature $ warpToWindow 0.5 0.5
|
||||||
, KeyBinding "M-C-s" "capture area" runAreaCapture
|
, KeyBinding "M-C-s" "capture area" runAreaCapture
|
||||||
, KeyBinding "M-C-S-s" "capture screen" runScreenCapture
|
, KeyBinding "M-C-S-s" "capture screen" runScreenCapture
|
||||||
, KeyBinding "M-C-d" "capture desktop" runDesktopCapture
|
, KeyBinding "M-C-d" "capture desktop" runDesktopCapture
|
||||||
|
@ -553,28 +543,22 @@ externalBindings bc sc ts lock =
|
||||||
]
|
]
|
||||||
|
|
||||||
, KeyGroup "System"
|
, KeyGroup "System"
|
||||||
[ KeyBinding "M-." "backlight up" $ return $ io <$> bctlInc bc
|
[ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc bc
|
||||||
, KeyBinding "M-," "backlight down" $ return $ io <$> bctlDec bc
|
, KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec bc
|
||||||
, KeyBinding "M-M1-," "backlight min" $ return $ io <$> bctlMin bc
|
, KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin bc
|
||||||
, KeyBinding "M-M1-." "backlight max" $ return $ io <$> bctlMax bc
|
, KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax bc
|
||||||
, KeyBinding "M-<End>" "power menu" $ noCheck $ runPowerPrompt lock
|
, KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock
|
||||||
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
|
, KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
|
||||||
-- TODO this won't be aware of when the lock doesn't exist
|
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
||||||
, KeyBinding "M-<Delete>" "lock screen" $ noCheck lock
|
|
||||||
-- M-<F1> reserved for showing the keymap
|
-- M-<F1> reserved for showing the keymap
|
||||||
, KeyBinding "M-<F2>" "restart xmonad" $ noCheck (runCleanup ts >> runRestart)
|
, KeyBinding "M-<F2>" "restart xmonad" $ ConstFeature (runCleanup ts >> runRestart)
|
||||||
, KeyBinding "M-<F3>" "recompile xmonad" $ noCheck runRecompile
|
, KeyBinding "M-<F3>" "recompile xmonad" $ ConstFeature runRecompile
|
||||||
, KeyBinding "M-<F7>" "start Isync Service" runStartISyncService
|
, KeyBinding "M-<F7>" "start Isync Service" runStartISyncService
|
||||||
, KeyBinding "M-C-<F7>" "start Isync Timer" runStartISyncTimer
|
, KeyBinding "M-C-<F7>" "start Isync Timer" runStartISyncTimer
|
||||||
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
|
, KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
|
||||||
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
|
, KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
|
||||||
, KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
|
, KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
|
||||||
, KeyBinding "M-<F11>" "toggle screensaver" $ return $ io <$> ssToggle sc
|
, KeyBinding "M-<F11>" "toggle screensaver" $ ioFeature $ ssToggle sc
|
||||||
, KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
|
, KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
-- where
|
|
||||||
-- TODO this is hacky, I shouldn't really need this data structure for
|
|
||||||
-- something that doesn't depend on executables
|
|
||||||
-- runMaybe c f = return $ maybe Ignore (\x -> Installed (io $ f x) []) c
|
|
||||||
|
|
||||||
|
|
|
@ -47,8 +47,8 @@ myDmenuNetworks = "networkmanager_dmenu"
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Other internal functions
|
-- | Other internal functions
|
||||||
|
|
||||||
spawnDmenuCmd :: [String] -> IO MaybeX
|
spawnDmenuCmd :: [String] -> FeatureX
|
||||||
spawnDmenuCmd = spawnCmdIfInstalled myDmenuCmd
|
spawnDmenuCmd = featureSpawnCmd myDmenuCmd
|
||||||
|
|
||||||
themeArgs :: String -> [String]
|
themeArgs :: String -> [String]
|
||||||
themeArgs hexColor =
|
themeArgs hexColor =
|
||||||
|
@ -62,41 +62,42 @@ myDmenuMatchingArgs = ["-i"] -- case insensitivity
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Exported Commands
|
-- | Exported Commands
|
||||||
|
|
||||||
runDevMenu :: IO MaybeX
|
runDevMenu :: FeatureX
|
||||||
runDevMenu = runIfInstalled [exe myDmenuDevices] $ do
|
runDevMenu = featureRun [exe myDmenuDevices] $ do
|
||||||
c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
|
c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
|
||||||
spawnCmd myDmenuDevices
|
spawnCmd myDmenuDevices
|
||||||
$ ["-c", c]
|
$ ["-c", c]
|
||||||
++ "--" : themeArgs "#999933"
|
++ "--" : themeArgs "#999933"
|
||||||
++ myDmenuMatchingArgs
|
++ myDmenuMatchingArgs
|
||||||
|
|
||||||
runBwMenu :: IO MaybeX
|
runBwMenu :: FeatureX
|
||||||
runBwMenu = runIfInstalled [exe myDmenuPasswords] $
|
runBwMenu = featureRun [exe myDmenuPasswords] $
|
||||||
spawnCmd myDmenuPasswords $ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
|
spawnCmd myDmenuPasswords $ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
|
||||||
|
|
||||||
|
-- TODO this is weirdly inverted
|
||||||
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
|
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
|
||||||
runShowKeys x = addName "Show Keybindings" $ do
|
runShowKeys x = addName "Show Keybindings" $ do
|
||||||
s <- io $ runDMenuShowKeys x
|
s <- io $ evalFeature $ runDMenuShowKeys x
|
||||||
ifInstalled s
|
ifInstalled s
|
||||||
$ spawnNotify
|
$ spawnNotify
|
||||||
$ defNoteError { body = Just $ Text "could not display keymap" }
|
$ defNoteError { body = Just $ Text "could not display keymap" }
|
||||||
|
|
||||||
runDMenuShowKeys :: [((KeyMask, KeySym), NamedAction)] -> IO MaybeX
|
runDMenuShowKeys :: [((KeyMask, KeySym), NamedAction)] -> FeatureX
|
||||||
runDMenuShowKeys kbs = runIfInstalled [exe myDmenuCmd] $ io $ do
|
runDMenuShowKeys kbs = featureRun [exe myDmenuCmd] $ io $ do
|
||||||
(h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
|
(h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
|
||||||
forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
|
forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
|
||||||
where
|
where
|
||||||
cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
|
cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
|
||||||
++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs
|
++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs
|
||||||
|
|
||||||
runCmdMenu :: IO MaybeX
|
runCmdMenu :: FeatureX
|
||||||
runCmdMenu = spawnDmenuCmd ["-show", "run"]
|
runCmdMenu = spawnDmenuCmd ["-show", "run"]
|
||||||
|
|
||||||
runAppMenu :: IO MaybeX
|
runAppMenu :: FeatureX
|
||||||
runAppMenu = spawnDmenuCmd ["-show", "drun"]
|
runAppMenu = spawnDmenuCmd ["-show", "drun"]
|
||||||
|
|
||||||
runClipMenu :: IO MaybeX
|
runClipMenu :: FeatureX
|
||||||
runClipMenu = runIfInstalled [exe myDmenuCmd, exe "greenclip"]
|
runClipMenu = featureRun [exe myDmenuCmd, exe "greenclip"]
|
||||||
$ spawnCmd myDmenuCmd args
|
$ spawnCmd myDmenuCmd args
|
||||||
where
|
where
|
||||||
args = [ "-modi", "\"clipboard:greenclip print\""
|
args = [ "-modi", "\"clipboard:greenclip print\""
|
||||||
|
@ -104,11 +105,11 @@ runClipMenu = runIfInstalled [exe myDmenuCmd, exe "greenclip"]
|
||||||
, "-run-command", "'{cmd}'"
|
, "-run-command", "'{cmd}'"
|
||||||
] ++ themeArgs "#00c44e"
|
] ++ themeArgs "#00c44e"
|
||||||
|
|
||||||
runWinMenu :: IO MaybeX
|
runWinMenu :: FeatureX
|
||||||
runWinMenu = spawnDmenuCmd ["-show", "window"]
|
runWinMenu = spawnDmenuCmd ["-show", "window"]
|
||||||
|
|
||||||
runNetMenu :: IO MaybeX
|
runNetMenu :: FeatureX
|
||||||
runNetMenu = spawnCmdIfInstalled myDmenuNetworks $ themeArgs "#ff3333"
|
runNetMenu = featureSpawnCmd myDmenuNetworks $ themeArgs "#ff3333"
|
||||||
|
|
||||||
runAutorandrMenu :: IO MaybeX
|
runAutorandrMenu :: FeatureX
|
||||||
runAutorandrMenu = spawnCmdIfInstalled myDmenuMonitors $ themeArgs "#ff0066"
|
runAutorandrMenu = featureSpawnCmd myDmenuMonitors $ themeArgs "#ff0066"
|
||||||
|
|
|
@ -17,7 +17,6 @@ module XMonad.Internal.Command.Desktop
|
||||||
, runVolumeUp
|
, runVolumeUp
|
||||||
, runVolumeMute
|
, runVolumeMute
|
||||||
, runToggleBluetooth
|
, runToggleBluetooth
|
||||||
-- , runToggleDPMS
|
|
||||||
, runToggleEthernet
|
, runToggleEthernet
|
||||||
, runRestart
|
, runRestart
|
||||||
, runRecompile
|
, runRecompile
|
||||||
|
@ -31,9 +30,11 @@ module XMonad.Internal.Command.Desktop
|
||||||
, runNotificationCloseAll
|
, runNotificationCloseAll
|
||||||
, runNotificationHistory
|
, runNotificationHistory
|
||||||
, runNotificationContext
|
, runNotificationContext
|
||||||
|
, playSound
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
( createDirectoryIfMissing
|
( createDirectoryIfMissing
|
||||||
|
@ -44,10 +45,10 @@ import System.FilePath
|
||||||
|
|
||||||
import XMonad.Actions.Volume
|
import XMonad.Actions.Volume
|
||||||
import XMonad.Core hiding (spawn)
|
import XMonad.Core hiding (spawn)
|
||||||
-- import XMonad.Internal.DBus.Screensaver
|
|
||||||
import XMonad.Internal.Dependency
|
import XMonad.Internal.Dependency
|
||||||
import XMonad.Internal.Notify
|
import XMonad.Internal.Notify
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
|
import XMonad.Internal.Shell
|
||||||
import XMonad.Operations
|
import XMonad.Operations
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -89,15 +90,11 @@ ethernetIface = "enp7s0f1"
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Some nice apps
|
-- | Some nice apps
|
||||||
|
|
||||||
runTerm :: IO MaybeX
|
runTerm :: FeatureX
|
||||||
runTerm = spawnIfInstalled myTerm
|
runTerm = featureSpawn myTerm
|
||||||
|
|
||||||
runTMux :: IO MaybeX
|
runTMux :: FeatureX
|
||||||
runTMux = evalFeature $ Feature
|
runTMux = featureRun [exe myTerm, exe "tmux", exe "bash"] cmd
|
||||||
{ ftrAction = cmd
|
|
||||||
, ftrSilent = False
|
|
||||||
, ftrChildren = [exe myTerm, exe "tmux", exe "bash"]
|
|
||||||
}
|
|
||||||
where
|
where
|
||||||
cmd = spawn
|
cmd = spawn
|
||||||
$ "tmux has-session"
|
$ "tmux has-session"
|
||||||
|
@ -106,95 +103,108 @@ runTMux = evalFeature $ Feature
|
||||||
c = "exec tmux attach-session -d"
|
c = "exec tmux attach-session -d"
|
||||||
msg = "could not connect to tmux session"
|
msg = "could not connect to tmux session"
|
||||||
|
|
||||||
runCalc :: IO MaybeX
|
runCalc :: FeatureX
|
||||||
runCalc = runIfInstalled [exe myTerm, exe "R"] $ spawnCmd myTerm ["-e", "R"]
|
runCalc = featureRun [exe myTerm, exe "R"] $ spawnCmd myTerm ["-e", "R"]
|
||||||
|
|
||||||
runBrowser :: IO MaybeX
|
runBrowser :: FeatureX
|
||||||
runBrowser = spawnIfInstalled myBrowser
|
runBrowser = featureSpawn myBrowser
|
||||||
|
|
||||||
runEditor :: IO MaybeX
|
runEditor :: FeatureX
|
||||||
runEditor = spawnCmdIfInstalled myEditor
|
runEditor = featureSpawnCmd myEditor
|
||||||
["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
|
["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
|
||||||
|
|
||||||
runFileManager :: IO MaybeX
|
runFileManager :: FeatureX
|
||||||
runFileManager = spawnIfInstalled "pcmanfm"
|
runFileManager = featureSpawn "pcmanfm"
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Multimedia Commands
|
-- | Multimedia Commands
|
||||||
|
|
||||||
runMultimediaIfInstalled :: String -> IO MaybeX
|
runMultimediaIfInstalled :: String -> FeatureX
|
||||||
runMultimediaIfInstalled cmd = spawnCmdIfInstalled myMultimediaCtl [cmd]
|
runMultimediaIfInstalled cmd = featureSpawnCmd myMultimediaCtl [cmd]
|
||||||
|
|
||||||
runTogglePlay :: IO MaybeX
|
runTogglePlay :: FeatureX
|
||||||
runTogglePlay = runMultimediaIfInstalled "play-pause"
|
runTogglePlay = runMultimediaIfInstalled "play-pause"
|
||||||
|
|
||||||
runPrevTrack :: IO MaybeX
|
runPrevTrack :: FeatureX
|
||||||
runPrevTrack = runMultimediaIfInstalled "previous"
|
runPrevTrack = runMultimediaIfInstalled "previous"
|
||||||
|
|
||||||
runNextTrack :: IO MaybeX
|
runNextTrack :: FeatureX
|
||||||
runNextTrack = runMultimediaIfInstalled "next"
|
runNextTrack = runMultimediaIfInstalled "next"
|
||||||
|
|
||||||
runStopPlay :: IO MaybeX
|
runStopPlay :: FeatureX
|
||||||
runStopPlay = runMultimediaIfInstalled "stop"
|
runStopPlay = runMultimediaIfInstalled "stop"
|
||||||
|
|
||||||
runVolumeDown :: IO MaybeX
|
--------------------------------------------------------------------------------
|
||||||
runVolumeDown = spawnSound volumeChangeSound (return ()) $ void (lowerVolume 2)
|
-- | Volume Commands
|
||||||
|
|
||||||
runVolumeUp :: IO MaybeX
|
soundDir :: FilePath
|
||||||
runVolumeUp = spawnSound volumeChangeSound (return ()) $ void (raiseVolume 2)
|
soundDir = "sound"
|
||||||
|
|
||||||
runVolumeMute :: IO MaybeX
|
playSound :: MonadIO m => FilePath -> m ()
|
||||||
runVolumeMute = spawnSound volumeChangeSound (void toggleMute) $ return ()
|
playSound file = do
|
||||||
|
p <- (</> soundDir </> file) <$> getXMonadDir
|
||||||
|
-- paplay seems to have less latency than aplay
|
||||||
|
spawnCmd "paplay" [p]
|
||||||
|
|
||||||
|
featureSound :: FilePath -> X () -> X () -> FeatureX
|
||||||
|
featureSound file pre post = featureRun [exe "paplay"]
|
||||||
|
$ pre >> playSound file >> post
|
||||||
|
|
||||||
|
runVolumeDown :: FeatureX
|
||||||
|
runVolumeDown = featureSound volumeChangeSound (return ()) $ void (lowerVolume 2)
|
||||||
|
|
||||||
|
runVolumeUp :: FeatureX
|
||||||
|
runVolumeUp = featureSound volumeChangeSound (return ()) $ void (raiseVolume 2)
|
||||||
|
|
||||||
|
runVolumeMute :: FeatureX
|
||||||
|
runVolumeMute = featureSound volumeChangeSound (void toggleMute) $ return ()
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Notification control
|
-- | Notification control
|
||||||
|
|
||||||
runNotificationCmd :: String -> IO MaybeX
|
runNotificationCmd :: String -> FeatureX
|
||||||
runNotificationCmd cmd = spawnCmdIfInstalled myNotificationCtrl [cmd]
|
runNotificationCmd cmd = featureSpawnCmd myNotificationCtrl [cmd]
|
||||||
|
|
||||||
runNotificationClose :: IO MaybeX
|
runNotificationClose :: FeatureX
|
||||||
runNotificationClose = runNotificationCmd "close"
|
runNotificationClose = runNotificationCmd "close"
|
||||||
|
|
||||||
runNotificationCloseAll :: IO MaybeX
|
runNotificationCloseAll :: FeatureX
|
||||||
runNotificationCloseAll = runNotificationCmd "close-all"
|
runNotificationCloseAll = runNotificationCmd "close-all"
|
||||||
|
|
||||||
runNotificationHistory :: IO MaybeX
|
runNotificationHistory :: FeatureX
|
||||||
runNotificationHistory = runNotificationCmd "history-pop"
|
runNotificationHistory = runNotificationCmd "history-pop"
|
||||||
|
|
||||||
runNotificationContext :: IO MaybeX
|
runNotificationContext :: FeatureX
|
||||||
runNotificationContext = runNotificationCmd "context"
|
runNotificationContext = runNotificationCmd "context"
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | System commands
|
-- | System commands
|
||||||
|
|
||||||
runToggleBluetooth :: IO MaybeX
|
runToggleBluetooth :: FeatureX
|
||||||
runToggleBluetooth = runIfInstalled [exe myBluetooth] $ spawn
|
runToggleBluetooth = featureRun [exe myBluetooth] $ spawn
|
||||||
$ myBluetooth ++ " show | grep -q \"Powered: no\""
|
$ myBluetooth ++ " show | grep -q \"Powered: no\""
|
||||||
#!&& "a=on"
|
#!&& "a=on"
|
||||||
#!|| "a=off"
|
#!|| "a=off"
|
||||||
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
|
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
|
||||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
||||||
|
|
||||||
-- runToggleDPMS :: IO MaybeX
|
runToggleEthernet :: FeatureX
|
||||||
-- runToggleDPMS = io <$> evalFeature callToggle
|
runToggleEthernet = featureRun [exe "nmcli"] $ spawn
|
||||||
|
|
||||||
runToggleEthernet :: IO MaybeX
|
|
||||||
runToggleEthernet = runIfInstalled [exe "nmcli"] $ spawn
|
|
||||||
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
||||||
#!&& "a=connect"
|
#!&& "a=connect"
|
||||||
#!|| "a=disconnect"
|
#!|| "a=disconnect"
|
||||||
#!>> fmtCmd "nmcli" ["device", "$a", ethernetIface]
|
#!>> fmtCmd "nmcli" ["device", "$a", ethernetIface]
|
||||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed" }
|
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed" }
|
||||||
|
|
||||||
runStartISyncTimer :: IO MaybeX
|
runStartISyncTimer :: FeatureX
|
||||||
runStartISyncTimer = runIfInstalled [userUnit "mbsync.timer"]
|
runStartISyncTimer = featureRun [userUnit "mbsync.timer"]
|
||||||
$ spawn
|
$ spawn
|
||||||
$ "systemctl --user start mbsync.timer"
|
$ "systemctl --user start mbsync.timer"
|
||||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync timer started" }
|
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync timer started" }
|
||||||
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "Isync timer failed to start" }
|
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "Isync timer failed to start" }
|
||||||
|
|
||||||
runStartISyncService :: IO MaybeX
|
runStartISyncService :: FeatureX
|
||||||
runStartISyncService = runIfInstalled [userUnit "mbsync.service"]
|
runStartISyncService = featureRun [userUnit "mbsync.service"]
|
||||||
$ spawn
|
$ spawn
|
||||||
$ "systemctl --user start mbsync.service"
|
$ "systemctl --user start mbsync.service"
|
||||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync completed" }
|
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync completed" }
|
||||||
|
@ -238,25 +248,25 @@ getCaptureDir = do
|
||||||
where
|
where
|
||||||
fallback = (</> ".local/share") <$> getHomeDirectory
|
fallback = (</> ".local/share") <$> getHomeDirectory
|
||||||
|
|
||||||
runFlameshot :: String -> IO MaybeX
|
runFlameshot :: String -> FeatureX
|
||||||
runFlameshot mode = runIfInstalled [exe myCapture] $ do
|
runFlameshot mode = featureRun [exe myCapture] $ do
|
||||||
ssDir <- io getCaptureDir
|
ssDir <- io getCaptureDir
|
||||||
spawnCmd myCapture $ mode : ["-p", ssDir]
|
spawnCmd myCapture $ mode : ["-p", ssDir]
|
||||||
|
|
||||||
-- TODO this will steal focus from the current window (and puts it
|
-- TODO this will steal focus from the current window (and puts it
|
||||||
-- in the root window?) ...need to fix
|
-- in the root window?) ...need to fix
|
||||||
runAreaCapture :: IO MaybeX
|
runAreaCapture :: FeatureX
|
||||||
runAreaCapture = runFlameshot "gui"
|
runAreaCapture = runFlameshot "gui"
|
||||||
|
|
||||||
-- myWindowCap = "screencap -w" --external script
|
-- myWindowCap = "screencap -w" --external script
|
||||||
|
|
||||||
runDesktopCapture :: IO MaybeX
|
runDesktopCapture :: FeatureX
|
||||||
runDesktopCapture = runFlameshot "full"
|
runDesktopCapture = runFlameshot "full"
|
||||||
|
|
||||||
runScreenCapture :: IO MaybeX
|
runScreenCapture :: FeatureX
|
||||||
runScreenCapture = runFlameshot "screen"
|
runScreenCapture = runFlameshot "screen"
|
||||||
|
|
||||||
runCaptureBrowser :: IO MaybeX
|
runCaptureBrowser :: FeatureX
|
||||||
runCaptureBrowser = runIfInstalled [exe myImageBrowser] $ do
|
runCaptureBrowser = featureRun [exe myImageBrowser] $ do
|
||||||
dir <- io getCaptureDir
|
dir <- io getCaptureDir
|
||||||
spawnCmd myImageBrowser [dir]
|
spawnCmd myImageBrowser [dir]
|
||||||
|
|
|
@ -28,6 +28,7 @@ import System.IO.Error
|
||||||
|
|
||||||
import XMonad.Core
|
import XMonad.Core
|
||||||
import XMonad.Internal.Dependency
|
import XMonad.Internal.Dependency
|
||||||
|
import XMonad.Internal.Shell
|
||||||
import qualified XMonad.Internal.Theme as T
|
import qualified XMonad.Internal.Theme as T
|
||||||
import XMonad.Prompt
|
import XMonad.Prompt
|
||||||
import XMonad.Prompt.ConfirmPrompt
|
import XMonad.Prompt.ConfirmPrompt
|
||||||
|
@ -44,9 +45,6 @@ myOptimusManager = "optimus-manager"
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Core commands
|
-- | Core commands
|
||||||
|
|
||||||
-- runScreenLock :: IO MaybeX
|
|
||||||
-- runScreenLock = spawnIfInstalled myScreenlock
|
|
||||||
|
|
||||||
runScreenLock :: Feature (X ()) (X ())
|
runScreenLock :: Feature (X ()) (X ())
|
||||||
runScreenLock = Feature
|
runScreenLock = Feature
|
||||||
{ ftrAction = spawn myScreenlock
|
{ ftrAction = spawn myScreenlock
|
||||||
|
@ -69,6 +67,7 @@ runReboot = spawn "systemctl reboot"
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Confirm prompt wrappers
|
-- | Confirm prompt wrappers
|
||||||
|
|
||||||
|
-- TODO doesn't this need to also lock the screen?
|
||||||
runSuspendPrompt :: X ()
|
runSuspendPrompt :: X ()
|
||||||
runSuspendPrompt = confirmPrompt T.promptTheme "suspend?" runSuspend
|
runSuspendPrompt = confirmPrompt T.promptTheme "suspend?" runSuspend
|
||||||
|
|
||||||
|
@ -88,7 +87,6 @@ hasBattery :: IO (Maybe String)
|
||||||
hasBattery = do
|
hasBattery = do
|
||||||
ps <- fromRight [] <$> tryIOError (listDirectory syspath)
|
ps <- fromRight [] <$> tryIOError (listDirectory syspath)
|
||||||
ts <- mapM readType ps
|
ts <- mapM readType ps
|
||||||
-- TODO this is obviously stupid
|
|
||||||
return $ if "Battery\n" `elem` ts then Nothing else Just "battery not found"
|
return $ if "Battery\n" `elem` ts then Nothing else Just "battery not found"
|
||||||
where
|
where
|
||||||
readType p = fromRight [] <$> tryIOError (readFile $ syspath </> p </> "type")
|
readType p = fromRight [] <$> tryIOError (readFile $ syspath </> p </> "type")
|
||||||
|
@ -106,14 +104,8 @@ runOptimusPrompt' = do
|
||||||
#!&& unwords [myOptimusManager, "--switch", mode, "--no-confirm"]
|
#!&& unwords [myOptimusManager, "--switch", mode, "--no-confirm"]
|
||||||
#!&& "killall xmonad"
|
#!&& "killall xmonad"
|
||||||
|
|
||||||
runOptimusPrompt :: IO MaybeX
|
runOptimusPrompt :: FeatureX
|
||||||
runOptimusPrompt = runIfInstalled [exe myOptimusManager] runOptimusPrompt'
|
runOptimusPrompt = featureRun [exe myOptimusManager] runOptimusPrompt'
|
||||||
-- runOptimusPrompt :: Feature (X ()) (X ())
|
|
||||||
-- runOptimusPrompt = Feature
|
|
||||||
-- { ftrAction = runOptimusPrompt'
|
|
||||||
-- , ftrSilent = False
|
|
||||||
-- , ftrChildren = [exe myOptimusManager]
|
|
||||||
-- }
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Universal power prompt
|
-- | Universal power prompt
|
||||||
|
@ -159,36 +151,6 @@ runPowerPrompt lock = mkXPrompt PowerPrompt theme comp executeAction
|
||||||
sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
|
sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
|
||||||
executeAction a = case toEnum $ read a of
|
executeAction a = case toEnum $ read a of
|
||||||
Poweroff -> runPowerOff
|
Poweroff -> runPowerOff
|
||||||
-- TODO these dependency functions need to be assembled elsewhere and fed
|
|
||||||
-- to this function
|
|
||||||
-- Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend
|
|
||||||
-- Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate
|
|
||||||
Shutdown -> lock >> runSuspend
|
Shutdown -> lock >> runSuspend
|
||||||
Hibernate -> lock >> runHibernate
|
Hibernate -> lock >> runHibernate
|
||||||
Reboot -> runReboot
|
Reboot -> runReboot
|
||||||
|
|
||||||
-- runPowerPrompt :: Feature (X ()) (X ()) -> IO (X ())
|
|
||||||
-- runPowerPrompt lock = do
|
|
||||||
-- lock' <- evalFeature lock
|
|
||||||
-- return $ mkXPrompt PowerPrompt theme comp $ executeAction $ fromRight (return ()) lock'
|
|
||||||
-- 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 l a = case toEnum $ read a of
|
|
||||||
-- Poweroff -> runPowerOff
|
|
||||||
-- -- TODO these dependency functions need to be assembled elsewhere and fed
|
|
||||||
-- -- to this function
|
|
||||||
-- Shutdown -> l >> runSuspend
|
|
||||||
-- Hibernate -> l >> runHibernate
|
|
||||||
-- Reboot -> runReboot
|
|
||||||
|
|
|
@ -94,8 +94,8 @@ acpiPath = "/var/run/acpid.socket"
|
||||||
|
|
||||||
-- | Spawn a new thread that will listen for ACPI events on the acpid socket
|
-- | Spawn a new thread that will listen for ACPI events on the acpid socket
|
||||||
-- and send ClientMessage events when it receives them
|
-- and send ClientMessage events when it receives them
|
||||||
runPowermon :: IO (MaybeExe (IO ()))
|
runPowermon :: FeatureIO
|
||||||
runPowermon = runIfInstalled [pathR acpiPath] listenACPI
|
runPowermon = featureRun [pathR acpiPath] listenACPI
|
||||||
|
|
||||||
-- | Handle ClientMessage event containing and ACPI event (to be used in
|
-- | Handle ClientMessage event containing and ACPI event (to be used in
|
||||||
-- Xmonad's event hook)
|
-- Xmonad's event hook)
|
||||||
|
@ -109,6 +109,5 @@ handleACPI lock tag = do
|
||||||
status <- io isDischarging
|
status <- io isDischarging
|
||||||
-- only run suspend if battery exists and is discharging
|
-- only run suspend if battery exists and is discharging
|
||||||
forM_ status $ flip when runSuspend
|
forM_ status $ flip when runSuspend
|
||||||
-- io runScreenLock >>= whenInstalled
|
|
||||||
lock
|
lock
|
||||||
|
|
||||||
|
|
|
@ -15,6 +15,7 @@ import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
-- import XMonad.Internal.DBus.Control (pathExists)
|
-- import XMonad.Internal.DBus.Control (pathExists)
|
||||||
|
import XMonad.Internal.Command.Desktop
|
||||||
import XMonad.Internal.Dependency
|
import XMonad.Internal.Dependency
|
||||||
|
|
||||||
bus :: BusName
|
bus :: BusName
|
||||||
|
@ -91,5 +92,5 @@ listenDevices = do
|
||||||
addMatch' client m p f = addMatch client ruleUdisks { matchMember = Just m }
|
addMatch' client m p f = addMatch client ruleUdisks { matchMember = Just m }
|
||||||
$ playSoundMaybe p . f . signalBody
|
$ playSoundMaybe p . f . signalBody
|
||||||
|
|
||||||
runRemovableMon :: IO (MaybeExe (IO ()))
|
runRemovableMon :: FeatureIO
|
||||||
runRemovableMon = runIfInstalled [addedDep, removedDep] listenDevices
|
runRemovableMon = featureRun [addedDep, removedDep] listenDevices
|
||||||
|
|
|
@ -39,10 +39,10 @@ data BrightnessConfig a b = BrightnessConfig
|
||||||
}
|
}
|
||||||
|
|
||||||
data BrightnessControls = BrightnessControls
|
data BrightnessControls = BrightnessControls
|
||||||
{ bctlMax :: MaybeExe (IO ())
|
{ bctlMax :: FeatureIO
|
||||||
, bctlMin :: MaybeExe (IO ())
|
, bctlMin :: FeatureIO
|
||||||
, bctlInc :: MaybeExe (IO ())
|
, bctlInc :: FeatureIO
|
||||||
, bctlDec :: MaybeExe (IO ())
|
, bctlDec :: FeatureIO
|
||||||
}
|
}
|
||||||
|
|
||||||
exportBrightnessControls :: RealFrac b => [Dependency (IO ())] -> BrightnessConfig a b
|
exportBrightnessControls :: RealFrac b => [Dependency (IO ())] -> BrightnessConfig a b
|
||||||
|
@ -50,17 +50,12 @@ exportBrightnessControls :: RealFrac b => [Dependency (IO ())] -> BrightnessConf
|
||||||
exportBrightnessControls deps bc client =
|
exportBrightnessControls deps bc client =
|
||||||
initControls client (brightnessExporter deps bc) controls
|
initControls client (brightnessExporter deps bc) controls
|
||||||
where
|
where
|
||||||
controls exporter = do
|
controls exporter = let callBacklight' = callBacklight bc exporter in
|
||||||
let callBacklight' = evalFeature . callBacklight bc exporter
|
BrightnessControls
|
||||||
mx <- callBacklight' memMax
|
{ bctlMax = callBacklight' memMax
|
||||||
mn <- callBacklight' memMin
|
, bctlMin = callBacklight' memMin
|
||||||
ic <- callBacklight' memInc
|
, bctlInc = callBacklight' memInc
|
||||||
dc <- callBacklight' memDec
|
, bctlDec = callBacklight' memDec
|
||||||
return $ BrightnessControls
|
|
||||||
{ bctlMax = mx
|
|
||||||
, bctlMin = mn
|
|
||||||
, bctlInc = ic
|
|
||||||
, bctlDec = dc
|
|
||||||
}
|
}
|
||||||
|
|
||||||
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
||||||
|
@ -99,7 +94,7 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
|
||||||
-- }
|
-- }
|
||||||
|
|
||||||
brightnessExporter :: RealFrac b => [Dependency (IO ())]
|
brightnessExporter :: RealFrac b => [Dependency (IO ())]
|
||||||
-> BrightnessConfig a b -> Client -> Feature (IO ()) (IO ())
|
-> BrightnessConfig a b -> Client -> FeatureIO
|
||||||
brightnessExporter deps bc client = Feature
|
brightnessExporter deps bc client = Feature
|
||||||
{ ftrAction = exportBrightnessControls' bc client
|
{ ftrAction = exportBrightnessControls' bc client
|
||||||
, ftrSilent = False
|
, ftrSilent = False
|
||||||
|
@ -132,8 +127,7 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
|
||||||
-- callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
|
-- callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
|
||||||
-- void $ callMethod $ methodCall p i mem
|
-- void $ callMethod $ methodCall p i mem
|
||||||
|
|
||||||
callBacklight :: BrightnessConfig a b -> Feature (IO ()) (IO ()) -> MemberName
|
callBacklight :: BrightnessConfig a b -> FeatureIO -> MemberName -> FeatureIO
|
||||||
-> Feature (IO ()) (IO ())
|
|
||||||
callBacklight BrightnessConfig { bcPath = p, bcInterface = i } exporter mem =
|
callBacklight BrightnessConfig { bcPath = p, bcInterface = i } exporter mem =
|
||||||
Feature
|
Feature
|
||||||
{ ftrAction = void $ callMethod $ methodCall p i mem
|
{ ftrAction = void $ callMethod $ methodCall p i mem
|
||||||
|
|
|
@ -58,37 +58,6 @@ incBrightness = incPercent steps curFile
|
||||||
decBrightness :: RawBrightness -> IO Brightness
|
decBrightness :: RawBrightness -> IO Brightness
|
||||||
decBrightness = decPercent steps curFile
|
decBrightness = decPercent steps curFile
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Access checks
|
|
||||||
|
|
||||||
-- | determine if backlight is accessible/present
|
|
||||||
-- Right True -> backlight accessible and present
|
|
||||||
-- Right False -> backlight not present
|
|
||||||
-- Left x -> backlight present but could not access (x explaining why)
|
|
||||||
-- hasBacklight' :: IO (Either String Bool)
|
|
||||||
-- hasBacklight' = do
|
|
||||||
-- mx <- isReadable maxFile
|
|
||||||
-- cx <- isWritable curFile
|
|
||||||
-- return $ case (mx, cx) of
|
|
||||||
-- (NotFoundError, NotFoundError) -> Right False
|
|
||||||
-- (PermResult True, PermResult True) -> Right True
|
|
||||||
-- (PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files"
|
|
||||||
-- _ -> Left "Could not determine permissions for backlight files"
|
|
||||||
|
|
||||||
-- msg :: Either String Bool -> IO ()
|
|
||||||
-- msg (Right True) = return ()
|
|
||||||
-- msg (Right False) = putStrLn "No backlight detected. Controls disabled"
|
|
||||||
-- msg (Left m) = putStrLn $ "WARNING: " ++ m
|
|
||||||
|
|
||||||
-- hasBacklightMsg :: IO Bool
|
|
||||||
-- hasBacklightMsg = do
|
|
||||||
-- b <- hasBacklight'
|
|
||||||
-- msg b
|
|
||||||
-- return $ fromRight False b
|
|
||||||
|
|
||||||
-- hasBacklight :: IO Bool
|
|
||||||
-- hasBacklight = fromRight False <$> hasBacklight'
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | DBus interface
|
-- | DBus interface
|
||||||
|
|
||||||
|
@ -122,10 +91,6 @@ maxFileDep = pathR maxFile
|
||||||
exportIntelBacklight :: Client -> IO BrightnessControls
|
exportIntelBacklight :: Client -> IO BrightnessControls
|
||||||
exportIntelBacklight =
|
exportIntelBacklight =
|
||||||
exportBrightnessControls [curFileDep, maxFileDep] intelBacklightConfig
|
exportBrightnessControls [curFileDep, maxFileDep] intelBacklightConfig
|
||||||
-- b <- hasBacklightMsg
|
|
||||||
-- if b
|
|
||||||
-- then Just <$> exportBrightnessControls intelBacklightConfig client
|
|
||||||
-- else return Nothing
|
|
||||||
|
|
||||||
callGetBrightnessIB :: IO (Maybe Brightness)
|
callGetBrightnessIB :: IO (Maybe Brightness)
|
||||||
callGetBrightnessIB = callGetBrightness intelBacklightConfig
|
callGetBrightnessIB = callGetBrightness intelBacklightConfig
|
||||||
|
|
|
@ -40,12 +40,11 @@ addMatchCallback rule cb = do
|
||||||
client <- connectSession
|
client <- connectSession
|
||||||
addMatch client rule $ cb . signalBody
|
addMatch client rule $ cb . signalBody
|
||||||
|
|
||||||
initControls :: Client -> (Client -> Feature (IO ()) (IO ()))
|
initControls :: Client -> (Client -> FeatureIO) -> (FeatureIO -> a) -> IO a
|
||||||
-> (Feature (IO ()) (IO ()) -> IO a) -> IO a
|
|
||||||
initControls client exporter controls = do
|
initControls client exporter controls = do
|
||||||
let x = exporter client
|
let x = exporter client
|
||||||
e <- evalFeature x
|
e <- evalFeature x
|
||||||
case e of
|
case e of
|
||||||
(Right c) -> c
|
(Right c) -> c
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
controls x
|
return $ controls x
|
||||||
|
|
|
@ -21,7 +21,7 @@ import XMonad.Internal.DBus.Brightness.Common
|
||||||
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.DBus.Screensaver
|
import XMonad.Internal.DBus.Screensaver
|
||||||
-- import XMonad.Internal.Dependency
|
import XMonad.Internal.Dependency
|
||||||
|
|
||||||
introspectInterface :: InterfaceName
|
introspectInterface :: InterfaceName
|
||||||
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
||||||
|
@ -38,14 +38,14 @@ data DBusXMonad = DBusXMonad
|
||||||
|
|
||||||
blankControls :: BrightnessControls
|
blankControls :: BrightnessControls
|
||||||
blankControls = BrightnessControls
|
blankControls = BrightnessControls
|
||||||
{ bctlMax = Left []
|
{ bctlMax = BlankFeature
|
||||||
, bctlMin = Left []
|
, bctlMin = BlankFeature
|
||||||
, bctlInc = Left []
|
, bctlInc = BlankFeature
|
||||||
, bctlDec = Left []
|
, bctlDec = BlankFeature
|
||||||
}
|
}
|
||||||
|
|
||||||
blankSSToggle :: SSControls
|
blankSSToggle :: SSControls
|
||||||
blankSSToggle = SSControls { ssToggle = Left [] }
|
blankSSToggle = SSControls { ssToggle = BlankFeature }
|
||||||
|
|
||||||
startXMonadService :: IO DBusXMonad
|
startXMonadService :: IO DBusXMonad
|
||||||
startXMonadService = do
|
startXMonadService = do
|
||||||
|
|
|
@ -97,16 +97,14 @@ bodyGetCurrentState _ = Nothing
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Exported haskell API
|
-- | Exported haskell API
|
||||||
|
|
||||||
newtype SSControls = SSControls { ssToggle :: MaybeExe (IO ()) }
|
newtype SSControls = SSControls { ssToggle :: FeatureIO }
|
||||||
|
|
||||||
exportScreensaver :: Client -> IO SSControls
|
exportScreensaver :: Client -> IO SSControls
|
||||||
exportScreensaver client = initControls client exportScreensaver' controls
|
exportScreensaver client = initControls client exportScreensaver' controls
|
||||||
where
|
where
|
||||||
controls exporter = do
|
controls exporter = SSControls { ssToggle = callToggle exporter }
|
||||||
t <- evalFeature $ callToggle exporter
|
|
||||||
return $ SSControls { ssToggle = t }
|
|
||||||
|
|
||||||
exportScreensaver' :: Client -> Feature (IO ()) (IO ())
|
exportScreensaver' :: Client -> FeatureIO
|
||||||
exportScreensaver' client = Feature
|
exportScreensaver' client = Feature
|
||||||
{ ftrAction = cmd
|
{ ftrAction = cmd
|
||||||
, ftrSilent = False
|
, ftrSilent = False
|
||||||
|
@ -121,7 +119,7 @@ exportScreensaver' client = Feature
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
callToggle :: Feature (IO ()) (IO ()) -> Feature (IO ()) (IO ())
|
callToggle :: FeatureIO -> FeatureIO
|
||||||
callToggle exporter = Feature
|
callToggle exporter = Feature
|
||||||
{ ftrAction = cmd
|
{ ftrAction = cmd
|
||||||
, ftrSilent = False
|
, ftrSilent = False
|
||||||
|
|
|
@ -8,7 +8,10 @@ module XMonad.Internal.Dependency
|
||||||
, DependencyData(..)
|
, DependencyData(..)
|
||||||
, DBusMember(..)
|
, DBusMember(..)
|
||||||
, MaybeX
|
, MaybeX
|
||||||
|
, FeatureX
|
||||||
|
, FeatureIO
|
||||||
, Feature(..)
|
, Feature(..)
|
||||||
|
, ioFeature
|
||||||
, evalFeature
|
, evalFeature
|
||||||
, exe
|
, exe
|
||||||
, systemUnit
|
, systemUnit
|
||||||
|
@ -16,25 +19,14 @@ module XMonad.Internal.Dependency
|
||||||
, pathR
|
, pathR
|
||||||
, pathW
|
, pathW
|
||||||
, pathRW
|
, pathRW
|
||||||
-- , checkInstalled
|
, featureRun
|
||||||
, runIfInstalled
|
, featureSpawnCmd
|
||||||
, depInstalled
|
, featureSpawn
|
||||||
, warnMissing
|
, warnMissing
|
||||||
, whenInstalled
|
, whenInstalled
|
||||||
, ifInstalled
|
, ifInstalled
|
||||||
, spawnIfInstalled
|
|
||||||
, spawnCmdIfInstalled
|
|
||||||
, noCheck
|
|
||||||
, fmtCmd
|
, fmtCmd
|
||||||
, spawnCmd
|
, spawnCmd
|
||||||
, doubleQuote
|
|
||||||
, singleQuote
|
|
||||||
, (#!&&)
|
|
||||||
, (#!||)
|
|
||||||
, (#!|)
|
|
||||||
, (#!>>)
|
|
||||||
, playSound
|
|
||||||
, spawnSound
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
@ -48,9 +40,8 @@ import qualified DBus.Introspection as I
|
||||||
|
|
||||||
import System.Directory (findExecutable, readable, writable)
|
import System.Directory (findExecutable, readable, writable)
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.FilePath
|
|
||||||
|
|
||||||
import XMonad.Core (X, getXMonadDir)
|
import XMonad.Core (X)
|
||||||
import XMonad.Internal.IO
|
import XMonad.Internal.IO
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
|
@ -84,44 +75,38 @@ data Feature a b = Feature
|
||||||
{ ftrAction :: a
|
{ ftrAction :: a
|
||||||
, ftrSilent :: Bool
|
, ftrSilent :: Bool
|
||||||
, ftrChildren :: [Dependency b]
|
, ftrChildren :: [Dependency b]
|
||||||
} | ConstFeature a
|
}
|
||||||
|
| ConstFeature a
|
||||||
|
| BlankFeature
|
||||||
|
|
||||||
-- data Chain a = Chain
|
type FeatureX = Feature (X ()) (X ())
|
||||||
-- { chainAction :: a
|
|
||||||
-- , chainChildren :: [Feature a a]
|
type FeatureIO = Feature (IO ()) (IO ())
|
||||||
-- , chainCompose :: a -> a -> a
|
|
||||||
-- }
|
ioFeature :: (MonadIO m, MonadIO n) => Feature (IO a) (IO b) -> Feature (m a) (n b)
|
||||||
|
ioFeature f@Feature { ftrAction = a, ftrChildren = ds } =
|
||||||
|
f { ftrAction = liftIO a, ftrChildren = fmap go ds }
|
||||||
|
where
|
||||||
|
go :: MonadIO o => Dependency (IO b) -> Dependency (o b)
|
||||||
|
go (SubFeature s) = SubFeature $ ioFeature s
|
||||||
|
go (Dependency d) = Dependency d
|
||||||
|
ioFeature (ConstFeature f) = ConstFeature $ liftIO f
|
||||||
|
ioFeature BlankFeature = BlankFeature
|
||||||
|
|
||||||
evalFeature :: Feature a b -> IO (MaybeExe a)
|
evalFeature :: Feature a b -> IO (MaybeExe a)
|
||||||
evalFeature (ConstFeature x) = return $ Right x
|
evalFeature (ConstFeature x) = return $ Right x
|
||||||
|
evalFeature BlankFeature = return $ Left []
|
||||||
evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do
|
evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do
|
||||||
es <- mapM go c
|
es <- mapM go c
|
||||||
return $ case concat es of
|
return $ case concat es of
|
||||||
[] -> Right a
|
[] -> Right a
|
||||||
es' -> Left (if s then [] else es')
|
es' -> Left (if s then [] else es')
|
||||||
-- return $ case foldl groupResult ([], []) c' of
|
|
||||||
-- ([], opt) -> Installed a opt
|
|
||||||
-- (req, opt) -> if s then Ignore else Missing req opt
|
|
||||||
where
|
where
|
||||||
go (SubFeature Feature { ftrChildren = cs }) = concat <$> mapM go cs
|
go (SubFeature Feature { ftrChildren = cs }) = concat <$> mapM go cs
|
||||||
go (SubFeature (ConstFeature _)) = return []
|
|
||||||
go (Dependency d) = do
|
go (Dependency d) = do
|
||||||
e <- depInstalled d
|
e <- depInstalled d
|
||||||
return $ maybeToList e
|
return $ maybeToList e
|
||||||
-- groupResult (x, y) (True, z) = (z:x, y)
|
go (SubFeature _) = return []
|
||||||
-- groupResult (x, y) (False, z) = (x, z:y)
|
|
||||||
|
|
||||||
-- evalChain :: Chain a -> IO (MaybeExe a)
|
|
||||||
-- evalChain Chain { chainAction = a, chainChildren = cs , chainCompose = f } =
|
|
||||||
-- flip Installed [] <$> foldM go a cs
|
|
||||||
-- where
|
|
||||||
-- go acc child = do
|
|
||||||
-- c <- evalFeature child
|
|
||||||
-- -- TODO need a way to get error messages out of this for anything
|
|
||||||
-- -- that's missing
|
|
||||||
-- return $ case c of
|
|
||||||
-- (Installed x _) -> f x acc
|
|
||||||
-- _ -> acc
|
|
||||||
|
|
||||||
exe :: String -> Dependency a
|
exe :: String -> Dependency a
|
||||||
exe = Dependency . Executable
|
exe = Dependency . Executable
|
||||||
|
@ -149,19 +134,23 @@ userUnit = unit UserUnit
|
||||||
|
|
||||||
-- TODO this is poorly named. This actually represents an action that has
|
-- TODO this is poorly named. This actually represents an action that has
|
||||||
-- one or more dependencies (where "action" is not necessarily executing an exe)
|
-- one or more dependencies (where "action" is not necessarily executing an exe)
|
||||||
-- data MaybeExe a = Installed a [DependencyData]
|
|
||||||
-- | Missing [DependencyData] [DependencyData]
|
|
||||||
-- | Ignore
|
|
||||||
-- deriving (Foldable, Traversable)
|
|
||||||
-- data MaybeExe a = MaybeExe (Maybe a) [String]
|
|
||||||
type MaybeExe a = Either [String] a
|
type MaybeExe a = Either [String] a
|
||||||
-- deriving (Foldable, Traversable)
|
|
||||||
|
|
||||||
-- instance Functor MaybeExe where
|
|
||||||
-- fmap f (MaybeExe x m) = MaybeExe (f <$> x) m
|
|
||||||
|
|
||||||
type MaybeX = MaybeExe (X ())
|
type MaybeX = MaybeExe (X ())
|
||||||
|
|
||||||
|
featureRun :: [Dependency a] -> b -> Feature b a
|
||||||
|
featureRun ds x = Feature
|
||||||
|
{ ftrAction = x
|
||||||
|
, ftrSilent = False
|
||||||
|
, ftrChildren = ds
|
||||||
|
}
|
||||||
|
|
||||||
|
featureSpawnCmd :: MonadIO m => String -> [String] -> Feature (m ()) (m ())
|
||||||
|
featureSpawnCmd cmd args = featureRun [exe cmd] $ spawnCmd cmd args
|
||||||
|
|
||||||
|
featureSpawn :: MonadIO m => String -> Feature (m ()) (m ())
|
||||||
|
featureSpawn cmd = featureSpawnCmd cmd []
|
||||||
|
|
||||||
exeInstalled :: String -> IO (Maybe String)
|
exeInstalled :: String -> IO (Maybe String)
|
||||||
exeInstalled x = do
|
exeInstalled x = do
|
||||||
r <- findExecutable x
|
r <- findExecutable x
|
||||||
|
@ -180,34 +169,22 @@ unitInstalled u x = do
|
||||||
unitType SystemUnit = "system"
|
unitType SystemUnit = "system"
|
||||||
unitType UserUnit = "user"
|
unitType UserUnit = "user"
|
||||||
|
|
||||||
-- pathAccessible :: FilePath -> Bool -> Bool -> IO (Maybe String)
|
|
||||||
pathAccessible :: FilePath -> Bool -> Bool -> IO (Maybe String)
|
pathAccessible :: FilePath -> Bool -> Bool -> IO (Maybe String)
|
||||||
pathAccessible p testread testwrite = do
|
pathAccessible p testread testwrite = do
|
||||||
res <- getPermissionsSafe p
|
res <- getPermissionsSafe p
|
||||||
let msg = permMsg res
|
let msg = permMsg res
|
||||||
return msg
|
return msg
|
||||||
-- return $ fmap (\m -> m ++ ": " ++ p) msg
|
|
||||||
where
|
where
|
||||||
testPerm False _ _ = Nothing
|
testPerm False _ _ = Nothing
|
||||||
testPerm True f r = Just $ f r
|
testPerm True f r = Just $ f r
|
||||||
permMsg NotFoundError = Just "file not found"
|
permMsg NotFoundError = Just "file not found"
|
||||||
permMsg PermError = Just "could not get permissions"
|
permMsg PermError = Just "could not get permissions"
|
||||||
-- permMsg NotFoundError = False
|
|
||||||
-- permMsg PermError = False
|
|
||||||
permMsg (PermResult r) =
|
permMsg (PermResult r) =
|
||||||
case (testPerm testread readable r, testPerm testwrite writable r) of
|
case (testPerm testread readable r, testPerm testwrite writable r) of
|
||||||
(Just False, Just False) -> Just "file not readable or writable"
|
(Just False, Just False) -> Just "file not readable or writable"
|
||||||
(Just False, _) -> Just "file not readable"
|
(Just False, _) -> Just "file not readable"
|
||||||
(_, Just False) -> Just "file not writable"
|
(_, Just False) -> Just "file not writable"
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
-- (Just True, Just True) -> True
|
|
||||||
-- (Just True, Nothing) -> True
|
|
||||||
-- (Nothing, Just True) -> True
|
|
||||||
-- _ -> False
|
|
||||||
-- (Just False, Just False) -> Just "file not readable or writable"
|
|
||||||
-- (Just False, _) -> Just "file not readable"
|
|
||||||
-- (_, Just False) -> Just "file not writable"
|
|
||||||
-- _ -> Nothing
|
|
||||||
|
|
||||||
introspectInterface :: InterfaceName
|
introspectInterface :: InterfaceName
|
||||||
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
||||||
|
@ -227,7 +204,6 @@ dbusInstalled bus usesystem objpath iface mem = do
|
||||||
return $ case res of
|
return $ case res of
|
||||||
Just _ -> Nothing
|
Just _ -> Nothing
|
||||||
_ -> Just "some random dbus interface not found"
|
_ -> Just "some random dbus interface not found"
|
||||||
-- return $ fromMaybe False res
|
|
||||||
where
|
where
|
||||||
findMem obj = fmap (matchMem mem)
|
findMem obj = fmap (matchMem mem)
|
||||||
$ find (\i -> I.interfaceName i == iface)
|
$ find (\i -> I.interfaceName i == iface)
|
||||||
|
@ -248,28 +224,6 @@ depInstalled DBusEndpoint { ddDbusBus = b
|
||||||
, ddDbusMember = m
|
, ddDbusMember = m
|
||||||
} = dbusInstalled b s o i m
|
} = dbusInstalled b s o i m
|
||||||
|
|
||||||
-- checkInstalled :: [Dependency a] -> IO ([DependencyData], [DependencyData])
|
|
||||||
-- checkInstalled = fmap go . filterMissing
|
|
||||||
-- where
|
|
||||||
-- go = join (***) (fmap depData) . partition depRequired
|
|
||||||
|
|
||||||
-- filterMissing :: [Dependency a] -> IO [Dependency a]
|
|
||||||
-- filterMissing = filterM (fmap not . depInstalled . depData)
|
|
||||||
|
|
||||||
runIfInstalled :: [Dependency a] -> b -> IO (MaybeExe b)
|
|
||||||
runIfInstalled ds x = evalFeature $
|
|
||||||
Feature
|
|
||||||
{ ftrAction = x
|
|
||||||
, ftrSilent = False
|
|
||||||
, ftrChildren = ds
|
|
||||||
}
|
|
||||||
|
|
||||||
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
|
|
||||||
spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
|
|
||||||
|
|
||||||
spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe (m ()))
|
|
||||||
spawnCmdIfInstalled n args = runIfInstalled [exe n] $ spawnCmd n args
|
|
||||||
|
|
||||||
whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
|
whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
|
||||||
whenInstalled = flip ifInstalled skip
|
whenInstalled = flip ifInstalled skip
|
||||||
|
|
||||||
|
@ -277,62 +231,5 @@ ifInstalled :: MaybeExe a -> a -> a
|
||||||
ifInstalled (Right x) _ = x
|
ifInstalled (Right x) _ = x
|
||||||
ifInstalled _ alt = alt
|
ifInstalled _ alt = alt
|
||||||
|
|
||||||
noCheck :: Monad m => a () -> m (MaybeExe (a ()))
|
|
||||||
noCheck = return . Right
|
|
||||||
|
|
||||||
-- not sure what to do with these
|
|
||||||
|
|
||||||
soundDir :: FilePath
|
|
||||||
soundDir = "sound"
|
|
||||||
|
|
||||||
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe (m ()))
|
|
||||||
spawnSound file pre post = runIfInstalled [exe "paplay"]
|
|
||||||
$ pre >> playSound file >> post
|
|
||||||
|
|
||||||
playSound :: MonadIO m => FilePath -> m ()
|
|
||||||
playSound file = do
|
|
||||||
p <- (</> soundDir </> file) <$> getXMonadDir
|
|
||||||
-- paplay seems to have less latency than aplay
|
|
||||||
spawnCmd "paplay" [p]
|
|
||||||
|
|
||||||
-- partitionMissing :: [MaybeExe a] -> ([DependencyData], [DependencyData])
|
|
||||||
-- partitionMissing = foldl (\(a, b) -> ((a++) *** (b++)) . go) ([], [])
|
|
||||||
-- where
|
|
||||||
-- go (Installed _ opt) = ([], opt)
|
|
||||||
-- go (Missing req opt) = (req, opt)
|
|
||||||
-- go Ignore = ([], [])
|
|
||||||
|
|
||||||
-- fmtMissing :: DependencyData -> String
|
|
||||||
-- -- TODO this error message is lame
|
|
||||||
-- fmtMissing (IOTest _) = "some random test failed"
|
|
||||||
-- fmtMissing DBusEndpoint {} = "some random dbus path is missing"
|
|
||||||
-- fmtMissing (AccessiblePath p True False) = "path '" ++ p ++ "' not readable"
|
|
||||||
-- fmtMissing (AccessiblePath p False True) = "path '" ++ p ++ "' not writable"
|
|
||||||
-- fmtMissing (AccessiblePath p True True) = "path '" ++ p ++ "' not readable/writable"
|
|
||||||
-- fmtMissing (AccessiblePath p _ _) = "path '" ++ p ++ "' not ...something"
|
|
||||||
-- fmtMissing (Executable n) = "executable '" ++ n ++ "' not found"
|
|
||||||
-- fmtMissing (Systemd st n) = "systemd " ++ unitType st ++ " unit '"
|
|
||||||
-- ++ n ++ "' not found"
|
|
||||||
-- where
|
|
||||||
-- unitType SystemUnit = "system"
|
|
||||||
-- unitType UserUnit = "user"
|
|
||||||
|
|
||||||
-- fmtMsgs :: [DependencyData] -> [DependencyData] -> [String]
|
|
||||||
-- fmtMsgs req opt = ("[WARNING] "++)
|
|
||||||
-- <$> (("[REQUIRED DEP] "++) . fmtMissing <$> req)
|
|
||||||
-- ++ (("[OPTIONAL DEP] "++) . fmtMissing <$> opt)
|
|
||||||
|
|
||||||
-- warnMsg ::
|
|
||||||
-- warnMsg xs = mapM_ putStrLn
|
|
||||||
-- $ [ "[WARNING] " ++ m | (MaybeExe _ (Just m)) <- xs ]
|
|
||||||
|
|
||||||
warnMissing :: [MaybeExe a] -> IO ()
|
warnMissing :: [MaybeExe a] -> IO ()
|
||||||
warnMissing xs = mapM_ putStrLn $ fmap ("[WARNING] "++) $ concat $ [ m | (Left m) <- xs ]
|
warnMissing xs = mapM_ putStrLn $ fmap ("[WARNING] "++) $ concat $ [ m | (Left m) <- xs ]
|
||||||
|
|
||||||
-- fmtType (AccessiblePath _ _ _) = undefined
|
|
||||||
|
|
||||||
-- splitDeps :: [MaybeExe a] -> ([a], [String])
|
|
||||||
-- splitDeps xs = undefined
|
|
||||||
|
|
||||||
-- splitDeps' :: [m (MaybeExe a)] -> ([m a], [String])
|
|
||||||
-- splitDeps' xs = undefined
|
|
||||||
|
|
Loading…
Reference in New Issue