module XMonad.Util.SpawnNamedPipe (
spawnNamedPipe
, getNamedPipe
) where
import XMonad
import XMonad.Util.Run
import System.IO
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Prelude
import qualified Data.Map as Map
newtype NamedPipes = NamedPipes { NamedPipes -> Map String Handle
pipeMap :: Map.Map String Handle }
deriving (Int -> NamedPipes -> ShowS
[NamedPipes] -> ShowS
NamedPipes -> String
(Int -> NamedPipes -> ShowS)
-> (NamedPipes -> String)
-> ([NamedPipes] -> ShowS)
-> Show NamedPipes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedPipes -> ShowS
showsPrec :: Int -> NamedPipes -> ShowS
$cshow :: NamedPipes -> String
show :: NamedPipes -> String
$cshowList :: [NamedPipes] -> ShowS
showList :: [NamedPipes] -> ShowS
Show)
instance ExtensionClass NamedPipes where
initialValue :: NamedPipes
initialValue = Map String Handle -> NamedPipes
NamedPipes Map String Handle
forall k a. Map k a
Map.empty
spawnNamedPipe :: String -> String -> X ()
spawnNamedPipe :: String -> String -> X ()
spawnNamedPipe String
cmd String
name = do
b <- (NamedPipes -> Bool) -> X Bool
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets (String -> Map String Handle -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member String
name (Map String Handle -> Bool)
-> (NamedPipes -> Map String Handle) -> NamedPipes -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedPipes -> Map String Handle
pipeMap)
unless b $ do
h <- spawnPipe cmd
XS.modify (NamedPipes . Map.insert name h . pipeMap)
getNamedPipe :: String -> X (Maybe Handle)
getNamedPipe :: String -> X (Maybe Handle)
getNamedPipe String
name = (NamedPipes -> Maybe Handle) -> X (Maybe Handle)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets (String -> Map String Handle -> Maybe Handle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name (Map String Handle -> Maybe Handle)
-> (NamedPipes -> Map String Handle) -> NamedPipes -> Maybe Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedPipes -> Map String Handle
pipeMap)