ENH define deps in terms of 'features'
This commit is contained in:
parent
39ac50191b
commit
3c6dafe8bd
|
@ -232,7 +232,7 @@ dateCmd = CmdSpec
|
||||||
-- toJust :: a -> Bool -> Maybe a
|
-- toJust :: a -> Bool -> Maybe a
|
||||||
-- toJust x b = if b then Just x else Nothing
|
-- toJust x b = if b then Just x else Nothing
|
||||||
|
|
||||||
dbusDep :: Bool -> BusName -> ObjectPath -> InterfaceName -> DBusMember -> Dependency
|
dbusDep :: Bool -> BusName -> ObjectPath -> InterfaceName -> DBusMember -> Dependency a
|
||||||
dbusDep usesys bus obj iface mem =
|
dbusDep usesys bus obj iface mem =
|
||||||
Dependency { depRequired = True, depData = d }
|
Dependency { depRequired = True, depData = d }
|
||||||
where
|
where
|
||||||
|
|
|
@ -17,7 +17,7 @@ module XMonad.Internal.Command.Desktop
|
||||||
, runVolumeUp
|
, runVolumeUp
|
||||||
, runVolumeMute
|
, runVolumeMute
|
||||||
, runToggleBluetooth
|
, runToggleBluetooth
|
||||||
, runToggleDPMS
|
-- , runToggleDPMS
|
||||||
, runToggleEthernet
|
, runToggleEthernet
|
||||||
, runRestart
|
, runRestart
|
||||||
, runRecompile
|
, runRecompile
|
||||||
|
@ -44,7 +44,7 @@ import System.FilePath
|
||||||
|
|
||||||
import XMonad.Actions.Volume
|
import XMonad.Actions.Volume
|
||||||
import XMonad.Core hiding (spawn)
|
import XMonad.Core hiding (spawn)
|
||||||
import XMonad.Internal.DBus.Screensaver
|
-- import XMonad.Internal.DBus.Screensaver
|
||||||
import XMonad.Internal.Dependency
|
import XMonad.Internal.Dependency
|
||||||
import XMonad.Internal.Notify
|
import XMonad.Internal.Notify
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
|
@ -93,7 +93,11 @@ runTerm :: IO MaybeX
|
||||||
runTerm = spawnIfInstalled myTerm
|
runTerm = spawnIfInstalled myTerm
|
||||||
|
|
||||||
runTMux :: IO MaybeX
|
runTMux :: IO MaybeX
|
||||||
runTMux = runIfInstalled [exe myTerm, exe "tmux", exe "bash"] cmd
|
runTMux = evalFeature $ Feature
|
||||||
|
{ ftrAction = cmd
|
||||||
|
, ftrSilent = False
|
||||||
|
, ftrChildren = [exe myTerm, exe "tmux", exe "bash"]
|
||||||
|
}
|
||||||
where
|
where
|
||||||
cmd = spawn
|
cmd = spawn
|
||||||
$ "tmux has-session"
|
$ "tmux has-session"
|
||||||
|
@ -171,8 +175,8 @@ runToggleBluetooth = runIfInstalled [exe myBluetooth] $ spawn
|
||||||
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
|
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
|
||||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
||||||
|
|
||||||
runToggleDPMS :: X ()
|
-- runToggleDPMS :: IO MaybeX
|
||||||
runToggleDPMS = io $ void callToggle
|
-- runToggleDPMS = io <$> evalFeature callToggle
|
||||||
|
|
||||||
runToggleEthernet :: IO MaybeX
|
runToggleEthernet :: IO MaybeX
|
||||||
runToggleEthernet = runIfInstalled [exe "nmcli"] $ spawn
|
runToggleEthernet = runIfInstalled [exe "nmcli"] $ spawn
|
||||||
|
|
|
@ -32,7 +32,7 @@ memAdded = memberName_ "InterfacesAdded"
|
||||||
memRemoved :: MemberName
|
memRemoved :: MemberName
|
||||||
memRemoved = memberName_ "InterfacesRemoved"
|
memRemoved = memberName_ "InterfacesRemoved"
|
||||||
|
|
||||||
dbusDep :: MemberName -> Dependency
|
dbusDep :: MemberName -> Dependency (IO a)
|
||||||
dbusDep m = Dependency { depRequired = True, depData = d }
|
dbusDep m = Dependency { depRequired = True, depData = d }
|
||||||
where
|
where
|
||||||
d = DBusEndpoint
|
d = DBusEndpoint
|
||||||
|
@ -43,10 +43,10 @@ dbusDep m = Dependency { depRequired = True, depData = d }
|
||||||
, ddDbusMember = Signal_ m
|
, ddDbusMember = Signal_ m
|
||||||
}
|
}
|
||||||
|
|
||||||
addedDep :: Dependency
|
addedDep :: Dependency (IO a)
|
||||||
addedDep = dbusDep memAdded
|
addedDep = dbusDep memAdded
|
||||||
|
|
||||||
removedDep :: Dependency
|
removedDep :: Dependency (IO a)
|
||||||
removedDep = dbusDep memRemoved
|
removedDep = dbusDep memRemoved
|
||||||
|
|
||||||
driveInsertedSound :: FilePath
|
driveInsertedSound :: FilePath
|
||||||
|
|
|
@ -9,7 +9,7 @@ module XMonad.Internal.DBus.Brightness.Common
|
||||||
, matchSignal
|
, matchSignal
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (void, when)
|
import Control.Monad (void)
|
||||||
|
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int32)
|
||||||
|
|
||||||
|
@ -45,18 +45,22 @@ data BrightnessControls = BrightnessControls
|
||||||
, bctlDec :: MaybeExe (IO ())
|
, bctlDec :: MaybeExe (IO ())
|
||||||
}
|
}
|
||||||
|
|
||||||
exportBrightnessControls :: RealFrac b => [Dependency] -> BrightnessConfig a b
|
exportBrightnessControls :: RealFrac b => [Dependency (IO ())] -> BrightnessConfig a b
|
||||||
-> Client -> IO BrightnessControls
|
-> Client -> IO BrightnessControls
|
||||||
exportBrightnessControls deps bc client = do
|
exportBrightnessControls deps bc client =
|
||||||
(req, opt) <- checkInstalled deps
|
initControls client (brightnessExporter deps bc) controls
|
||||||
let callBacklight' = createInstalled req opt . callBacklight bc
|
where
|
||||||
when (null req) $
|
controls exporter = do
|
||||||
exportBrightnessControls' bc client
|
let callBacklight' = evalFeature . callBacklight bc exporter
|
||||||
|
mx <- callBacklight' memMax
|
||||||
|
mn <- callBacklight' memMin
|
||||||
|
ic <- callBacklight' memInc
|
||||||
|
dc <- callBacklight' memDec
|
||||||
return $ BrightnessControls
|
return $ BrightnessControls
|
||||||
{ bctlMax = callBacklight' memMax
|
{ bctlMax = mx
|
||||||
, bctlMin = callBacklight' memMin
|
, bctlMin = mn
|
||||||
, bctlInc = callBacklight' memInc
|
, bctlInc = ic
|
||||||
, bctlDec = callBacklight' memDec
|
, bctlDec = dc
|
||||||
}
|
}
|
||||||
|
|
||||||
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
||||||
|
@ -78,6 +82,30 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Internal DBus Crap
|
-- | Internal DBus Crap
|
||||||
|
|
||||||
|
-- exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
|
||||||
|
-- exportBrightnessControls' bc client = do
|
||||||
|
-- maxval <- bcGetMax bc -- assume the max value will never change
|
||||||
|
-- let autoMethod' m f = autoMethod m $ emitBrightness bc client =<< f bc maxval
|
||||||
|
-- let funget = bcGet bc
|
||||||
|
-- export client (bcPath bc) defaultInterface
|
||||||
|
-- { interfaceName = bcInterface bc
|
||||||
|
-- , interfaceMethods =
|
||||||
|
-- [ autoMethod' memMax bcMax
|
||||||
|
-- , autoMethod' memMin bcMin
|
||||||
|
-- , autoMethod' memInc bcInc
|
||||||
|
-- , autoMethod' memDec bcDec
|
||||||
|
-- , autoMethod memGet (round <$> funget maxval :: IO Int32)
|
||||||
|
-- ]
|
||||||
|
-- }
|
||||||
|
|
||||||
|
brightnessExporter :: RealFrac b => [Dependency (IO ())]
|
||||||
|
-> BrightnessConfig a b -> Client -> Feature (IO ()) (IO ())
|
||||||
|
brightnessExporter deps bc client = Feature
|
||||||
|
{ ftrAction = exportBrightnessControls' bc client
|
||||||
|
, ftrSilent = False
|
||||||
|
, ftrChildren = deps
|
||||||
|
}
|
||||||
|
|
||||||
exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
|
exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
|
||||||
exportBrightnessControls' bc client = do
|
exportBrightnessControls' bc client = do
|
||||||
maxval <- bcGetMax bc -- assume the max value will never change
|
maxval <- bcGetMax bc -- assume the max value will never change
|
||||||
|
@ -100,9 +128,18 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
|
||||||
where
|
where
|
||||||
sig = signal p i memCur
|
sig = signal p i memCur
|
||||||
|
|
||||||
callBacklight :: BrightnessConfig a b -> MemberName -> IO ()
|
-- callBacklight :: BrightnessConfig a b -> MemberName -> IO ()
|
||||||
callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
|
-- callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
|
||||||
void $ callMethod $ methodCall p i mem
|
-- void $ callMethod $ methodCall p i mem
|
||||||
|
|
||||||
|
callBacklight :: BrightnessConfig a b -> Feature (IO ()) (IO ()) -> MemberName
|
||||||
|
-> Feature (IO ()) (IO ())
|
||||||
|
callBacklight BrightnessConfig { bcPath = p, bcInterface = i } exporter mem =
|
||||||
|
Feature
|
||||||
|
{ ftrAction = void $ callMethod $ methodCall p i mem
|
||||||
|
, ftrSilent = False
|
||||||
|
, ftrChildren = [SubFeature exporter]
|
||||||
|
}
|
||||||
|
|
||||||
bodyGetBrightness :: Num a => [Variant] -> Maybe a
|
bodyGetBrightness :: Num a => [Variant] -> Maybe a
|
||||||
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
||||||
|
|
|
@ -113,10 +113,10 @@ intelBacklightConfig = BrightnessConfig
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Exported haskell API
|
-- | Exported haskell API
|
||||||
|
|
||||||
curFileDep :: Dependency
|
curFileDep :: Dependency (IO a)
|
||||||
curFileDep = pathRW curFile
|
curFileDep = pathRW curFile
|
||||||
|
|
||||||
maxFileDep :: Dependency
|
maxFileDep :: Dependency (IO a)
|
||||||
maxFileDep = pathR maxFile
|
maxFileDep = pathR maxFile
|
||||||
|
|
||||||
exportIntelBacklight :: Client -> IO BrightnessControls
|
exportIntelBacklight :: Client -> IO BrightnessControls
|
||||||
|
|
|
@ -6,11 +6,14 @@ module XMonad.Internal.DBus.Common
|
||||||
, callMethod'
|
, callMethod'
|
||||||
, addMatchCallback
|
, addMatchCallback
|
||||||
, xmonadBus
|
, xmonadBus
|
||||||
|
, initControls
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
|
import XMonad.Internal.Dependency
|
||||||
|
|
||||||
xmonadBus :: BusName
|
xmonadBus :: BusName
|
||||||
xmonadBus = busName_ "org.xmonad"
|
xmonadBus = busName_ "org.xmonad"
|
||||||
|
|
||||||
|
@ -36,3 +39,13 @@ addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
|
||||||
addMatchCallback rule cb = do
|
addMatchCallback rule cb = do
|
||||||
client <- connectSession
|
client <- connectSession
|
||||||
addMatch client rule $ cb . signalBody
|
addMatch client rule $ cb . signalBody
|
||||||
|
|
||||||
|
initControls :: Client -> (Client -> Feature (IO ()) (IO ()))
|
||||||
|
-> (Feature (IO ()) (IO ()) -> IO a) -> IO a
|
||||||
|
initControls client exporter controls = do
|
||||||
|
let x = exporter client
|
||||||
|
e <- evalFeature x
|
||||||
|
case e of
|
||||||
|
(Installed c _) -> c
|
||||||
|
_ -> return ()
|
||||||
|
controls x
|
||||||
|
|
|
@ -11,7 +11,7 @@ module XMonad.Internal.DBus.Screensaver
|
||||||
, SSControls(..)
|
, SSControls(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (void, when)
|
import Control.Monad (void)
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
@ -31,7 +31,7 @@ type SSState = Bool -- true is enabled
|
||||||
ssExecutable :: String
|
ssExecutable :: String
|
||||||
ssExecutable = "xset"
|
ssExecutable = "xset"
|
||||||
|
|
||||||
ssDep :: Dependency
|
ssDep :: Dependency (IO a)
|
||||||
ssDep = exe ssExecutable
|
ssDep = exe ssExecutable
|
||||||
|
|
||||||
toggle :: IO SSState
|
toggle :: IO SSState
|
||||||
|
@ -100,15 +100,20 @@ bodyGetCurrentState _ = Nothing
|
||||||
newtype SSControls = SSControls { ssToggle :: MaybeExe (IO ()) }
|
newtype SSControls = SSControls { ssToggle :: MaybeExe (IO ()) }
|
||||||
|
|
||||||
exportScreensaver :: Client -> IO SSControls
|
exportScreensaver :: Client -> IO SSControls
|
||||||
exportScreensaver client = do
|
exportScreensaver client = initControls client exportScreensaver' controls
|
||||||
(req, opt) <- checkInstalled [ssDep]
|
where
|
||||||
when (null req) $
|
controls exporter = do
|
||||||
exportScreensaver' client
|
t <- evalFeature $ callToggle exporter
|
||||||
return $ SSControls { ssToggle = createInstalled req opt callToggle }
|
return $ SSControls { ssToggle = t }
|
||||||
|
|
||||||
exportScreensaver' :: Client -> IO ()
|
exportScreensaver' :: Client -> Feature (IO ()) (IO ())
|
||||||
exportScreensaver' client = do
|
exportScreensaver' client = Feature
|
||||||
export client ssPath defaultInterface
|
{ ftrAction = cmd
|
||||||
|
, ftrSilent = False
|
||||||
|
, ftrChildren = [ssDep]
|
||||||
|
}
|
||||||
|
where
|
||||||
|
cmd = export client ssPath defaultInterface
|
||||||
{ interfaceName = interface
|
{ interfaceName = interface
|
||||||
, interfaceMethods =
|
, interfaceMethods =
|
||||||
[ autoMethod memToggle $ emitState client =<< toggle
|
[ autoMethod memToggle $ emitState client =<< toggle
|
||||||
|
@ -116,8 +121,14 @@ exportScreensaver' client = do
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
|
|
||||||
callToggle :: IO ()
|
callToggle :: Feature (IO ()) (IO ()) -> Feature (IO ()) (IO ())
|
||||||
callToggle = void $ callMethod $ methodCall ssPath interface memToggle
|
callToggle exporter = Feature
|
||||||
|
{ ftrAction = cmd
|
||||||
|
, ftrSilent = False
|
||||||
|
, ftrChildren = [SubFeature exporter]
|
||||||
|
}
|
||||||
|
where
|
||||||
|
cmd = void $ callMethod $ methodCall ssPath interface memToggle
|
||||||
|
|
||||||
callQuery :: IO (Maybe SSState)
|
callQuery :: IO (Maybe SSState)
|
||||||
callQuery = do
|
callQuery = do
|
||||||
|
|
|
@ -10,6 +10,8 @@ module XMonad.Internal.Dependency
|
||||||
, DependencyData(..)
|
, DependencyData(..)
|
||||||
, DBusMember(..)
|
, DBusMember(..)
|
||||||
, MaybeX
|
, MaybeX
|
||||||
|
, Feature(..)
|
||||||
|
, evalFeature
|
||||||
, exe
|
, exe
|
||||||
, systemUnit
|
, systemUnit
|
||||||
, userUnit
|
, userUnit
|
||||||
|
@ -80,43 +82,69 @@ data DependencyData = Executable String
|
||||||
| Systemd UnitType String
|
| Systemd UnitType String
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data Dependency = Dependency
|
-- data Dependency = Dependency
|
||||||
|
-- { depRequired :: Bool
|
||||||
|
-- , depData :: DependencyData
|
||||||
|
-- }
|
||||||
|
-- deriving (Eq, Show)
|
||||||
|
|
||||||
|
data Dependency a = SubFeature (Feature a a)
|
||||||
|
| Dependency
|
||||||
{ depRequired :: Bool
|
{ depRequired :: Bool
|
||||||
, depData :: DependencyData
|
, depData :: DependencyData
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
deriving (Eq, Show)
|
|
||||||
|
|
||||||
exe :: String -> Dependency
|
data Feature a b = Feature
|
||||||
|
{ ftrAction :: a
|
||||||
|
, ftrSilent :: Bool
|
||||||
|
, ftrChildren :: [Dependency b]
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
evalFeature :: Feature a b -> IO (MaybeExe a)
|
||||||
|
evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do
|
||||||
|
c' <- concat <$> mapM go c
|
||||||
|
return $ case foldl groupResult ([], []) c' of
|
||||||
|
([], opt) -> Installed a opt
|
||||||
|
(req, opt) -> if s then Ignore else Missing req opt
|
||||||
|
where
|
||||||
|
go (SubFeature Feature { ftrChildren = cs }) = concat <$> mapM go cs
|
||||||
|
go Dependency { depRequired = r, depData = d } = do
|
||||||
|
i <- depInstalled d
|
||||||
|
return [(r, d) | not i ]
|
||||||
|
groupResult (x, y) (True, z) = (z:x, y)
|
||||||
|
groupResult (x, y) (False, z) = (x, z:y)
|
||||||
|
|
||||||
|
exe :: String -> Dependency a
|
||||||
exe n = Dependency
|
exe n = Dependency
|
||||||
{ depRequired = True
|
{ depRequired = True
|
||||||
, depData = Executable n
|
, depData = Executable n
|
||||||
}
|
}
|
||||||
|
|
||||||
unit :: UnitType -> String -> Dependency
|
unit :: UnitType -> String -> Dependency a
|
||||||
unit t n = Dependency
|
unit t n = Dependency
|
||||||
{ depRequired = True
|
{ depRequired = True
|
||||||
, depData = Systemd t n
|
, depData = Systemd t n
|
||||||
}
|
}
|
||||||
|
|
||||||
path :: Bool -> Bool -> String -> Dependency
|
path :: Bool -> Bool -> String -> Dependency a
|
||||||
path r w n = Dependency
|
path r w n = Dependency
|
||||||
{ depRequired = True
|
{ depRequired = True
|
||||||
, depData = AccessiblePath n r w
|
, depData = AccessiblePath n r w
|
||||||
}
|
}
|
||||||
|
|
||||||
pathR :: String -> Dependency
|
pathR :: String -> Dependency a
|
||||||
pathR = path True False
|
pathR = path True False
|
||||||
|
|
||||||
pathW :: String -> Dependency
|
pathW :: String -> Dependency a
|
||||||
pathW = path False True
|
pathW = path False True
|
||||||
|
|
||||||
pathRW :: String -> Dependency
|
pathRW :: String -> Dependency a
|
||||||
pathRW = path True True
|
pathRW = path True True
|
||||||
|
|
||||||
systemUnit :: String -> Dependency
|
systemUnit :: String -> Dependency a
|
||||||
systemUnit = unit SystemUnit
|
systemUnit = unit SystemUnit
|
||||||
|
|
||||||
userUnit :: String -> Dependency
|
userUnit :: String -> Dependency a
|
||||||
userUnit = unit UserUnit
|
userUnit = unit UserUnit
|
||||||
|
|
||||||
-- TODO this is poorly named. This actually represents an action that has
|
-- TODO this is poorly named. This actually represents an action that has
|
||||||
|
@ -210,7 +238,7 @@ depInstalled DBusEndpoint { ddDbusBus = b
|
||||||
, ddDbusMember = m
|
, ddDbusMember = m
|
||||||
} = dbusInstalled b s o i m
|
} = dbusInstalled b s o i m
|
||||||
|
|
||||||
checkInstalled :: [Dependency] -> IO ([DependencyData], [DependencyData])
|
checkInstalled :: [Dependency a] -> IO ([DependencyData], [DependencyData])
|
||||||
checkInstalled = fmap go . filterMissing
|
checkInstalled = fmap go . filterMissing
|
||||||
where
|
where
|
||||||
go = join (***) (fmap depData) . partition depRequired
|
go = join (***) (fmap depData) . partition depRequired
|
||||||
|
@ -218,14 +246,16 @@ checkInstalled = fmap go . filterMissing
|
||||||
createInstalled :: [DependencyData] -> [DependencyData] -> a -> MaybeExe a
|
createInstalled :: [DependencyData] -> [DependencyData] -> a -> MaybeExe a
|
||||||
createInstalled req opt x = if null req then Installed x opt else Missing req opt
|
createInstalled req opt x = if null req then Installed x opt else Missing req opt
|
||||||
|
|
||||||
filterMissing :: [Dependency] -> IO [Dependency]
|
filterMissing :: [Dependency a] -> IO [Dependency a]
|
||||||
filterMissing = filterM (fmap not . depInstalled . depData)
|
filterMissing = filterM (fmap not . depInstalled . depData)
|
||||||
|
|
||||||
-- runIfInstalled :: MonadIO m => [Dependency] -> m a -> IO (MaybeExe (m a))
|
runIfInstalled :: [Dependency a] -> b -> IO (MaybeExe b)
|
||||||
runIfInstalled :: [Dependency] -> a -> IO (MaybeExe a)
|
runIfInstalled ds x = evalFeature $
|
||||||
runIfInstalled ds x = do
|
Feature
|
||||||
(req, opt) <- checkInstalled ds
|
{ ftrAction = x
|
||||||
return $ createInstalled req opt x
|
, ftrSilent = False
|
||||||
|
, ftrChildren = ds
|
||||||
|
}
|
||||||
|
|
||||||
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
|
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
|
||||||
spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
|
spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
|
||||||
|
|
Loading…
Reference in New Issue