REF use rio monad for rofi

app/rofi-autorandr.hs

@@ -32,19 +32,18 @@ checkExe cmd = do
 
 newtype ARClientConf = ARClientConf [T.Text]
 
-instance RofiConf ARClientConf where
+instance HasRofiConf ARClientConf where
   defArgs (ARClientConf a) = a
 
 runPrompt :: [String] -> IO ()
 runPrompt a = do
   let c = ARClientConf $ fmap T.pack a
   staticProfs <- getAutoRandrProfiles
-  runRofiIO c $
+  runRofi c $
-    selectAction $
+    emptyMenu
-      emptyMenu
+      { groups = [mkGroup "Static" staticProfs, mkGroup "Virtual" virtProfs]
-        { groups = [mkGroup "Static" staticProfs, mkGroup "Virtual" virtProfs]
+      , prompt = Just "Select Profile"
-        , prompt = Just "Select Profile"
+      }
-        }
   where
     mkGroup header =
       titledGroup header
@@ -69,7 +68,7 @@ getAutoRandrDir = do
   where
     appendToHome p = (</> p) <$> getHomeDirectory
 
-selectProfile :: T.Text -> RofiIO ARClientConf ()
+selectProfile :: T.Text -> RIO ARClientConf ()
 selectProfile name = liftIO $ do
   TI.putStrLn name
   void $ spawnProcess "autorandr" ["--change", T.unpack name]

app/rofi-bt.hs

@@ -20,7 +20,7 @@ main = getArgs >>= runPrompt
 
 data RofiBTConf = RofiBTConf [T.Text] ObjectPath
 
-instance RofiConf RofiBTConf where
+instance HasRofiConf RofiBTConf where
   defArgs (RofiBTConf as _) = as
 
 type BTAction = RofiAction RofiBTConf
@@ -36,12 +36,11 @@ runPrompt args = do
         getAdapter paths
     actions client paths adapter = do
       ras <- getRofiActions client paths
-      runRofiIO (RofiBTConf (fmap T.pack args) adapter) $
+      runRofi (RofiBTConf (fmap T.pack args) adapter) $
-        selectAction $
+        emptyMenu
-          emptyMenu
+          { groups = [untitledGroup $ toRofiActions ras]
-            { groups = [untitledGroup $ toRofiActions ras]
+          , prompt = Just "Select Device"
-            , prompt = Just "Select Device"
+          }
-            }
 
 getRofiActions :: Client -> [ObjectPath] -> IO [BTAction]
 getRofiActions client os = do
@@ -63,7 +62,7 @@ deviceToRofiAction client dev = do
     mkAction True = callDeviceDisconnect client dev
     mkAction False = callDeviceConnect client dev
 
-powerAdapterMaybe :: Client -> RofiIO RofiBTConf ()
+powerAdapterMaybe :: Client -> RIO RofiBTConf ()
 powerAdapterMaybe client = do
   (RofiBTConf _ adapter) <- ask
   let mc = btMethodCall adapter i m

app/rofi-dev.hs

@@ -117,7 +117,7 @@ runMounts opts = do
           }
   let byAlias = mountByAlias $ optsUnmount opts
   let byPrompt = runPrompt =<< getGroups
-  runRofiIO mountconf $ maybe byPrompt byAlias $ optsAlias opts
+  runRIO mountconf $ maybe byPrompt byAlias $ optsAlias opts
 
 parseStaticConfig :: FilePath -> IO (Maybe StaticConfig)
 parseStaticConfig p = do
@@ -126,7 +126,7 @@ parseStaticConfig p = do
     Left e -> TI.putStrLn (T.pack $ show (e :: SomeException)) >> return Nothing
     Right c -> return $ Just (c :: StaticConfig)
 
-runPrompt :: RofiConf c => [RofiGroup c] -> RofiIO c ()
+runPrompt :: HasRofiConf c => [RofiGroup c] -> RIO c ()
 runPrompt gs =
   selectAction $
     emptyMenu
@@ -200,7 +200,7 @@ data MountConf = MountConf
 
 -- deriving (Show)
 
-instance RofiConf MountConf where
+instance HasRofiConf MountConf where
   defArgs MountConf {mountconfRofiArgs = a} = a
 
 --------------------------------------------------------------------------------
