FIX return codes from keys

This commit is contained in:
Nathan Dwarshuis 2023-02-16 22:40:24 -05:00
parent 57b4c2d805
commit 6acd60187e
3 changed files with 41 additions and 31 deletions

View File

@ -28,21 +28,23 @@ import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import Graphics.X11.Xrandr import Graphics.X11.Xrandr
import RIO hiding (Display) import RIO hiding (Display)
import RIO.Process
import qualified RIO.Text as T import qualified RIO.Text as T
import System.Environment import UnliftIO.Environment
import System.Process
main :: IO () main :: IO ()
main = do main = runSimpleApp $ do
r <- getMonitorName r <- getMonitorName
let pre = maybe [] (\n -> ["-m", n]) r
args <- getArgs args <- getArgs
callProcess "/usr/bin/rofi" $ (fmap T.unpack pre) ++ args let allArgs = maybe [] (\n -> ["-m", T.unpack n] ++ args) r
c <- proc "/usr/bin/rofi" allArgs runProcess
exitWith c
data Coord = Coord Int Int deriving (Eq, Show) data Coord = Coord Int Int deriving (Eq, Show)
getMonitorName :: IO (Maybe T.Text) -- TODO bracket this
getMonitorName = do getMonitorName :: MonadIO m => m (Maybe T.Text)
getMonitorName = liftIO $ do
dpy <- openDisplay "" dpy <- openDisplay ""
root <- rootWindow dpy $ defaultScreen dpy root <- rootWindow dpy $ defaultScreen dpy
index <- getCurrentDesktopIndex dpy root index <- getCurrentDesktopIndex dpy root

View File

