From 6acd60187eaefb9346f71672444051f62aeffd13 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Thu, 16 Feb 2023 22:40:24 -0500 Subject: [PATCH] FIX return codes from keys --- app/rofi.hs | 16 +++++++----- lib/Bitwarden/Internal.hs | 2 -- lib/Rofi/Command.hs | 54 +++++++++++++++++++++++---------------- 3 files changed, 41 insertions(+), 31 deletions(-) diff --git a/app/rofi.hs b/app/rofi.hs index ed19a39..bf86a2a 100644 --- a/app/rofi.hs +++ b/app/rofi.hs @@ -28,21 +28,23 @@ import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras import Graphics.X11.Xrandr import RIO hiding (Display) +import RIO.Process import qualified RIO.Text as T -import System.Environment -import System.Process +import UnliftIO.Environment main :: IO () -main = do +main = runSimpleApp $ do r <- getMonitorName - let pre = maybe [] (\n -> ["-m", n]) r 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) -getMonitorName :: IO (Maybe T.Text) -getMonitorName = do +-- TODO bracket this +getMonitorName :: MonadIO m => m (Maybe T.Text) +getMonitorName = liftIO $ do dpy <- openDisplay "" root <- rootWindow dpy $ defaultScreen dpy index <- getCurrentDesktopIndex dpy root diff --git a/lib/Bitwarden/Internal.hs b/lib/Bitwarden/Internal.hs index 46a8297..bdccb16 100644 --- a/lib/Bitwarden/Internal.hs +++ b/lib/Bitwarden/Internal.hs @@ -191,14 +191,12 @@ selectCopy l = copyHotkey = Hotkey { keyCombo = "Alt+c" - , keyIndex = 1 , keyDescription = "Copy One" , keyActions = loginToRofiActions l copyRepeat } backHotkey = Hotkey { keyCombo = "Alt+q" - , keyIndex = 2 , keyDescription = "Back" , -- TODO this is overly complicated, all entries do the same thing -- TODO this is slow, we can cache the logins somehow... diff --git a/lib/Rofi/Command.hs b/lib/Rofi/Command.hs index 1830a12..364c02b 100644 --- a/lib/Rofi/Command.hs +++ b/lib/Rofi/Command.hs @@ -23,10 +23,11 @@ module Rofi.Command ) where -import qualified Data.Map.Ordered as M +import qualified Data.Map.Ordered as OM import RIO import qualified RIO.List as L import qualified RIO.Text as T +import qualified RIO.Vector.Boxed as V import System.Process class HasRofiConf c where @@ -34,7 +35,7 @@ class HasRofiConf c where 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 { actions :: RofiActions c @@ -49,16 +50,14 @@ titledGroup t a = (untitledGroup a) {title = Just t} data Hotkey c = Hotkey { keyCombo :: !T.Text - , -- only 1-10 are valid - keyIndex :: !Int , keyDescription :: !T.Text , keyActions :: RofiActions c } -hotkeyBinding :: Hotkey c -> [T.Text] -hotkeyBinding Hotkey {keyIndex = e, keyCombo = c} = [k, c] +hotkeyBinding :: Int -> Hotkey c -> [T.Text] +hotkeyBinding i Hotkey {keyCombo = c} = [k, c] 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 {keyCombo = c, keyDescription = d} = @@ -69,12 +68,14 @@ hotkeyMsg [] = [] hotkeyMsg hs = ["-mesg", T.intercalate " | " $ fmap hotkeyMsg1 hs] 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 - { groups :: [RofiGroup c] - , prompt :: Maybe T.Text - , hotkeys :: [Hotkey c] + { groups :: ![RofiGroup c] + , prompt :: !(Maybe T.Text) + , hotkeys :: ![Hotkey c] } emptyMenu :: RofiMenu c @@ -82,20 +83,22 @@ emptyMenu = RofiMenu { groups = [] , prompt = Nothing - , hotkeys = [] + , hotkeys = mempty } io :: MonadIO m => IO a -> m a io = liftIO toRofiActions :: [(T.Text, RIO c ())] -> RofiActions c -toRofiActions = M.fromList +toRofiActions = OM.fromList 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 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 {actions = a, title = t} @@ -105,7 +108,7 @@ groupEntries RofiGroup {actions = a, title = t} title' = maybe "" (`T.append` "\n") t 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 = T.intercalate "\n\n" . filter (not . T.null) . fmap groupEntries . groups @@ -117,10 +120,16 @@ selectAction rm = do res <- readRofi (p ++ hArgs) $ menuEntries rm case res of Right key -> lookupRofiAction key $ menuActions rm - Left (n, key, _) -> - mapM_ (lookupRofiAction key . keyActions) $ - L.find ((==) n . (+ 9) . keyIndex) $ - hotkeys rm + Left (1, _, _) -> exitWith $ ExitFailure 1 + Left (n, key, _) -> do + maybe + (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 c = runRIO c . selectAction @@ -167,12 +176,13 @@ readCmdEither' cmd args input environ = es -> Just $ fmap (bimap T.unpack T.unpack) es p = (proc (T.unpack cmd) (fmap T.unpack args)) {env = e} +-- TODO why strip whitespace? resultToEither :: (ExitCode, String, String) -> 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) = - 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.intercalate "\n"