Hi. Sorry for big delay, rewriting my previous solution takes a lot of time. On 2015年01月20日 23:14, Brandon Allbery wrote:
then there is no (Show a, Read a) constraint. It will come up only, when i mention PersistentExtension in one of case branches, but, on the other hand, may be i can avoid
That would be expected, I believe; if you mentioned it, it must apply to the whole instance, not just one case branch. But I'm not quite clear on what you are saying here.
I mean, that i already have contraint (ExtensionClass a) in e.g. instance (ExtensionClass a) => ExtensionClass (Maybe a) where initialValue = Nothing then if type a had Show and Read instances, then (Maybe a) will had them too and i may define 'extensionType = PersistentExtension' in (Maybe a) instance. If type a had no Show and Read instances, then i may only define (Maybe a) to be a StateExtension . Thus, theoretically, (ExtensionClass a) contraint is enough, and i want to express above condition on (Maybe a) extensionType value with only that contraint. I can't express it by pattern-matching on type a's StateExtension data contructor, because that will bring up (Show a, Read a) constraint on (Maybe a) instance. I.e. i, probably, can't do it with condition at data level. Then, may be, i can make a condition at type level somehow?
In particular, remember that the child process "closest" to xmonad in a spawnPipe is a shell, *not* the program you ran. And that shell has the same problem, so killing it will not kill the xmobar it starts!)
Yes, i've noticed that, and that's why i modify spawnPipe from XMonad.Util.Run to run specified process directly, not through the shell. But, perhaps, i also may add 'exec ' before command executed by shell too. On 2015年01月21日 01:17, Thomas Bach wrote:
I had kind of the same problem and went for the this option, i.e. defining a data type. But I implemented this via a pid file which gets saved on xmonad start up. This way these program can even survive a restart of the XServer properly.
Thanks for answer, i've tried to integrate your solution with my (below). But i don't understand, why may i need to know pid of processes after restarting X server? They all will die anyway, won't they?
However, I don't see the point in defining the data type to contain start/stop functions. These will be the same for most of the programs,
Not exactly. Let's consider three of them: xmobar, trayer and feh . For xmobar i need to create a pipe and save Handle in extensible state, so i can access it later from dynamicLogWithPP . For trayer i just need to start a program with arguments. And for feh i need to check existence of '~/.fehbg' file and evaluate its content through shell. If file does not exist, i need to use some fallback, like `xsetroot -grey`. Though, feh finishes right after setting background and is not very good exameple, still start/stop functions may not be the same: they may open pipes, check existence of different files, etc. - all that you usually do in shell scripts :) Your PidProg-s implement only "trayer" case. xmobar in your Config.hs started using `xmobar` function from XMonad.Hooks.DynamicLog , and, i guess, it restarts correctly with xmonad only, because you have StdinReader in template in your xmobarrc (in other words, your Config.hs has the same problem with xmobar, as i try to solve here, you just don't see it). However, it turns out, that your PidProg and my per-program newtype-s has one more difference: you have names for ProcessID-s (e.g. command record may be thought as such), but i have not. So, let's start from the beginning. I may just store all ProcessID-s in list - [ProcessID]. But then i don't even know which ProcessID belongs to which process. Then, i may add names for ProcessID-s, so i can distinguish them later - e.g. [(String, ProcessID)]. This is essentially your solution: pid file (and PidProg value) binds process name and pid together. But now all ProcessID-s have the same start/stop functions. Finally, i may store start/stop functions in data type as well, but such type can't have Show and Read instance, so it can't be stored in extensible state persistently with 'extensionType = PersistentExtension'. Then i may try to store in extensible state only ProcessID and name and find start/stop function for them using type-class . Moreover, i even does not need name - i can use Eq instance for this and compare any fields (not only e.g. command names) there. So, here is my rewritten implementation of that ideas:
{-# LANGUAGE FlexibleContexts , DeriveDataTypeable , GeneralizedNewtypeDeriving #-}
import Data.Monoid import XMonad import qualified XMonad.Util.ExtensibleState as XS import System.Posix.Process import System.IO import System.Posix.IO import System.Posix.Types import System.Posix.Signals import System.Directory import System.FilePath import Control.Exception import Control.Monad
spawnPipe' :: [String] -> X (Handle, ProcessID) spawnPipe' (x : xs) = io $ do (rd, wr) <- createPipe setFdOption wr CloseOnExec True h <- fdToHandle wr hSetBuffering h LineBuffering p <- xfork $ do _ <- dupTo rd stdInput --executeFile "/bin/sh" False ["-c", encodeString x] Nothing executeFile x True xs Nothing closeFd rd return (h, p)
spawnPID' :: MonadIO m => [String] -> m ProcessID spawnPID' (x : xs) = xfork $ executeFile x True xs Nothing
I've defined XmobarPID3 newtype allowing to launching several xmobar's
data XmobarPID3 = XmobarPID3 { xmobarPID :: First ProcessID , xmobarConf :: FilePath } deriving (Show, Read, Typeable) instance Eq XmobarPID3 where XmobarPID3 {xmobarConf = xcf} == XmobarPID3 {xmobarConf = ycf} | xcf == ycf = True | otherwise = False instance Monoid XmobarPID3 where mempty = XmobarPID3 { xmobarPID = First Nothing , xmobarConf = "" } x `mappend` y = XmobarPID3 { xmobarPID = xmobarPID x `mappend` xmobarPID y , xmobarConf = xmobarConf x }
newtype XmobarHandle = XmobarHandle (Maybe Handle) deriving (Typeable) instance ExtensionClass XmobarHandle where initialValue = XmobarHandle Nothing
and TrayerPID3 and FehPID3 designed for one program instance only (because all values of these types are equal):
newtype TrayerPID3 = TrayerPID3 {trayerPID :: First ProcessID} deriving (Show, Read, Typeable, Monoid) instance Eq TrayerPID3 where _ == _ = True
newtype FehPID3 = FehPID3 {fehPID :: First ProcessID} deriving (Show, Read, Typeable, Monoid) instance Eq FehPID3 where _ == _ = True
Then i define typeclass for start/stop interface (why there is Monoid constraint see runWith code below):
class (Eq a, Monoid a) => RestartClass3 a where getPidP3 :: a -> Maybe ProcessID setPidP3 :: Maybe ProcessID -> a -> a runP3 :: a -> X a -- restartP3' relies on PID 'Nothing' after killP3, because it then calls -- startP3' and it won't do anything, if PID will still exist. So, here i -- should either set it to Nothing, or wait until it really terminates. killP3 :: a -> X a killP3 x = io $ do whenJust (getPidP3 x) $ signalProcess sigTERM return (setPidP3 Nothing x)
defaultRunP3 :: RestartClass3 a => [String] -> a -> X a defaultRunP3 xs z = do p <- spawnPID' xs return (setPidP3 (Just p) z)
then i define instances for XmobarPID3 and FehPID3 with custom runP3 functions:
instance RestartClass3 XmobarPID3 where getPidP3 = getFirst . xmobarPID setPidP3 mp' x = x{xmobarPID = First mp'} runP3 x = do (h, p) <- spawnPipe' ["/usr/bin/xmobar", xmobarConf x] XS.put (XmobarHandle (Just h)) return (x{xmobarPID = First (Just p)})
instance RestartClass3 FehPID3 where getPidP3 = getFirst . fehPID setPidP3 mp' x = x{fehPID = First mp'} runP3 x = do h <- io $ getHomeDirectory let f = h ".fehbg" b <- io $ doesFileExist f p <- if b then do cmd <- io $ readFile f -- ~/.fehbg content written assuming evaluation by shell, -- but i still need real process's PID, so add 'exec' . spawnPID ("exec " ++ cmd) else spawnPID' ["xsetroot", "-grey"] return (x{fehPID = First (Just p)})
trayer will use default run/kill implementation:
instance RestartClass3 TrayerPID3 where getPidP3 = getFirst . trayerPID setPidP3 mp' x = x{trayerPID = First mp'} runP3 = defaultRunP3 [ "trayer" , "--edge", "top", "--align", "right" , "--SetDockType", "true", "--SetPartialStrut", "true" , "--expand", "true", "--width", "10" , "--transparent", "true" , "--tint", "0x191970" , "--height", "12" ]
The other deficiency of my previous implementation was that i may store only one program's info for each newtype (e.g. i may run only one xmobar, because i've used (Maybe XmobarPID) to store its pid). Now i'll switch to list instead of Maybe in extensible state. Also, i want to make 'respawn' record of PidProg implicit: if i call 'restart' i ever want to kill program and run again; if i just want to be sure, that program is running, i should call the 'start' instead.
instance (Show a, Read a, Typeable a) => ExtensionClass [a] where initialValue = [] extensionType = PersistentExtension
-- Similar to insertWith from Data.Map, but for lists. insertWith :: Eq a => (a -> a -> a) -> a -> [a] -> [a] insertWith f y [] = [y] insertWith f y (x : xs) | y == x = f y x : xs | otherwise = x : insertWith f y xs
-- Run function on matched PIDs with specific type. -- Argument's Eq instance is used to find value in extensible state -- to act upon. Also, argument is `mappend`-ed to found value, -- so i should pass mempty, if i want to just "match", and -- something different, if i want to "match and replace". runWith :: (Eq a, Monoid a, ExtensionClass [a]) => (a -> X a) -> a -> X () runWith f y = do xs <- XS.gets (insertWith mappend y) xs'' <- mapM (\x -> if y == x then f x else return x) xs XS.put xs''
-- Based on doesPidProgRun . refreshPid :: (MonadIO m, RestartClass3 a) => a -> m a refreshPid x = case (getPidP3 x) of Nothing -> return x Just p -> liftIO $ do either (const (setPidP3 Nothing x)) (const x) `fmap` (try $ getProcessPriority p :: IO (Either IOException Int))
-- Run, if program is not running or already dead, otherwise do nothing. -- Note, that this function work on argument, not on extensible state. startP3' :: RestartClass3 a => a -> X a startP3' x = do x' <- refreshPid x case (getPidP3 x') of Nothing -> runP3 x' Just _ -> return x'
-- Kill program and run again. Note, that it will run again only, -- if killP3 kills it properly: either sets pid to Nothing -- or waits until it dies. -- Note, that this function work on argument, not on extensible state. restartP3' :: RestartClass3 a => a -> X a restartP3' = startP3' <=< killP3 <=< refreshPid
-- Here are versions of start/restart working on extensible state. -- Usually, these should be used. startP3 :: (ExtensionClass [a], RestartClass3 a) => a -> X () startP3 = runWith startP3'
restartP3 :: (ExtensionClass [a], RestartClass3 a) => a -> X () restartP3 = runWith restartP3'
Finally, i may define some concerete examples:
xmobarTop :: XmobarPID3 xmobarTop = XmobarPID3 { xmobarPID = First Nothing , xmobarConf = "/home/sgf" ".xmobarrc" } xmobarBot :: XmobarPID3 xmobarBot = XmobarPID3 { xmobarPID = First Nothing , xmobarConf = "/home/sgf" ".xmobarrc2" } trayer :: TrayerPID3 trayer = TrayerPID3 {trayerPID = First Nothing}
feh :: FehPID3 feh = FehPID3 {fehPID = First Nothing}
restartXmobarTop :: X () restartXmobarTop = restartP3 xmobarTop startXmobarTop :: X () startXmobarTop = startP3 xmobarTop
restartXmobarBoth :: X () restartXmobarBoth = mapM_ restartP3 [xmobarTop, xmobarBot] startXmobarBoth :: X () startXmobarBoth = mapM_ startP3 [xmobarTop, xmobarBot]
restartAll :: X () restartAll = do startP3 feh restartP3 trayer mapM_ restartP3 [xmobarTop, xmobarBot] startAll :: X () startAll = do startP3 feh startP3 trayer mapM_ startP3 [xmobarTop, xmobarBot]
Usually, i should just use `restartAll` in startupHook .