@ -191,14 +191,12 @@ selectCopy l =
copyHotkey = copyHotkey =
Hotkey Hotkey
{ keyCombo = "Alt+c" { keyCombo = "Alt+c"
, keyIndex = 1
, keyDescription = "Copy One" , keyDescription = "Copy One"
, keyActions = loginToRofiActions l copyRepeat , keyActions = loginToRofiActions l copyRepeat
} }
backHotkey = backHotkey =
Hotkey Hotkey
{ keyCombo = "Alt+q" { keyCombo = "Alt+q"
, keyIndex = 2
, keyDescription = "Back" , keyDescription = "Back"
, -- TODO this is overly complicated, all entries do the same thing , -- TODO this is overly complicated, all entries do the same thing
-- TODO this is slow, we can cache the logins somehow... -- TODO this is slow, we can cache the logins somehow...

View File

@ -23,10 +23,11 @@ module Rofi.Command
) )
where where
import qualified Data.Map.Ordered as M import qualified Data.Map.Ordered as OM
import RIO import RIO
import qualified RIO.List as L import qualified RIO.List as L
import qualified RIO.Text as T import qualified RIO.Text as T
import qualified RIO.Vector.Boxed as V
import System.Process import System.Process
class HasRofiConf c where class HasRofiConf c where
@ -34,7 +35,7 @@ class HasRofiConf c where
type RofiAction c = (T.Text, RIO c ()) type RofiAction c = (T.Text, RIO c ())
type RofiActions c = M.OMap T.Text (RIO c ()) type RofiActions c = OM.OMap T.Text (RIO c ())
data RofiGroup c = RofiGroup data RofiGroup c = RofiGroup
{ actions :: RofiActions c { actions :: RofiActions c
@ -49,16 +50,14 @@ titledGroup t a = (untitledGroup a) {title = Just t}
data Hotkey c = Hotkey data Hotkey c = Hotkey
{ keyCombo :: !T.Text { keyCombo :: !T.Text
, -- only 1-10 are valid
keyIndex :: !Int
, keyDescription :: !T.Text , keyDescription :: !T.Text
, keyActions :: RofiActions c , keyActions :: RofiActions c
} }
hotkeyBinding :: Hotkey c -> [T.Text] hotkeyBinding :: Int -> Hotkey c -> [T.Text]
hotkeyBinding Hotkey {keyIndex = e, keyCombo = c} = [k, c] hotkeyBinding i Hotkey {keyCombo = c} = [k, c]
where where
k = T.append "-kb-custom-" $ T.pack $ show e k = T.append "-kb-custom-" $ T.pack $ show i
hotkeyMsg1 :: Hotkey c -> T.Text hotkeyMsg1 :: Hotkey c -> T.Text
hotkeyMsg1 Hotkey {keyCombo = c, keyDescription = d} = hotkeyMsg1 Hotkey {keyCombo = c, keyDescription = d} =
@ -69,12 +68,14 @@ hotkeyMsg [] = []
hotkeyMsg hs = ["-mesg", T.intercalate " | " $ fmap hotkeyMsg1 hs] hotkeyMsg hs = ["-mesg", T.intercalate " | " $ fmap hotkeyMsg1 hs]
hotkeyArgs :: [Hotkey c] -> [T.Text] hotkeyArgs :: [Hotkey c] -> [T.Text]
hotkeyArgs hks = hotkeyMsg hks ++ concatMap hotkeyBinding hks hotkeyArgs hks =
(hotkeyMsg hks)
++ (concatMap (uncurry hotkeyBinding) $ take 19 $ zip [1 ..] hks)
data RofiMenu c = RofiMenu data RofiMenu c = RofiMenu
{ groups :: [RofiGroup c] { groups :: ![RofiGroup c]
, prompt :: Maybe T.Text , prompt :: !(Maybe T.Text)
, hotkeys :: [Hotkey c] , hotkeys :: ![Hotkey c]
} }
emptyMenu :: RofiMenu c emptyMenu :: RofiMenu c
@ -82,20 +83,22 @@ emptyMenu =
RofiMenu RofiMenu
{ groups = [] { groups = []
, prompt = Nothing , prompt = Nothing
, hotkeys = [] , hotkeys = mempty
} }
io :: MonadIO m => IO a -> m a io :: MonadIO m => IO a -> m a
io = liftIO io = liftIO
toRofiActions :: [(T.Text, RIO c ())] -> RofiActions c toRofiActions :: [(T.Text, RIO c ())] -> RofiActions c
toRofiActions = M.fromList toRofiActions = OM.fromList
rofiActionKeys :: RofiActions c -> T.Text rofiActionKeys :: RofiActions c -> T.Text
rofiActionKeys = joinNewline . map fst . M.assocs rofiActionKeys = joinNewline . map fst . OM.assocs
lookupRofiAction :: T.Text -> RofiActions c -> RIO c () lookupRofiAction :: T.Text -> RofiActions c -> RIO c ()
lookupRofiAction key ras = fromMaybe (return ()) $ M.lookup key ras lookupRofiAction key = fromMaybe err . OM.lookup key
where
err = error $ T.unpack $ T.concat ["could not lookup key: '", key, "'"]
groupEntries :: RofiGroup c -> T.Text groupEntries :: RofiGroup c -> T.Text
groupEntries RofiGroup {actions = a, title = t} groupEntries RofiGroup {actions = a, title = t}
@ -105,7 +108,7 @@ groupEntries RofiGroup {actions = a, title = t}
title' = maybe "" (`T.append` "\n") t title' = maybe "" (`T.append` "\n") t
menuActions :: RofiMenu c -> RofiActions c menuActions :: RofiMenu c -> RofiActions c
menuActions = L.foldr (M.<>|) M.empty . fmap actions . groups menuActions = L.foldr (OM.<>|) OM.empty . fmap actions . groups
menuEntries :: RofiMenu c -> T.Text menuEntries :: RofiMenu c -> T.Text
menuEntries = T.intercalate "\n\n" . filter (not . T.null) . fmap groupEntries . groups menuEntries = T.intercalate "\n\n" . filter (not . T.null) . fmap groupEntries . groups
@ -117,10 +120,16 @@ selectAction rm = do
res <- readRofi (p ++ hArgs) $ menuEntries rm res <- readRofi (p ++ hArgs) $ menuEntries rm
case res of case res of
Right key -> lookupRofiAction key $ menuActions rm Right key -> lookupRofiAction key $ menuActions rm
Left (n, key, _) -> Left (1, _, _) -> exitWith $ ExitFailure 1
mapM_ (lookupRofiAction key . keyActions) $ Left (n, key, _) -> do
L.find ((==) n . (+ 9) . keyIndex) $ maybe
hotkeys rm (error $ T.unpack $ T.append "could not find key index: " $ T.pack $ show n)
(lookupRofiAction key . keyActions)
-- this sketchy assumption has to do with the fact that the custom
-- keybindings are labeled 1-19 and thus need to be explicitly
-- indexed, and the program itself tells the world which key was
-- pressed via return code (any possible integer)
((V.fromList $ hotkeys rm) V.!? (n - 10))
runRofi :: (MonadIO m, HasRofiConf c) => c -> RofiMenu c -> m () runRofi :: (MonadIO m, HasRofiConf c) => c -> RofiMenu c -> m ()
runRofi c = runRIO c . selectAction runRofi c = runRIO c . selectAction
@ -167,12 +176,13 @@ readCmdEither' cmd args input environ =
es -> Just $ fmap (bimap T.unpack T.unpack) es es -> Just $ fmap (bimap T.unpack T.unpack) es
p = (proc (T.unpack cmd) (fmap T.unpack args)) {env = e} p = (proc (T.unpack cmd) (fmap T.unpack args)) {env = e}
-- TODO why strip whitespace?
resultToEither resultToEither
:: (ExitCode, String, String) :: (ExitCode, String, String)
-> Either (Int, T.Text, T.Text) T.Text -> Either (Int, T.Text, T.Text) T.Text
resultToEither (ExitSuccess, out, _) = Right $ T.strip $ T.pack out resultToEither (ExitSuccess, out, _) = Right $ T.stripEnd $ T.pack out
resultToEither (ExitFailure n, out, err) = resultToEither (ExitFailure n, out, err) =
Left (n, T.strip $ T.pack out, T.strip $ T.pack err) Left (n, T.stripEnd $ T.pack out, T.stripEnd $ T.pack err)
joinNewline :: [T.Text] -> T.Text joinNewline :: [T.Text] -> T.Text
joinNewline = T.intercalate "\n" joinNewline = T.intercalate "\n"