REF clean up concurrency libs
This commit is contained in:
parent
e3e89c2754
commit
f5ee8882bc
|
@ -9,18 +9,13 @@ module XMonad.Internal.Concurrent.ACPIEvent
|
||||||
, runHandleACPI
|
, runHandleACPI
|
||||||
) where
|
) 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 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.Core
|
||||||
import XMonad.Internal.Command.Power
|
import XMonad.Internal.Command.Power
|
||||||
|
@ -64,7 +59,9 @@ parseLine line =
|
||||||
(_:"LID":"close":_) -> Just LidClose
|
(_:"LID":"close":_) -> Just LidClose
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
where
|
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
|
-- | Send an ACPIEvent to the X server as a ClientMessage
|
||||||
sendACPIEvent :: ACPIEvent -> IO ()
|
sendACPIEvent :: ACPIEvent -> IO ()
|
||||||
|
@ -72,20 +69,18 @@ sendACPIEvent = sendXMsg ACPI . show . fromEnum
|
||||||
|
|
||||||
isDischarging :: IO (Maybe Bool)
|
isDischarging :: IO (Maybe Bool)
|
||||||
isDischarging = do
|
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
|
case status of
|
||||||
Left _ -> return Nothing
|
Left _ -> return Nothing
|
||||||
Right s -> return $ Just (s == "Discharging")
|
Right s -> return $ Just (s == "Discharging")
|
||||||
|
|
||||||
listenACPI :: IO ()
|
listenACPI :: IO ()
|
||||||
listenACPI = do
|
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 :: FilePath
|
||||||
acpiPath = "/var/run/acpid.socket"
|
acpiPath = "/var/run/acpid.socket"
|
||||||
|
|
|
@ -28,6 +28,9 @@ import Graphics.X11.Xlib.Atom
|
||||||
import Graphics.X11.Xlib.Display
|
import Graphics.X11.Xlib.Display
|
||||||
import Graphics.X11.Xlib.Event
|
import Graphics.X11.Xlib.Event
|
||||||
import Graphics.X11.Xlib.Extras
|
import Graphics.X11.Xlib.Extras
|
||||||
|
import Graphics.X11.Xlib.Types
|
||||||
|
|
||||||
|
import RIO hiding (Display)
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Data structure for the ClientMessage
|
-- | Data structure for the ClientMessage
|
||||||
|
@ -58,13 +61,19 @@ splitXMsg :: (Integral a) => [a] -> (XMsgType, String)
|
||||||
splitXMsg [] = (Unknown, "")
|
splitXMsg [] = (Unknown, "")
|
||||||
splitXMsg (x:xs) = (xtype, tag)
|
splitXMsg (x:xs) = (xtype, tag)
|
||||||
where
|
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
|
-- | Emit a ClientMessage event to the X server with the given type and payloud
|
||||||
sendXMsg :: XMsgType -> String -> IO ()
|
sendXMsg :: XMsgType -> String -> IO ()
|
||||||
sendXMsg xtype tag = do
|
sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
|
||||||
dpy <- openDisplay ""
|
|
||||||
root <- rootWindow dpy $ defaultScreen dpy
|
root <- rootWindow dpy $ defaultScreen dpy
|
||||||
allocaXEvent $ \e -> do
|
allocaXEvent $ \e -> do
|
||||||
setEventType e clientMessage
|
setEventType e clientMessage
|
||||||
|
@ -84,8 +93,6 @@ sendXMsg xtype tag = do
|
||||||
-- for more details.
|
-- for more details.
|
||||||
setClientMessageEvent' e root bITMAP 8 (x:t)
|
setClientMessageEvent' e root bITMAP 8 (x:t)
|
||||||
sendEvent dpy root False substructureNotifyMask e
|
sendEvent dpy root False substructureNotifyMask e
|
||||||
flush dpy
|
|
||||||
closeDisplay dpy
|
|
||||||
where
|
where
|
||||||
x = fromIntegral $ fromEnum xtype
|
x = fromIntegral $ fromEnum xtype
|
||||||
t = fmap (fromIntegral . fromEnum) tag
|
t = fmap (fromIntegral . fromEnum) tag
|
||||||
|
|
|
@ -41,11 +41,6 @@ import Data.Maybe
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
|
||||||
import RIO hiding
|
|
||||||
( Display
|
|
||||||
, display
|
|
||||||
)
|
|
||||||
import qualified RIO.Set as S
|
|
||||||
|
|
||||||
import Graphics.X11.Types
|
import Graphics.X11.Types
|
||||||
|
|
||||||
|
@ -56,6 +51,12 @@ import Graphics.X11.Xlib.Extras
|
||||||
import Graphics.X11.Xlib.Misc
|
import Graphics.X11.Xlib.Misc
|
||||||
import Graphics.X11.Xlib.Types
|
import Graphics.X11.Xlib.Types
|
||||||
|
|
||||||
|
import RIO hiding
|
||||||
|
( Display
|
||||||
|
, display
|
||||||
|
)
|
||||||
|
import qualified RIO.Set as S
|
||||||
|
|
||||||
import XMonad.Actions.DynamicWorkspaces
|
import XMonad.Actions.DynamicWorkspaces
|
||||||
import XMonad.Core
|
import XMonad.Core
|
||||||
( ManageHook
|
( ManageHook
|
||||||
|
@ -103,11 +104,11 @@ data WConf = WConf
|
||||||
|
|
||||||
type W a = RIO 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 :: [DynWorkspace] -> IO ()
|
||||||
runWorkspaceMon dws = withDisplay $ \dpy -> do
|
runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
|
||||||
root <- rootWindow dpy $ defaultScreen dpy
|
root <- rootWindow dpy $ defaultScreen dpy
|
||||||
-- listen only for substructure change events (which includes MapNotify)
|
-- listen only for substructure change events (which includes MapNotify)
|
||||||
allocaSetWindowAttributes $ \a -> do
|
allocaSetWindowAttributes $ \a -> do
|
||||||
|
|
|
@ -10,18 +10,15 @@ module XMonad.Internal.Concurrent.VirtualBox
|
||||||
, qual
|
, qual
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception
|
|
||||||
|
|
||||||
import Data.Internal.Dependency
|
import Data.Internal.Dependency
|
||||||
|
|
||||||
import Text.XML.Light
|
import Text.XML.Light
|
||||||
|
|
||||||
import RIO hiding (try)
|
import RIO hiding (try)
|
||||||
|
import RIO.Directory
|
||||||
import RIO.FilePath
|
import RIO.FilePath
|
||||||
import qualified RIO.Text as T
|
import qualified RIO.Text as T
|
||||||
|
|
||||||
import System.Directory
|
|
||||||
|
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
|
|
||||||
vmExists :: T.Text -> IO (Maybe Msg)
|
vmExists :: T.Text -> IO (Maybe Msg)
|
||||||
|
@ -41,7 +38,7 @@ vmInstanceConfig vmName = do
|
||||||
vmDirectory :: IO (Either String String)
|
vmDirectory :: IO (Either String String)
|
||||||
vmDirectory = do
|
vmDirectory = do
|
||||||
p <- vmConfig
|
p <- vmConfig
|
||||||
(s :: Either IOException String) <- try $ readFile p
|
s <- tryIO $ readFile p
|
||||||
return $ case s of
|
return $ case s of
|
||||||
(Left _) -> Left "could not read VirtualBox config file"
|
(Left _) -> Left "could not read VirtualBox config file"
|
||||||
(Right x) -> maybe (Left "Could not parse VirtualBox config file") Right
|
(Right x) -> maybe (Left "Could not parse VirtualBox config file") Right
|
||||||
|
|
|
@ -42,6 +42,7 @@ dependencies:
|
||||||
- lifted-base >= 0.2.3.12
|
- lifted-base >= 0.2.3.12
|
||||||
- utf8-string >= 1.0.2
|
- utf8-string >= 1.0.2
|
||||||
- typed-process >= 0.2.8.0
|
- typed-process >= 0.2.8.0
|
||||||
|
- network >= 3.1.2.7
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: lib/
|
source-dirs: lib/
|
||||||
|
|
Loading…
Reference in New Issue