@@ -280,7 +280,7 @@ mountableToAction
   -> RofiMountIO [(Header, ProtoAction [T.Text])]
 mountableToAction ms = mapM mkAction =<< ms
 
-type RofiMountIO a = RofiIO MountConf a
+type RofiMountIO a = RIO MountConf a
 
 -- headers appear in the order listed here (per Enum)
 data Header
@@ -577,7 +577,7 @@ instance Actionable Removable where
 -- reported by 'lsblk'. If the LABEL does not exist on the filesystem, the
 -- label shown on the prompt will be 'SIZE Volume' where size is the size of
 -- the device
-getRemovableDevices :: RofiIO c [Removable]
+getRemovableDevices :: RIO c [Removable]
 getRemovableDevices =
   fromLines toDev . T.lines . T.pack
     <$> io (readProcess "lsblk" ["-n", "-r", "-o", columns] "")

app/rofi-evpn.hs

@@ -22,19 +22,18 @@ runPrompt args = do
     run (VPNStatus connected servers) = do
       let d = getDisconnectAction <$> connected
       let cs = fmap (getConnectAction connected) servers
-      runRofiIO (RofiVPNConf $ fmap T.pack args) $
+      runRofi (RofiVPNConf $ fmap T.pack args) $
-        selectAction $
+        emptyMenu
-          emptyMenu
+          { groups =
-            { groups =
+              [ untitledGroup $ toRofiActions $ maybeToList d
-                [ untitledGroup $ toRofiActions $ maybeToList d
+              , untitledGroup $ toRofiActions cs
-                , untitledGroup $ toRofiActions cs
+              ]
-                ]
+          , prompt = Just "Select Action"
-            , prompt = Just "Select Action"
+          }
-            }
 
 newtype RofiVPNConf = RofiVPNConf [T.Text]
 
-instance RofiConf RofiVPNConf where
+instance HasRofiConf RofiVPNConf where
   defArgs (RofiVPNConf as) = as
 
 type VPNAction = RofiAction RofiVPNConf

lib/Bitwarden/Internal.hs

@@ -110,18 +110,17 @@ notifyStatus succeeded msg =
 --     - anything else (notes and such) -> copy to clipboard
 newtype BWClientConf = BWClientConf [T.Text]
 
-instance RofiConf BWClientConf where
+instance HasRofiConf BWClientConf where
   defArgs (BWClientConf a) = a
 
 runClient :: [T.Text] -> IO ()
 runClient a = do
   let c = BWClientConf a
-  runRofiIO c $
+  runRofi c $
-    selectAction $
+    emptyMenu
-      emptyMenu
+      { groups = [untitledGroup $ toRofiActions ras]
-        { groups = [untitledGroup $ toRofiActions ras]
+      , prompt = Just "Action"
-        , prompt = Just "Action"
+      }
-        }
   where
     ras =
       [ ("Browse Logins", browseLogins)
@@ -129,7 +128,7 @@ runClient a = do
       , ("Lock Session", io callLockSession)
       ]
 
-browseLogins :: RofiConf c => RofiIO c ()
+browseLogins :: HasRofiConf c => RIO c ()
 browseLogins = io getItems >>= selectItem
 
 getItems :: IO [Item]
@@ -167,7 +166,7 @@ instance FromJSON Login
 
 -- TODO make menu buttons here to go back and to copy without leaving
 -- the current menu
-selectItem :: RofiConf c => [Item] -> RofiIO c ()
+selectItem :: HasRofiConf c => [Item] -> RIO c ()
 selectItem items =
   selectAction $
     emptyMenu
@@ -175,10 +174,10 @@ selectItem items =
       , prompt = Just "Login"
       }
 
-itemsToRofiActions :: RofiConf c => [Item] -> RofiActions c
+itemsToRofiActions :: HasRofiConf c => [Item] -> RofiActions c
 itemsToRofiActions = toRofiActions . fmap (\i -> (name i, selectCopy $ login i))
 
-selectCopy :: RofiConf c => Login -> RofiIO c ()
+selectCopy :: HasRofiConf c => Login -> RIO c ()
 selectCopy l =
   selectAction $
     emptyMenu
@@ -206,7 +205,7 @@ selectCopy l =
           keyActions = loginToRofiActions l (const browseLogins)
         }
 
