diff --git a/qbar/src/QBar/Qubes/AdminAPI.hs b/qbar/src/QBar/Qubes/AdminAPI.hs index 375fe47a02f7f0007f5cb1e9c2ffe668ddd74516..013b6813386bb4b09b35d583d181cb2c0067f72b 100644 --- a/qbar/src/QBar/Qubes/AdminAPI.hs +++ b/qbar/src/QBar/Qubes/AdminAPI.hs @@ -6,7 +6,6 @@ module QBar.Qubes.AdminAPI ( qubesEvents, qubesGetProperty, qubesListLabelNames, - qubesListLabels, qubesListProperties, qubesListVMs, qubesListVMsP, @@ -17,7 +16,7 @@ module QBar.Qubes.AdminAPI ( import QBar.Prelude -import Control.Monad (forM_, guard) +import Control.Monad (forM_) import Data.Binary import Data.Binary.Get import Data.Binary.Put @@ -29,7 +28,6 @@ import Data.Function ((&)) import Data.Map qualified as Map import Data.Maybe (fromMaybe) import Network.HostName -import Numeric (showHex, readHex) import Pipes import Pipes.Prelude qualified as P import Pipes.Safe qualified as P @@ -298,9 +296,6 @@ qubesGetProperty name = parse <$> qubesAdminCall "admin.property.Get" [name] splitOn ch = fmap BLC.tail . BLC.break (== ch) (isDefault, (typeStr, value)) = splitOn ' ' reply & fmap (splitOn ' ') -qubesListPropertyNames :: IO [BL.ByteString] -qubesListPropertyNames = qubesAdminCallLines "admin.property.List" [] - qubesListProperties :: IO [(BL.ByteString, QubesPropertyInfo)] qubesListProperties = qubesListLabelNames >>= mapM (toSndM qubesGetProperty) where @@ -323,33 +318,10 @@ qubesUsageOfDefaultPool = qubesGetDefaultPool >>= qubesGetPoolInfo >>= extract tryReadProp :: Read a => BL.ByteString -> [(BL.ByteString, BL.ByteString)] -> Maybe a tryReadProp name props = readMaybe . BLC.unpack =<< lookup name props -newtype QubesLabelColor = QubesLabelColor { fromQubesLabelColor :: Int } - deriving (Eq, Ord) - -instance Show QubesLabelColor where - showsPrec _ (QubesLabelColor x) = \s -> "0x" <> pad 6 (showHex x "") <> s - where pad l s = replicate (l - length s) '0' <> s - -instance Read QubesLabelColor where - readsPrec _ ('0' : 'x' : xs) = do - let (num, remainder) = splitAt 6 xs - guard $ length num == 6 - (num', []) <- readHex num - [(QubesLabelColor num', remainder)] - readsPrec _ _ = [] - -qubesGetLabelColor :: BL.ByteString -> IO QubesLabelColor -qubesGetLabelColor name = read . BLC.unpack <$> qubesAdminCall "admin.label.Get" [name] qubesListLabelNames :: IO [BL.ByteString] qubesListLabelNames = qubesAdminCallLines "admin.label.List" [] -qubesListLabels :: IO [(BL.ByteString, QubesLabelColor)] -qubesListLabels = qubesListLabelNames >>= mapM (toSndM qubesGetLabelColor) - where - toSndM :: Applicative m => (a -> m b) -> a -> m (a, b) - toSndM f x = sequenceA (x, f x) - qubesMonitorProperty :: forall m. MonadIO m => Producer QubesEvent m () -> BL.ByteString -> Producer QubesPropertyInfo m () qubesMonitorProperty events name = events >-> P.filter isRelevant >-> fetchValue diff --git a/qbar/src/QBar/Server.hs b/qbar/src/QBar/Server.hs index 73c6f9ca2a6c95326e30a4ace68762effa2e15de..80f816012999a61be3764d17d1d480de17ba625c 100644 --- a/qbar/src/QBar/Server.hs +++ b/qbar/src/QBar/Server.hs @@ -30,9 +30,6 @@ import Pipes.Concurrent (Input, spawn, latest, toOutput, fromInput) import Pipes.Prelude qualified as PP import System.IO (stdin, stdout, stderr, hFlush) -data ServerMode = Host | Mirror -data ServerOutput = Sway | Headless - renderIndicators :: [Text] renderIndicators = ["*"] <> cycle ["/", "-", "\\", "|"]