REF rename a bunch of stuff
This commit is contained in:
parent
17ebd0137f
commit
1b4480ac3a
|
@ -12,7 +12,7 @@
|
|||
module Main (main) where
|
||||
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import Options.Applicative
|
||||
import RIO hiding (hFlush)
|
||||
import qualified RIO.ByteString.Lazy as BL
|
||||
|
|
|
@ -10,7 +10,7 @@
|
|||
module Main (main) where
|
||||
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import Data.Monoid
|
||||
import Data.Text.IO (hPutStrLn)
|
||||
import Graphics.X11.Types
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
--------------------------------------------------------------------------------
|
||||
-- Functions for handling dependencies
|
||||
|
||||
module Data.Internal.Dependency
|
||||
module Data.Internal.XIO
|
||||
-- feature types
|
||||
( Feature
|
||||
, Always (..)
|
||||
|
@ -26,6 +26,7 @@ module Data.Internal.Dependency
|
|||
, SubfeatureRoot
|
||||
, Msg (..)
|
||||
-- configuration
|
||||
, XEnv (..)
|
||||
, XParams (..)
|
||||
, XPFeatures (..)
|
||||
, XPQuery
|
||||
|
@ -134,7 +135,7 @@ runXIO x = do
|
|||
pc <- mkDefaultProcessContext
|
||||
withLogFunc logOpts $ \f -> do
|
||||
p <- getParams
|
||||
let s = DepStage f pc p
|
||||
let s = XEnv f pc p
|
||||
runRIO s x
|
||||
|
||||
-- | Execute an Always immediately
|
||||
|
@ -377,19 +378,19 @@ data PostFail = PostFail [Msg] | PostMissing Msg
|
|||
--------------------------------------------------------------------------------
|
||||
-- Configuration
|
||||
|
||||
type XIO a = RIO DepStage a
|
||||
type XIO a = RIO XEnv a
|
||||
|
||||
data DepStage = DepStage
|
||||
{ dsLogFun :: !LogFunc
|
||||
, dsProcCxt :: !ProcessContext
|
||||
, dsParams :: !XParams
|
||||
data XEnv = XEnv
|
||||
{ xLogFun :: !LogFunc
|
||||
, xProcCxt :: !ProcessContext
|
||||
, xParams :: !XParams
|
||||
}
|
||||
|
||||
instance HasLogFunc DepStage where
|
||||
logFuncL = lens dsLogFun (\x y -> x {dsLogFun = y})
|
||||
instance HasLogFunc XEnv where
|
||||
logFuncL = lens xLogFun (\x y -> x {xLogFun = y})
|
||||
|
||||
instance HasProcessContext DepStage where
|
||||
processContextL = lens dsProcCxt (\x y -> x {dsProcCxt = y})
|
||||
instance HasProcessContext XEnv where
|
||||
processContextL = lens xProcCxt (\x y -> x {xProcCxt = y})
|
||||
|
||||
data XParams = XParams
|
||||
{ xpLogLevel :: LogLevel
|
||||
|
@ -510,7 +511,7 @@ infix 9 .:+
|
|||
|
||||
evalSometimesMsg :: Sometimes a -> XIO (Either [FMsg] (a, [FMsg]))
|
||||
evalSometimesMsg (Sometimes n u xs) = do
|
||||
r <- asks (u . xpFeatures . dsParams)
|
||||
r <- asks (u . xpFeatures . xParams)
|
||||
if not r
|
||||
then return $ Left [dis n]
|
||||
else do
|
|
@ -20,7 +20,7 @@ where
|
|||
|
||||
import DBus
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import Graphics.X11.Types
|
||||
import RIO.Directory
|
||||
( XdgDirectory (..)
|
||||
|
|
|
@ -41,7 +41,7 @@ where
|
|||
|
||||
import DBus
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO
|
||||
import RIO.Directory
|
||||
import RIO.FilePath
|
||||
|
|
|
@ -26,7 +26,7 @@ module XMonad.Internal.Command.Power
|
|||
)
|
||||
where
|
||||
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import Graphics.X11.Types
|
||||
import RIO
|
||||
import RIO.Directory
|
||||
|
|
|
@ -10,7 +10,7 @@ module XMonad.Internal.Concurrent.ACPIEvent
|
|||
)
|
||||
where
|
||||
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import Network.Socket
|
||||
import Network.Socket.ByteString
|
||||
import RIO
|
||||
|
|
|
@ -88,13 +88,14 @@ data DynWorkspace = DynWorkspace
|
|||
-- the same as that in XMonad itself (eg with Query types)
|
||||
-- type MatchTags = M.Map String String
|
||||
|
||||
data WConf = WConf
|
||||
{ display :: Display
|
||||
, dynWorkspaces :: [DynWorkspace]
|
||||
, curPIDs :: MVar (S.Set Pid)
|
||||
data WEnv = WEnv
|
||||
{ wDisplay :: !Display
|
||||
, wDynWorkspaces :: ![DynWorkspace]
|
||||
, wCurPIDs :: !(MVar (S.Set Pid))
|
||||
-- , wXEnv :: !XEnv
|
||||
}
|
||||
|
||||
type W a = RIO WConf ()
|
||||
type WIO a = RIO WEnv a
|
||||
|
||||
runWorkspaceMon :: [DynWorkspace] -> IO ()
|
||||
runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
|
||||
|
@ -107,19 +108,19 @@ runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
|
|||
where
|
||||
withEvents dpy e = do
|
||||
ps <- newMVar S.empty
|
||||
let c = WConf {display = dpy, dynWorkspaces = dws, curPIDs = ps}
|
||||
let c = WEnv {wDisplay = dpy, wDynWorkspaces = dws, wCurPIDs = ps}
|
||||
runRIO c $
|
||||
forever $
|
||||
handleEvent =<< io (nextEvent dpy e >> getEvent e)
|
||||
|
||||
handleEvent :: Event -> W ()
|
||||
handleEvent :: Event -> WIO ()
|
||||
|
||||
-- | assume this fires at least once when a new window is created (also could
|
||||
-- use CreateNotify but that is really noisy)
|
||||
handleEvent MapNotifyEvent {ev_window = w} = do
|
||||
dpy <- asks display
|
||||
dpy <- asks wDisplay
|
||||
hint <- io $ getClassHint dpy w
|
||||
dws <- asks dynWorkspaces
|
||||
dws <- asks wDynWorkspaces
|
||||
let tag =
|
||||
M.lookup (resClass hint) $
|
||||
M.fromList $
|
||||
|
@ -133,9 +134,9 @@ handleEvent MapNotifyEvent {ev_window = w} = do
|
|||
_ -> return ()
|
||||
handleEvent _ = return ()
|
||||
|
||||
withUniquePid :: Pid -> String -> W ()
|
||||
withUniquePid :: Pid -> String -> WIO ()
|
||||
withUniquePid pid tag = do
|
||||
ps <- asks curPIDs
|
||||
ps <- asks wCurPIDs
|
||||
pids <- readMVar ps
|
||||
io
|
||||
$ unless (pid `elem` pids)
|
||||
|
|
|
@ -11,7 +11,7 @@ module XMonad.Internal.Concurrent.VirtualBox
|
|||
)
|
||||
where
|
||||
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO hiding (try)
|
||||
import RIO.Directory
|
||||
import RIO.FilePath
|
||||
|
|
|
@ -15,7 +15,7 @@ where
|
|||
|
||||
import DBus
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO
|
||||
import RIO.FilePath
|
||||
import XMonad.Internal.DBus.Brightness.Common
|
||||
|
|
|
@ -18,7 +18,7 @@ import DBus
|
|||
import DBus.Client
|
||||
import qualified DBus.Introspection as I
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO
|
||||
import qualified RIO.Text as T
|
||||
import XMonad.Core (io)
|
||||
|
|
|
@ -15,7 +15,7 @@ where
|
|||
|
||||
import DBus
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO
|
||||
import RIO.FilePath
|
||||
import XMonad.Internal.DBus.Brightness.Common
|
||||
|
|
|
@ -27,7 +27,7 @@ where
|
|||
import DBus
|
||||
import DBus.Client
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO
|
||||
import qualified RIO.Text as T
|
||||
import XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
||||
|
|
|
@ -11,7 +11,7 @@ module XMonad.Internal.DBus.Removable (runRemovableMon) where
|
|||
import DBus
|
||||
import DBus.Client
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO
|
||||
import qualified RIO.Map as M
|
||||
import XMonad.Core (io)
|
||||
|
|
|
@ -16,7 +16,7 @@ import DBus
|
|||
import DBus.Client
|
||||
import qualified DBus.Introspection as I
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import Graphics.X11.XScreenSaver
|
||||
import RIO
|
||||
import XMonad.Internal.DBus.Common
|
||||
|
|
|
@ -42,7 +42,7 @@ where
|
|||
import DBus
|
||||
import DBus.Client
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO
|
||||
import RIO.FilePath
|
||||
import RIO.List
|
||||
|
|
|
@ -14,7 +14,7 @@ where
|
|||
|
||||
import DBus
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO
|
||||
import qualified RIO.Text as T
|
||||
import XMonad.Internal.Command.Desktop
|
||||
|
|
|
@ -16,7 +16,7 @@ where
|
|||
|
||||
import DBus
|
||||
import Data.Internal.DBus
|
||||
import Data.Internal.Dependency
|
||||
import Data.Internal.XIO
|
||||
import RIO
|
||||
import qualified RIO.Map as M
|
||||
import qualified RIO.Set as S
|
||||
|
|
Loading…
Reference in New Issue