diff --git a/src/QBar/Cli.hs b/src/QBar/Cli.hs index 75fdfed92ce8c5d0747a495006a301088d2c7c9c..c9f421d1c0c2d70d16d74be407719956aef544a2 100644 --- a/src/QBar/Cli.hs +++ b/src/QBar/Cli.hs @@ -2,18 +2,25 @@ module QBar.Cli where +import QBar.Theme + import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import Options.Applicative -data BarCommand = BarServer | DefaultTheme | RainbowTheme +data BarCommand = BarServerCommand | SetThemeCommand Text barCommandParser :: Parser BarCommand -barCommandParser = hsubparser - ( command "server" (info (pure BarServer) (progDesc "Start a new qbar server. Should be called by swaybar, i3bar or or another i3bar-protocol compatible host process.")) <> - command "default" (info (pure DefaultTheme) (progDesc "Send a message to a running qbar server.")) <> - command "rainbow" (info (pure RainbowTheme) (progDesc "Send a message to a running qbar server.")) +barCommandParser = hsubparser ( + command "server" (info (pure BarServerCommand) (progDesc "Start a new qbar server. Should be called by swaybar, i3bar or or another i3bar-protocol compatible host process.")) <> + command "theme" (info themeCommandParser (progDesc "Change the theme of the running qbar server.")) <> + command "default" (info (pure $ SetThemeCommand "default") (progDesc "Shortcut for 'qbar theme default'.")) <> + command "rainbow" (info (pure $ SetThemeCommand "rainbow") (progDesc "Shortcut for 'qbar theme rainbow'.")) ) +themeCommandParser :: Parser BarCommand +themeCommandParser = SetThemeCommand <$> strArgument (metavar "THEME" <> completeWith (map TL.unpack themeNames)) + data MainOptions = MainOptions { verbose :: Bool, indicator :: Bool, diff --git a/src/QBar/Server.hs b/src/QBar/Server.hs index 3f596dd78fa061a59709d598c1b231dba503c4a3..e72cdfb652749185e562df186062368f901a6310 100644 --- a/src/QBar/Server.hs +++ b/src/QBar/Server.hs @@ -193,6 +193,5 @@ runBarServer defaultBarConfig options = runBarHost barServer (swayBarInput optio runQBar :: BarIO () -> MainOptions -> IO () runQBar barConfiguration options@MainOptions{barCommand} = runCommand barCommand where - runCommand BarServer = runBarServer barConfiguration options - runCommand DefaultTheme = sendIpc options $ SetTheme "default" - runCommand RainbowTheme = sendIpc options $ SetTheme "rainbow" + runCommand BarServerCommand = runBarServer barConfiguration options + runCommand (SetThemeCommand themeName) = sendIpc options $ SetTheme themeName diff --git a/src/QBar/Theme.hs b/src/QBar/Theme.hs index cc589390116e8b8c5dfd976a464d6a8b6e69102b..ca3a888f37b45f8ab7f7c9d4fb19ff1bbdb19032 100644 --- a/src/QBar/Theme.hs +++ b/src/QBar/Theme.hs @@ -9,6 +9,7 @@ import Control.Lens ((^.)) import Control.Monad.State.Lazy (State, evalState, get, put) import Data.Colour.RGBSpace import Data.Colour.RGBSpace.HSV (hsv) +import qualified Data.HashMap.Lazy as HM import qualified Data.Text.Lazy as T import Data.Time.Clock.POSIX (getPOSIXTime) import Pipes @@ -50,10 +51,23 @@ isAnimated (AnimatedTheme _) = True isAnimated _ = False +themesList :: [(Text, Theme)] +themesList = [ + ("default", defaultTheme), + ("rainbow", rainbowTheme) + ] + +themeNames :: [Text] +themeNames = map fst themesList + +themes :: HM.HashMap Text Theme +themes = HM.fromList themesList + + findTheme :: Text -> Either Text Theme -findTheme "default" = Right defaultTheme -findTheme "rainbow" = Right rainbowTheme -findTheme name = Left $ "Invalid theme: " <> name +findTheme themeName = maybe invalidThemeName Right $ HM.lookup themeName themes + where + invalidThemeName = Left $ "Invalid theme: " <> themeName mkTheme :: SimplifiedTheme -> Theme