-loginToRofiActions :: Login -> (T.Text -> RofiIO c ()) -> RofiActions c
+loginToRofiActions :: Login -> (T.Text -> RIO c ()) -> RofiActions c
 loginToRofiActions Login {username = u, password = p} a =
   toRofiActions $ catMaybes [user, pwd]
   where

lib/Rofi/Command.hs

@@ -1,14 +1,12 @@
 module Rofi.Command
-  ( RofiConf (..)
+  ( HasRofiConf (..)
   , RofiMenu (..)
   , RofiAction
   , RofiActions
-  , RofiIO
   , RofiGroup
   , Hotkey (..)
   , io
   , emptyMenu
-  , runRofiIO
   , toRofiActions
   , rofiActionKeys
   , untitledGroup
@@ -22,6 +20,7 @@ module Rofi.Command
   , dmenuArgs
   , joinNewline
   , stripWS
+  , runRofi
   )
 where
 
@@ -32,12 +31,12 @@ import qualified RIO.List as L
 import qualified RIO.Text as T
 import System.Process
 
-class RofiConf c where
+class HasRofiConf c where
   defArgs :: c -> [T.Text]
 
-type RofiAction c = (T.Text, RofiIO c ())
+type RofiAction c = (T.Text, RIO c ())
 
-type RofiActions c = M.OMap T.Text (RofiIO c ())
+type RofiActions c = M.OMap T.Text (RIO c ())
 
 data RofiGroup c = RofiGroup
   { actions :: RofiActions c
@@ -88,22 +87,16 @@ emptyMenu =
     , hotkeys = []
     }
 
-newtype RofiIO c a = RofiIO (ReaderT c IO a)
-  deriving (Functor, Applicative, Monad, MonadIO, MonadReader c, MonadUnliftIO)
-
 io :: MonadIO m => IO a -> m a
 io = liftIO
 
-runRofiIO :: c -> RofiIO c a -> IO a
+toRofiActions :: [(T.Text, RIO c ())] -> RofiActions c
-runRofiIO c (RofiIO r) = runReaderT r c
-
-toRofiActions :: [(T.Text, RofiIO c ())] -> RofiActions c
 toRofiActions = M.fromList
 
 rofiActionKeys :: RofiActions c -> T.Text
 rofiActionKeys = joinNewline . map fst . M.assocs
 
-lookupRofiAction :: T.Text -> RofiActions c -> RofiIO c ()
+lookupRofiAction :: T.Text -> RofiActions c -> RIO c ()
 lookupRofiAction key ras = fromMaybe (return ()) $ M.lookup key ras
 
 groupEntries :: RofiGroup c -> T.Text
@@ -119,7 +112,7 @@ menuActions = L.foldr (M.<>|) M.empty . fmap actions . groups
 menuEntries :: RofiMenu c -> T.Text
 menuEntries = T.intercalate "\n\n" . filter (not . T.null) . fmap groupEntries . groups
 
-selectAction :: RofiConf c => RofiMenu c -> RofiIO c ()
+selectAction :: HasRofiConf c => RofiMenu c -> RIO c ()
 selectAction rm = do
   let p = maybeOption "-p" $ prompt rm
   let hArgs = hotkeyArgs $ hotkeys rm
@@ -131,6 +124,9 @@ selectAction rm = do
         L.find ((==) n . (+ 9) . keyIndex) $
           hotkeys rm
 
+runRofi :: (MonadIO m, HasRofiConf c) => c -> RofiMenu c -> m ()
+runRofi c = runRIO c . selectAction
+
 maybeOption :: T.Text -> Maybe T.Text -> [T.Text]
 maybeOption switch = maybe [] (\o -> [switch, o])
 
@@ -138,10 +134,10 @@ dmenuArgs :: [T.Text]
 dmenuArgs = ["-dmenu"]
 
 readRofi
-  :: RofiConf c
+  :: HasRofiConf c
   => [T.Text]
   -> T.Text
-  -> RofiIO c (Either (Int, T.Text, T.Text) T.Text)
+  -> RIO c (Either (Int, T.Text, T.Text) T.Text)
 readRofi uargs input = do
   dargs <- asks defArgs
   io $ readCmdEither "rofi" (dmenuArgs ++ dargs ++ uargs) input