REF clean up concurrency libs

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           RIO
-import           System.IO.Streams.UnixSocket
+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"
+  status <- tryIO $ B.readFile "/sys/class/power_supply/BAT0/status"
-    :: IO (Either IOException String)
   case status of
     Left _  -> return Nothing
     Right s -> return $ Just (s == "Discharging")
 
 listenACPI :: IO ()
 listenACPI = do
-  Connection { source = s } <- connect acpiPath
+  sock <- socket AF_UNIX Stream defaultProtocol
-  forever $ readStream s
+  connect sock $ SockAddrUnix acpiPath
-  where
+  forever $ do
-    readStream s = do
+    out <- recv sock 1024
-      out <- S.read s
+    mapM_ sendACPIEvent $ parseLine out
-      mapM_ sendACPIEvent $ parseLine =<< out
 
 acpiPath :: FilePath
 acpiPath = "/var/run/acpid.socket"

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
+    xtype = toEnum $ fromIntegral x
-    tag = map (chr . fromInteger . toInteger) $ takeWhile (/= 0) xs
+    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
+sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
-  dpy <- openDisplay ""
   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

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
+withOpenDisplay :: (Display -> IO a) -> IO a
-withDisplay = bracket (openDisplay "") closeDisplay
+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

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

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/