diff --git a/app/rofi-autorandr.hs b/app/rofi-autorandr.hs index b5b0947..63ce502 100644 --- 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] diff --git a/app/rofi-bt.hs b/app/rofi-bt.hs index 79421ff..ca42140 100644 --- 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 diff --git a/app/rofi-dev.hs b/app/rofi-dev.hs index 6ba7917..255a566 100644 --- 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] "") diff --git a/app/rofi-evpn.hs b/app/rofi-evpn.hs index 2ab6f62..949cbc3 100644 --- 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 diff --git a/lib/Bitwarden/Internal.hs b/lib/Bitwarden/Internal.hs index 3786fca..46a8297 100644 --- 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 diff --git a/lib/Rofi/Command.hs b/lib/Rofi/Command.hs index c60b67e..76766ec 100644 --- 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