diff --git a/bin/xmobar.hs b/bin/xmobar.hs index 4a56132..4f2e496 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -56,17 +56,20 @@ main = getArgs >>= parse parse :: [String] -> IO () parse [] = run parse ["--deps"] = withCache printDeps -parse ["--test"] = void $ withCache . evalConfig =<< connectDBus +parse ["--test"] = withCache $ do + db <- connectDBus + void $ evalConfig db parse _ = usage run :: IO () -run = do - db <- connectDBus - c <- withCache $ evalConfig db - disconnectDBus db - -- this is needed to see any printed messages - hFlush stdout - xmobar c +run = + withCache $ do + db <- connectDBus + c <- evalConfig db + disconnectDBus db + -- this is needed to see any printed messages + liftIO $ hFlush stdout + liftIO $ xmobar c evalConfig :: DBusState -> FIO Config evalConfig db = do @@ -78,10 +81,10 @@ evalConfig db = do printDeps :: FIO () printDeps = do - db <- io connectDBus + db <- connectDBus let ps = sort $ nub $ fmap showFulfillment $ concatMap dumpFeature $ allFeatures db io $ mapM_ (putStrLn . T.unpack) ps - io $ disconnectDBus db + disconnectDBus db usage :: IO () usage = putStrLn $ intercalate "\n" diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 316b242..75ed5c4 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -8,12 +8,8 @@ module Main (main) where -import Control.Monad - import Data.Internal.DBus import Data.Internal.Dependency -import Data.List -import Data.Maybe import Data.Monoid import Data.Text.IO (hPutStrLn) @@ -23,6 +19,7 @@ import Graphics.X11.Xlib.Extras import RIO import RIO.Directory +import RIO.List import RIO.Process import qualified RIO.Text as T @@ -204,7 +201,7 @@ startChildDaemons :: FeatureSet -> FIO [Process () () ()] startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs) withDBusX :: (DBusState -> FIO a) -> FIO a -withDBusX = bracket (io connectDBusX) cleanup +withDBusX = bracket connectDBusX cleanup where cleanup db = do logInfo "unregistering xmonad from DBus" @@ -226,7 +223,7 @@ withXmobar = bracket startXmobar cleanup printDeps :: FIO () printDeps = do - db <- io connectDBus + db <- connectDBus (i, f, d) <- allFeatures db io $ mapM_ (putStrLn . T.unpack) $ fmap showFulfillment diff --git a/lib/Data/Internal/DBus.hs b/lib/Data/Internal/DBus.hs index 0bfe459..94a8c8f 100644 --- a/lib/Data/Internal/DBus.hs +++ b/lib/Data/Internal/DBus.hs @@ -27,14 +27,9 @@ module Data.Internal.DBus , bodyToMaybe ) where -import Control.Exception -import Control.Monad - -import Data.Bifunctor -import qualified Data.Map.Strict as M -import Data.Maybe - -import qualified RIO.Text as T +import RIO +import qualified RIO.Map as M +import qualified RIO.Text as T import DBus import DBus.Client @@ -45,23 +40,38 @@ import DBus.Client class SafeClient c where toClient :: c -> Client - getDBusClient :: IO (Maybe c) + getDBusClient + :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env) + => m (Maybe c) - disconnectDBusClient :: c -> IO () - disconnectDBusClient = disconnect . toClient + disconnectDBusClient + :: (MonadUnliftIO m) + => c + -> m () + disconnectDBusClient = liftIO . disconnect . toClient - withDBusClient :: (c -> IO a) -> IO (Maybe a) + withDBusClient + :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env) + => (c -> m a) + -> m (Maybe a) + -- TODO bracket withDBusClient f = do client <- getDBusClient forM client $ \c -> do r <- f c - disconnect (toClient c) + liftIO $ disconnect (toClient c) return r - withDBusClient_ :: (c -> IO ()) -> IO () + withDBusClient_ + :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env) + => (c -> m ()) + -> m () withDBusClient_ = void . withDBusClient - fromDBusClient :: (c -> a) -> IO (Maybe a) + fromDBusClient + :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env) + => (c -> a) + -> m (Maybe a) fromDBusClient f = withDBusClient (return . f) newtype SysClient = SysClient Client @@ -69,20 +79,25 @@ newtype SysClient = SysClient Client instance SafeClient SysClient where toClient (SysClient cl) = cl - getDBusClient = fmap SysClient <$> getDBusClient' True + getDBusClient = fmap SysClient <$> getDBusClient_ True newtype SesClient = SesClient Client instance SafeClient SesClient where toClient (SesClient cl) = cl - getDBusClient = fmap SesClient <$> getDBusClient' False + getDBusClient = fmap SesClient <$> getDBusClient_ False -getDBusClient' :: Bool -> IO (Maybe Client) -getDBusClient' sys = do - res <- try $ if sys then connectSystem else connectSession +getDBusClient_ + :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env) + => Bool + -> m (Maybe Client) +getDBusClient_ sys = do + res <- try $ liftIO $ if sys then connectSystem else connectSession case res of - Left e -> putStrLn (clientErrorMessage e) >> return Nothing + Left e -> do + logError $ Utf8Builder $ encodeUtf8Builder $ T.pack $ clientErrorMessage e + return Nothing Right c -> return $ Just c -------------------------------------------------------------------------------- @@ -90,12 +105,14 @@ getDBusClient' sys = do type MethodBody = Either T.Text [Variant] -callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody -callMethod' cl = fmap (bimap (T.pack . methodErrorMessage) methodReturnBody) +callMethod' :: (MonadIO m, SafeClient c) => c -> MethodCall -> m MethodBody +callMethod' cl = + liftIO + . fmap (bimap (T.pack . methodErrorMessage) methodReturnBody) . call (toClient cl) -callMethod :: SafeClient c => c -> BusName -> ObjectPath -> InterfaceName - -> MemberName -> IO MethodBody +callMethod :: (MonadIO m, SafeClient c) => c -> BusName -> ObjectPath -> InterfaceName + -> MemberName -> m MethodBody callMethod client bus path iface = callMethod' client . methodCallBus bus path iface methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall @@ -108,7 +125,7 @@ methodCallBus b p i m = (methodCall p i m) dbusInterface :: InterfaceName dbusInterface = interfaceName_ "org.freedesktop.DBus" -callGetNameOwner :: SafeClient c => c -> BusName -> IO (Maybe BusName) +callGetNameOwner :: (MonadIO m, SafeClient c) => c -> BusName -> m (Maybe BusName) callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc where mc = (methodCallBus dbusName dbusPath dbusInterface mem) @@ -129,9 +146,14 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant type SignalCallback = [Variant] -> IO () -addMatchCallback :: SafeClient c => MatchRule -> SignalCallback -> c - -> IO SignalHandler -addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody +addMatchCallback + :: (MonadIO m, SafeClient c) + => MatchRule + -> SignalCallback + -> c + -> m SignalHandler +addMatchCallback rule cb cl = + liftIO $ addMatch (toClient cl) rule $ cb . signalBody matchSignal :: Maybe BusName -> Maybe ObjectPath -> Maybe InterfaceName -> Maybe MemberName -> MatchRule @@ -142,8 +164,14 @@ matchSignal b p i m = matchAny , matchMember = m } -matchSignalFull :: SafeClient c => c -> BusName -> Maybe ObjectPath - -> Maybe InterfaceName -> Maybe MemberName -> IO (Maybe MatchRule) +matchSignalFull + :: (MonadIO m, SafeClient c) + => c + -> BusName + -> Maybe ObjectPath + -> Maybe InterfaceName + -> Maybe MemberName + -> m (Maybe MatchRule) matchSignalFull client b p i m = fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b @@ -156,23 +184,29 @@ propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties" propertySignal :: MemberName propertySignal = memberName_ "PropertiesChanged" -callPropertyGet :: SafeClient c => BusName -> ObjectPath -> InterfaceName - -> MemberName -> c -> IO [Variant] -callPropertyGet bus path iface property cl = fmap (either (const []) (:[])) +callPropertyGet :: (MonadIO m, SafeClient c) => BusName -> ObjectPath -> InterfaceName + -> MemberName -> c -> m [Variant] +callPropertyGet bus path iface property cl = + liftIO + $ fmap (either (const []) (:[])) $ getProperty (toClient cl) $ methodCallBus bus path iface property matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule matchProperty b p = matchSignal b p (Just propertyInterface) (Just propertySignal) -matchPropertyFull :: SafeClient c => c -> BusName -> Maybe ObjectPath - -> IO (Maybe MatchRule) +matchPropertyFull + :: (MonadIO m, SafeClient c) + => c + -> BusName + -> Maybe ObjectPath + -> m (Maybe MatchRule) matchPropertyFull cl b p = matchSignalFull cl b p (Just propertyInterface) (Just propertySignal) data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show) -withSignalMatch :: (Maybe a -> IO ()) -> SignalMatch a -> IO () +withSignalMatch :: Monad m => (Maybe a -> m ()) -> SignalMatch a -> m () withSignalMatch f (Match x) = f (Just x) withSignalMatch f Failure = f Nothing withSignalMatch _ NoMatch = return () @@ -208,24 +242,44 @@ omInterfacesAdded = memberName_ "InterfacesAdded" omInterfacesRemoved :: MemberName omInterfacesRemoved = memberName_ "InterfacesRemoved" -callGetManagedObjects :: SafeClient c => c -> BusName -> ObjectPath - -> IO ObjectTree +callGetManagedObjects + :: (MonadIO m, SafeClient c) + => c + -> BusName + -> ObjectPath + -> m ObjectTree callGetManagedObjects cl bus path = either (const M.empty) (fromMaybe M.empty . fromSingletonVariant) <$> callMethod cl bus path omInterface getManagedObjects -addInterfaceChangedListener :: SafeClient c => BusName -> MemberName - -> ObjectPath -> SignalCallback -> c -> IO (Maybe SignalHandler) +addInterfaceChangedListener + :: (MonadIO m, SafeClient c) + => BusName + -> MemberName + -> ObjectPath + -> SignalCallback + -> c + -> m (Maybe SignalHandler) addInterfaceChangedListener bus prop path sc cl = do rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop) forM rule $ \r -> addMatchCallback r sc cl -addInterfaceAddedListener :: SafeClient c => BusName -> ObjectPath - -> SignalCallback -> c -> IO (Maybe SignalHandler) +addInterfaceAddedListener + :: (MonadIO m, SafeClient c) + => BusName + -> ObjectPath + -> SignalCallback + -> c + -> m (Maybe SignalHandler) addInterfaceAddedListener bus = addInterfaceChangedListener bus omInterfacesAdded -addInterfaceRemovedListener :: SafeClient c => BusName -> ObjectPath - -> SignalCallback -> c -> IO (Maybe SignalHandler) +addInterfaceRemovedListener + :: (MonadIO m, SafeClient c) + => BusName + -> ObjectPath + -> SignalCallback + -> c + -> m (Maybe SignalHandler) addInterfaceRemovedListener bus = addInterfaceChangedListener bus omInterfacesRemoved diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs index 930ce34..6a23520 100644 --- a/lib/Data/Internal/Dependency.hs +++ b/lib/Data/Internal/Dependency.hs @@ -106,38 +106,31 @@ module Data.Internal.Dependency , shellTest ) where -import Control.Monad.IO.Class -import Control.Monad.Identity -import Control.Monad.Reader - -import Data.Aeson hiding (Error, Result) +import Data.Aeson hiding (Error, Result) import Data.Aeson.Key -import Data.Bifunctor -import Data.Either import Data.Internal.DBus -import Data.List -import Data.Maybe import Data.Yaml -import GHC.IO.Exception (ioe_description) +import GHC.IO.Exception (ioe_description) -import DBus hiding (typeOf) -import qualified DBus.Introspection as I +import DBus hiding (typeOf) +import qualified DBus.Introspection as I -import RIO hiding (bracket, fromString) +import RIO hiding (bracket, fromString) +import RIO.Directory import RIO.FilePath -import RIO.Process hiding (findExecutable) -import qualified RIO.Text as T +import RIO.List +import RIO.Process hiding (findExecutable) +import qualified RIO.Text as T -import System.Directory import System.Environment import System.IO.Error import System.Posix.Files -import System.Process.Typed (nullStream) +import System.Process.Typed (nullStream) -import XMonad.Core (X, io) +import XMonad.Core (X, io) import XMonad.Internal.IO -import XMonad.Internal.Shell hiding (proc, runProcess) +import XMonad.Internal.Shell hiding (proc, runProcess) import XMonad.Internal.Theme -------------------------------------------------------------------------------- diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs index 2fb2477..5d69630 100644 --- a/lib/XMonad/Internal/Command/DMenu.hs +++ b/lib/XMonad/Internal/Command/DMenu.hs @@ -24,12 +24,9 @@ import DBus import Graphics.X11.Types +import RIO.Directory import qualified RIO.Text as T -import System.Directory - ( XdgDirectory (..) - , getXdgDirectory - ) import System.IO import XMonad.Core hiding (spawn) diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs index 6a4d00c..509bca0 100644 --- a/lib/XMonad/Internal/Command/Desktop.hs +++ b/lib/XMonad/Internal/Command/Desktop.hs @@ -47,11 +47,11 @@ import Data.Internal.Dependency import DBus import RIO +import RIO.Directory import RIO.FilePath import qualified RIO.Process as P import qualified RIO.Text as T -import System.Directory import System.Environment import System.Posix.User diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs index f9a83b2..f376aa5 100644 --- a/lib/XMonad/Internal/Command/Power.hs +++ b/lib/XMonad/Internal/Command/Power.hs @@ -29,17 +29,15 @@ module XMonad.Internal.Command.Power import Data.Internal.Dependency -import Data.Either -import qualified Data.Map as M - import Graphics.X11.Types import RIO +import RIO.Directory import RIO.FilePath +import qualified RIO.Map as M import qualified RIO.Process as P import qualified RIO.Text as T -import System.Directory import System.IO.Error import XMonad.Core hiding (spawn) diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs index d5ee052..deda5a8 100644 --- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs +++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs @@ -19,6 +19,7 @@ module XMonad.Internal.Concurrent.ClientMessage ( XMsgType(..) , sendXMsg , splitXMsg + , withOpenDisplay ) where import Data.Char diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs index 4944611..3a43626 100644 --- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs +++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs @@ -33,17 +33,7 @@ module XMonad.Internal.Concurrent.DynamicWorkspaces , doSink ) where -import Data.List (deleteBy, find) -import qualified Data.Map as M -import Data.Maybe - --- import Control.Concurrent -import Control.Monad -import Control.Monad.Reader - - import Graphics.X11.Types - import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Display import Graphics.X11.Xlib.Event @@ -55,6 +45,8 @@ import RIO hiding ( Display , display ) +import RIO.List +import qualified RIO.Map as M import qualified RIO.Set as S import System.Process @@ -106,9 +98,6 @@ data WConf = WConf type W a = RIO WConf () -withOpenDisplay :: (Display -> IO a) -> IO a -withOpenDisplay = bracket (openDisplay "") closeDisplay - runWorkspaceMon :: [DynWorkspace] -> IO () runWorkspaceMon dws = withOpenDisplay $ \dpy -> do root <- rootWindow dpy $ defaultScreen dpy diff --git a/lib/XMonad/Internal/Concurrent/VirtualBox.hs b/lib/XMonad/Internal/Concurrent/VirtualBox.hs index 7d1f857..2695e74 100644 --- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs +++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs @@ -12,13 +12,13 @@ module XMonad.Internal.Concurrent.VirtualBox import Data.Internal.Dependency -import Text.XML.Light - import RIO hiding (try) import RIO.Directory import RIO.FilePath import qualified RIO.Text as T +import Text.XML.Light + import XMonad.Internal.Shell vmExists :: T.Text -> IO (Maybe Msg) diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs index 3395f4b..1ce79f8 100644 --- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs +++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs @@ -12,14 +12,12 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard , blPath ) where -import Control.Monad (when) - -import Data.Int (Int32) import Data.Internal.DBus import Data.Internal.Dependency import DBus +import RIO import RIO.FilePath import XMonad.Internal.DBus.Brightness.Common diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs index 8146055..05e6313 100644 --- a/lib/XMonad/Internal/DBus/Brightness/Common.hs +++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs @@ -13,9 +13,6 @@ module XMonad.Internal.DBus.Brightness.Common , signalDep ) where -import Control.Monad (void) - -import Data.Int (Int32) import Data.Internal.DBus import Data.Internal.Dependency @@ -23,6 +20,7 @@ import DBus import DBus.Client import qualified DBus.Introspection as I +import RIO import qualified RIO.Text as T import XMonad.Core (io) diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs index 9c29cae..c79b557 100644 --- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs +++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs @@ -12,12 +12,12 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight , blPath ) where -import Data.Int (Int32) import Data.Internal.DBus import Data.Internal.Dependency import DBus +import RIO import RIO.FilePath import XMonad.Internal.DBus.Brightness.Common diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index 719a4c4..bb5d4fc 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE ScopedTypeVariables #-} - --------------------------------------------------------------------------------- -- | High-level interface for managing XMonad's DBus +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + module XMonad.Internal.DBus.Control ( Client , DBusState(..) @@ -17,14 +17,15 @@ module XMonad.Internal.DBus.Control , dbusExporters ) where -import Control.Monad - import Data.Internal.DBus import Data.Internal.Dependency import DBus import DBus.Client +import RIO +import qualified RIO.Text as T + import XMonad.Internal.DBus.Brightness.ClevoKeyboard import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Common @@ -37,27 +38,36 @@ data DBusState = DBusState } -- | Connect to the DBus -connectDBus :: IO DBusState +connectDBus + :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env) + => m DBusState connectDBus = do ses <- getDBusClient sys <- getDBusClient return DBusState { dbSesClient = ses, dbSysClient = sys } -- | Disconnect from the DBus -disconnectDBus :: DBusState -> IO () +disconnectDBus + :: (MonadUnliftIO m) + => DBusState -> m () disconnectDBus db = disc dbSesClient >> disc dbSysClient where disc f = maybe (return ()) disconnectDBusClient $ f db -- | Connect to the DBus and request the XMonad name -connectDBusX :: IO DBusState +connectDBusX + :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env) + => m DBusState connectDBusX = do db <- connectDBus forM_ (dbSesClient db) requestXMonadName return db -- | Disconnect from DBus and release the XMonad name -disconnectDBusX :: DBusState -> IO () +disconnectDBusX + :: (MonadUnliftIO m) + => DBusState + -> m () disconnectDBusX db = do forM_ (dbSesClient db) releaseXMonadName disconnectDBus db @@ -66,18 +76,25 @@ disconnectDBusX db = do dbusExporters :: [Maybe SesClient -> SometimesIO] dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard] -releaseXMonadName :: SesClient -> IO () -releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName +releaseXMonadName + :: (MonadUnliftIO m) + => SesClient + -> m () +releaseXMonadName ses = void $ liftIO $ releaseName (toClient ses) xmonadBusName -requestXMonadName :: SesClient -> IO () +requestXMonadName + :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env) + => SesClient + -> m () requestXMonadName ses = do - res <- requestName (toClient ses) xmonadBusName [] + res <- liftIO $ requestName (toClient ses) xmonadBusName [] -- TODO if the client is not released on shutdown the owner will be different let msg | res == NamePrimaryOwner = Nothing - | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn + | res == NameAlreadyOwner = Just "this process already owns bus name" | res == NameInQueue - || res == NameExists = Just $ "another process owns " ++ xn - | otherwise = Just $ "unknown error when requesting " ++ xn - forM_ msg putStrLn + || res == NameExists = Just "another process owns bus name" + | otherwise = Just "unknown error when requesting bus name" + forM_ msg $ \m -> + logError $ Utf8Builder $ encodeUtf8Builder $ T.concat [m, ": ", xn] where - xn = "'" ++ formatBusName xmonadBusName ++ "'" + xn = T.pack $ formatBusName xmonadBusName diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs index e891314..ed31e4a 100644 --- a/lib/XMonad/Internal/DBus/Removable.hs +++ b/lib/XMonad/Internal/DBus/Removable.hs @@ -8,15 +8,15 @@ module XMonad.Internal.DBus.Removable (runRemovableMon) where -import Control.Monad - import Data.Internal.DBus import Data.Internal.Dependency -import Data.Map.Strict (Map, member) import DBus import DBus.Client +import RIO +import qualified RIO.Map as M + import XMonad.Core (io) import XMonad.Internal.Command.Desktop @@ -60,7 +60,7 @@ driveFlag :: String driveFlag = "org.freedesktop.UDisks2.Drive" addedHasDrive :: [Variant] -> Bool -addedHasDrive [_, a] = maybe False (member driveFlag) +addedHasDrive [_, a] = maybe False (M.member driveFlag) (fromVariant a :: Maybe (Map String (Map String Variant))) addedHasDrive _ = False diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs index 81e8bab..8b5c6f5 100644 --- a/lib/XMonad/Internal/DBus/Screensaver.hs +++ b/lib/XMonad/Internal/DBus/Screensaver.hs @@ -14,15 +14,15 @@ module XMonad.Internal.DBus.Screensaver import Data.Internal.DBus import Data.Internal.Dependency -import RIO - import DBus import DBus.Client -import qualified DBus.Introspection as I +import qualified DBus.Introspection as I import Graphics.X11.XScreenSaver -import Graphics.X11.Xlib.Display +import RIO + +import XMonad.Internal.Concurrent.ClientMessage import XMonad.Internal.DBus.Common import XMonad.Internal.Shell @@ -45,10 +45,7 @@ toggle = do query :: IO SSState query = do - -- TODO bracket the display - dpy <- openDisplay "" - xssi <- xScreenSaverQueryInfo dpy - closeDisplay dpy + xssi <- withOpenDisplay xScreenSaverQueryInfo return $ case xssi of Just XScreenSaverInfo { xssi_state = ScreenSaverDisabled } -> False Just XScreenSaverInfo { xssi_state = _ } -> True diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs index 00e212f..87b374f 100644 --- a/lib/XMonad/Internal/IO.hs +++ b/lib/XMonad/Internal/IO.hs @@ -25,12 +25,11 @@ module XMonad.Internal.IO ) where import Data.Char -import Data.Text (pack, unpack) -import Data.Text.IO as T (readFile, writeFile) import RIO import RIO.Directory import RIO.FilePath +import qualified RIO.Text as T import System.IO.Error @@ -38,7 +37,7 @@ import System.IO.Error -- | read readInt :: (Read a, Integral a) => FilePath -> IO a -readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile +readInt = fmap (read . T.unpack . T.takeWhile isDigit) . readFileUtf8 readBool :: FilePath -> IO Bool readBool = fmap (==(1 :: Int)) . readInt @@ -47,7 +46,7 @@ readBool = fmap (==(1 :: Int)) . readInt -- | write writeInt :: (Show a, Integral a) => FilePath -> a -> IO () -writeInt f = T.writeFile f . pack . show +writeInt f = writeFileUtf8 f . T.pack . show writeBool :: FilePath -> Bool -> IO () writeBool f b = writeInt f ((if b then 1 else 0) :: Int) diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs deleted file mode 100644 index 1e493d6..0000000 --- a/lib/XMonad/Internal/Process.hs +++ /dev/null @@ -1,17 +0,0 @@ --------------------------------------------------------------------------------- --- | Functions for managing processes - -module XMonad.Internal.Process where - --- import Control.Exception --- import Control.Monad --- import Control.Monad.IO.Class - --- import qualified RIO.Text as T - --- import System.Exit --- import System.IO --- import System.Process - --- import XMonad.Core hiding (spawn) - diff --git a/lib/Xmobar/Plugins/BacklightCommon.hs b/lib/Xmobar/Plugins/BacklightCommon.hs index b8f9f7f..9ca7a69 100644 --- a/lib/Xmobar/Plugins/BacklightCommon.hs +++ b/lib/Xmobar/Plugins/BacklightCommon.hs @@ -10,6 +10,7 @@ module Xmobar.Plugins.BacklightCommon (startBacklight) where import Data.Internal.DBus +import RIO import qualified RIO.Text as T import Xmobar.Plugins.Common @@ -17,9 +18,9 @@ import Xmobar.Plugins.Common startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ()) -> (SesClient -> IO (Maybe a)) -> T.Text -> Callback -> IO () startBacklight matchSignal callGetBrightness icon cb = do - withDBusClientConnection cb $ \c -> do - matchSignal display c - display =<< callGetBrightness c + withDBusClientConnection cb $ \c -> liftIO $ do + matchSignal dpy c + dpy =<< callGetBrightness c where formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"] - display = displayMaybe cb formatBrightness + dpy = displayMaybe cb formatBrightness diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs index 9a9dbd9..1fee0aa 100644 --- a/lib/Xmobar/Plugins/Bluetooth.hs +++ b/lib/Xmobar/Plugins/Bluetooth.hs @@ -38,19 +38,16 @@ module Xmobar.Plugins.Bluetooth , btDep ) where -import Control.Concurrent.MVar -import Control.Monad - import Data.Internal.DBus import Data.Internal.Dependency -import Data.List import Data.List.Split -import qualified Data.Map as M -import Data.Maybe import DBus import DBus.Client +import RIO +import RIO.List +import qualified RIO.Map as M import qualified RIO.Text as T import XMonad.Internal.DBus.Common @@ -71,23 +68,24 @@ instance Exec Bluetooth where start (Bluetooth icons colors) cb = withDBusClientConnection cb $ startAdapter icons colors cb -startAdapter :: Icons -> Colors -> Callback -> SysClient -> IO () +startAdapter :: MonadIO m => Icons -> Colors -> Callback -> SysClient -> m () startAdapter is cs cb cl = do ot <- getBtObjectTree cl + -- TODO use RIO for this? state <- newMVar emptyState - let display = displayIcon cb (iconFormatter is cs) state - forM_ (findAdapter ot) $ \adapter -> do + let dpy = displayIcon cb (iconFormatter is cs) state + forM_ (findAdapter ot) $ \adapter -> liftIO $ do -- set up adapter initAdapter state adapter cl -- TODO this step could fail; at least warn the user... - void $ addAdaptorListener state display adapter cl + void $ addAdaptorListener state dpy adapter cl -- set up devices on the adapter (and listeners for adding/removing devices) let devices = findDevices adapter ot - addDeviceAddedListener state display adapter cl - addDeviceRemovedListener state display adapter cl - forM_ devices $ \d -> addAndInitDevice state display d cl + addDeviceAddedListener state dpy adapter cl + addDeviceRemovedListener state dpy adapter cl + forM_ devices $ \d -> addAndInitDevice state dpy d cl -- after setting things up, show the icon based on the initialized state - display + dpy -------------------------------------------------------------------------------- -- | Icon Display @@ -99,9 +97,9 @@ type IconFormatter = (Maybe Bool -> Bool -> T.Text) type Icons = (T.Text, T.Text) -displayIcon :: Callback -> IconFormatter -> MutableBtState -> IO () +displayIcon :: MonadIO m => Callback -> IconFormatter -> MutableBtState -> m () displayIcon callback formatter = - callback . T.unpack . uncurry formatter <=< readState + liftIO . callback . T.unpack . uncurry formatter <=< readState -- TODO maybe I want this to fail when any of the device statuses are Nothing iconFormatter :: Icons -> Colors -> IconFormatter @@ -138,7 +136,7 @@ emptyState = BtState , btPowered = Nothing } -readState :: MutableBtState -> IO (Maybe Bool, Bool) +readState :: MonadIO m => MutableBtState -> m (Maybe Bool, Bool) readState state = do p <- readPowered state c <- readDevices state @@ -161,55 +159,55 @@ adaptorHasDevice adaptor device = case splitPath device of splitPath :: ObjectPath -> [T.Text] splitPath = fmap T.pack . splitOn "/" . dropWhile (=='/') . formatObjectPath -getBtObjectTree :: SysClient -> IO ObjectTree +getBtObjectTree :: MonadIO m => SysClient -> m ObjectTree getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath btOMPath :: ObjectPath btOMPath = objectPath_ "/" -addBtOMListener :: SignalCallback -> SysClient -> IO () -addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc +addBtOMListener :: MonadIO m => SignalCallback -> SysClient -> m () +addBtOMListener sc = liftIO . void . addInterfaceAddedListener btBus btOMPath sc -addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO () -addDeviceAddedListener state display adapter client = +addDeviceAddedListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m () +addDeviceAddedListener state dpy adapter client = addBtOMListener addDevice client where - addDevice = pathCallback adapter display $ \d -> - addAndInitDevice state display d client + addDevice = pathCallback adapter dpy $ \d -> + addAndInitDevice state dpy d client -addDeviceRemovedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO () -addDeviceRemovedListener state display adapter sys = +addDeviceRemovedListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m () +addDeviceRemovedListener state dpy adapter sys = addBtOMListener remDevice sys where - remDevice = pathCallback adapter display $ \d -> do + remDevice = pathCallback adapter dpy $ \d -> do old <- removeDevice state d forM_ old $ removeMatch (toClient sys) . btDevSigHandler pathCallback :: ObjectPath -> IO () -> (ObjectPath -> IO ()) -> SignalCallback -pathCallback adapter display f [device, _] = forM_ (fromVariant device) $ \d -> - when (adaptorHasDevice adapter d) $ f d >> display +pathCallback adapter dpy f [device, _] = forM_ (fromVariant device) $ \d -> + when (adaptorHasDevice adapter d) $ f d >> dpy pathCallback _ _ _ _ = return () -------------------------------------------------------------------------------- -- | Adapter -initAdapter :: MutableBtState -> ObjectPath -> SysClient -> IO () +initAdapter :: MonadIO m => MutableBtState -> ObjectPath -> SysClient -> m () initAdapter state adapter client = do reply <- callGetPowered adapter client - putPowered state $ fromSingletonVariant reply + liftIO $ putPowered state $ fromSingletonVariant reply -matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule) +matchBTProperty :: MonadIO m => SysClient -> ObjectPath -> m (Maybe MatchRule) matchBTProperty sys p = matchPropertyFull sys btBus (Just p) -addAdaptorListener :: MutableBtState -> IO () -> ObjectPath -> SysClient - -> IO (Maybe SignalHandler) -addAdaptorListener state display adaptor sys = do +addAdaptorListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient + -> m (Maybe SignalHandler) +addAdaptorListener state dpy adaptor sys = do rule <- matchBTProperty sys adaptor forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys where - procMatch = withSignalMatch $ \b -> putPowered state b >> display + procMatch = withSignalMatch $ \b -> liftIO $ putPowered state b >> dpy -callGetPowered :: ObjectPath -> SysClient -> IO [Variant] +callGetPowered :: MonadIO m => ObjectPath -> SysClient -> m [Variant] callGetPowered adapter = callPropertyGet btBus adapter adapterInterface $ memberName_ $ T.unpack adaptorPowered @@ -219,7 +217,7 @@ matchPowered = matchPropertyChanged adapterInterface adaptorPowered putPowered :: MutableBtState -> Maybe Bool -> IO () putPowered m ds = modifyMVar_ m (\s -> return s { btPowered = ds }) -readPowered :: MutableBtState -> IO (Maybe Bool) +readPowered :: MonadIO m => MutableBtState -> m (Maybe Bool) readPowered = fmap btPowered . readMVar adapterInterface :: InterfaceName @@ -231,13 +229,13 @@ adaptorPowered = "Powered" -------------------------------------------------------------------------------- -- | Devices -addAndInitDevice :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO () -addAndInitDevice state display device client = do - sh <- addDeviceListener state display device client +addAndInitDevice :: MonadUnliftIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m () +addAndInitDevice state dpy device client = do + sh <- addDeviceListener state dpy device client -- TODO add some intelligent error messages here forM_ sh $ \s -> initDevice state s device client -initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO () +initDevice :: MonadUnliftIO m => MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> m () initDevice state sh device sys = do reply <- callGetConnected device sys void $ insertDevice state device $ @@ -245,22 +243,22 @@ initDevice state sh device sys = do , btDevSigHandler = sh } -addDeviceListener :: MutableBtState -> IO () -> ObjectPath -> SysClient - -> IO (Maybe SignalHandler) -addDeviceListener state display device sys = do +addDeviceListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient + -> m (Maybe SignalHandler) +addDeviceListener state dpy device sys = do rule <- matchBTProperty sys device forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys where - procMatch = withSignalMatch $ \c -> updateDevice state device c >> display + procMatch = withSignalMatch $ \c -> updateDevice state device c >> dpy matchConnected :: [Variant] -> SignalMatch Bool matchConnected = matchPropertyChanged devInterface devConnected -callGetConnected :: ObjectPath -> SysClient -> IO [Variant] +callGetConnected :: MonadIO m => ObjectPath -> SysClient -> m [Variant] callGetConnected p = callPropertyGet btBus p devInterface $ memberName_ (T.unpack devConnected) -insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool +insertDevice :: MonadUnliftIO m => MutableBtState -> ObjectPath -> BTDevice -> m Bool insertDevice m device dev = modifyMVar m $ \s -> do let new = M.insert device dev $ btDevices s return (s { btDevices = new }, anyDevicesConnected new) @@ -278,7 +276,7 @@ removeDevice m device = modifyMVar m $ \s -> do let devs = btDevices s return (s { btDevices = M.delete device devs }, M.lookup device devs) -readDevices :: MutableBtState -> IO ConnectedDevices +readDevices :: MonadIO m => MutableBtState -> m ConnectedDevices readDevices = fmap btDevices . readMVar devInterface :: InterfaceName diff --git a/lib/Xmobar/Plugins/ClevoKeyboard.hs b/lib/Xmobar/Plugins/ClevoKeyboard.hs index 92a8f12..67b45f5 100644 --- a/lib/Xmobar/Plugins/ClevoKeyboard.hs +++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs @@ -14,7 +14,6 @@ module Xmobar.Plugins.ClevoKeyboard import qualified RIO.Text as T import Xmobar - import Xmobar.Plugins.BacklightCommon import XMonad.Internal.DBus.Brightness.ClevoKeyboard diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs index d28ee2b..45b6eb0 100644 --- a/lib/Xmobar/Plugins/Common.hs +++ b/lib/Xmobar/Plugins/Common.hs @@ -10,18 +10,17 @@ module Xmobar.Plugins.Common , Callback , Colors(..) , displayMaybe - , displayMaybe' + , displayMaybe_ , xmobarFGColor ) where -import Control.Monad - import Data.Internal.DBus import DBus import DBus.Client +import RIO import qualified RIO.Text as T import XMonad.Hooks.DynamicLog (xmobarColor) @@ -35,17 +34,21 @@ data Colors = Colors } deriving (Eq, Show, Read) -startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant]) +startListener :: (MonadIO m, SafeClient c, IsVariant a) => MatchRule -> (c -> m [Variant]) -> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback - -> c -> IO () + -> c -> m () startListener rule getProp fromSignal toColor cb client = do reply <- getProp client - displayMaybe cb toColor $ fromSingletonVariant reply + displayMaybe cb (liftIO . toColor) $ fromSingletonVariant reply void $ addMatchCallback rule (procMatch . fromSignal) client where procMatch = procSignalMatch cb toColor -procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO () +procSignalMatch + :: Callback + -> (a -> IO T.Text) + -> SignalMatch a + -> IO () procSignalMatch cb f = withSignalMatch (displayMaybe cb f) colorText :: Colors -> Bool -> T.Text -> T.Text @@ -58,11 +61,17 @@ xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack na :: T.Text na = "N/A" -displayMaybe :: Callback -> (a -> IO T.Text) -> Maybe a -> IO () -displayMaybe cb f = (cb . T.unpack) <=< maybe (return na) f +displayMaybe :: (MonadIO m) => Callback -> (a -> m T.Text) -> Maybe a -> m () +displayMaybe cb f = (liftIO . cb . T.unpack) <=< maybe (return na) f -displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO () -displayMaybe' cb = maybe (cb $ T.unpack na) +displayMaybe_ :: MonadIO m => Callback -> (a -> m ()) -> Maybe a -> m () +displayMaybe_ cb = maybe (liftIO $ cb $ T.unpack na) -withDBusClientConnection :: SafeClient c => Callback -> (c -> IO ()) -> IO () -withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient +withDBusClientConnection + :: (SafeClient c) + => Callback + -> (c -> RIO SimpleApp ()) + -> IO () +withDBusClientConnection cb f = do + -- TODO be more sophisticated + runSimpleApp $ withDBusClient_ $ displayMaybe_ cb f . Just diff --git a/lib/Xmobar/Plugins/Device.hs b/lib/Xmobar/Plugins/Device.hs index 13abdb0..e16db36 100644 --- a/lib/Xmobar/Plugins/Device.hs +++ b/lib/Xmobar/Plugins/Device.hs @@ -11,14 +11,12 @@ module Xmobar.Plugins.Device , devDep ) where -import Control.Monad - import Data.Internal.DBus import Data.Internal.Dependency -import Data.Word import DBus +import RIO import qualified RIO.Text as T import XMonad.Internal.Command.Desktop @@ -64,9 +62,9 @@ matchStatus = matchPropertyChanged nmDeviceInterface devSignal instance Exec Device where alias (Device (iface, _, _)) = T.unpack iface start (Device (iface, text, colors)) cb = do - withDBusClientConnection cb $ \sys -> do + withDBusClientConnection cb $ \sys -> liftIO $ do path <- getDevice sys iface - displayMaybe' cb (listener sys) path + displayMaybe_ cb (listener sys) path where listener sys path = do rule <- matchPropertyFull sys networkManagerBus (Just path) diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs index e60a0fd..d9f35b3 100644 --- a/lib/Xmobar/Plugins/IntelBacklight.hs +++ b/lib/Xmobar/Plugins/IntelBacklight.hs @@ -14,7 +14,6 @@ module Xmobar.Plugins.IntelBacklight import qualified RIO.Text as T import Xmobar - import Xmobar.Plugins.BacklightCommon import XMonad.Internal.DBus.Brightness.IntelBacklight diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs index ef125cb..c511216 100644 --- a/lib/Xmobar/Plugins/Screensaver.hs +++ b/lib/Xmobar/Plugins/Screensaver.hs @@ -11,6 +11,7 @@ module Xmobar.Plugins.Screensaver , ssAlias ) where +import RIO import qualified RIO.Text as T import Xmobar @@ -26,9 +27,9 @@ ssAlias = "screensaver" instance Exec Screensaver where alias (Screensaver _) = T.unpack ssAlias start (Screensaver (text, colors)) cb = do - withDBusClientConnection cb $ \sys -> do - matchSignal display sys - display =<< callQuery sys + withDBusClientConnection cb $ \sys -> liftIO $ do + matchSignal dpy sys + dpy =<< callQuery sys where - display = displayMaybe cb $ return . (\s -> colorText colors s text) + dpy = displayMaybe cb $ return . (\s -> colorText colors s text) diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs index 625abf8..c617d68 100644 --- a/lib/Xmobar/Plugins/VPN.hs +++ b/lib/Xmobar/Plugins/VPN.hs @@ -13,17 +13,15 @@ module Xmobar.Plugins.VPN , vpnDep ) where -import Control.Concurrent.MVar -import Control.Monad import Data.Internal.DBus import Data.Internal.Dependency -import qualified Data.Map as M -import Data.Maybe -import qualified Data.Set as S import DBus +import RIO +import qualified RIO.Map as M +import qualified RIO.Set as S import qualified RIO.Text as T import XMonad.Internal.Command.Desktop @@ -38,11 +36,11 @@ instance Exec VPN where start (VPN (text, colors)) cb = withDBusClientConnection cb $ \c -> do state <- initState c - let display = displayMaybe cb iconFormatter . Just =<< readState state - let signalCallback' f = f state display + let dpy = displayMaybe cb iconFormatter . Just =<< readState state + let signalCallback' f = f state dpy vpnAddedListener (signalCallback' addedCallback) c vpnRemovedListener (signalCallback' removedCallback) c - display + liftIO dpy where iconFormatter b = return $ colorText colors b text @@ -57,7 +55,7 @@ type VPNState = S.Set ObjectPath type MutableVPNState = MVar VPNState -initState :: SysClient -> IO MutableVPNState +initState :: MonadIO m => SysClient -> m MutableVPNState initState client = do ot <- getVPNObjectTree client newMVar $ findTunnels ot @@ -65,28 +63,28 @@ initState client = do readState :: MutableVPNState -> IO Bool readState = fmap (not . null) . readMVar -updateState :: (ObjectPath -> VPNState -> VPNState) -> MutableVPNState - -> ObjectPath -> IO () +updateState :: MonadUnliftIO m => (ObjectPath -> VPNState -> VPNState) -> MutableVPNState + -> ObjectPath -> m () updateState f state op = modifyMVar_ state $ return . f op -------------------------------------------------------------------------------- -- | Tunnel Device Detection -- -getVPNObjectTree :: SysClient -> IO ObjectTree +getVPNObjectTree :: MonadIO m => SysClient -> m ObjectTree getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath findTunnels :: ObjectTree -> VPNState findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys) -vpnAddedListener :: SignalCallback -> SysClient -> IO () +vpnAddedListener :: MonadIO m => SignalCallback -> SysClient -> m () vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb -vpnRemovedListener :: SignalCallback -> SysClient -> IO () +vpnRemovedListener :: MonadIO m => SignalCallback -> SysClient -> m () vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb addedCallback :: MutableVPNState -> IO () -> SignalCallback -addedCallback state display [device, added] = update >> display +addedCallback state dpy [device, added] = update >> dpy where added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant)) is = M.keys $ fromMaybe M.empty added' @@ -94,7 +92,7 @@ addedCallback state display [device, added] = update >> display addedCallback _ _ _ = return () removedCallback :: MutableVPNState -> IO () -> SignalCallback -removedCallback state display [device, interfaces] = update >> display +removedCallback state dpy [device, interfaces] = update >> dpy where is = fromMaybe [] $ fromVariant interfaces :: [T.Text] update = updateDevice S.delete state device is