REF use rio monad for rofi

This commit is contained in:
Nathan Dwarshuis 2023-02-14 22:28:26 -05:00
parent 9fcdd1b5f1
commit 49c3947b5a
6 changed files with 52 additions and 60 deletions

View File

@ -32,19 +32,18 @@ checkExe cmd = do
newtype ARClientConf = ARClientConf [T.Text] newtype ARClientConf = ARClientConf [T.Text]
instance RofiConf ARClientConf where instance HasRofiConf ARClientConf where
defArgs (ARClientConf a) = a defArgs (ARClientConf a) = a
runPrompt :: [String] -> IO () runPrompt :: [String] -> IO ()
runPrompt a = do runPrompt a = do
let c = ARClientConf $ fmap T.pack a let c = ARClientConf $ fmap T.pack a
staticProfs <- getAutoRandrProfiles 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 where
mkGroup header = mkGroup header =
titledGroup header titledGroup header
@ -69,7 +68,7 @@ getAutoRandrDir = do
where where
appendToHome p = (</> p) <$> getHomeDirectory appendToHome p = (</> p) <$> getHomeDirectory
selectProfile :: T.Text -> RofiIO ARClientConf () selectProfile :: T.Text -> RIO ARClientConf ()
selectProfile name = liftIO $ do selectProfile name = liftIO $ do
TI.putStrLn name TI.putStrLn name
void $ spawnProcess "autorandr" ["--change", T.unpack name] void $ spawnProcess "autorandr" ["--change", T.unpack name]

View File

@ -20,7 +20,7 @@ main = getArgs >>= runPrompt
data RofiBTConf = RofiBTConf [T.Text] ObjectPath data RofiBTConf = RofiBTConf [T.Text] ObjectPath
instance RofiConf RofiBTConf where instance HasRofiConf RofiBTConf where
defArgs (RofiBTConf as _) = as defArgs (RofiBTConf as _) = as
type BTAction = RofiAction RofiBTConf type BTAction = RofiAction RofiBTConf
@ -36,12 +36,11 @@ runPrompt args = do
getAdapter paths getAdapter paths
actions client paths adapter = do actions client paths adapter = do
ras <- getRofiActions client paths 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 -> [ObjectPath] -> IO [BTAction]
getRofiActions client os = do getRofiActions client os = do
@ -63,7 +62,7 @@ deviceToRofiAction client dev = do
mkAction True = callDeviceDisconnect client dev mkAction True = callDeviceDisconnect client dev
mkAction False = callDeviceConnect client dev mkAction False = callDeviceConnect client dev
powerAdapterMaybe :: Client -> RofiIO RofiBTConf () powerAdapterMaybe :: Client -> RIO RofiBTConf ()
powerAdapterMaybe client = do powerAdapterMaybe client = do
(RofiBTConf _ adapter) <- ask (RofiBTConf _ adapter) <- ask
let mc = btMethodCall adapter i m let mc = btMethodCall adapter i m

View File

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

View File

@ -22,19 +22,18 @@ runPrompt args = do
run (VPNStatus connected servers) = do run (VPNStatus connected servers) = do
let d = getDisconnectAction <$> connected let d = getDisconnectAction <$> connected
let cs = fmap (getConnectAction connected) servers 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] newtype RofiVPNConf = RofiVPNConf [T.Text]
instance RofiConf RofiVPNConf where instance HasRofiConf RofiVPNConf where
defArgs (RofiVPNConf as) = as defArgs (RofiVPNConf as) = as
type VPNAction = RofiAction RofiVPNConf type VPNAction = RofiAction RofiVPNConf

View File

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

View File

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