REF use rio monad for rofi
This commit is contained in:
parent
9fcdd1b5f1
commit
49c3947b5a
|
|
@ -32,15 +32,14 @@ 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 $
|
||||
runRofi c $
|
||||
emptyMenu
|
||||
{ groups = [mkGroup "Static" staticProfs, mkGroup "Virtual" virtProfs]
|
||||
, prompt = Just "Select Profile"
|
||||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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,8 +36,7 @@ runPrompt args = do
|
|||
getAdapter paths
|
||||
actions client paths adapter = do
|
||||
ras <- getRofiActions client paths
|
||||
runRofiIO (RofiBTConf (fmap T.pack args) adapter) $
|
||||
selectAction $
|
||||
runRofi (RofiBTConf (fmap T.pack args) adapter) $
|
||||
emptyMenu
|
||||
{ groups = [untitledGroup $ toRofiActions ras]
|
||||
, prompt = Just "Select Device"
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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] "")
|
||||
|
|
|
|||
|
|
@ -22,8 +22,7 @@ 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 $
|
||||
runRofi (RofiVPNConf $ fmap T.pack args) $
|
||||
emptyMenu
|
||||
{ groups =
|
||||
[ untitledGroup $ toRofiActions $ maybeToList d
|
||||
|
|
@ -34,7 +33,7 @@ runPrompt args = do
|
|||
|
||||
newtype RofiVPNConf = RofiVPNConf [T.Text]
|
||||
|
||||
instance RofiConf RofiVPNConf where
|
||||
instance HasRofiConf RofiVPNConf where
|
||||
defArgs (RofiVPNConf as) = as
|
||||
|
||||
type VPNAction = RofiAction RofiVPNConf
|
||||
|
|
|
|||
|
|
@ -110,14 +110,13 @@ 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 $
|
||||
runRofi c $
|
||||
emptyMenu
|
||||
{ groups = [untitledGroup $ toRofiActions ras]
|
||||
, prompt = Just "Action"
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue