diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs index 1c9761b..485ecd9 100644 --- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs +++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs @@ -9,18 +9,13 @@ module XMonad.Internal.Concurrent.ACPIEvent , runHandleACPI ) where -import Control.Exception -import Control.Monad - -import Data.ByteString hiding (readFile) -import Data.ByteString.Char8 as C hiding (readFile) -import Data.Connection import Data.Internal.Dependency -import Text.Read (readMaybe) +import Network.Socket +import Network.Socket.ByteString -import System.IO.Streams as S (read) -import System.IO.Streams.UnixSocket +import RIO +import qualified RIO.ByteString as B import XMonad.Core import XMonad.Internal.Command.Power @@ -64,7 +59,9 @@ parseLine line = (_:"LID":"close":_) -> Just LidClose _ -> Nothing where - splitLine = C.words . C.reverse . C.dropWhile (== '\n') . C.reverse + splitLine = B.split space . B.reverse . B.dropWhile (== newline) . B.reverse + newline = 10 + space = 32 -- | Send an ACPIEvent to the X server as a ClientMessage sendACPIEvent :: ACPIEvent -> IO () @@ -72,20 +69,18 @@ sendACPIEvent = sendXMsg ACPI . show . fromEnum isDischarging :: IO (Maybe Bool) isDischarging = do - status <- try $ readFile "/sys/class/power_supply/BAT0/status" - :: IO (Either IOException String) + status <- tryIO $ B.readFile "/sys/class/power_supply/BAT0/status" case status of Left _ -> return Nothing Right s -> return $ Just (s == "Discharging") listenACPI :: IO () listenACPI = do - Connection { source = s } <- connect acpiPath - forever $ readStream s - where - readStream s = do - out <- S.read s - mapM_ sendACPIEvent $ parseLine =<< out + sock <- socket AF_UNIX Stream defaultProtocol + connect sock $ SockAddrUnix acpiPath + forever $ do + out <- recv sock 1024 + mapM_ sendACPIEvent $ parseLine out acpiPath :: FilePath acpiPath = "/var/run/acpid.socket" diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs index f380b3e..d5ee052 100644 --- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs +++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs @@ -28,6 +28,9 @@ import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Display import Graphics.X11.Xlib.Event import Graphics.X11.Xlib.Extras +import Graphics.X11.Xlib.Types + +import RIO hiding (Display) -------------------------------------------------------------------------------- -- | Data structure for the ClientMessage @@ -58,13 +61,19 @@ splitXMsg :: (Integral a) => [a] -> (XMsgType, String) splitXMsg [] = (Unknown, "") splitXMsg (x:xs) = (xtype, tag) where - xtype = toEnum $ fromInteger $ toInteger x - tag = map (chr . fromInteger . toInteger) $ takeWhile (/= 0) xs + xtype = toEnum $ fromIntegral x + tag = chr . fromIntegral <$> takeWhile (/= 0) xs + +withOpenDisplay :: (Display -> IO a) -> IO a +withOpenDisplay = bracket (openDisplay "") cleanup + where + cleanup dpy = do + flush dpy + closeDisplay dpy -- | Emit a ClientMessage event to the X server with the given type and payloud sendXMsg :: XMsgType -> String -> IO () -sendXMsg xtype tag = do - dpy <- openDisplay "" +sendXMsg xtype tag = withOpenDisplay $ \dpy -> do root <- rootWindow dpy $ defaultScreen dpy allocaXEvent $ \e -> do setEventType e clientMessage @@ -84,8 +93,6 @@ sendXMsg xtype tag = do -- for more details. setClientMessageEvent' e root bITMAP 8 (x:t) sendEvent dpy root False substructureNotifyMask e - flush dpy - closeDisplay dpy where x = fromIntegral $ fromEnum xtype t = fmap (fromIntegral . fromEnum) tag diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs index 8cb33f9..b6e8a20 100644 --- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs +++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs @@ -41,11 +41,6 @@ import Data.Maybe import Control.Monad import Control.Monad.Reader -import RIO hiding - ( Display - , display - ) -import qualified RIO.Set as S import Graphics.X11.Types @@ -56,6 +51,12 @@ import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Misc import Graphics.X11.Xlib.Types +import RIO hiding + ( Display + , display + ) +import qualified RIO.Set as S + import XMonad.Actions.DynamicWorkspaces import XMonad.Core ( ManageHook @@ -103,11 +104,11 @@ data WConf = WConf type W a = RIO WConf () -withDisplay :: (Display -> IO a) -> IO a -withDisplay = bracket (openDisplay "") closeDisplay +withOpenDisplay :: (Display -> IO a) -> IO a +withOpenDisplay = bracket (openDisplay "") closeDisplay runWorkspaceMon :: [DynWorkspace] -> IO () -runWorkspaceMon dws = withDisplay $ \dpy -> do +runWorkspaceMon dws = withOpenDisplay $ \dpy -> do root <- rootWindow dpy $ defaultScreen dpy -- listen only for substructure change events (which includes MapNotify) allocaSetWindowAttributes $ \a -> do diff --git a/lib/XMonad/Internal/Concurrent/VirtualBox.hs b/lib/XMonad/Internal/Concurrent/VirtualBox.hs index dddfb72..7d1f857 100644 --- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs +++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs @@ -10,18 +10,15 @@ module XMonad.Internal.Concurrent.VirtualBox , qual ) where -import Control.Exception - 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 System.Directory - import XMonad.Internal.Shell vmExists :: T.Text -> IO (Maybe Msg) @@ -41,7 +38,7 @@ vmInstanceConfig vmName = do vmDirectory :: IO (Either String String) vmDirectory = do p <- vmConfig - (s :: Either IOException String) <- try $ readFile p + s <- tryIO $ readFile p return $ case s of (Left _) -> Left "could not read VirtualBox config file" (Right x) -> maybe (Left "Could not parse VirtualBox config file") Right diff --git a/package.yaml b/package.yaml index cbffa4e..3885185 100644 --- a/package.yaml +++ b/package.yaml @@ -42,6 +42,7 @@ dependencies: - lifted-base >= 0.2.3.12 - utf8-string >= 1.0.2 - typed-process >= 0.2.8.0 + - network >= 3.1.2.7 library: source-dirs: lib/