FIX return codes from keys

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

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...

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"