2020-08-17 18:40:43 -04:00
|
|
|
--------------------------------------------------------------------------------
|
2023-02-13 22:19:49 -05:00
|
|
|
-- rofi-autorandr - a rofi prompt to select autorandr profiles
|
2020-08-17 18:40:43 -04:00
|
|
|
--
|
|
|
|
-- Simple wrapper to select an autorandr profile.
|
|
|
|
|
|
|
|
module Main (main) where
|
|
|
|
|
2023-02-13 22:19:49 -05:00
|
|
|
import RIO
|
2023-02-22 22:44:44 -05:00
|
|
|
import RIO.Directory
|
2023-02-13 22:19:49 -05:00
|
|
|
import qualified RIO.Text as T
|
|
|
|
import Rofi.Command
|
2023-02-22 23:02:04 -05:00
|
|
|
import Rofi.IO
|
2023-02-13 22:19:49 -05:00
|
|
|
import System.FilePath.Posix
|
|
|
|
import System.Process
|
2023-02-22 22:44:44 -05:00
|
|
|
import UnliftIO.Environment
|
2020-08-17 18:40:43 -04:00
|
|
|
|
|
|
|
main :: IO ()
|
2023-02-22 22:44:44 -05:00
|
|
|
main = runSimpleApp $ do
|
2023-02-22 23:02:04 -05:00
|
|
|
checkExe "autorandr"
|
2023-02-22 22:44:44 -05:00
|
|
|
getArgs >>= runPrompt
|
2020-08-17 18:40:43 -04:00
|
|
|
|
2023-02-13 23:31:50 -05:00
|
|
|
newtype ARClientConf = ARClientConf [T.Text]
|
2020-08-17 18:40:43 -04:00
|
|
|
|
2023-02-14 22:28:26 -05:00
|
|
|
instance HasRofiConf ARClientConf where
|
2020-08-17 18:40:43 -04:00
|
|
|
defArgs (ARClientConf a) = a
|
|
|
|
|
2023-02-22 22:44:44 -05:00
|
|
|
runPrompt :: MonadIO m => [String] -> m ()
|
2020-08-17 18:40:43 -04:00
|
|
|
runPrompt a = do
|
2023-02-13 23:31:50 -05:00
|
|
|
let c = ARClientConf $ fmap T.pack a
|
2021-06-25 00:04:50 -04:00
|
|
|
staticProfs <- getAutoRandrProfiles
|
2023-02-14 22:28:26 -05:00
|
|
|
runRofi c $
|
|
|
|
emptyMenu
|
|
|
|
{ groups = [mkGroup "Static" staticProfs, mkGroup "Virtual" virtProfs]
|
|
|
|
, prompt = Just "Select Profile"
|
|
|
|
}
|
2021-06-25 00:04:50 -04:00
|
|
|
where
|
2023-02-13 22:19:49 -05:00
|
|
|
mkGroup header =
|
|
|
|
titledGroup header
|
|
|
|
. toRofiActions
|
2023-02-13 23:31:50 -05:00
|
|
|
. fmap (\s -> (T.append " " s, selectProfile s))
|
2021-06-25 00:04:50 -04:00
|
|
|
|
2023-02-13 23:31:50 -05:00
|
|
|
virtProfs :: [T.Text]
|
2021-06-25 00:04:50 -04:00
|
|
|
virtProfs = ["off", "common", "clone-largest", "horizontal", "vertical"]
|
2020-08-17 18:40:43 -04:00
|
|
|
|
|
|
|
-- TODO filter profiles based on which xrandr outputs are actually connected
|
2023-02-22 22:44:44 -05:00
|
|
|
getAutoRandrProfiles :: MonadIO m => m [T.Text]
|
2020-08-17 18:40:43 -04:00
|
|
|
getAutoRandrProfiles = do
|
|
|
|
dir <- getAutoRandrDir
|
|
|
|
contents <- listDirectory dir
|
2023-02-13 23:31:50 -05:00
|
|
|
(fmap T.pack) <$> filterM (doesDirectoryExist . (dir </>)) contents
|
2020-08-17 18:40:43 -04:00
|
|
|
|
2023-02-22 22:44:44 -05:00
|
|
|
getAutoRandrDir :: MonadIO m => m FilePath
|
2020-08-17 18:40:43 -04:00
|
|
|
getAutoRandrDir = do
|
2021-06-25 00:04:50 -04:00
|
|
|
c <- getXdgDirectory XdgConfig "autorandr"
|
|
|
|
e <- doesDirectoryExist c
|
|
|
|
if e then return c else appendToHome ".autorandr"
|
2020-08-17 18:40:43 -04:00
|
|
|
where
|
|
|
|
appendToHome p = (</> p) <$> getHomeDirectory
|
|
|
|
|
2023-02-14 22:28:26 -05:00
|
|
|
selectProfile :: T.Text -> RIO ARClientConf ()
|
2023-02-22 22:44:44 -05:00
|
|
|
selectProfile name =
|
|
|
|
liftIO $
|
|
|
|
void $
|
|
|
|
spawnProcess "autorandr" ["--change", T.unpack name]
|