REF use rio monad for rofi

2023-02-14 22:28:26 -05:00 · 2023-02-14 22:28:26 -05:00 · 49c3947b5a
parent 9fcdd1b5f1
commit 49c3947b5a
6 changed files with 52 additions and 60 deletions
--- a/app/rofi-autorandr.hs
+++ b/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 $
-    selectAction $
-      emptyMenu
-        { groups = [mkGroup "Static" staticProfs, mkGroup "Virtual" virtProfs]
-        , prompt = Just "Select Profile"
-        }
+  runRofi c $
+    emptyMenu
+      { groups = [mkGroup "Static" staticProfs, mkGroup "Virtual" virtProfs]
+      , 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]
--- a/app/rofi-bt.hs
+++ b/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) $
-        selectAction $
-          emptyMenu
-            { groups = [untitledGroup $ toRofiActions ras]
-            , prompt = Just "Select Device"
-            }
+      runRofi (RofiBTConf (fmap T.pack args) adapter) $
+        emptyMenu
+          { groups = [untitledGroup $ toRofiActions ras]
+          , 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
--- a/app/rofi-dev.hs
+++ b/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] "")
--- a/app/rofi-evpn.hs
+++ b/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) $
-        selectAction $
-          emptyMenu
-            { groups =
-                [ untitledGroup $ toRofiActions $ maybeToList d
-                , untitledGroup $ toRofiActions cs
-                ]
-            , prompt = Just "Select Action"
-            }
+      runRofi (RofiVPNConf $ fmap T.pack args) $
+        emptyMenu
+          { groups =
+              [ untitledGroup $ toRofiActions $ maybeToList d
+              , untitledGroup $ toRofiActions cs
+              ]
+          , 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
--- a/lib/Bitwarden/Internal.hs
+++ b/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 $
-    selectAction $
-      emptyMenu
-        { groups = [untitledGroup $ toRofiActions ras]
-        , prompt = Just "Action"
-        }
+  runRofi c $
+    emptyMenu
+      { groups = [untitledGroup $ toRofiActions ras]
+      , 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
--- a/lib/Rofi/Command.hs
+++ b/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
-runRofiIO c (RofiIO r) = runReaderT r c
-
-toRofiActions :: [(T.Text, RofiIO c ())] -> RofiActions c
+toRofiActions :: [(T.Text, RIO 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